From c0383dbd8a2cf8d45eaf8875e30154b5ab636000 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 22 Mar 2022 09:35:17 +0000 Subject: [PATCH] Make analyser into one machine --- src/Dodge/Data.hs | 1 + src/Dodge/LevelGen/Data.hs | 5 +-- src/Dodge/Machine.hs | 13 +++++++ src/Dodge/Placement/Instance/Analyser.hs | 45 +++++++++++++++++++++++- src/Dodge/Placement/Instance/Terminal.hs | 36 ++++++++++++++++--- src/Dodge/Render/HUD.hs | 2 +- src/Dodge/Room/LasTurret.hs | 2 +- src/Dodge/Room/Procedural.hs | 2 +- 8 files changed, 95 insertions(+), 11 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index da5ef14cd..c676fbb46 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -329,6 +329,7 @@ data TerminalParams = NoTerminalParams | TerminalParams { _termDisplayedLines :: [World -> (String,Color)] , _termFutureLines :: [TerminalLine] , _termMaxLines :: Int + , _termTitle :: String } data TerminalLine = TerminalLineDisplay diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 425997094..c04d04f92 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -20,7 +20,7 @@ import qualified Data.IntMap.Strict as IM data PSType = PutCrit {_unPutCrit :: Creature} | PutMachine { _putMachineColor :: Color, _putMachinePoly :: [Point2], _unPutMachine :: Machine } | PutLS LightSource - | PutButton {_pstPutButton :: Button} + | PutButton {_putButton :: Button} | PutProp Prop | PutFlIt Item | PutPPlate PressPlate @@ -28,7 +28,8 @@ data PSType = PutCrit {_unPutCrit :: Creature} | PutCoord Point2 | PutMod Modification | PutTrigger (World -> Bool) - | PutLineBlock Wall BlockMaterial Float Float Point2 Point2 + | PutLineBlock {_putWall :: Wall, _putBlockMaterial :: BlockMaterial + , _putWidth :: Float, _putDepth :: Float, _putStartPoint :: Point2, _putEndPoint :: Point2} | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall } | PutSlideDr Bool Color (World -> Bool) Float Point2 Point2 Float | PutDoor Color (World -> Bool) [(Point2,Point2)] diff --git a/src/Dodge/Machine.hs b/src/Dodge/Machine.hs index e58799088..b4e6e3065 100644 --- a/src/Dodge/Machine.hs +++ b/src/Dodge/Machine.hs @@ -9,6 +9,19 @@ import Dodge.Base import qualified Data.IntMap.Strict as IM +machineUpdateLiveDieEff + :: (Machine -> World -> World) -- | effect when hp >= 1 + -> (Machine -> World -> World) -- | effect (once) when hp < 1 + -> Machine -> World -> World +machineUpdateLiveDieEff livef dief mc + | _mcHP mc < 1 = dief mc + . (machines %~ IM.delete mcid) + . deleteWallIDs (_mcWallIDs mc) + | otherwise = livef mc . (machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) )) + where + dams = sum $ map _dmAmount $ _mcDamage mc + mcid = _mcID mc + machineUpdateDeathEff :: (Machine -> World -> World) -> Machine -> World -> World machineUpdateDeathEff f mc diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 3fd0929b1..77af0de8e 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -34,6 +34,47 @@ import Data.Maybe --import Control.Monad.State --import System.Random + +initMCUpdate + :: (Machine -> World -> World) + -> (Machine -> World -> World) + -> Machine -> World -> World +initMCUpdate initup f mc + = (machines . ix (_mcID mc) . mcUpdate .~ f) + . initup mc + +analyser' + :: [String] -- | initial text + -> String -- | succeed text + -> String -- | fail text + -> [String] -- | after text + -> (Machine -> World -> World) + -> PlacementSpot + -> PlacementSpot + -> Placement +analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp -> + Just $ updatebuttonname $ plSpot .~ psmc $ putTerminal' aquamarine (termupdate tp) + where + termupdate tp btid = initMCUpdate + (\mc -> buttons . ix btid . btTerminalParams .~ + TerminalParams + { _termDisplayedLines = [] + , _termFutureLines = map simpleline starts + ++ [testline' (_mcID mc)] + ++ map simpleline afters + , _termMaxLines = 7 + , _termTitle = "ANALYSER" + } + ) + (\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_mcSensorToggle mc)) + ) + simpleline str = TerminalLineDisplay {_tlPause = 0, _tlString = const (str,white)} + testline' mcid = TerminalLineDisplay 0 (testline mcid) + testline mcid w = case w ^? machines . ix mcid . mcSensorToggle of + Just True -> (sucs,green) + _ -> (fails,red) + updatebuttonname = plType . putButton . btText .~ "ANALYSER" + analyser :: [String] -- | initial text -> String -- | succeed text @@ -52,12 +93,13 @@ analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp } ) $ \anmc -> Just $ plSpot .~ shiftRelativeToPS (V2 20 0) (_plSpot anmc) - $ putTerminal $ const $ TerminalParams + $ updatebuttontext $ putTerminal $ const $ TerminalParams { _termDisplayedLines = [] , _termFutureLines = map simpleline starts ++ [testline' (fromJust $ _plMID anmc)] ++ map simpleline afters , _termMaxLines = 7 + , _termTitle = "ANALYSER" } where simpleline str = TerminalLineDisplay {_tlPause = 0, _tlString = const (str,white)} @@ -65,6 +107,7 @@ analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp testline mcid w = case w ^? machines . ix mcid . mcSensorToggle of Just True -> (sucs,green) _ -> (fails,red) + updatebuttontext = plType . putButton . btText .~ "ANALYSER" testYourHealth :: Int -> Machine -> World -> World testYourHealth hp mc w diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 347c4f150..507457cbc 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -1,6 +1,7 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Placement.Instance.Terminal ( putTerminal + , putTerminal' , simpleTermMessage , genTermMessage ) where @@ -19,10 +20,33 @@ import Sound.Data import Data.Maybe +putTerminal' + :: Color + -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input + -> Placement +putTerminal' col mcf = ps0PushPS (PutButton thebutton) + $ \pl -> Just $ pt0 (PutMachine col (reverse $ square 10) defaultMachine + { _mcDraw = noPic . colorSH col . terminalShape + , _mcHP = 100 + , _mcUpdate = mcf (fromJust $ _plMID pl) + }) + $ const Nothing + where + thebutton = Button + { _btPict = const mempty + , _btPos = 0 + , _btRot = 0 + , _btEvent = displayTerminalMessage . _btID + , _btID = 0 + , _btText = "TERMINAL" + , _btState = BtOff + , _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" + } + putTerminal :: (GenParams -> TerminalParams) -> Placement putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton) $ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine - { _mcDraw = drawTerminal + { _mcDraw = noPic . colorSH terminalColor . terminalShape , _mcHP = 100 , _mcUpdate = machineAddSound fridgeHumS $ machineUpdateDeathEff $ \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing) @@ -31,7 +55,7 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton) $ const Nothing where g gp pl = (gp, - pl & plType . pstPutButton . btTerminalParams .~ f gp + pl & plType . putButton . btTerminalParams .~ f gp & plGenUpdate .~ Nothing ) thebutton = Button @@ -42,14 +66,14 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton) , _btID = 0 , _btText = "TERMINAL" , _btState = BtOff - , _btTerminalParams = TerminalParams [] [] 10 + , _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" } terminalColor :: Color terminalColor = dark magenta -drawTerminal :: Machine -> SPic -drawTerminal _ = noPic $ colorSH terminalColor $ upperPrismPoly 15 $ square 10 +terminalShape :: Machine -> Shape +terminalShape _ = upperPrismPoly 15 $ square 10 displayTerminalMessage :: Int -> World -> World displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal @@ -63,6 +87,7 @@ simpleTermMessage ss = const $ TerminalParams ,_termFutureLines = TerminalLineEffect 0 termsound : map totermline (topflush ++ ss) ,_termMaxLines = 7 + ,_termTitle = "TERMINAL" } where topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]] @@ -77,6 +102,7 @@ genTermMessage f = \gp -> TerminalParams ,_termFutureLines = termSoundLine computerBeepingS : map totermline (topflush (f gp) ++ f gp) ,_termMaxLines = 7 + ,_termTitle = "TERMINAL" } where topflush ss = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]] diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 9f2972ef9..ec4859144 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -83,7 +83,7 @@ subInventoryDisplay subinv cfig w = case subinv of , listTextPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it) ] DisplayTerminal {_termParams = tp} -> pictures - [ invHead cfig "TERMINAL" + [ invHead cfig (_termTitle tp) , renderListAt subInvX 60 cfig . reverse . take (_termMaxLines tp) diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index b926d2fd2..f7cd1cff6 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -92,7 +92,7 @@ analyserByDoor sa sb sc sd mcf outplid rm = rm ] & rmOutPmnt .~ [OutPlacement - (analyser sa sb sc sd + (analyser' sa sb sc sd mcf (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) (atFstLnkOutShiftBy sensorshift) diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index f00ae5be8..ebe143f0e 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -149,7 +149,7 @@ quarterRoomTri w = do ] , [ blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))] , [ blockLine (V2 (w/2) (w/2)) (V2 0 (w/2)) - , blockLine (V2 (-29) w) (V2 0 (w/2)) + , blockLine (V2 (-29) w) (V2 0 (w/2)) & plType . putWall . wlRotateTo .~ False ] ] pure $ defaultRoom