Successfully push proximity sensor parameters into data

This commit is contained in:
2022-06-07 10:34:59 +01:00
parent 14acd2ee6a
commit 5117fb2a1a
5 changed files with 42 additions and 39 deletions
+3 -3
View File
@@ -993,9 +993,9 @@ data Sensor = NoSensor
}
deriving (Eq,Ord)
data ProximityRequirement
= HasHealth {_proxReqMinHealth :: Int}
| HasEquipment {_proxReqEquipment :: CombineType}
| HasBottom
= RequireHealth {_proxReqMinHealth :: Int}
| RequireEquipment {_proxReqEquipment :: CombineType}
| RequireImpossible
deriving (Eq,Ord,Show)
data CloseToggle = NotClose | IsClose
deriving (Eq,Ord)
+1 -1
View File
@@ -337,6 +337,6 @@ defaultProximitySensor :: Sensor
defaultProximitySensor = ProximitySensor
{ _proxStatus = NotClose
, _proxDist = 40
, _proxRequirement = HasBottom
, _proxRequirement = RequireImpossible
, _sensToggle = False
}
+22 -25
View File
@@ -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 ->
Just $ plSpot .~ psmc $ putTerminal' aquamarine tparams (termupdate tp)
analyser proxreq pslight psmc = extTrigLitPos pslight $ \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
mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
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
mcProximitySensorUpdate :: Machine -> World -> World
mcProximitySensorUpdate mc w = case
(_proxStatus sens
, _sensToggle sens
, t w
, dist (_crPos ycr) (_mcPos mc) < 40) of
, mcProxTest mc w
, 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
testYouHave ct = analyserTest (any (\itm -> _itType itm == ct) . _crInv . you )
testYourHealth :: Int -> Machine -> World -> World
testYourHealth hp = analyserTest (\w -> _crHP (you w) >= hp)
mcProxTest :: Machine -> World -> Bool
mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
Just (RequireHealth x) -> _crHP cr >= x
Just (RequireEquipment ct) -> any (\itm -> _itType itm == ct) (_crInv cr)
_ -> False
where
cr = you w
+11 -2
View File
@@ -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
+5 -8
View File
@@ -84,23 +84,20 @@ keyCardRoomRunPast keyid rmid = do
,TreeSubLabelling "keyCardRoomRunPast" Nothing)
keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
keyCardAnalyserByDoor keyid = analyserByDoor
(machineAddSound fridgeHumS $ testYouHave (KEYCARD keyid))
keyCardAnalyserByDoor keyid = analyserByDoor (RequireEquipment (KEYCARD keyid))
healthAnalyserByDoor :: Int -> Room -> Room
healthAnalyserByDoor = analyserByDoor
(machineAddSound fridgeHumS $ testYourHealth 1100)
healthAnalyserByDoor = analyserByDoor (RequireHealth 1100)
analyserByDoor :: (Machine -> World -> World) -> Int -> Room -> Room
analyserByDoor mcf outplid rm = rm
analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
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
mcf
(analyser proxreq
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(atFstLnkOutShiftBy sensorshift)
)