Proof of coloured lighting concept

src/Dodge/Creature/Inanimate.hs

@@ -30,6 +30,18 @@ import Data.Monoid
 defaultInanimate :: Creature
 defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
 
+colorLamp 
+    :: Point3   -- color of lamp
+    -> Float    -- height of lamp
+    -> Creature
+colorLamp col h = defaultInanimate
+    { _crUpdate = initialiseColorLamp col h
+    , _crHP = 100
+    , _crPict = picAtCrPosNoRot (lampPic h)
+    , _crRad = 3
+    , _crMass = 3
+    }
+
 lamp :: Float -> Creature
 lamp h = defaultInanimate
     { _crUpdate = initialiseLamp h
@@ -68,6 +80,13 @@ initialiseLamp h cr _ = ( Endo addLS , Just $ cr & crUpdate .~ updateLamp h i)
     addLS = over lightSources (IM.insert i (lightAt (V3 x y h) i))
     (V2 x y) = _crPos cr
 
+initialiseColorLamp :: Point3 -> Float -> CRUpdate
+initialiseColorLamp col h cr _ = ( Endo addLS , Just $ cr & crUpdate .~ updateLamp h i)
+  where
+    i = _crID cr
+    addLS = over lightSources (IM.insert i (colorLightAt col (V3 x y h) i))
+    (V2 x y) = _crPos cr
+
 updateLamp :: Float -> Int -> CRUpdate
 updateLamp h i = unrandUpdate handleLS internalUpdate
   where