Successfully push proximity sensor parameters into data
This commit is contained in:
+3
-3
@@ -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)
|
||||
|
||||
@@ -337,6 +337,6 @@ defaultProximitySensor :: Sensor
|
||||
defaultProximitySensor = ProximitySensor
|
||||
{ _proxStatus = NotClose
|
||||
, _proxDist = 40
|
||||
, _proxRequirement = HasBottom
|
||||
, _proxRequirement = RequireImpossible
|
||||
, _sensToggle = False
|
||||
}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user