Add lights to buttons, cleanup

This commit is contained in:
2021-11-02 19:38:22 +00:00
parent 9eda8c81a9
commit 59f43a3602
25 changed files with 356 additions and 349 deletions
+15 -15
View File
@@ -12,7 +12,7 @@ module Dodge.Room.Procedural
import Dodge.Data
import Dodge.Default.Wall
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Placements
import Dodge.Room.Link
import Dodge.Room.Path
import Dodge.Default.Room
@@ -24,7 +24,7 @@ import Dodge.Item.Weapon.Launcher
import Dodge.RandomHelp
import Dodge.LevelGen
import Dodge.LevelGen.Data
import Dodge.LightSources.Fitting
import Dodge.LevelGen.Switch
import Dodge.Creature
import Geometry
import Geometry.Vector3D
@@ -60,12 +60,12 @@ roomRect x y xn yn = defaultRoom
where
yd = (y - 40) / fromIntegral yn
xd = (x - 40) / fromIntegral xn
elnks = zip (translateS (V2 0 20) $ gridPoints 0 1 yd (yn+1)) (repeat ( pi/2))
wlnks = zip (translateS (V2 x 20) $ gridPoints 0 1 yd (yn+1)) (repeat (-pi/2))
nlnks = zip (translateS (V2 20 y) $ gridPoints xd (xn+1) 0 1 ) (repeat 0 )
slnks = zip (translateS (V2 20 0) $ gridPoints xd (xn+1) 0 1 ) (repeat pi )
elnks = zip (map (+.+ V2 0 20) $ gridPoints 0 1 yd (yn+1)) (repeat ( pi/2))
wlnks = zip (map (+.+ V2 x 20) $ gridPoints 0 1 yd (yn+1)) (repeat (-pi/2))
nlnks = zip (map (+.+ V2 20 y) $ gridPoints xd (xn+1) 0 1 ) (repeat 0 )
slnks = zip (map (+.+ V2 20 0) $ gridPoints xd (xn+1) 0 1 ) (repeat pi )
lnks = nlnks ++ elnks ++ wlnks ++ slnks
pth = linksAndPath lnks $ translateS (V2 20 20) (makeGrid xd xn yd yn)
pth = linksAndPath lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
{- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -}
roomRectAutoLinks :: Float -> Float -> Room
roomRectAutoLinks x y = roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60)
@@ -94,16 +94,16 @@ Add a light and a 'PutNothing' placement. -}
quarterRoomFlat :: RandomGen g => Float -> State g Room
quarterRoomFlat w = do
b <- takeOne
[ [ mountedLightV (V2 0 w) (V3 0 (w-20) 70)
, mountedLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
[ [ mountLightV (V2 0 w) (V3 0 (w-20) 70)
, mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
, sPS (V2 (w-20) (w-20)) pi PutNothing
, blockLine (V2 (w/2) (w/2)) (V2 (w/2) w)
]
, [ mountedLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
, [ mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
, sPS (V2 (w-20) (w-20)) pi PutNothing
, blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))
]
, [ mountedLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
, [ mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
, sPS (V2 (w-20) (w-20)) pi PutNothing
, blockLine (V2 (w/2) (w/2)) (V2 0 (w/2))
, blockLine (V2 (-29) w) (V2 0 (w/2))
@@ -127,17 +127,17 @@ quarterRoomFlat w = do
fourthCornerWall :: RandomGen g => Float -> State g Room
fourthCornerWall w = do
b <- takeOne
[ [ mountedLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
[ [ mountLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w)
, sPS (V2 20 (2*w-40)) pi PutNothing
]
, [ mountedLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
, [ mountLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 (negate w) w ) (V2 0 w)
, sPS (V2 20 (2*w-40)) pi PutNothing
]
, [ mountedLight (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20) (1.3*w-20) 70)
, [ mountLight (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20) (1.3*w-20) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 0 w) (V2 0 (w*2))
, sPS (V2 20 (2*w-40)) pi PutNothing
@@ -222,7 +222,7 @@ centerVaultRoom w h d = do
,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
,sps0 $ PutForeground $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h))
]
++ map (\a -> mountedLightV (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
++ map (\a -> mountLightV (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
[0,0.5*pi,pi,1.5*pi]
++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor)
[0,pi/2,pi,3*pi/2]