Add light fittings

This commit is contained in:
2021-09-29 19:07:02 +01:00
parent f3437adef7
commit d7f975d40e
10 changed files with 252 additions and 192 deletions
+1 -1
View File
@@ -4,7 +4,7 @@ import Dodge.Room.Data
import Dodge.Room.Foreground
import Dodge.Default.Room
import Dodge.LevelGen.Data
import Dodge.LightSources
import Dodge.LightSources.Lamp
import Geometry
import Tile
+3 -3
View File
@@ -15,7 +15,7 @@ import Dodge.LevelGen.Switch
import Dodge.RandomHelp
import Dodge.Creature.Inanimate
import Dodge.Creature
import Dodge.LightSources
import Dodge.LightSources.Lamp
import Picture
import Geometry
@@ -56,9 +56,9 @@ twinSlowDoorRoom drid w h x = defaultRoom
, _rmName = "twinSlowDoorRoom"
}
where
addColorChange lsid drid = over pjUpdate $ chain $ const f
addColorChange lsid drid' = over pjUpdate $ chain $ const f
where
f w' | _drStatus (_doors w' IM.! drid) == DoorHalfway
f w' | _drStatus (_doors w' IM.! drid') == DoorHalfway
= w' & lightSources . ix lsid . lsIntensity .~ V3 8 0 0
| otherwise = w' & lightSources . ix lsid . lsIntensity .~ 0.7
drmoving i w' = DoorHalfway == _drStatus (_doors w' IM.! i)
+6 -11
View File
@@ -4,11 +4,11 @@ import Dodge.Room.Data
import Dodge.Room.Door
import Dodge.Room.Link
import Dodge.Room.Procedural
import Dodge.Room.Placement
--import Dodge.Room.Placement
import Dodge.Room.Foreground
import Dodge.Layout.Tree.Polymorphic
import Dodge.LevelGen.Data
--import Dodge.LightSources
import Dodge.LightSources.Fitting
--import Picture
import Geometry.Data
@@ -25,18 +25,13 @@ startRoom = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
let fground = sPS (V2 0 0) 0 $ PutForeground $
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)
girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
-- <> highPipe 40 (V2 0 (h/2)) (V2 w (h/2))
-- <> highPipe 60 (V2 (w/3) 0 ) (V2 (w/3) h )
treeFromPost [Left rezBox, Left door] . Right
<$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0)
$ 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
, wallMountA (V2 0 (h/3)) (V3 40 (h/3) 70)
]
)
where
--lampHeight = 41