From 8e9f33d038cbfe65400866ae8968431c788e3494 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 6 Jun 2022 11:17:11 +0100 Subject: [PATCH] Commit before making terminals there own entities --- src/Dodge/Data.hs | 16 ++++++++-- src/Dodge/Default.hs | 19 ++++++++++-- src/Dodge/Event.hs | 6 ---- src/Dodge/Inventory.hs | 8 ++--- src/Dodge/Placement/Instance/Terminal.hs | 37 +++++++++++------------- src/Dodge/Terminal.hs | 7 +++-- 6 files changed, 56 insertions(+), 37 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 5e8ef1dbe..aabb38bf5 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -405,7 +405,7 @@ data Button = Button , _btText :: String , _btState :: ButtonState -- , _btTerminalParams :: World -> TerminalParams - , _btTerminal :: Maybe Int + , _btTermMID :: Maybe Int , _btName :: String } data TerminalParams = NoTerminalParams | TerminalParams @@ -418,6 +418,7 @@ data TerminalParams = NoTerminalParams | TerminalParams , _termInput :: Maybe T.Text , _termScrollCommands :: [TerminalCommand] , _termWriteCommands :: [TerminalCommand] + , _termDeathCommand :: Maybe String } data TerminalLine = TerminalLineDisplay @@ -426,8 +427,8 @@ data TerminalLine } | TerminalLineInput {_tlPause :: Int - ,_tlScrollCommands :: [TerminalCommand] - ,_tlWriteCommands :: [TerminalCommand] +-- ,_tlScrollCommands :: [TerminalCommand] +-- ,_tlWriteCommands :: [TerminalCommand] } | TerminalLineEffect {_tlPause :: Int @@ -953,6 +954,14 @@ data Terminal = Terminal , _tmButtonID :: Int , _tmMachineID :: Int , _tmName :: String + , _tmDisplayedLines :: [(String,Color)] + , _tmFutureLines :: [TerminalLine] + , _tmTitle :: String + , _tmSel :: Maybe (Int,Int) + , _tmInput :: Maybe T.Text + , _tmScrollCommands :: [TerminalCommand] + , _tmWriteCommands :: [TerminalCommand] + , _tmDeathEffect :: Terminal -> World -> World } data Machine = Machine { _mcID :: Int @@ -970,6 +979,7 @@ data Machine = Machine , _mcLSs :: [Int] , _mcType :: MachineType , _mcName :: String + , _mcTermMID :: Maybe Int } data Sensor = NoSensor | SensorToggleAmount diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 183ad2ff2..06d3f8770 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -220,6 +220,7 @@ defaultMachine = Machine , _mcLSs = [] , _mcType = StaticMachine , _mcName = "" + , _mcTermMID = Nothing } defaultMachineUpdate :: Machine -> World -> World defaultMachineUpdate mc @@ -241,7 +242,21 @@ defaultDrawButton col bt = | otherwise = rectNSEW 2 (-1) width (-width) width = 8 defaultTerminal :: Terminal -defaultTerminal = Terminal 0 (\_ _ -> NoTerminalParams) 0 0 "TESTTERMINAL" +defaultTerminal = Terminal + { _tmID = 0 + , _tmProgram = (\_ _ -> NoTerminalParams) + , _tmButtonID = 0 + , _tmMachineID = 0 + , _tmName = "TESTTERMINAL" + , _tmDisplayedLines = [] + , _tmFutureLines = [] + , _tmTitle = "TERMINAL IN LOCATION" + , _tmSel = Nothing + , _tmInput = Nothing + , _tmScrollCommands = [] + , _tmWriteCommands = [] + , _tmDeathEffect = const id + } defaultButton :: Button defaultButton = Button @@ -253,7 +268,7 @@ defaultButton = Button , _btID = 0 , _btText = "Button" , _btState = BtOff - , _btTerminal = Nothing + , _btTermMID = Nothing , _btName = "" } defaultPT :: Prop diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index d6d0f68ca..4781f2343 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -96,12 +96,6 @@ handlePressedMouseButton but w = case (_hudElement (_hud $ _uvWorld w), but) of (_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) ( DisplayInventory (DisplayTerminal _ _) , ButtonLeft) -> Just $ over uvWorld doTerminalEffect w --- -> Just $ fromMaybe w --- $ do -- ugly --- i <- _termSel tp --- f <- _termOptions tp !? i --- return $ w & uvWorld %~ snd f ----- & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory ( DisplayInventory (CombineInventory mi) , ButtonLeft) -> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do -- ugly diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index d1608e78e..5d4598900 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -166,11 +166,11 @@ updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams . Just (TerminalLineEffect _ eff) -> w & pointTermParams . termFutureLines %~ tail & eff (_subInventory . _hudElement $ _hud w) - Just (TerminalLineInput _ scrollc writec) -> w & pointTermParams %~ + Just (TerminalLineInput _) -> w & pointTermParams %~ ( ( termFutureLines %~ tail ) - . ( termInput ?~ T.empty ) - . ( termScrollCommands .~ scrollc ) - . ( termWriteCommands .~ writec ) ) +-- . ( termScrollCommands .~ scrollc ) +-- . ( termWriteCommands .~ writec ) + . ( termInput ?~ T.empty ) ) where pointTermParams = hud . hudElement . subInventory . termParams diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 087918d1e..3a8c72625 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -28,15 +28,24 @@ putTerminal'' -> (World -> TerminalParams) -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input -> Placement -putTerminal'' mc f mcf = ps0PushPSw (PutTerminal theterminal) $ \_ tmpl -> Just $ - ps0PushPS (PutButton $ termButton & btTerminal .~ _plMID tmpl) - $ \pl -> Just $ pt0 (PutMachine (reverse $ square 10) - (mc & mcUpdate .~ machineAddSound fridgeHumS (mcf (fromJust $ _plMID pl)) - & mcDeath %~ (\fd mc' -> (buttons . at (fromJust (_plMID pl)) .~ Nothing) . fd mc') +putTerminal'' mc f mcf = ps0PushPS (PutTerminal theterminal) $ \tmpl -> Just $ + ps0PushPS (PutButton $ termButton) + $ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10) + (mc & mcUpdate .~ machineAddSound fridgeHumS (mcf (fromJust $ _plMID btpl)) + & mcDeath %~ (\fd mc' -> (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc') ) ) - $ const Nothing + $ \mcpl -> Just $ sps0 $ PutWorldUpdate (const $ setids tmpl btpl mcpl) where + setids tmpl btpl mcpl w = w + & terminals . ix tmid . tmButtonID .~ btid + & terminals . ix tmid . tmMachineID .~ mcid + & machines . ix mcid . mcTermMID ?~ tmid + & buttons . ix btid . btTermMID ?~ tmid + where + tmid = fromJust (_plMID tmpl) + btid = fromJust (_plMID btpl) + mcid = fromJust (_plMID mcpl) theterminal = defaultTerminal & tmProgram .~ const f putTerminal' @@ -58,29 +67,17 @@ putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpd , _mcHP = 100 , _mcDeath = makeExplosionAt . _mcPos } --- ps0PushPSw (PutTerminal theterminal) $ \_ tmpl -> Just $ --- ps0PushPS (PutButton $ termButton & btTerminal .~ _plMID tmpl) --- $ \pl -> Just $ pt0 (PutMachine (reverse $ square 10) (defaultMachine & mcColor .~ col) --- { _mcDraw = noPic . terminalShape --- , _mcHP = 100 --- , _mcUpdate = basicMachineUpdate $ machineAddSound fridgeHumS (const id) --- , _mcDeath = \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing) --- . makeExplosionAt (_mcPos mc) --- }) --- $ const Nothing --- where --- theterminal = defaultTerminal & tmProgram .~ const f termButton :: Button termButton = Button { _btPict = const mempty , _btPos = 0 , _btRot = 0 - , _btEvent = displayTerminalMessage . _btTerminal + , _btEvent = displayTerminalMessage . _btTermMID , _btID = 0 , _btText = "TERMINAL" , _btState = BtOff - , _btTerminal = Nothing + , _btTermMID = Nothing , _btName = "" } diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index f0a37b13e..cf9ac828d 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -164,8 +164,10 @@ doTerminalEffect' s w = fromMaybe (w & badinput) $ do ) addInputLine :: [TerminalCommand] -> [TerminalCommand] -> TerminalParams -> TerminalParams -addInputLine searchablecommands hiddencommands = termFutureLines ++.~ - [TerminalLineInput 0 searchablecommands hiddencommands] +addInputLine searchablecommands hiddencommands = + (termFutureLines ++.~ [TerminalLineInput 0]) + . (termScrollCommands ++.~ searchablecommands) + . (termWriteCommands ++.~ hiddencommands) defaultTermParams :: TerminalParams defaultTermParams = TerminalParams @@ -178,6 +180,7 @@ defaultTermParams = TerminalParams ,_termInput = Nothing ,_termScrollCommands = [] ,_termWriteCommands = [] + ,_termDeathCommand = Nothing } connectionBlurb :: [String]