Commit before making terminals there own entities

This commit is contained in:
2022-06-06 11:17:11 +01:00
parent 384a16851b
commit 8e9f33d038
6 changed files with 56 additions and 37 deletions
+13 -3
View File
@@ -405,7 +405,7 @@ data Button = Button
, _btText :: String , _btText :: String
, _btState :: ButtonState , _btState :: ButtonState
-- , _btTerminalParams :: World -> TerminalParams -- , _btTerminalParams :: World -> TerminalParams
, _btTerminal :: Maybe Int , _btTermMID :: Maybe Int
, _btName :: String , _btName :: String
} }
data TerminalParams = NoTerminalParams | TerminalParams data TerminalParams = NoTerminalParams | TerminalParams
@@ -418,6 +418,7 @@ data TerminalParams = NoTerminalParams | TerminalParams
, _termInput :: Maybe T.Text , _termInput :: Maybe T.Text
, _termScrollCommands :: [TerminalCommand] , _termScrollCommands :: [TerminalCommand]
, _termWriteCommands :: [TerminalCommand] , _termWriteCommands :: [TerminalCommand]
, _termDeathCommand :: Maybe String
} }
data TerminalLine data TerminalLine
= TerminalLineDisplay = TerminalLineDisplay
@@ -426,8 +427,8 @@ data TerminalLine
} }
| TerminalLineInput | TerminalLineInput
{_tlPause :: Int {_tlPause :: Int
,_tlScrollCommands :: [TerminalCommand] -- ,_tlScrollCommands :: [TerminalCommand]
,_tlWriteCommands :: [TerminalCommand] -- ,_tlWriteCommands :: [TerminalCommand]
} }
| TerminalLineEffect | TerminalLineEffect
{_tlPause :: Int {_tlPause :: Int
@@ -953,6 +954,14 @@ data Terminal = Terminal
, _tmButtonID :: Int , _tmButtonID :: Int
, _tmMachineID :: Int , _tmMachineID :: Int
, _tmName :: String , _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 data Machine = Machine
{ _mcID :: Int { _mcID :: Int
@@ -970,6 +979,7 @@ data Machine = Machine
, _mcLSs :: [Int] , _mcLSs :: [Int]
, _mcType :: MachineType , _mcType :: MachineType
, _mcName :: String , _mcName :: String
, _mcTermMID :: Maybe Int
} }
data Sensor = NoSensor data Sensor = NoSensor
| SensorToggleAmount | SensorToggleAmount
+17 -2
View File
@@ -220,6 +220,7 @@ defaultMachine = Machine
, _mcLSs = [] , _mcLSs = []
, _mcType = StaticMachine , _mcType = StaticMachine
, _mcName = "" , _mcName = ""
, _mcTermMID = Nothing
} }
defaultMachineUpdate :: Machine -> World -> World defaultMachineUpdate :: Machine -> World -> World
defaultMachineUpdate mc defaultMachineUpdate mc
@@ -241,7 +242,21 @@ defaultDrawButton col bt =
| otherwise = rectNSEW 2 (-1) width (-width) | otherwise = rectNSEW 2 (-1) width (-width)
width = 8 width = 8
defaultTerminal :: Terminal 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
defaultButton = Button defaultButton = Button
@@ -253,7 +268,7 @@ defaultButton = Button
, _btID = 0 , _btID = 0
, _btText = "Button" , _btText = "Button"
, _btState = BtOff , _btState = BtOff
, _btTerminal = Nothing , _btTermMID = Nothing
, _btName = "" , _btName = ""
} }
defaultPT :: Prop defaultPT :: Prop
-6
View File
@@ -96,12 +96,6 @@ handlePressedMouseButton but w = case (_hudElement (_hud $ _uvWorld w), but) of
(_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) (_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
( DisplayInventory (DisplayTerminal _ _) , ButtonLeft) ( DisplayInventory (DisplayTerminal _ _) , ButtonLeft)
-> Just $ over uvWorld doTerminalEffect w -> 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) ( DisplayInventory (CombineInventory mi) , ButtonLeft)
-> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory) -> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory)
$ do -- ugly $ do -- ugly
+4 -4
View File
@@ -166,11 +166,11 @@ updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams .
Just (TerminalLineEffect _ eff) -> w Just (TerminalLineEffect _ eff) -> w
& pointTermParams . termFutureLines %~ tail & pointTermParams . termFutureLines %~ tail
& eff (_subInventory . _hudElement $ _hud w) & eff (_subInventory . _hudElement $ _hud w)
Just (TerminalLineInput _ scrollc writec) -> w & pointTermParams %~ Just (TerminalLineInput _) -> w & pointTermParams %~
( ( termFutureLines %~ tail ) ( ( termFutureLines %~ tail )
. ( termInput ?~ T.empty ) -- . ( termScrollCommands .~ scrollc )
. ( termScrollCommands .~ scrollc ) -- . ( termWriteCommands .~ writec )
. ( termWriteCommands .~ writec ) ) . ( termInput ?~ T.empty ) )
where where
pointTermParams = hud . hudElement . subInventory . termParams pointTermParams = hud . hudElement . subInventory . termParams
+17 -20
View File
@@ -28,15 +28,24 @@ putTerminal''
-> (World -> TerminalParams) -> (World -> TerminalParams)
-> (Int -> Machine -> World -> World) -- | machine update, takes button id as input -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input
-> Placement -> Placement
putTerminal'' mc f mcf = ps0PushPSw (PutTerminal theterminal) $ \_ tmpl -> Just $ putTerminal'' mc f mcf = ps0PushPS (PutTerminal theterminal) $ \tmpl -> Just $
ps0PushPS (PutButton $ termButton & btTerminal .~ _plMID tmpl) ps0PushPS (PutButton $ termButton)
$ \pl -> Just $ pt0 (PutMachine (reverse $ square 10) $ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10)
(mc & mcUpdate .~ machineAddSound fridgeHumS (mcf (fromJust $ _plMID pl)) (mc & mcUpdate .~ machineAddSound fridgeHumS (mcf (fromJust $ _plMID btpl))
& mcDeath %~ (\fd mc' -> (buttons . at (fromJust (_plMID pl)) .~ Nothing) . fd mc') & mcDeath %~ (\fd mc' -> (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc')
) )
) )
$ const Nothing $ \mcpl -> Just $ sps0 $ PutWorldUpdate (const $ setids tmpl btpl mcpl)
where 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 theterminal = defaultTerminal & tmProgram .~ const f
putTerminal' putTerminal'
@@ -58,29 +67,17 @@ putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpd
, _mcHP = 100 , _mcHP = 100
, _mcDeath = makeExplosionAt . _mcPos , _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
termButton = Button termButton = Button
{ _btPict = const mempty { _btPict = const mempty
, _btPos = 0 , _btPos = 0
, _btRot = 0 , _btRot = 0
, _btEvent = displayTerminalMessage . _btTerminal , _btEvent = displayTerminalMessage . _btTermMID
, _btID = 0 , _btID = 0
, _btText = "TERMINAL" , _btText = "TERMINAL"
, _btState = BtOff , _btState = BtOff
, _btTerminal = Nothing , _btTermMID = Nothing
, _btName = "" , _btName = ""
} }
+5 -2
View File
@@ -164,8 +164,10 @@ doTerminalEffect' s w = fromMaybe (w & badinput) $ do
) )
addInputLine :: [TerminalCommand] -> [TerminalCommand] -> TerminalParams -> TerminalParams addInputLine :: [TerminalCommand] -> [TerminalCommand] -> TerminalParams -> TerminalParams
addInputLine searchablecommands hiddencommands = termFutureLines ++.~ addInputLine searchablecommands hiddencommands =
[TerminalLineInput 0 searchablecommands hiddencommands] (termFutureLines ++.~ [TerminalLineInput 0])
. (termScrollCommands ++.~ searchablecommands)
. (termWriteCommands ++.~ hiddencommands)
defaultTermParams :: TerminalParams defaultTermParams :: TerminalParams
defaultTermParams = TerminalParams defaultTermParams = TerminalParams
@@ -178,6 +180,7 @@ defaultTermParams = TerminalParams
,_termInput = Nothing ,_termInput = Nothing
,_termScrollCommands = [] ,_termScrollCommands = []
,_termWriteCommands = [] ,_termWriteCommands = []
,_termDeathCommand = Nothing
} }
connectionBlurb :: [String] connectionBlurb :: [String]