Successfully push proximity sensor parameters into data

src/Dodge/Data.hs

@@ -993,9 +993,9 @@ data Sensor = NoSensor
         }
   deriving (Eq,Ord)
 data ProximityRequirement
-    = HasHealth {_proxReqMinHealth :: Int}
+    = RequireHealth {_proxReqMinHealth :: Int}
-    | HasEquipment {_proxReqEquipment :: CombineType}
+    | RequireEquipment {_proxReqEquipment :: CombineType}
-    | HasBottom
+    | RequireImpossible
   deriving (Eq,Ord,Show)
 data CloseToggle = NotClose | IsClose
   deriving (Eq,Ord)

src/Dodge/Default.hs

@@ -337,6 +337,6 @@ defaultProximitySensor :: Sensor
 defaultProximitySensor = ProximitySensor
     { _proxStatus   = NotClose
     , _proxDist = 40
-    , _proxRequirement  = HasBottom
+    , _proxRequirement  = RequireImpossible
     , _sensToggle   = False
     }

src/Dodge/Placement/Instance/Analyser.hs

@@ -1,13 +1,11 @@
 module Dodge.Placement.Instance.Analyser 
     ( analyser
-    , testYouHave
-    , testYourHealth
     ) where
 --import Dodge.LevelGen.Data
 --import Dodge.PlacementSpot
 import Dodge.Data
 import Dodge.Base.You
---import Dodge.Default
+import Dodge.Default
 import Dodge.Terminal
 --import Dodge.Tree
 --import Dodge.RoomLink
@@ -41,31 +39,28 @@ import Data.Maybe
 --import System.Random
 
 analyser 
-    :: (Machine -> World -> World)
+    :: ProximityRequirement
     -> PlacementSpot
     -> PlacementSpot
     -> Placement
-analyser upf pslight psmc = extTrigLitPos pslight $ \tp ->
+analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
-    Just $ plSpot .~ psmc $ putTerminal' aquamarine tparams (termupdate tp)
+    Just $ plSpot .~ psmc $ putTerminal'' themachine tparams (linksensortotrigger tp)
   where
     tparams = basicTerminal & tmScrollCommands .:~ sensorCommand
-    termupdate tp _ mc = upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
+    linksensortotrigger tp _ mc 
+        = (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
+    themachine = defaultMachine & mcColor .~ aquamarine
+        & mcUpdate .~ mcProximitySensorUpdate
+        & mcDraw .~ terminalSPic
+        & mcHP .~ 100
+        & mcSensor .~ defaultProximitySensor {_proxRequirement = proxreq}
 
-mcProxTest :: Machine -> World -> Bool
+mcProximitySensorUpdate :: Machine -> World -> World
-mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
+mcProximitySensorUpdate mc w = case 
-    Just (HasHealth x) | distreq -> _crHP cr >= x
-    Just (HasEquipment ct) | distreq -> any (\itm -> _itType itm == ct) (_crInv cr)
-    _ -> False
-  where
-    cr = you w
-    distreq = maybe False (dist (_crPos cr) (_mcPos mc) < ) (mc ^? mcSensor . proxDist)
-
-analyserTest :: (World -> Bool) -> Machine -> World -> World
-analyserTest t mc w = case 
         (_proxStatus sens
         , _sensToggle sens
-        , t w 
+        , mcProxTest mc w 
-        , dist (_crPos ycr) (_mcPos mc) < 40) of
+        , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
     (_,True,_,_) -> w
     (_,False,True,True) -> w 
             & machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
@@ -80,8 +75,10 @@ analyserTest t mc w = case
     ycr = you w
     sens = _mcSensor mc
 
-testYouHave :: CombineType -> Machine -> World -> World
+mcProxTest :: Machine -> World -> Bool
-testYouHave ct = analyserTest (any (\itm -> _itType itm == ct) . _crInv . you )
+mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
-
+    Just (RequireHealth x)      -> _crHP cr >= x
-testYourHealth :: Int -> Machine -> World -> World
+    Just (RequireEquipment ct)  -> any (\itm -> _itType itm == ct) (_crInv cr)
-testYourHealth hp = analyserTest (\w -> _crHP (you w) >= hp)
+    _ -> False
+  where
+    cr = you w

src/Dodge/Placement/Instance/Terminal.hs

@@ -2,9 +2,11 @@
 module Dodge.Placement.Instance.Terminal 
     ( putTerminal
     , putTerminal'
+    , putTerminal''
     , simpleTermMessage
     , topFlushStrings
     , terminalColor
+    , terminalSPic
     ) where
 import Dodge.Data
 import Dodge.LevelGen.Data
@@ -18,6 +20,7 @@ import Geometry
 import ShapePicture
 import LensHelp
 import Shape
+import ShapePicture
 --import Sound.Data
 
 import Data.Maybe
@@ -30,7 +33,7 @@ putTerminal''
 putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) 
     $ \tmpl -> Just $ ps0PushPS (PutButton termButton)
     $ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10)
-        (mc & mcUpdate .~ machineAddSound fridgeHumS (mcf (fromJust $ _plMID btpl))
+        (mc & mcUpdate %~ (\fmu mc' -> (mcf (fromJust $ _plMID btpl) mc' . fmu mc'))
             & mcDeath %~ (\fd mc' -> mcKillTerm mc' . (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc')
         )       )
     $ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl) 
@@ -45,6 +48,8 @@ putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm)
         btid = fromJust (_plMID btpl)
         mcid = fromJust (_plMID mcpl)
 
+-- machineAddSound fridgeHumS 
+
 mcKillTerm :: Machine -> World -> World
 mcKillTerm mc w = fromMaybe w $ do
     tmid <- _mcTermMID mc
@@ -67,7 +72,7 @@ putTerminal :: Color -> Terminal -> Placement
 putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpdate $ const id)
   where
     mc = defaultMachine
-        { _mcDraw = noPic . terminalShape
+        { _mcDraw = terminalSPic
         , _mcHP = 100
         , _mcDeath = makeExplosionAt . _mcPos
         }
@@ -89,6 +94,10 @@ termButton = Button
 terminalColor :: Color
 terminalColor = dark magenta
 
+terminalSPic :: Machine -> SPic
+--terminalShape _ = upperPrismPoly 15 $ square 10
+terminalSPic = noPic . terminalShape
+
 terminalShape :: Machine -> Shape
 --terminalShape _ = upperPrismPoly 15 $ square 10
 terminalShape mc = colorSH col (prismPoly

src/Dodge/Room/LasTurret.hs

@@ -84,23 +84,20 @@ keyCardRoomRunPast keyid rmid = do
         ,TreeSubLabelling "keyCardRoomRunPast" Nothing)
 
 keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
-keyCardAnalyserByDoor keyid = analyserByDoor 
+keyCardAnalyserByDoor keyid = analyserByDoor (RequireEquipment (KEYCARD keyid))
-    (machineAddSound fridgeHumS $ testYouHave (KEYCARD keyid))
 
 healthAnalyserByDoor :: Int -> Room -> Room
-healthAnalyserByDoor = analyserByDoor 
+healthAnalyserByDoor = analyserByDoor (RequireHealth 1100)
-    (machineAddSound fridgeHumS $ testYourHealth 1100)
 
-analyserByDoor :: (Machine -> World -> World) -> Int -> Room -> Room
+analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
-analyserByDoor mcf outplid rm = rm 
+analyserByDoor proxreq outplid rm = rm 
     & rmPmnts .++~ 
         [ psPt atFstLnkOut $ PutShape $ colorSH yellow 
             $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
         ]
     & rmOutPmnt .~ 
         [OutPlacement 
-            (analyser
+            (analyser proxreq
-                mcf
                 (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
                 (atFstLnkOutShiftBy sensorshift)
             )