Move machine update into outside function

src/Dodge/Data.hs

@@ -1020,11 +1020,16 @@ data TerminalToggle = TerminalToggle
     { _ttTriggerID :: Int
     , _ttDeathEffect :: (World -> Bool) -> (World -> Bool)
     }
+--data DamageApplication
+--    = ApplyNoDamage
+--    | DefaultApplyDamage
+
 data Machine = Machine
     { _mcID     :: Int
     , _mcWallIDs    :: IS.IntSet
-    , _mcUpdate :: Machine -> World -> World
+--    , _mcUpdate :: Machine -> World -> World
     , _mcDraw   :: Machine -> SPic
+--    , _mcDamageApplication :: DamageApplication
     , _mcPos    :: Point2
     , _mcDir    :: Float
     , _mcColor  :: Color
@@ -1035,7 +1040,8 @@ data Machine = Machine
     , _mcType   :: MachineType
     , _mcMounts :: M.Map Object Int
     , _mcName   :: String
-    , _mcCloseSound :: Maybe SoundID
+--    , _mcTriggerCond :: Machine -> Bool
+    , _mcCloseSound  :: Maybe SoundID
 --    , _mcTermMID :: Maybe Int
     }
 data Sensor = NoSensor

src/Dodge/Data/Object.hs

@@ -10,4 +10,5 @@ data Object
     | ObForegroundShape
     | ObLightSource
     | ObProp
+    | ObTrigger
   deriving (Eq,Show,Ord,Read,Enum,Bounded)

src/Dodge/Default.hs

@@ -180,7 +180,7 @@ defaultMachine :: Machine
 defaultMachine = Machine
     { _mcID = 0
     , _mcWallIDs = mempty
-    , _mcUpdate = defaultMachineUpdate
+--    , _mcUpdate = defaultMachineUpdate
     , _mcDraw = const mempty
     , _mcColor = white
     , _mcPos = V2 0 0
@@ -193,6 +193,7 @@ defaultMachine = Machine
     , _mcName = ""
     , _mcMounts = mempty
     , _mcCloseSound = Nothing
+--    , _mcTriggerCond = const True
     }
 defaultMachineUpdate :: Machine -> World -> World
 defaultMachineUpdate mc

src/Dodge/Floor.hs

@@ -45,7 +45,7 @@ initialAnoTree = OnwardList
 --    , AnRoom $ tanksRoom [] []
 --    , AnRoom $ roomCCrits 0
 --    , AnRoom $ return airlock0
-    , AnRoom slowDoorRoom
+--    , AnRoom slowDoorRoom
 --    , AnRoom $ roomCCrits 10
 --    , AnTree firstBreather
 --    , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
@@ -55,10 +55,10 @@ initialAnoTree = OnwardList
 --extraAnoList =
 ----     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
 --    [ AnRoom $ roomCCrits 10
-    , AnRoom $ roomCCrits 10
+--    , AnRoom $ roomCCrits 10
-    , AnTree $ tToBTree "spawners" <$> spawnerRoom
+--    , AnTree $ tToBTree "spawners" <$> spawnerRoom
-    , AnRoom pistolerRoom
+--    , AnRoom pistolerRoom
-    , AnRoom doubleCorridorBarrels
+--    , AnRoom doubleCorridorBarrels
     , IntAnno $ PassthroughLockKeyLists
         [(sensorRoomRunPast ELECTRICAL, takeOne [CRAFT STATICMODULE,HELD SPARKGUN] )] itemRooms
     , IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms

src/Dodge/Item/Draw/SPic.hs

@@ -24,7 +24,7 @@ itemSPic it = foldMap (modulesSPic it) (_iyModules $ _itType it) $ case it ^. it
     KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic)
 --    
     MEDKIT _  -> defSPic
-    CRAFT _ -> defSPic
+    CRAFT _ -> flatShieldEquipSPic
 
 equipItemSPic :: EquipItemType -> Item -> SPic
 equipItemSPic et _ = case et of

src/Dodge/Machine/Update.hs

@@ -26,6 +26,7 @@ updateMachine mc
     | _mcHP mc < 1 = destroyMachine mc
     | otherwise = mcApplyDamage (_mcDamage mc) mc
         . mcPlaySound mc
+        . mcSensorTriggerUpdate mc
         . mcTurretUpdate mc
         . mcSensorUpdate mc
 
@@ -100,6 +101,19 @@ updateTurret rotSpeed mc w
         | closeFireAngle = machines . ix mcid . mcType . tuFireTime .~ 20
         | otherwise      = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
 
+mcSensorTriggerUpdate :: Machine -> World -> World
+mcSensorTriggerUpdate mc = fromMaybe id $ do
+    trid <- mc ^? mcMounts . ix ObTrigger
+    bval <- mcTriggerVal mc
+    return $ triggers . ix trid .~ const bval
+
+mcTriggerVal :: Machine -> Maybe Bool
+mcTriggerVal mc = case mc ^. mcSensor of
+    NoSensor -> Nothing
+    s@ProximitySensor{} -> s ^? sensToggle
+    s@SensorToggleAmount{} -> Just $ (_sensAmount s) > 900
+    
+
 mcPlaySound :: Machine -> World -> World
 mcPlaySound mc w = case _mcCloseSound mc of
     Just sid | d < 200 -> soundContinueVol (1-0.005*d) (MachineSound mid) (_mcPos mc) sid (Just 2) w
@@ -109,8 +123,10 @@ mcPlaySound mc w = case _mcCloseSound mc of
     mid = _mcID mc
 
 mcApplyDamage :: [Damage] -> Machine -> World -> World
-mcApplyDamage ds mc = machines . ix (_mcID mc) %~
+mcApplyDamage ds mc = case _mcSensor mc of
-    ( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) )
+    NoSensor -> machines . ix (_mcID mc) %~
+        ( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) )
+    _ -> id
 
 mcSensorUpdate :: Machine -> World -> World
 mcSensorUpdate mc w = case _mcSensor mc of

src/Dodge/Placement/Instance/Analyser.hs

@@ -4,7 +4,7 @@ module Dodge.Placement.Instance.Analyser
 --import Dodge.LevelGen.Data
 --import Dodge.PlacementSpot
 import Dodge.Data
-import Dodge.Base.You
+--import Dodge.Base.You
 import Dodge.Default
 import Dodge.Terminal
 --import Dodge.Tree
@@ -18,13 +18,13 @@ import Dodge.Terminal
 --import Dodge.Room.RoadBlock
 import Dodge.Placement.Instance
 --import Dodge.Placement.Shift
-import Dodge.SoundLogic
+--import Dodge.SoundLogic
 --import Dodge.Default.Room
 --import Dodge.Item.Weapon.BulletGuns
 --import Dodge.Item.Weapon.Utility
 --import Dodge.LevelGen.Data
 --import Geometry.Data
-import Geometry
+--import Geometry
 --import Padding
 import Color
 --import Shape
@@ -33,7 +33,7 @@ import LensHelp
 --import Dodge.RandomHelp
 
 --import qualified Data.Set as S
-import Data.Maybe
+--import Data.Maybe
 --import Data.Tree
 --import Control.Monad.State
 --import System.Random
@@ -44,41 +44,44 @@ analyser
     -> PlacementSpot
     -> Placement
 analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
-    Just $ plSpot .~ psmc $ putTerminal'' themachine tparams (linksensortotrigger tp)
+    Just $ plSpot .~ psmc $ putTerminal''
+        (themachine & mcMounts . at ObTrigger .~ _plMID tp)
+        tparams -- (linksensortotrigger tp)
   where
     tparams = basicTerminal & tmScrollCommands .:~ sensorCommand
-    linksensortotrigger tp _ mc 
+--    linksensortotrigger tp _ mc 
-        = triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)
+--        = triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)
     themachine = defaultMachine & mcColor .~ aquamarine
-        & mcUpdate .~ mcProximitySensorUpdate
+--        & mcUpdate .~ mcProximitySensorUpdate
         & mcDraw .~ terminalSPic
         & mcHP .~ 100
         & mcSensor .~ defaultProximitySensor {_proxRequirement = proxreq}
 
-mcProximitySensorUpdate :: Machine -> World -> World
+--this can probably be deleted
-mcProximitySensorUpdate mc w = case 
+--mcProximitySensorUpdate :: Machine -> World -> World
-        (_proxStatus sens
+--mcProximitySensorUpdate mc w = case 
-        , _sensToggle sens
+--        (_proxStatus sens
-        , mcProxTest mc w 
+--        , _sensToggle sens
-        , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
+--        , mcProxTest mc w 
-    (_,True,_,_) -> w
+--        , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
-    (_,False,True,True) -> w 
+--    (_,True,_,_) -> w
-            & machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
+--    (_,False,True,True) -> w 
-            & playsound dedaS
+--            & machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
-            & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
+--            & playsound dedaS
-    (NotClose,_,False,True) -> w & playsound dedumS
+--            & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
-            & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
+--    (NotClose,_,False,True) -> w & playsound dedumS
-    (_,_,_,False) -> w & machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
+--            & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
-    _ -> w
+--    (_,_,_,False) -> w & machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
- where
+--    _ -> w
-    playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
+-- where
-    ycr = you w
+--    playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
-    sens = _mcSensor mc
+--    ycr = you w
-
+--    sens = _mcSensor mc
-mcProxTest :: Machine -> World -> Bool
+--
-mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
+--mcProxTest :: Machine -> World -> Bool
-    Just (RequireHealth x)      -> _crHP cr >= x
+--mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
-    Just (RequireEquipment ct)  -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
+--    Just (RequireHealth x)      -> _crHP cr >= x
-    _ -> False
+--    Just (RequireEquipment ct)  -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
-  where
+--    _ -> False
-    cr = you w
+--  where
+--    cr = you w

src/Dodge/Placement/Instance/Sensor.hs

@@ -14,44 +14,52 @@ import Shape
 
 import qualified Data.Map.Strict as M
 import Control.Lens
-import Data.Either
+--import Data.Either
 
 damageSensor 
     :: DamageType -- Left gets sensed, Right does damage
     -> Float
-    -> (Machine -> World -> World)
+    -> Maybe Int
+--    -> (Machine -> World -> World)
     -> PlacementSpot -> Placement
-damageSensor dt wdth upf ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
+damageSensor dt wdth mtrid -- upf 
+    ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
     $ \lsid -> Just $ spNoID ps $ PutUsingGenParams 
-    $ \gw -> (,) gw $ PutMachine (reverse $ square wdth) (defaultMachine & mcColor .~ yellow)
+    $ \gw -> (,) gw $ PutMachine (reverse $ square wdth) 
+        (defaultMachine 
+            & mcColor .~ yellow
+            & mcMounts . at ObTrigger .~ mtrid
+            )
         { _mcDraw = sensorSPic wdth $ _sensorCoding (_genParams gw) M.! dt
-        , _mcUpdate = \mc -> upf mc . sensorUpdate dt mc
+--        , _mcUpdate = \mc -> upf mc . sensorUpdate dt mc
         , _mcSensor = SensorToggleAmount False 0
         , _mcLSs = [lsid]
         }
 
-lightSensor :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement
+lightSensor :: Float -- -> (Machine -> World -> World) 
+    -> Maybe Int
+    -> PlacementSpot -> Placement
 lightSensor = damageSensor LASERING
-
+--
-sensorUpdate :: DamageType -> Machine -> World -> World
+--sensorUpdate :: DamageType -> Machine -> World -> World
-sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
+--sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
-    & lightSources . ix lsid %~ upls
+--    & lightSources . ix lsid %~ upls
-  where
+--  where
-    upmc = ( mcSensor . sensAmount %~ \x' -> min 1000 (max 0 (x' - 5 + newSense)) )
+--    upmc = ( mcSensor . sensAmount %~ \x' -> min 1000 (max 0 (x' - 5 + newSense)) )
-        . ( mcHP -~ sum dam )
+--        . ( mcHP -~ sum dam )
-        . (mcDamage .~ [])
+--        . (mcDamage .~ [])
-    x = _sensAmount $ _mcSensor mc
+--    x = _sensAmount $ _mcSensor mc
-    mcid = _mcID mc
+--    mcid = _mcID mc
-    lsid = head (_mcLSs mc)
+--    lsid = head (_mcLSs mc)
-    (senseData,dam) = partitionEithers $ map (damageUsing damF) $ _mcDamage mc
+--    (senseData,dam) = partitionEithers $ map (damageUsing damF) $ _mcDamage mc
-    newSense = sum senseData
+--    newSense = sum senseData
-    ni = fromIntegral x / 1000
+--    ni = fromIntegral x / 1000
-    upls = lsParam . lsCol .~ V3 ni ni ni
+--    upls = lsParam . lsCol .~ V3 ni ni ni
-
+--
-damageUsing :: DamageType -> Damage -> Either Int Int
+--damageUsing :: DamageType -> Damage -> Either Int Int
-damageUsing dt dm
+--damageUsing dt dm
-    | _dmType dm == dt = Left $ _dmAmount dm
+--    | _dmType dm == dt = Left $ _dmAmount dm
-    | otherwise = Right 0
+--    | otherwise = Right 0
 
 sensorSPic :: Float -> (PaletteColor,DecorationShape) -> Machine -> SPic
 sensorSPic wdth (pc,ds) mc = noPic 

src/Dodge/Placement/Instance/Terminal.hs

@@ -10,7 +10,7 @@ module Dodge.Placement.Instance.Terminal
 import Dodge.Data
 import Dodge.LevelGen.Data
 import Dodge.Default
-import Dodge.Machine
+--import Dodge.Machine
 import Dodge.SoundLogic
 import Dodge.Terminal
 import Color
@@ -26,13 +26,15 @@ import Data.Maybe
 putTerminal''
     :: Machine
     -> Terminal
-    -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
+--    -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
     -> Placement
-putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) 
+putTerminal'' mc tm --mcf 
+    = ps0PushPS (PutTerminal tm) 
     $ \tmpl -> Just $ ps0PushPS (PutButton termButton)
     $ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10)
-        (mc & mcUpdate %~ (\fmu mc' -> mcf (fromJust $ _plMID btpl) mc' . fmu mc') . machineAddSound fridgeHumS
+        (mc -- & mcUpdate %~ (\fmu mc' -> mcf (fromJust $ _plMID btpl) mc' . fmu mc') . machineAddSound fridgeHumS
             & mcMounts . at ObButton ?~ fromJust (_plMID btpl)
+            & mcCloseSound ?~ fridgeHumS
         )       )
     $ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl) 
   where
@@ -49,7 +51,7 @@ putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm)
 putTerminal' 
     :: Color
     -> Terminal
-    -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
+--    -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
     -> Placement
 putTerminal' col = putTerminal'' (defaultMachine 
         & mcColor .~ col)
@@ -59,7 +61,7 @@ putTerminal' col = putTerminal'' (defaultMachine
     }
 
 putTerminal :: Color -> Terminal -> Placement
-putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpdate $ const id)
+putTerminal col f = putTerminal'' (mc & mcColor .~ col) f -- (\_ -> basicMachineUpdate $ const id)
   where
     mc = defaultMachine
         { _mcDraw = terminalSPic

src/Dodge/Placement/Instance/Turret.hs

@@ -30,8 +30,8 @@ import Data.Maybe
 putLasTurret :: Float -> Placement
 putLasTurret rotSpeed = sps0 $ PutMachine (reverse $ square wdth) (defaultMachine & mcColor .~ blue)
     { _mcDraw = drawTurret
-    , _mcUpdate = updateTurret rotSpeed
+--    , _mcUpdate = updateTurret rotSpeed
-    , _mcType = lasTurret
+    , _mcType = lasTurret & tuTurnSpeed .~ rotSpeed
     , _mcHP = 50000
     }
 lasTurret :: MachineType

src/Dodge/Room/LasTurret.hs

@@ -21,7 +21,7 @@ import LensHelp
 import RandomHelp
 
 import qualified Data.Set as S
-import Data.Maybe
+--import Data.Maybe
 
 cenLasTur :: Room
 cenLasTur = roomNgon 8 200 & rmPmnts .~
@@ -44,7 +44,8 @@ lightSensInsideDoor outplid rm = rm
 lasSensLightAboveDoor :: Float -> PlacementSpot -> Placement
 lasSensLightAboveDoor wth ps = extTrigLitPos 
     (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
-    ( \tp -> Just $ lightSensor wth (upf $ fromJust $ _plMID tp) ps )
+    ( \tp -> Just $ lightSensor wth (_plMID tp) --(upf $ fromJust $ _plMID tp) 
+        ps )
   where
     upf trid mc w | _sensAmount (_mcSensor mc) > 900 = w & triggers . ix trid .~ const True
         | otherwise = w

src/Dodge/Room/SensorDoor.hs

@@ -60,7 +60,8 @@ sensorRoomRunPast dt n = do
 sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
 sensAboveDoor sensetype wth ps = extTrigLitPos 
     (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
-    ( \tp -> Just $ damageSensor sensetype wth (upf $ fromJust $ _plMID tp) ps )
+    ( \tp -> Just $ damageSensor sensetype wth (_plMID tp) --(upf $ fromJust $ _plMID tp) 
+        ps )
   where
     upf trid mc w | _sensAmount (_mcSensor mc) > 900 = w & triggers . ix trid .~ const True
         | otherwise = w

src/Dodge/Update.hs

@@ -5,6 +5,7 @@ Description : Simulation update
 -}
 module Dodge.Update ( updateUniverse ) where
 import Dodge.Data
+import Dodge.Machine.Update
 import Dodge.RadarBlip
 import Dodge.Flare
 import Dodge.Menu
@@ -14,7 +15,7 @@ import Dodge.Distortion
 import Dodge.SoundLogic
 --import Dodge.Wall.Delete
 import Dodge.Update.WallDamage
-import Dodge.Machine.Destroy
+--import Dodge.Machine.Destroy
 --import Dodge.Menu
 import Dodge.Base
 import Dodge.Zone
@@ -89,7 +90,8 @@ functionalUpdate cfig w = checkEndGame
     . zoneClouds
     . updateMIM magnets _mgUpdate
     . updateIMl' _terminals tmUpdate
-    . updateIMl _machines mcChooseUpdate
+--    . updateIMl _machines mcChooseUpdate
+    . updateIMl' _machines updateMachine
     . updateIMl _creatures _crUpdate 
         -- creatures should be updated early so that crOldPos is set before any position change
     . over creatures (fmap setOldPos)
@@ -125,13 +127,10 @@ updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mous
     g   | ButtonRight `M.member` _mouseButtons w = rSelect .~ mwp
         | otherwise = id
 
-mcChooseUpdate :: Machine -> Machine -> World -> World
+--mcChooseUpdate :: Machine -> Machine -> World -> World
-mcChooseUpdate mc mc'
+--mcChooseUpdate mc mc'
-    | _mcHP mc > 0  = _mcUpdate mc mc'
+--    | _mcHP mc > 0  = _mcUpdate mc mc'
-    | otherwise     = destroyMachine mc
+--    | otherwise     = destroyMachine mc
---        (machines %~ IM.delete (_mcID mc))
---        . deleteWallIDs (_mcWallIDs mc)
---        . _mcDeath mc mc'
 
 tmUpdate :: Terminal -> World -> World
 tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of