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

Move towards simplifying terminal lines/effects

Browse Source
This commit is contained in:
justin
2025-08-15 11:55:56 +01:00
parent 91d19e7c42
commit 56f4670493
12 changed files with 175 additions and 145 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Terminal.hs
+57 -41
View File
@@ -1,28 +1,29 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Terminal where
module Dodge.Data.Terminal (
module Dodge.Data.Terminal,
module Dodge.Data.Terminal.Status,
) where
import Sound.Data
import Color
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import qualified Data.Map.Strict as M
import Dodge.Data.WorldEffect
import Dodge.Data.BlBl
data TerminalStatus = TerminalOff | TerminalBusy | TerminalTextInput {_tiText :: String}
-- | TerminalArgumentInput TerminalCommand
deriving Eq
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
import Dodge.Data.Terminal.Status
import Dodge.Data.WorldEffect
data TerminalInput = TerminalInput
{ --_tiText :: String
_tiSel :: (Int, Int)
_tiSel :: (Int, Int)
}
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Terminal = Terminal
{ _tmID :: Int
@@ -40,22 +41,23 @@ data Terminal = Terminal
, _tmCommandHistory :: [String]
, _tmToggles :: M.Map String TerminalToggle
, _tmPartialCommand :: Maybe TerminalCommand
-- , _tmType :: TerminalType
-- , _tmType :: TerminalType
}
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
data TerminalType = DefaultTerminal
data TerminalLineString = TerminalLineConst String Color
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data TmTm
= TmId
| TmTmClearDisplayedLines
| TmTmSetStatus TerminalStatus
| TmTmSetPartialCommand (Maybe TerminalCommand)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
-- | TmTmSetPartialCommand (Maybe TerminalCommand)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data TerminalLine
= TerminalLineDisplay
@@ -70,15 +72,16 @@ data TerminalLine
{ _tlPause :: Int
, _tlEffect :: TmWdWd --Terminal -> World -> World
}
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
data TerminalToggle = TerminalToggle
{ _ttTriggerID :: Int
, _ttDeathEffect :: BlBl
}
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data EffectArguments
= NoArguments {_cmdEffect :: [TerminalLine]}
@@ -86,8 +89,9 @@ data EffectArguments
{ _argType :: String
, _argList :: M.Map String [TerminalLine]
}
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
data TerminalCommandEffect
= TerminalCommandArguments EffectArguments
@@ -99,8 +103,9 @@ data TerminalCommandEffect
| TerminalCommandEffectCommands
| TerminalCommandEffectSingleCommand WdWd [String]
| TerminalCommandEffectNone
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
data TerminalCommand = TerminalCommand
{ _tcString :: String
@@ -108,8 +113,18 @@ data TerminalCommand = TerminalCommand
, _tcHelp :: String
, _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
}
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
data TmWdWd
= TmWdId
| TmWdWdDisconnectTerminal
| TmWdWdfromWdWd WdWd
| TmWdWdTermSound SoundID
| TmWdWdDoDeathTriggers
| TmTmClearDisplayedLines
| TmTmSetStatus TerminalStatus
| TmTmSetPartialCommand (Maybe TerminalCommand)
makeLenses ''TerminalInput
makeLenses ''Terminal
@@ -117,17 +132,18 @@ makeLenses ''TerminalLine
makeLenses ''TerminalToggle
makeLenses ''EffectArguments
makeLenses ''TerminalCommand
makeLenses ''TerminalStatus
concat <$> mapM (deriveJSON defaultOptions)
[ ''TerminalStatus
, ''TerminalInput
, ''TerminalLineString
, ''TmTm
, ''TerminalLine
, ''TerminalToggle
, ''EffectArguments
, ''TerminalCommandEffect
, ''TerminalCommand
, ''Terminal
, ''TerminalType
]
concat
<$> mapM
(deriveJSON defaultOptions)
[ ''TerminalInput
, ''TerminalLineString
, ''TmTm
, ''TerminalLine
, ''TerminalToggle
, ''EffectArguments
, ''TerminalCommandEffect
, ''TerminalCommand
, ''TmWdWd
, ''Terminal
, ''TerminalType
]
src/Dodge/Data/WorldEffect.hs
-7
View File
@@ -69,12 +69,6 @@ data DrWdWd
| DoorMechanism
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data TmWdWd
= TmWdId
| TmWdWdDisconnectTerminal
| TmWdWdfromWdWd WdWd
| TmWdWdTermSound SoundID
| TmWdWdDoDeathTriggers
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
@@ -85,4 +79,3 @@ deriveJSON defaultOptions ''MdWdWd
deriveJSON defaultOptions ''WdBl
deriveJSON defaultOptions ''WdP2f
deriveJSON defaultOptions ''DrWdWd
deriveJSON defaultOptions ''TmWdWd
src/Dodge/Default/Terminal.hs
+2 -1
View File
@@ -2,9 +2,10 @@ module Dodge.Default.Terminal
( defaultTerminal
) where
import Dodge.Data.Terminal.Status
import Color
import Dodge.Data.Terminal
import Dodge.Data.WorldEffect
--import Dodge.Data.WorldEffect
defaultTerminal :: Terminal
defaultTerminal =
src/Dodge/InputFocus.hs
+4 -7
View File
@@ -1,8 +1,6 @@
module Dodge.InputFocus (
inTextInputFocus,
) where
module Dodge.InputFocus (inTextInputFocus) where
import Control.Monad
import Dodge.Data.Terminal.Status
import Data.Maybe
import Dodge.Data.World
import LensHelp
@@ -26,10 +24,9 @@ textInputFocus w = case w ^? hud . hudElement . subInventory of
Just (-1) -> Just $ hud . hudElement . subInventory . ciFilter . _Just
_ -> Nothing
Just DisplayTerminal{_termID = tmid} -> do
connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
-- guard $ connectionstatus == TerminalTextInput
-- connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
-- guard $ connectionstatus == TerminalTextInput
return $ cWorld . lWorld . terminals . ix tmid . tmStatus . tiText
_ -> Nothing
where
he = w ^. hud . hudElement
src/Dodge/Render/HUD.hs
+4 -1
View File
@@ -4,6 +4,7 @@ module Dodge.Render.HUD (
drawHUD,
) where
import Dodge.Data.Terminal.Status
import Control.Applicative
import Control.Lens
import Control.Monad
@@ -385,7 +386,9 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
TerminalBusy -> (++ [([cFilledRect], white)])
TerminalTextInput s ->
(++ [(getPromptTM ++ s ++ [cFilledRect], white)])
partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
TerminalPressTo s ->
(++ [("PRESS TO "++s, white)])
-- partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
-- displayInputText tm s
-- | TerminalTextInput <- _tmStatus tm = getPromptTM ++ s
---- | _tmStatus tm == TerminalReady = partcommand tm ++ getPromptTM ++ s
src/Dodge/Terminal.hs
+6 -4
View File
@@ -17,6 +17,8 @@ module Dodge.Terminal (
terminalReturnEffect,
) where
import Dodge.Data.WorldEffect
import Dodge.Data.Terminal.Status
import Color
--import Control.Monad
import Data.Char
@@ -51,7 +53,7 @@ connectionBlurbLines tls =
]
++ tls
++ [ TerminalLineDisplay 10 (TerminalLineConst "READY FOR INPUT" termTextColor)]
++ [TerminalLineTerminalEffect 0 (TmTmSetStatus (TerminalTextInput ""))]
++ [TerminalLineEffect 0 (TmTmSetStatus (TerminalTextInput ""))]
quitCommand :: TerminalCommand
quitCommand =
@@ -212,7 +214,7 @@ disconnectTerminal tm =
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
. exitTerminalSubInv
. ( cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
.~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines]
.~ [TerminalLineEffect 0 TmTmClearDisplayedLines]
)
exitTerminalSubInv :: World -> World
@@ -255,10 +257,10 @@ commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
OneArgument argtype m ->
let setpartial
| null (_tmPartialCommand tm) =
TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just command)) :
TerminalLineEffect 0 (TmTmSetPartialCommand (Just command)) :
makeTermPara ("Expects " ++ argtype ++ " as an argument")
| otherwise =
TerminalLineTerminalEffect 0 (TmTmSetPartialCommand Nothing) :
TerminalLineEffect 0 (TmTmSetPartialCommand Nothing) :
makeTermPara "No argument input, cancelling"
in Just $
fromMaybe setpartial $
src/Dodge/Terminal/Color.hs
+2
View File
@@ -2,6 +2,7 @@ module Dodge.Terminal.Color (
termScreenColor,
) where
import Dodge.Data.Terminal.Status
import Dodge.Data.Terminal
import Color
import Control.Lens
@@ -10,4 +11,5 @@ termScreenColor :: Terminal -> Maybe Color
termScreenColor tm = case tm ^. tmStatus of
TerminalOff -> Nothing
TerminalTextInput _ -> Just green
TerminalPressTo{} -> Just green
TerminalBusy -> Just white
src/Dodge/TmTm.hs
+5 -4
View File
@@ -1,11 +1,12 @@
module Dodge.TmTm where
import Control.Lens
--import Control.Lens
import Dodge.Data.Terminal
doTmTm :: TmTm -> Terminal -> Terminal
doTmTm tmtm = case tmtm of
TmTmClearDisplayedLines -> tmDisplayedLines .~ []
TmTmSetStatus s -> tmStatus .~ s
-- TmTmClearDisplayedLines -> tmDisplayedLines .~ []
-- TmTmSetStatus s -> tmStatus .~ s
TmId -> id
TmTmSetPartialCommand ms -> tmPartialCommand .~ ms
-- TmTmSetPartialCommand ms -> tmPartialCommand .~ ms
src/Dodge/Update/Input/InGame.hs
+1
View File
@@ -5,6 +5,7 @@ module Dodge.Update.Input.InGame (
updateMouseInGame,
) where
import Dodge.Data.Terminal.Status
import Control.Applicative
import Control.Monad
import Data.Foldable
src/Dodge/Update/Scroll.hs
+1
View File
@@ -2,6 +2,7 @@ module Dodge.Update.Scroll (
updateWheelEvent,
) where
import Dodge.Data.Terminal.Status
import Dodge.Data.EquipType
import Padding
import Control.Monad
src/Dodge/WorldEffect.hs
+11
View File
@@ -6,6 +6,7 @@ module Dodge.WorldEffect (
) where
--import Dodge.DoubleTree
import Dodge.Data.Terminal.Status
import Dodge.Item.Grammar
import Dodge.Creature.Impulse.UseItem
import Dodge.BlBl
@@ -59,6 +60,7 @@ accessTerminal mtmid w = fromMaybe w $ do
tryToBoot tm = case _tmStatus tm of
TerminalTextInput {} -> tm
TerminalBusy -> tm
TerminalPressTo {} -> tm
TerminalOff ->
tm
& tmFutureLines .~ _tmBootLines tm
@@ -93,6 +95,15 @@ doDeathToggle (TerminalToggle trid f) = ix trid %~ doBlBl f
doTmWdWd :: TmWdWd -> Terminal -> World -> World
doTmWdWd tmwdwd = case tmwdwd of
TmTmClearDisplayedLines -> \tm -> fromMaybe id $ do
tid <- tm ^? tmID
return $ cWorld . lWorld . terminals . ix tid . tmDisplayedLines .~ []
TmTmSetStatus x -> \tm -> fromMaybe id $ do
tid <- tm ^? tmID
return $ cWorld . lWorld . terminals . ix tid . tmStatus .~ x
TmTmSetPartialCommand x -> \tm -> fromMaybe id $ do
tid <- tm ^? tmID
return $ cWorld . lWorld . terminals . ix tid . tmPartialCommand .~ x
TmWdId -> const id
TmWdWdDisconnectTerminal -> disconnectTerminal
TmWdWdTermSound sid -> \tm w ->