justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Work on terminals and machines

Browse Source
This commit is contained in:
justin
2022-06-06 00:14:46 +01:00
parent a6141fd79a
commit b0173c3778
8 changed files with 81 additions and 66 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/Terminal.hs
+47 -21
View File
@@ -23,40 +23,58 @@ import Shape
import Data.Maybe
putTerminal'
:: Color
putTerminal''
:: Machine
-> (World -> TerminalParams)
-> (Int -> Machine -> World -> World) -- | machine update, takes button id as input
-> Placement
putTerminal' col mcf = ps0PushPS (PutButton termButton)
$ \pl -> Just $ pt0 (PutMachine col (reverse $ square 10) defaultMachine
{ _mcDraw = noPic . terminalShape col
, _mcHP = 100
, _mcUpdate = mcf (fromJust $ _plMID pl)
, _mcSensor = SensorCloseToggle NotClose False
})
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')
)
)
$ const Nothing
where
theterminal = defaultTerminal & tmProgram .~ const f
putTerminal'
:: Color
-> (World -> TerminalParams)
-> (Int -> Machine -> World -> World) -- | machine update, takes button id as input
-> Placement
putTerminal' col = putTerminal'' (defaultMachine & mcColor .~ col)
{ _mcDraw = noPic . terminalShape
, _mcHP = 100
, _mcSensor = SensorCloseToggle NotClose False
}
putTerminal :: Color -> (World -> TerminalParams) -> Placement
putTerminal col f = ps0PushPSw PutNothing $ \_ _ -> Just $
ps0PushPS (PutButton $ termButton & btTerminalParams .~ f)
$ \pl -> Just $ pt0 (PutMachine col (reverse $ square 10) defaultMachine
{ _mcDraw = noPic . terminalShape col
putTerminal col f = 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 . _btID
, _btEvent = displayTerminalMessage . _btTerminal
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing Nothing [] []
, _btTerminal = Nothing
, _btName = ""
}
@@ -64,9 +82,9 @@ termButton = Button
terminalColor :: Color
terminalColor = dark magenta
terminalShape :: Color -> Machine -> Shape
terminalShape :: Machine -> Shape
--terminalShape _ = upperPrismPoly 15 $ square 10
terminalShape col _ = colorSH col (prismPoly
terminalShape mc = colorSH col (prismPoly
[V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
[V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0]
)
@@ -76,12 +94,20 @@ terminalShape col _ = colorSH col (prismPoly
--[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10]
--[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8) 9, V3 8 (-8) 9]
)
where
col = _mcColor mc
displayTerminalMessage :: Int -> World -> World
displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal
{ _termID = btid
, _termParams = fromMaybe NoTerminalParams $ (w ^? buttons . ix btid . btTerminalParams) <&> ($ w)
}
displayTerminalMessage :: Maybe Int -> World -> World
displayTerminalMessage mtmid w = case mtmid of
Nothing -> w
Just tmid -> w & hud . hudElement .~ DisplayInventory DisplayTerminal
{ _termID = tmid
, _termParams = message tmid
}
where
message tmid = fromMaybe NoTerminalParams $ do
tm <- w ^? terminals . ix tmid
return $ _tmProgram tm tm w
simpleTermMessage :: [String] -> World -> TerminalParams
simpleTermMessage = genTermMessage . const