Move machine update into outside function

2022-07-14 21:01:53 +01:00
parent ad33ddd569
commit 5463328d41
13 changed files with 130 additions and 92 deletions
@@ -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 
-        = 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
+--        & mcUpdate .~ mcProximitySensorUpdate
        & mcDraw .~ terminalSPic
        & mcHP .~ 100
        & mcSensor .~ defaultProximitySensor {_proxRequirement = proxreq}

-mcProximitySensorUpdate :: Machine -> World -> World
-mcProximitySensorUpdate mc w = case 
-        (_proxStatus sens
-        , _sensToggle sens
-        , mcProxTest mc w 
-        , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
-    (_,True,_,_) -> w
-    (_,False,True,True) -> w 
-            & machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
-            & playsound dedaS
-            & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
-    (NotClose,_,False,True) -> w & playsound dedumS
-            & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
-    (_,_,_,False) -> w & machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
-    _ -> w
- where
-    playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
-    ycr = you w
-    sens = _mcSensor mc
-
-mcProxTest :: Machine -> World -> Bool
-mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
-    Just (RequireHealth x)      -> _crHP cr >= x
-    Just (RequireEquipment ct)  -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
-    _ -> False
-  where
-    cr = you w
+--this can probably be deleted
+--mcProximitySensorUpdate :: Machine -> World -> World
+--mcProximitySensorUpdate mc w = case 
+--        (_proxStatus sens
+--        , _sensToggle sens
+--        , mcProxTest mc w 
+--        , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
+--    (_,True,_,_) -> w
+--    (_,False,True,True) -> w 
+--            & machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
+--            & playsound dedaS
+--            & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
+--    (NotClose,_,False,True) -> w & playsound dedumS
+--            & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
+--    (_,_,_,False) -> w & machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
+--    _ -> w
+-- where
+--    playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
+--    ycr = you w
+--    sens = _mcSensor mc
+--
+--mcProxTest :: Machine -> World -> Bool
+--mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
+--    Just (RequireHealth x)      -> _crHP cr >= x
+--    Just (RequireEquipment ct)  -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
+--    _ -> False
+--  where
+--    cr = you w
@@ -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 damF mc w = w & machines . ix mcid %~ upmc
-    & lightSources . ix lsid %~ upls
-  where
-    upmc = ( mcSensor . sensAmount %~ \x' -> min 1000 (max 0 (x' - 5 + newSense)) )
-        . ( mcHP -~ sum dam )
-        . (mcDamage .~ [])
-    x = _sensAmount $ _mcSensor mc
-    mcid = _mcID mc
-    lsid = head (_mcLSs mc)
-    (senseData,dam) = partitionEithers $ map (damageUsing damF) $ _mcDamage mc
-    newSense = sum senseData
-    ni = fromIntegral x / 1000
-    upls = lsParam . lsCol .~ V3 ni ni ni
-
-damageUsing :: DamageType -> Damage -> Either Int Int
-damageUsing dt dm
-    | _dmType dm == dt = Left $ _dmAmount dm
-    | otherwise = Right 0
+--
+--sensorUpdate :: DamageType -> Machine -> World -> World
+--sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
+--    & lightSources . ix lsid %~ upls
+--  where
+--    upmc = ( mcSensor . sensAmount %~ \x' -> min 1000 (max 0 (x' - 5 + newSense)) )
+--        . ( mcHP -~ sum dam )
+--        . (mcDamage .~ [])
+--    x = _sensAmount $ _mcSensor mc
+--    mcid = _mcID mc
+--    lsid = head (_mcLSs mc)
+--    (senseData,dam) = partitionEithers $ map (damageUsing damF) $ _mcDamage mc
+--    newSense = sum senseData
+--    ni = fromIntegral x / 1000
+--    upls = lsParam . lsCol .~ V3 ni ni ni
+--
+--damageUsing :: DamageType -> Damage -> Either Int Int
+--damageUsing dt dm
+--    | _dmType dm == dt = Left $ _dmAmount dm
+--    | otherwise = Right 0

 sensorSPic :: Float -> (PaletteColor,DecorationShape) -> Machine -> SPic
 sensorSPic wdth (pc,ds) mc = noPic 
@@ -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
@@ -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
-    , _mcType = lasTurret
+--    , _mcUpdate = updateTurret rotSpeed
+    , _mcType = lasTurret & tuTurnSpeed .~ rotSpeed
    , _mcHP = 50000
    }
 lasTurret :: MachineType