Implement basic laser sensor

src/Dodge/Data.hs

@@ -561,6 +561,7 @@ data Machine = Machine
     , _mcHP      :: Int
     , _mcSensor  :: Int
     , _mcDamage  :: [DamageType]
+    , _mcLSs     :: [Int]
     }
 data Door = Door
     { _drID :: Int

src/Dodge/Default.hs

@@ -221,6 +221,7 @@ defaultMachine = Machine
     , _mcHP = 1000
     , _mcSensor = 0
     , _mcDamage = []
+    , _mcLSs = []
     }
 defaultMachineUpdate :: Machine -> World -> World
 defaultMachineUpdate mc
@@ -270,6 +271,20 @@ defaultPP = PressPlate
     , _ppID = -1
     , _ppText = "Pressure plate"
     }
+defaultLS :: LightSource
+defaultLS = LS
+    { _lsID = 0
+    , _lsPos = 0
+    , _lsDir = 0
+    , _lsRad = 4
+    , _lsIntensity = 0.5
+    , _lsPict = defLSPic 
+    }
+defLSPic :: LightSource -> Picture
+defLSPic ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 4
+  where
+    col = V4 r g b 2
+    V3 r g b = _lsIntensity ls
 defaultTLS :: TempLightSource
 defaultTLS = TLS
     { _tlsPos = 0

src/Dodge/LevelGen.hs

@@ -196,7 +196,7 @@ placeMachine color wallpoly mc p rot w = (mcid
   where 
     mcid = IM.newKey $ _machines w
     wlid = IM.newKey $ _walls w
-    wlids = IS.fromList [wlid .. wlid + length wallpoly]
+    wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
     addMc mcs = IM.insert mcid (mc {_mcPos = p,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids}) mcs
 -- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
 placeMachineWalls :: Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall

src/Dodge/LightSources/Lamp.hs

@@ -12,10 +12,10 @@ module Dodge.LightSources.Lamp
     where
 import Dodge.Data
 import Geometry.Data
-import Picture
 import ShapePicture
 import Shape
 import Geometry
+import Dodge.Default
 
 import Control.Lens
 
@@ -26,13 +26,8 @@ colorLightAt col pos i =
        ,_lsDir = 0
        ,_lsRad = 700
        ,_lsIntensity = col
-       ,_lsPict = lightSourcePicture
+       ,_lsPict = defLSPic
        }
-lightSourcePicture :: LightSource -> Picture
-lightSourcePicture ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 4
-  where
-    col = V4 r g b 2
-    V3 r g b = _lsIntensity ls
 
 lightAt :: Point3 -> Int -> LightSource
 lightAt = colorLightAt 0.75

src/Dodge/Machine/Sensor.hs

@@ -5,17 +5,46 @@ import Color
 import Dodge.Data
 import Dodge.LevelGen.Data
 import Dodge.Default
+import Dodge.Data.DamageType
 import Geometry
 import ShapePicture
 import Shape
 
-lightSensor :: PSType
-lightSensor = PutMachine blue (reverse $ square wdth) defaultMachine
-    { _mcDraw = const lightSensorSPic 
-    }
+import Control.Lens
 
-lightSensorSPic :: SPic
-lightSensorSPic = ( colorSH blue $ upperPrismPoly 25 (square wdth)
+lightSensor :: Point2 -> Float -> Placement
+lightSensor p r = Placement (PS p r $ PutLS theLS)
+    $ \lsid -> jsps p r $ PutMachine blue (reverse $ square wdth) defaultMachine
+        { _mcDraw = lightSensorSPic 
+        , _mcUpdate = lightSensorUpdate
+        , _mcLSs = [lsid]
+        }
+  where
+    theLS = defaultLS
+        { _lsPos = V3 0 0 30
+        , _lsIntensity = 0.1
+        }
+
+lightSensorUpdate :: Machine -> World -> World
+lightSensorUpdate mc w = w & machines . ix mcid %~ upmc
+    & lightSources . ix lsid %~ upls
+  where
+    upmc = ( mcSensor %~ \x' -> min 750 (max 0 (x' - 5 + newSense)) )
+        . (mcDamage .~ [])
+    x = _mcSensor mc
+    mcid = _mcID mc
+    lsid = head (_mcLSs mc)
+    newSense = sum . map _dmAmount $ filter isLasering $ _mcDamage mc
+    ni = fromIntegral x / 500
+    upls = lsIntensity .~ V3 ni ni ni
+
+isLasering Lasering {} = True
+isLasering _ = False
+isElectrical Electrical {} = True
+isElectrical _ = False
+
+lightSensorSPic :: Machine -> SPic
+lightSensorSPic mc = ( colorSH blue $ upperPrismPoly 25 (square wdth)
     , mempty )
 
 wdth :: Float

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -120,12 +120,10 @@ bulIncCr' bt p cr w
     incFlamelets = over worldEvents $ (.) (makeFlameletTimed p 20 v Nothing 3 20)
 {- | Creates a shockwave when hitting a creature.  -}
 bulConCr :: Particle -> Point2 -> Creature -> World -> World
-bulConCr bt p cr w 
-    = over (creatures . ix cid . crState . crDamage)
-           ( Blunt 10 sp p ep : )
-    $ bulletHitSound p
-    $ (worldEvents %~ (makeShockwaveAt [] p 15 4 1 white . ))
-    w
+bulConCr bt p cr
+    = over (creatures . ix cid . crState . crDamage) (Blunt 10 sp p ep :)
+    . over worldEvents (makeShockwaveAt [] p 15 4 1 white .)
+    . bulletHitSound p
   where   
     cid = _crID cr
     sp = head $ _btTrail' bt

src/Dodge/Room/Start.hs

@@ -37,7 +37,7 @@ startRoom = do
             , tankSquareEmboss4 (dim orange) 50 (h-60)
             , tankSquare (dim orange) 50 50
             , tankSquare (dim orange) 50 120
-            , sPS (V2 (0.8*w) (0.25*h)) 0 lightSensor
+            , lightSensor (V2 (0.8*w) (0.25*h)) 0
             , sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
             ]
             )