Cleanup

src/Dodge/Creature/Lamp.hs

@@ -0,0 +1,68 @@
+module Dodge.Creature.Lamp 
+    ( lamp
+    , colorLamp
+    ) where
+import Dodge.Data
+import Dodge.Default
+import Dodge.Creature.Picture
+import Dodge.LightSource
+import Dodge.WorldEvent.Flash
+import Dodge.WorldEvent.Sound
+import Dodge.Creature.State
+import Geometry
+import Picture
+import Polyhedra
+import qualified IntMapHelp as IM
+import LensHelp
+
+colorLamp 
+    :: Point3   -- color of lamp
+    -> Float    -- height of lamp
+    -> Creature
+colorLamp col h = defaultInanimate
+    { _crUpdate = initialiseColorLamp col h
+    , _crHP = 100
+    , _crPict = picAtCrPosNoRot (lampCrPic h)
+    , _crRad = 3
+    , _crMass = 3
+    }
+
+lamp :: Float -> Creature
+lamp h = defaultInanimate
+    { _crUpdate = initialiseLamp h
+    , _crHP = 100
+    , _crPict = picAtCrPosNoRot (lampCrPic h)
+    , _crRad = 3
+    , _crMass = 3
+    }
+lampCrPic :: Float -> Picture
+lampCrPic h = pictures 
+    [ setLayer 1 (setDepth h . color white $ circleSolid 3)
+    , concatMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
+    ]
+  where
+    f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] 0 polyNum
+
+initialiseLamp :: Float -> Creature -> World -> World
+initialiseLamp = initialiseColorLamp 0.75
+
+initialiseColorLamp :: Point3 -> Float -> Creature -> World -> World
+initialiseColorLamp col h cr w = w
+    & lightSources . at lsid ?~ lsColPosID col (addZ h $ _crPos cr) lsid
+    & creatures . ix (_crID cr) . crUpdate .~ updateLamp h lsid 
+  where
+    lsid = IM.newKey $ _lightSources w
+
+updateLamp :: Float -> Int -> Creature -> World -> World
+updateLamp h i cr w 
+    | _crHP cr < 0 = w
+        & explosionFlashAt cpos 
+        & mkSoundBreakGlass cpos 
+        & lightSources . at i .~ Nothing
+        & creatures . at cid .~ Nothing
+    | otherwise = w 
+        & lightSources . ix i . lsParam . lsPos .~ addZ h cpos
+        & creatures . ix cid %~ doDamage
+  where
+    cpos = _crPos cr
+    cid  = _crID cr