From 5117fb2a1a42077266bc5aa60ecb2384dda66d9a Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 7 Jun 2022 10:34:59 +0100 Subject: [PATCH] Successfully push proximity sensor parameters into data --- src/Dodge/Data.hs | 6 +-- src/Dodge/Default.hs | 2 +- src/Dodge/Placement/Instance/Analyser.hs | 47 +++++++++++------------- src/Dodge/Placement/Instance/Terminal.hs | 13 ++++++- src/Dodge/Room/LasTurret.hs | 13 +++---- 5 files changed, 42 insertions(+), 39 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 78f84256d..46a561688 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index b743ebbd4..360c36161 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -337,6 +337,6 @@ defaultProximitySensor :: Sensor defaultProximitySensor = ProximitySensor { _proxStatus = NotClose , _proxDist = 40 - , _proxRequirement = HasBottom + , _proxRequirement = RequireImpossible , _sensToggle = False } diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 37bca4146..dd89e7289 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/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 -> - 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 diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 3df041c69..b4a443427 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/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 diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index bf203cf85..96b996135 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -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) )