Cleanup: broken pathfinding

src/Dodge/Placement/Instance/Sensor.hs

@@ -0,0 +1,54 @@
+module Dodge.Placement.Instance.Sensor
+    ( lightSensor
+    ) where
+import Color
+import Dodge.Data
+import Dodge.LevelGen.Data
+import Dodge.Default
+import Geometry
+import ShapePicture
+import Shape
+
+import Control.Lens
+import Data.Either
+
+damageSensor 
+    :: (DamageType -> Either Int Int) -- Left gets sensed, Right does damage
+    -> Point2 -> Float -> Placement
+damageSensor damF p r = pContID (PS p r) ( PutLS theLS)
+    $ \lsid -> jsps p r $ PutMachine yellow (reverse $ square wdth) defaultMachine
+        { _mcDraw = sensorSPic 
+        , _mcUpdate = sensorUpdate damF
+        , _mcLSs = [lsid]
+        }
+  where
+    theLS = defaultLS { _lsPos = V3 0 0 30 , _lsIntensity = 0.1 }
+
+lightSensor :: Point2 -> Float -> Placement
+lightSensor = damageSensor senseLasering
+
+senseLasering :: DamageType -> Either Int Int
+senseLasering Lasering {_dmAmount = x} = Left x
+senseLasering _ = Right 0
+
+sensorUpdate :: (DamageType -> Either Int Int) -> Machine -> World -> World
+sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
+    & lightSources . ix lsid %~ upls
+  where
+    upmc = ( mcSensor %~ \x' -> min 750 (max 0 (x' - 5 + newSense)) )
+        . ( mcHP -~ sum dam )
+        . (mcDamage .~ [])
+    x = _mcSensor mc
+    mcid = _mcID mc
+    lsid = head (_mcLSs mc)
+    (senseData,dam) = partitionEithers $ map damF $ _mcDamage mc
+    newSense = sum senseData
+    ni = fromIntegral x / 500
+    upls = lsIntensity .~ V3 ni ni ni
+
+sensorSPic :: Machine -> SPic
+sensorSPic _ = ( colorSH yellow $ upperPrismPoly 25 (square wdth)
+    , mempty )
+
+wdth :: Float
+wdth = 10