Add laser central room, using new placement/roompos functionality

src/Dodge/Placement/Instance/Button.hs

@@ -12,6 +12,7 @@ import ShapePicture
 
 import Data.Maybe
 import Control.Lens
+import qualified Data.IntMap.Strict as IM
 
 triggerSwitchSPic :: (Button -> SPic) -> PlacementSpot -> Placement
 triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger (const False))
@@ -56,7 +57,9 @@ putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p')
     changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
     ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
 
-putLitButOnPos :: Color -> (RoomPos -> Maybe PlacementSpot) -> (Int -> Maybe Placement) -> Placement
+putLitButOnPos :: Color 
+    -> (RoomPos -> Maybe (PlacementSpot,RoomPos)) 
+    -> (Int -> Maybe Placement) -> Placement
 putLitButOnPos col f subpl 
     = plSpot .~ thePS $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
     $ \plmnt -> let lsid = fromJust $ _plMID plmnt
@@ -65,9 +68,29 @@ putLitButOnPos col f subpl
   where
     changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
     ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
-    thePS = PSLnk f (const id) Nothing
+    thePS = PSPos f (const id) Nothing
 
-putLitButOnPosExtTrig :: Color -> (RoomPos -> Maybe PlacementSpot) -> Placement
+-- creates a lit external trigger, passes the trigger placement forward
+extTrigLitPos :: PlacementSpot -> (Placement -> Maybe Placement) -> Placement
+extTrigLitPos ps f = psPtCont ps (PutTrigger (const False))
+    $ \tp -> Just $ pContID (ps' tp) (PutLS thels)
+    $ \lsid -> Just $ pContID (ps' tp) (PutMod $ themod lsid tp)
+    $ const (f tp)
+  where
+    ps' tp = _plSpot tp
+    themod lsid tp = ModIDID
+        {_mdID = 0
+        ,_mdExternalID1 = lsid
+        ,_mdExternalID2 = fromJust $ _plMID tp
+        ,_mdUpdate = \md w -> if (_triggers w IM.! _mdExternalID2 md) w
+            then w & lightSources . ix (_mdExternalID1 md) . lsIntensity .~ V3 0 0.5 0
+            else w & lightSources . ix (_mdExternalID1 md) . lsIntensity .~ V3 0.5 0 0
+        }
+    thels = defaultLS {_lsIntensity = V3 0.5 0 0, _lsPos = V3 0 0 78, _lsRad = 75}
+
+putLitButOnPosExtTrig :: Color 
+   -> (RoomPos -> Maybe (PlacementSpot,RoomPos)) 
+   -> Placement
 putLitButOnPosExtTrig col f 
     = psPtCont thePS (PutTrigger (const False))
     $ \tp -> Just $ plSpot .~ _plSpot tp $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
@@ -80,4 +103,4 @@ putLitButOnPosExtTrig col f
     oneff tid = triggers . ix tid .~ const True
     changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
     ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
-    thePS = PSLnk f (const id) Nothing
+    thePS = PSPos f (const id) Nothing

src/Dodge/Placement/Instance/LightSource.hs

@@ -80,10 +80,12 @@ vShape wallpos (V3 x y z) =
 mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
 mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing)
 
-mntLSCond :: (Point2 -> Point3 -> Shape) -> (RoomPos -> Maybe PlacementSpot) -> Placement
+mntLSCond :: (Point2 -> Point3 -> Shape) 
+    -> (RoomPos -> Maybe (PlacementSpot,RoomPos)) 
+    -> Placement
 mntLSCond shp shift = -- updatePSToLevel 1 (const $ PSLnk shift (const id) Nothing) $ 
     mntLS shp 0 (V3 0 (-40) 90)
-    & plSpot .~ PSLnk shift (const id) Nothing
+    & plSpot .~ PSPos shift (const id) Nothing
     -- note that this perhaps pushes the vshape light out too far
 
 mntLight :: Point2 -> Point2 -> Placement
@@ -91,14 +93,15 @@ mntLight a b = RandomPlacement $ do
     shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
     return $ mntLS shp a (addZ 90 b)
 
-mntLightLnkCond :: (RoomPos -> Maybe PlacementSpot) -> Placement
+mntLightLnkCond :: (RoomPos -> Maybe (PlacementSpot,RoomPos)) 
+    -> Placement
 mntLightLnkCond f = RandomPlacement $ do
     shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
     return $ mntLSCond shp f
 
-unusedLnkToPS :: RoomPos -> Maybe PlacementSpot
+unusedLnkToPS :: RoomPos -> Maybe (PlacementSpot,RoomPos)
 unusedLnkToPS rp = case rp of
-    UnusedLink p a -> Just $ PS p a
+    UnusedLink p a -> Just (PS p a,PosPl p a)
     _ -> Nothing
 
 spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement

src/Dodge/Placement/Instance/Sensor.hs

@@ -14,17 +14,18 @@ import Data.Either
 
 damageSensor 
     :: (DamageType -> Either Int Int) -- Left gets sensed, Right does damage
+    -> (Machine -> World -> World)
     -> Point2 -> Float -> Placement
-damageSensor damF p r = pContID (PS p r) ( PutLS theLS)
+damageSensor damF upf p r = pContID (PS p r) ( PutLS theLS)
     $ \lsid -> jsps p r $ PutMachine yellow (reverse $ square wdth) defaultMachine
         { _mcDraw = sensorSPic 
-        , _mcUpdate = sensorUpdate damF
+        , _mcUpdate = \mc w -> upf mc $ sensorUpdate damF mc w
         , _mcLSs = [lsid]
         }
   where
     theLS = defaultLS { _lsPos = V3 0 0 30 , _lsIntensity = 0.1 }
 
-lightSensor :: Point2 -> Float -> Placement
+lightSensor :: (Machine -> World -> World) -> Point2 -> Float -> Placement
 lightSensor = damageSensor senseLasering
 
 senseLasering :: DamageType -> Either Int Int