Implement simple sweep light

This commit is contained in:
2021-09-26 23:38:32 +01:00
parent c0480f0ad6
commit d9ad55ec50
6 changed files with 66 additions and 5 deletions
+2 -2
View File
@@ -17,8 +17,8 @@ corridor = defaultRoom
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPS =
[ sPS (V2 20 40) 0 $ PutLS (lightAt (V3 0 0 50) 0) (lampPic 50)
, sPS (V2 0 0) 0 $ PutForeground $ highPipe 55 (V2 0 40) (V2 40 40)
[-- sPS (V2 20 40) 0 $ PutLS (lightAt (V3 0 0 50) 0) (lampPic 50)
sPS (V2 0 0) 0 $ PutForeground $ highPipe 55 (V2 0 40) (V2 40 40)
]
, _rmBound = [ rectNSWE 50 30 0 40 ]
, _rmFloor = [makeTileFromPoly poly 2]
+12 -3
View File
@@ -8,6 +8,7 @@ import Dodge.Room.Placement
import Dodge.Room.Foreground
import Dodge.Layout.Tree.Polymorphic
import Dodge.LevelGen.Data
import Dodge.LightSources
--import Picture
import Geometry.Data
@@ -24,13 +25,21 @@ startRoom = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
let fground = sPS (V2 0 0) 0 $ PutForeground $
girderV 50 20 10 (V2 0 (h/5)) (V2 w (h/5))
<> highPipe 40 (V2 0 (h/2)) (V2 w (h/3))
girderV 40 20 10 (V2 0 (h/6)) (V2 w (h/6))
<> highPipe 40 (V2 0 (h/2)) (V2 w (h/2))
<> highPipe 60 (V2 (w/3) 0 ) (V2 (w/3) h )
theLamp = sPS (V2 (w/2) (h/2)) 0 $ putColorLamp (V3 0.75 0.75 0.75)
treeFromPost [Left rezBox, Left door] . Right
<$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0)
$ roomRectAutoLinks w h & rmPS .~ [fground,theLamp])
$ roomRectAutoLinks w h & rmPS .~
[ fground
--, theLamp
, sPS (V2 100 100) 0 $ PutLS (colorLightAt (V3 0.75 0 0) (V3 0 0 lampHeight) 0) (lampPic lampHeight)
, sPS (V2 100 100) 0 $ PutProp $ lampCover lampHeight
]
)
where
lampHeight = 41
-- where
-- cola = dark . dark . light . light $ light red
-- colb = dark . dark . light . light $ light blue