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

Broken: refactor terminals

Browse Source
This commit is contained in:
justin
2022-07-25 00:45:15 +01:00
parent d1bf49319a
commit d219d8d889
25 changed files with 505 additions and 364 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Button/Event.hs
+1 -1
View File
@@ -17,7 +17,7 @@ doButtonEvent be = case be of
ButtonSimpleSwith oneff offeff -> flipSwitch oneff offeff
ButtonAccessTerminal -> accessTerminal . _btTermMID
flipSwitch :: WorldEffect -> WorldEffect -> Button -> World -> World
flipSwitch :: WdWd -> WdWd -> Button -> World -> World
flipSwitch oneff offeff bt
| _btState bt == BtOff = doWorldEffect oneff . dosound
. over (buttons . ix (_btID bt)) turnon
src/Dodge/Data.hs
+4 -62
View File
@@ -86,7 +86,9 @@ module Dodge.Data
, module Dodge.Data.MountedObject
, module Dodge.Data.Machine
, module Dodge.Data.GenParams
, module Dodge.Data.Terminal
) where
import Dodge.Data.Terminal
import Dodge.Data.GenParams
import Dodge.Data.Machine
import Dodge.Data.MountedObject
@@ -255,8 +257,8 @@ data World = World
, _randGen :: StdGen
, _modifications :: IM.IntMap Modification
, _yourID :: Int
, _worldEvents :: [WorldEffect]
, _delayedEvents :: [(Int,WorldEffect)]
, _worldEvents :: [WdWd]
, _delayedEvents :: [(Int,WdWd)]
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _toPlaySounds :: M.Map SoundOrigin Sound
@@ -355,19 +357,6 @@ data MenuOption
{ _moKey :: Scancode
, _moEff :: Universe -> IO (Maybe Universe)
}
data TerminalLine
= TerminalLineDisplay
{_tlPause :: Int
,_tlString :: World -> (String, Color)
}
| TerminalLineTerminalEffect
{_tlPause :: Int
,_tlTermEffect :: Terminal -> Terminal
}
| TerminalLineEffect
{_tlPause :: Int
,_tlEffect :: Terminal -> World -> World
}
data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
deriving (Eq,Ord,Show,Read)
@@ -402,49 +391,6 @@ type HitEffect' = Flame
-> (World,Maybe Flame)
data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
deriving (Eq,Ord,Show)
data TerminalInput = TerminalInput
{ _tiText :: T.Text
, _tiFocus :: Bool
, _tiSel :: (Int,Int)
}
data Terminal = Terminal
{ _tmID :: Int
, _tmBootProgram :: Terminal -> World -> [TerminalLine]
, _tmButtonID :: Int
, _tmMachineID :: Int
, _tmName :: String
, _tmDisplayedLines :: [(String,Color)]
, _tmFutureLines :: [TerminalLine]
, _tmMaxLines :: Int
, _tmTitle :: String
, _tmInput :: TerminalInput
, _tmScrollCommands :: [TerminalCommand]
, _tmWriteCommands :: [TerminalCommand]
, _tmDeathEffect :: Terminal -> World -> World
, _tmStatus :: TerminalStatus
, _tmCommandHistory :: [String]
, _tmToggles :: M.Map String TerminalToggle
}
data TerminalToggle = TerminalToggle
{ _ttTriggerID :: Int
, _ttDeathEffect :: Bool -> Bool
}
data EffectArguments
= NoArguments {_cmdEffect :: [TerminalLine]}
| OneArgument
{_argType :: String
,_argList :: M.Map String [TerminalLine]
}
data TerminalCommand = TerminalCommand
{ _tcString :: String
, _tcAlias :: [String]
, _tcHelp :: String
, _tcEffect :: Terminal -> World -> EffectArguments
}
---- ROOM DATATYPES
data PSType = PutCrit {_unPutCrit :: Creature}
@@ -547,16 +493,12 @@ data InPlacement = InPlacement
makeLenses ''World
makeLenses ''FloorItem
--makeLenses ''Particle
makeLenses ''Terminal
makeLenses ''Universe
makeLenses ''GunBarrels
makeLenses ''Nozzle
makeLenses ''TerminalLine
makeLenses ''Equipment
makeLenses ''ScreenLayer
makeLenses ''WorldBeams
makeLenses ''TerminalCommand
makeLenses ''TerminalInput
----- ROOM LENSES
makeLenses ''Room
src/Dodge/Data/Button.hs
+3 -3
View File
@@ -15,7 +15,7 @@ data ButtonEvent = ButtonDoNothing
{_bpState :: ButtonState
,_bpEvent :: ButtonEvent
,_bpSound :: SoundID
,_bpEff :: WorldEffect
,_bpEff :: WdWd
}
-- | ButtonSwitch
-- {_bonState :: ButtonState
@@ -28,8 +28,8 @@ data ButtonEvent = ButtonDoNothing
-- ,_boffEff :: WorldEffect
-- }
| ButtonSimpleSwith
{_bonEff :: WorldEffect
,_boffEff :: WorldEffect
{_bonEff :: WdWd
,_boffEff :: WdWd
}
| ButtonAccessTerminal
src/Dodge/Data/Corpse.hs
+2 -2
View File
@@ -5,9 +5,8 @@ import ShapePicture.Data
import Geometry.Data
import Control.Lens
data CorpseResurrection = NoResurrection
deriving (Eq,Ord,Show,Read)
data Corpse = Corpse
{ _cpID :: Int
, _cpPos :: Point2
@@ -15,4 +14,5 @@ data Corpse = Corpse
, _cpSPic :: SPic
, _cpRes :: CorpseResurrection
}
deriving (Eq,Ord,Show,Read)
makeLenses ''Corpse
src/Dodge/Data/ForegroundShape.hs
+1 -1
View File
@@ -12,5 +12,5 @@ data ForegroundShape = ForegroundShape
, _fsRad :: Float -- This should probably be a bounding box
, _fsSPic :: SPic
}
deriving ()
deriving (Eq,Ord,Show,Read)
makeLenses ''ForegroundShape
src/Dodge/Data/Machine.hs
+3 -1
View File
@@ -20,6 +20,7 @@ data MachineDraw = MachineDrawMempty
| MachineDrawTerminal
| MachineDrawTurret
| MachineDrawDamageSensor Float (PaletteColor,DecorationShape)
deriving (Eq,Ord,Show,Read)
data Machine = Machine
{ _mcID :: Int
, _mcWallIDs :: IS.IntSet
@@ -36,6 +37,7 @@ data Machine = Machine
, _mcName :: String
, _mcCloseSound :: Maybe SoundID
}
deriving (Eq,Ord,Show,Read)
data MachineType
= StaticMachine
| Turret
@@ -44,6 +46,6 @@ data MachineType
, _tuFireTime :: Int
, _tuMCrID :: Maybe Int
}
deriving (Eq,Ord,Show,Read)
makeLenses ''Machine
makeLenses ''MachineType
src/Dodge/Data/Sensor.hs
+3 -3
View File
@@ -17,13 +17,13 @@ data Sensor = NoSensor
, _proxRequirement :: ProximityRequirement
, _sensToggle :: Bool
}
deriving (Eq,Ord)
deriving (Eq,Ord,Show,Read)
data ProximityRequirement
= RequireHealth {_proxReqMinHealth :: Int}
| RequireEquipment {_proxReqEquipment :: ItemBaseType}
| RequireImpossible
deriving (Eq,Ord,Show)
deriving (Eq,Ord,Show,Read)
data CloseToggle = NotClose | IsClose
deriving (Eq,Ord,Show)
deriving (Eq,Ord,Show,Read)
makeLenses ''Sensor
makeLenses ''ProximityRequirement
src/Dodge/Data/Terminal.hs
+99
View File
@@ -0,0 +1,99 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Terminal
where
import Dodge.Data.WorldEffect
import Color
import Control.Lens
import qualified Data.Text as T
import qualified Data.Map.Strict as M
data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
deriving (Eq,Ord,Show,Read)
data TerminalInput = TerminalInput
{ _tiText :: T.Text
, _tiFocus :: Bool
, _tiSel :: (Int,Int)
}
deriving (Eq,Ord,Show,Read)
data TerminalBootProgram = TerminalBootMempty
| TerminalBootLines [TerminalLine]
deriving (Eq,Ord,Show,Read)
data Terminal = Terminal
{ _tmID :: Int
, _tmBootProgram :: TerminalBootProgram -- Terminal -> World -> [TerminalLine]
, _tmButtonID :: Int
, _tmMachineID :: Int
, _tmName :: String
, _tmDisplayedLines :: [(String,Color)]
, _tmFutureLines :: [TerminalLine]
, _tmMaxLines :: Int
, _tmTitle :: String
, _tmInput :: TerminalInput
, _tmScrollCommands :: [TerminalCommand]
, _tmWriteCommands :: [TerminalCommand]
, _tmDeathEffect :: TmWdWd -- Terminal -> World -> World
, _tmStatus :: TerminalStatus
, _tmCommandHistory :: [String]
, _tmToggles :: M.Map String TerminalToggle
}
deriving (Eq,Ord,Show,Read)
data TerminalLineString = TerminalLineConst String Color
deriving (Eq,Ord,Show,Read)
data TmTm = TmId
| TmTmClearDisplayedLines
| TmTmSetStatus TerminalStatus
deriving (Eq,Ord,Show,Read)
data TerminalLine
= TerminalLineDisplay
{_tlPause :: Int
,_tlString :: TerminalLineString -- World -> (String, Color)
}
| TerminalLineTerminalEffect
{_tlPause :: Int
,_tlTermEffect :: TmTm -- Terminal -> Terminal
}
| TerminalLineEffect
{_tlPause :: Int
,_tlEffect :: TmWdWd --Terminal -> World -> World
}
deriving (Eq,Ord,Show,Read)
data TerminalToggle = TerminalToggle
{ _ttTriggerID :: Int
, _ttDeathEffect :: BlBl
}
deriving (Eq,Ord,Show,Read)
data BlBl = BlNegate
| BlConst Bool
| BlId
deriving (Eq,Ord,Show,Read)
data EffectArguments
= NoArguments {_cmdEffect :: [TerminalLine]}
| OneArgument
{_argType :: String
,_argList :: M.Map String [TerminalLine]
}
deriving (Eq,Ord,Show,Read)
data TerminalCommandEffect = TerminalCommandArguments EffectArguments
| TerminalCommandEffectDamageCoding
| TerminalCommandEffectSensorParameter
| TerminalCommandEffectLinkedObject
| TerminalCommandEffectHelp
| TerminalCommandEffectNoArgumentsStr String
| TerminalCommandEffectCommands
| TerminalCommandEffectSingleCommand WdWd [String]
| TerminalCommandEffectNone
deriving (Eq,Ord,Show,Read)
data TerminalCommand = TerminalCommand
{ _tcString :: String
, _tcAlias :: [String]
, _tcHelp :: String
, _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
}
deriving (Eq,Ord,Show,Read)
makeLenses ''Terminal
makeLenses ''TerminalLine
makeLenses ''TerminalCommand
makeLenses ''TerminalInput
src/Dodge/Data/WorldEffect.hs
+9 -2
View File
@@ -3,15 +3,16 @@ import Dodge.Data.CreatureEffect
import Sound.Data
import Geometry.Data
import Dodge.Data.SoundOrigin
data WorldEffect = NoWorldEffect
data WdWd = NoWorldEffect
| SetTrigger Bool Int
| WorldEffects [WorldEffect]
| WorldEffects [WdWd]
| SetLSCol Point3 Int
| AccessTerminal (Maybe Int)
| UnlockInv Int
| SoundStart SoundOrigin Point2 SoundID (Maybe Int)
| MakeStartCloudAt Point3
| TorqueCr Float Int
| WdWdNegateTrig Int
deriving (Eq,Ord,Show,Read)
data WdP2 = WdP2Const Point2
| WdYouPos
@@ -37,3 +38,9 @@ data DrWdWd = DrWdId
| DrWdMechanismStepwise Int [Int] [(Point2,Point2)]
| DoorMechanism
deriving (Eq,Ord,Show,Read)
data TmWdWd = TmWdId
| TmWdWdDisconnectTerminal
| TmWdWdfromWdWd WdWd
| TmWdWdTermSound SoundID
| TmWdWdDoDeathTriggers
deriving (Eq,Ord,Show,Read)
src/Dodge/Default.hs
+2 -25
View File
@@ -11,7 +11,9 @@ module Dodge.Default
, module Dodge.Default.Weapon
, module Dodge.Default.Wall
, module Dodge.Default.Creature
, module Dodge.Default.Terminal
) where
import Dodge.Default.Terminal
import Dodge.Default.Wall
import Dodge.Default.Creature
import Dodge.Default.Weapon
@@ -58,31 +60,6 @@ defaultMachine = Machine
, _mcMounts = mempty
, _mcCloseSound = Nothing
}
defaultTerminal :: Terminal
defaultTerminal = Terminal
{ _tmID = 0
, _tmBootProgram = \_ _ -> []
, _tmButtonID = 0
, _tmMachineID = 0
, _tmName = "TESTTERMINAL"
, _tmDisplayedLines = []
, _tmFutureLines = []
, _tmMaxLines = 14
, _tmTitle = "TERMINAL IN LOCATION"
, _tmInput = defaultTerminalInput
, _tmScrollCommands = []
, _tmWriteCommands = []
, _tmDeathEffect = const id
, _tmStatus = TerminalOff
, _tmCommandHistory = []
, _tmToggles = M.empty
}
defaultTerminalInput :: TerminalInput
defaultTerminalInput = TerminalInput
{ _tiText = T.pack ""
, _tiFocus = True
, _tiSel = (0,0)
}
defaultButton :: Button
defaultButton = Button
src/Dodge/Default/Terminal.hs
+32
View File
@@ -0,0 +1,32 @@
module Dodge.Default.Terminal
where
import Dodge.Data.WorldEffect
import Dodge.Data.Terminal
import qualified Data.Map.Strict as M
import qualified Data.Text as T
defaultTerminal :: Terminal
defaultTerminal = Terminal
{ _tmID = 0
, _tmBootProgram = TerminalBootMempty
, _tmButtonID = 0
, _tmMachineID = 0
, _tmName = "TESTTERMINAL"
, _tmDisplayedLines = []
, _tmFutureLines = []
, _tmMaxLines = 14
, _tmTitle = "TERMINAL IN LOCATION"
, _tmInput = defaultTerminalInput
, _tmScrollCommands = []
, _tmWriteCommands = []
, _tmDeathEffect = TmWdId
, _tmStatus = TerminalOff
, _tmCommandHistory = []
, _tmToggles = M.empty
}
defaultTerminalInput :: TerminalInput
defaultTerminalInput = TerminalInput
{ _tiText = T.pack ""
, _tiFocus = True
, _tiSel = (0,0)
}
src/Dodge/Event.hs
+3 -14
View File
@@ -14,6 +14,7 @@ the simulation step; in particular see 'updatePressedButtons'.
module Dodge.Event
( handleEvent
) where
import Dodge.Terminal
import Dodge.Tweak
import Dodge.HeldScroll
import Dodge.InputFocus
@@ -142,7 +143,7 @@ getArguments' :: TerminalCommand -> Terminal -> World -> [String]
getArguments' tc tm = ("" :) . getArguments tc tm
getArguments :: TerminalCommand -> Terminal -> World -> [String]
getArguments tc tm w = case _tcEffect tc tm w of
getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
NoArguments {} -> []
OneArgument _ m -> M.keys m
@@ -153,7 +154,7 @@ nullCommand = TerminalCommand
{ _tcString = ""
, _tcAlias = []
, _tcHelp = ""
, _tcEffect = \_ _ -> NoArguments []
, _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments []
}
scrollRBOption :: Float -> World -> World
@@ -162,18 +163,6 @@ scrollRBOption y w
| y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1)
| otherwise = w
-- nice idea, but the chain of setters and getters seems prohibitive
--scrollOver :: Foldable t
-- => ASetter s s Int Int -- index setter
-- -> Getting (First (t a)) s (t a) -- pointer to object of size
-- -> Float -- direction
-- -> s -> s
--scrollOver theset theget y w = case w ^? theget of
-- Just t -> w & theset %~ ( (`mod` length t) . (subtract y'))
-- Nothing -> w
-- where
-- y' = round $ signum y
moveTweakSel :: Int -> World -> World
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
Just l -> w & creatures . ix (_yourID w) . crInv . ix (crSel (you w))
src/Dodge/Item/Weapon/TriggerType.hs
+2 -1
View File
@@ -63,6 +63,7 @@ module Dodge.Item.Weapon.TriggerType
, modClock
, ammoHammerCheck
) where
import Dodge.Data.WorldEffect
import Dodge.Data
import Dodge.Base.Collide
import Dodge.SoundLogic
@@ -543,7 +544,7 @@ spreadLoaded eff item cr w = foldr f w dirs
numBulLoaded = _laLoaded $ _itConsumption item
sideEffectOnFrame :: Int
-> (Item -> Creature -> WorldEffect)
-> (Item -> Creature -> WdWd)
-> ChainEffect
sideEffectOnFrame i sf f it cr w = f it cr w
& delayedEvents .:~ (i, sf it cr)
src/Dodge/LevelGen/Switch.hs
+5 -5
View File
@@ -14,7 +14,7 @@ import Geometry
makeButton
:: Color
-> WorldEffect -- ^ Effect when pressed
-> WdWd -- ^ Effect when pressed
-> Button
makeButton col eff = defaultButton
{ _btPict = DefaultDrawButton col
@@ -38,8 +38,8 @@ drawSwitchWire col1 col2 bt
makeSwitchSPic
:: ButtonDraw
-> WorldEffect -- ^ Switch on effect
-> WorldEffect -- ^ Switch off effect
-> WdWd -- ^ Switch on effect
-> WdWd -- ^ Switch off effect
-> Button
makeSwitchSPic dswitch effOn effOff = defaultButton
{ _btPict = dswitch
@@ -51,7 +51,7 @@ makeSwitchSPic dswitch effOn effOff = defaultButton
makeSwitch
:: Color
-> Color
-> WorldEffect -- ^ Switch on effect
-> WorldEffect -- ^ Switch off effect
-> WdWd -- ^ Switch on effect
-> WdWd -- ^ Switch off effect
-> Button
makeSwitch col1 col2 = makeSwitchSPic (DefaultDrawSwitch col1 col2)
src/Dodge/Machine/Destroy.hs
+3 -1
View File
@@ -1,4 +1,6 @@
module Dodge.Machine.Destroy where
import Dodge.WorldEffect
import Dodge.Terminal
import Dodge.Wall.Delete
import Dodge.Data
import Dodge.WorldEvent.Explosion
@@ -19,7 +21,7 @@ mcKillTerm mc w = fromMaybe w $ do
tmid <- mc ^? mcMounts . ix ObTerminal
tm <- w ^? terminals . ix tmid
return $ w
& _tmDeathEffect tm tm
& doTmWdWd (_tmDeathEffect tm) tm
mcKillBut :: Machine -> World -> World
mcKillBut mc w = fromMaybe w $ do
src/Dodge/Placement/Instance/LightSource.hs
-3
View File
@@ -24,10 +24,7 @@ propLSThen :: PropUpdate
-> Placement
propLSThen propf lsf ls prop cont = pt0 (PutLS ls)
$ \lspl -> Just $ pt0 (PutProp $ prop & prUpdate .~ PropUpdates [propf,PropUpdateLS (fromJust $ _plMID lspl) lsf])
-- theupdate (fromJust $ _plMID lspl))
$ cont lspl
where
--theupdate lsid pr w = propf pr w & lightSources . ix lsid %~ lsf pr w
moveLSThen :: WdP2f --(World -> (Point2,Float))
-> Point3 -- ^ light source offset
src/Dodge/Placement/Instance/Terminal.hs
+2 -21
View File
@@ -2,15 +2,14 @@
module Dodge.Placement.Instance.Terminal
( putMessageTerminal
, putTerminal
, simpleTermMessage
-- , simpleTermMessage
, terminalColor
, accessTerminal
-- , accessTerminal
) where
import Dodge.Data
import Dodge.LevelGen.Data
import Dodge.Default
import Dodge.SoundLogic
import Dodge.Terminal
import Color
import Geometry
import LensHelp
@@ -61,21 +60,3 @@ termButton = Button
terminalColor :: Color
terminalColor = dark magenta
accessTerminal :: Maybe Int -> World -> World
accessTerminal mtmid w = case mtmid of
Nothing -> w
Just tmid -> w & hud . hudElement .~ DisplayInventory (DisplayTerminal tmid)
& terminals . ix tmid . tmInput . tiFocus .~ True
& terminals . ix tmid %~ tryToBoot
where
tryToBoot tm = case _tmStatus tm of
TerminalReady -> tm
TerminalBusy -> tm
TerminalOff -> tm
& tmFutureLines .~ _tmBootProgram tm tm w
& tmStatus .~ TerminalBusy
simpleTermMessage :: [String] -> Terminal
simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs
src/Dodge/Prop/Draw.hs
+1 -1
View File
@@ -15,7 +15,7 @@ drawProp :: PropDraw -> Prop -> SPic
drawProp pd = case pd of
PropDrawSPic spic -> const spic
PropDrawMovingShape pd' -> \pr -> drawMovingShape pr (fst $ drawProp pd' pr)
PropDrawMovingShapeCol sh -> \pr -> drawMovingShapeCol pr sh
PropDrawMovingShapeCol sh -> (`drawMovingShapeCol` sh)
PropDoubleLampCover h -> drawDoubleLampCover h
PropVerticalLampCover h -> drawVerticalLampCover h
PropLampCover h -> drawLampCover h
src/Dodge/Room/Warning.hs
+2 -1
View File
@@ -1,5 +1,6 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Room.Warning where
import Dodge.WorldEffect
import Dodge.Cleat
import Dodge.Terminal
import Dodge.PlacementSpot
@@ -44,7 +45,7 @@ addWarningTerminal str outplid = (rmName .++~ "warningTerm-")
termMessages trpl = lineOutputTerminal (makeColorTermLine red "WARNING":makeTermPara str)
& tmScrollCommands .:~ toggleCommand
& tmToggles .~ M.fromList
[("DOOR",TerminalToggle (fromJust $ _plMID trpl) (const True))]
[("DOOR",TerminalToggle (fromJust $ _plMID trpl) (BlConst True))]
moveToSideFirstOutLink :: RoomPos -> Room -> Maybe (Point2,Float)
moveToSideFirstOutLink rp rm = case rp ^? rpLinkStatus . rplsChildNum of
src/Dodge/Terminal.hs
+64 -213
View File
@@ -1,5 +1,12 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Terminal where
import Dodge.SoundLogic
import Dodge.WorldEvent.Cloud
import Dodge.Data
import Dodge.Inventory.Lock
import Dodge.Placement.Instance.Terminal
import Dodge.Data.WorldEffect
import Dodge.Data.Terminal
import Dodge.Data
import Dodge.Default
--import Dodge.Base
@@ -18,75 +25,46 @@ import qualified IntMapHelp as IM
import qualified Data.Text as T
--import Text.Read
import System.Random
import Control.Lens
basicTerminal :: Terminal
basicTerminal = defaultTerminal
{_tmDisplayedLines = []
,_tmFutureLines = []
,_tmMaxLines = 14
,_tmTitle = "TERMINAL"
,_tmInput = defaultTerminalInput
,_tmScrollCommands = [quitCommand]
,_tmWriteCommands = [helpCommand,commandsCommand]
,_tmBootProgram = TerminalBootLines connectionBlurb
, _tmDeathEffect = TmWdWdDoDeathTriggers
}
connectionBlurbLines :: [TerminalLine] -> [TerminalLine]
connectionBlurbLines tls =
[termSoundLine computerBeepingS
,TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor)
,TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor)
,TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor)
] ++ tls ++
[TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady)]
quitCommand :: TerminalCommand
quitCommand = TerminalCommand
{ _tcString = "QUIT"
, _tcAlias = ["Q","EXIT","X","SHUTDOWN",""]
, _tcHelp = "DISCONNECTS THE TERMINAL."
, _tcEffect = \_ _ -> NoArguments [TerminalLineEffect 0 disconnectTerminal]
, _tcEffect = TerminalCommandArguments $ NoArguments [TerminalLineEffect 0 TmWdWdDisconnectTerminal]
}
disconnectTerminal :: Terminal -> World -> World
disconnectTerminal tm w = w
& terminals . ix (_tmID tm) . tmStatus .~ TerminalOff
& exitTerminalSubInv
& terminals . ix (_tmID tm) . tmFutureLines .~
[ TerminalLineTerminalEffect 0 (tmDisplayedLines .~ []) ]
exitTerminalSubInv :: World -> World
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w
damageCodeCommand :: TerminalCommand
damageCodeCommand = TerminalCommand
{ _tcString = "DAMAGECODE"
, _tcAlias = ["DCODE","DC"]
, _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE."
, _tcEffect = \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
}
getDamageCoding :: World -> M.Map String [TerminalLine]
getDamageCoding = decodedtmap . _sensorCoding . _genParams
decodedtmap :: M.Map DamageType (PaletteColor,DecorationShape) -> M.Map String [TerminalLine]
decodedtmap = M.mapKeys show . M.map ((:[]) . makeTermLine . show)
sensorCommand :: TerminalCommand
sensorCommand = TerminalCommand
{ _tcString = "SENSOR"
, _tcAlias = ["SEN"]
, _tcHelp = "ACCESS INFORMATION CONCERNING THE CONNECTED SENSOR."
, _tcEffect = \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
}
sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine]
sensorInfoMap tm w = M.fromList
[("REQUIREMENT", getSensor _proxRequirement tm w)
,("DISTANCE", getSensor _proxDist tm w)
,("CURRENTSTATUS", getSensor _proxStatus tm w)
,("PASTSTATUS", getSensor _sensToggle tm w)
]
getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine]
getSensor f tm w = maybe [] (makeTermPara . map toUpper . show . f)
(w ^? machines . ix (_tmMachineID tm) . mcSensor)
toggleCommand :: TerminalCommand
toggleCommand = TerminalCommand
{ _tcString = "TOGGLE"
, _tcAlias = ["TOG"]
, _tcHelp = "PERFORMS A REVERSABLE EFFECT."
, _tcEffect = \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
}
togglesToEffects :: Terminal -> M.Map String [TerminalLine]
togglesToEffects = fmap f . _tmToggles
where
f tt = [TerminalLineEffect 0 $ \_ -> triggers . ix (_ttTriggerID tt) %~ not]
helpCommand :: TerminalCommand
helpCommand = TerminalCommand
{ _tcString = "HELP"
, _tcAlias = ["H","MAN"]
, _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND."
, _tcEffect = \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
, _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
}
getCommandsHelp :: Terminal -> World -> M.Map String [TerminalLine]
getCommandsHelp tm w = foldr f mempty $ getCommands tm
where
@@ -100,20 +78,37 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm
(arghelp,Just args) -> makeTermPara (_tcHelp tc ++ " " ++ arghelp)
++ [makeColorTermLine commandColor $ unwords args]
)
commandsCommand :: TerminalCommand
commandsCommand = TerminalCommand
{ _tcString = "COMMANDS"
, _tcAlias = ["COMMAND","COM"]
, _tcHelp = "DISPLAYS AVAILABLE COMMANDS."
, _tcEffect = TerminalCommandEffectCommands
}
connectionBlurb :: [TerminalLine]
connectionBlurb =
[termSoundLine computerBeepingS
,TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor)
,TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor)
,TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor)
,TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady)]
termSoundLine :: SoundID -> TerminalLine
termSoundLine sid = TerminalLineEffect 0 (TmWdWdTermSound sid)
-- where
-- termsound tm w = soundStart TerminalSound tpos sid Nothing w
-- where
-- tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos
termTextColor :: Color
termTextColor = greyN 0.9
getCommands :: Terminal -> [TerminalCommand]
getCommands tm = _tmScrollCommands tm ++ _tmWriteCommands tm
infoClearInput :: Terminal -> [TerminalLine] -> World -> World
infoClearInput tm tls = terminals . ix (_tmID tm) %~
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~ tls)
)
argumentHelp :: TerminalCommand -> Terminal -> World -> (String,Maybe [String])
argumentHelp tc tm w = case _tcEffect tc tm w of
NoArguments {} -> ("ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED.",Nothing)
OneArgument argtype argm -> ("EXPECTS " ++ argtype ++ " AS ARGUMENT. AVAILABLE ARGUMENTS: "
, Just (M.keys argm) )
makeTermLine :: String -> TerminalLine
makeTermLine = makeColorTermLine termTextColor
makeTermPara :: String -> [TerminalLine]
makeTermPara = map makeTermLine . makeParagraph 60
@@ -122,151 +117,7 @@ makeColorTermPara :: Color -> String -> [TerminalLine]
makeColorTermPara col = map (makeColorTermLine col) . makeParagraph 60
makeColorTermLine :: Color -> String -> TerminalLine
makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col)
makeTermLine :: String -> TerminalLine
makeTermLine = makeColorTermLine termTextColor
termTextColor :: Color
termTextColor = greyN 0.9
termSoundLine :: SoundID -> TerminalLine
termSoundLine sid = TerminalLineEffect 0 termsound
where
termsound tm w = soundStart TerminalSound tpos sid Nothing w
where
tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos
infoCommand :: String -> TerminalCommand
infoCommand str = TerminalCommand
{ _tcString = "INFORMATION"
, _tcAlias = ["INFO","I"]
, _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
, _tcEffect = \_ _ -> NoArguments (makeTermPara str)
}
commandsCommand :: TerminalCommand
commandsCommand = TerminalCommand
{ _tcString = "COMMANDS"
, _tcAlias = ["COMMAND","COM"]
, _tcHelp = "DISPLAYS AVAILABLE COMMANDS."
, _tcEffect = \tm _ -> NoArguments
( makeTermLine "AVAILABLE COMMANDS:"
: makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm))
)
}
makeColorTermLine col str = TerminalLineDisplay 0 $ TerminalLineConst str col
commandColor :: Color
commandColor = yellow
singleCommand :: [String] -> String -> [String] -> String -> (World -> World) -> TerminalCommand
singleCommand followingLines command aliases htext eff = TerminalCommand
{_tcString = command
,_tcAlias = aliases
,_tcHelp = htext
,_tcEffect = \_ _ -> NoArguments $ TerminalLineEffect 0 (const eff) : map makeTermLine followingLines
}
guardDisconnected :: Terminal -> World -> World -> World
guardDisconnected tm w w' = case _tmStatus tm of
TerminalOff -> w
TerminalBusy -> w
TerminalReady -> w'
doTerminalEffectLB :: Terminal -> World -> World
doTerminalEffectLB tm w = guardDisconnected tm w $ fromMaybe w $ do
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
if null (words s)
then Just $ defocusTerminalInput w
else return $ terminalReturnEffect tm w
terminalReturnEffect :: Terminal -> World -> World
terminalReturnEffect tm w = guardDisconnected tm w $ fromMaybe w $ do
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
return $ runTerminalString s tm $ w
& terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>':s)]
commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do
(str,args) <- safeUncons $ words s
command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm)
case _tcEffect command tm w of
NoArguments tls -> Just tls
OneArgument argtype m -> Just $ fromMaybe [errline $ "^ INVALID ARGUMENT: EXPECTS "++ argtype]
$ safeHead args >>= (m M.!?)
where
errline = makeColorTermLine red
runTerminalString :: String -> Terminal -> World -> World
runTerminalString s tm w = w & terminals . ix (_tmID tm) %~
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~ commandFutureLines s tm w)
. (tmCommandHistory %~ take 10 . (s:))
)
defocusTerminalInput :: World -> World
defocusTerminalInput w = fromMaybe w $ do
tmid <- w ^? hud . hudElement . subInventory . termID
return $ w & terminals . ix tmid . tmInput . tiFocus %~ const False
doCommandInstant :: String -> Terminal -> World -> World
doCommandInstant arg tm w = doLineEffectsInstant tm w $ commandFutureLines arg tm w
-- doesn't do internal terminal effects
doLineEffectsInstant :: Terminal -> World -> [TerminalLine] -> World
doLineEffectsInstant tm = foldr f
where
f tl w = case tl of
TerminalLineEffect _ eff -> eff tm w
_ -> w
basicTerminal :: Terminal
basicTerminal = defaultTerminal
{_tmDisplayedLines = []
,_tmFutureLines = []
,_tmMaxLines = 14
,_tmTitle = "TERMINAL"
,_tmInput = defaultTerminalInput
,_tmScrollCommands = [quitCommand]
,_tmWriteCommands = [helpCommand,commandsCommand]
,_tmBootProgram = \_ _ -> connectionBlurb
, _tmDeathEffect = doDeathTriggers
}
lineOutputTerminal :: [TerminalLine] -> Terminal
lineOutputTerminal tls = defaultTerminal
{_tmDisplayedLines = []
,_tmFutureLines = []
,_tmMaxLines = 14
,_tmTitle = "TERMINAL"
,_tmInput = defaultTerminalInput
,_tmScrollCommands = [quitCommand]
,_tmWriteCommands = [helpCommand,commandsCommand]
,_tmBootProgram = \_ _ -> connectionBlurbLines tls
, _tmDeathEffect = doDeathTriggers
}
doDeathTriggers :: Terminal -> World -> World
doDeathTriggers tm w = w
& triggers %~ flip (foldl' $ flip doDeathToggle) xs
where
xs = M.elems $ _tmToggles tm
doDeathToggle :: TerminalToggle -> IM.IntMap Bool -> IM.IntMap Bool
doDeathToggle (TerminalToggle trid f) = ix trid %~ f
connectionBlurb :: [TerminalLine]
connectionBlurb =
[termSoundLine computerBeepingS
,TerminalLineDisplay 0 (const ("CONNECTING",termTextColor))
,TerminalLineDisplay 10 (const ("...",termTextColor))
,TerminalLineDisplay 10 (const ("CONNECTED",termTextColor))
,TerminalLineTerminalEffect 0 (tmStatus .~ TerminalReady)]
connectionBlurbLines :: [TerminalLine] -> [TerminalLine]
connectionBlurbLines tls =
[termSoundLine computerBeepingS
,TerminalLineDisplay 0 (const ("CONNECTING",termTextColor))
,TerminalLineDisplay 10 (const ("...",termTextColor))
,TerminalLineDisplay 10 (const ("CONNECTED",termTextColor))
] ++ tls ++
[TerminalLineTerminalEffect 0 (tmStatus .~ TerminalReady)]
src/Dodge/TerminalCommandEffect.hs
+4
View File
@@ -0,0 +1,4 @@
module Dodge.TerminalCommandEffect
where
import Dodge.Data
src/Dodge/TmTm.hs
+9
View File
@@ -0,0 +1,9 @@
module Dodge.TmTm
where
import Dodge.Data.Terminal
import Control.Lens
doTmTm :: TmTm -> Terminal -> Terminal
doTmTm tmtm = case tmtm of
TmTmClearDisplayedLines -> tmDisplayedLines .~ []
TmTmSetStatus s -> tmStatus .~ s
src/Dodge/TmWdWd.hs
+6
View File
@@ -0,0 +1,6 @@
module Dodge.TmWdWd
where
import Dodge.Terminal
import Dodge.Data
src/Dodge/Update.hs
+10 -3
View File
@@ -4,6 +4,9 @@ Module : Dodge.Update
Description : Simulation update
-}
module Dodge.Update ( updateUniverse ) where
import Dodge.TmTm
import Dodge.Terminal
import Color
import Dodge.DrWdWd
import Dodge.TractorBeam.Update
import Dodge.Prop.Update
@@ -164,20 +167,24 @@ updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mous
-- | _mcHP mc > 0 = _mcUpdate mc mc'
-- | otherwise = destroyMachine mc
displayTerminalLineString :: TerminalLineString -> World -> (String,Color)
displayTerminalLineString tls = case tls of
TerminalLineConst str col -> const (str,col)
tmUpdate :: Terminal -> World -> World
tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of
Nothing -> w
Just tl | _tlPause tl > 0 -> w & pointTermParams . tmFutureLines . ix 0 . tlPause -~ 1
Just (TerminalLineDisplay _ f) -> w & pointTermParams %~
( ( tmFutureLines %~ tail )
. ( tmDisplayedLines .:~ f w )
. ( tmDisplayedLines .:~ displayTerminalLineString f w )
)
Just (TerminalLineEffect _ eff) -> w
& pointTermParams . tmFutureLines %~ tail
& eff tm
& doTmWdWd eff tm
Just (TerminalLineTerminalEffect _ eff) -> w
& pointTermParams . tmFutureLines %~ tail
& pointTermParams %~ eff
& pointTermParams %~ doTmTm eff
where
pointTermParams = terminals . ix (_tmID tm)
src/Dodge/WorldEffect.hs
+235 -1
View File
@@ -1,14 +1,34 @@
module Dodge.WorldEffect where
import Dodge.Terminal
import Dodge.SoundLogic
import Dodge.WorldEvent.Cloud
import Dodge.Data
import Dodge.Inventory.Lock
import Dodge.Placement.Instance.Terminal
import Dodge.Data.WorldEffect
import Dodge.Data.Terminal
import Dodge.Data
import Dodge.Default
--import Dodge.Base
import Dodge.SoundLogic
import Color
import Justify
import LensHelp
import Sound.Data
import ListHelp (safeUncons,safeHead)
import Data.Char
import Data.Maybe
import Data.Foldable
import qualified Data.Map.Strict as M
import qualified IntMapHelp as IM
import qualified Data.Text as T
--import Text.Read
import System.Random
import Control.Lens
doWorldEffect :: WorldEffect -> World -> World
doWorldEffect :: WdWd -> World -> World
doWorldEffect we = case we of
NoWorldEffect -> id
SetTrigger bool tid -> triggers . ix tid .~ bool
@@ -20,9 +40,223 @@ doWorldEffect we = case we of
TorqueCr x cid -> torqueCr x cid
SoundStart so p sid mi -> soundStart so p sid mi
accessTerminal :: Maybe Int -> World -> World
accessTerminal mtmid w = case mtmid of
Nothing -> w
Just tmid -> w & hud . hudElement .~ DisplayInventory (DisplayTerminal tmid)
& terminals . ix tmid . tmInput . tiFocus .~ True
& terminals . ix tmid %~ tryToBoot
where
tryToBoot tm = case _tmStatus tm of
TerminalReady -> tm
TerminalBusy -> tm
TerminalOff -> tm
& tmFutureLines .~ doTerminalBootProgram (_tmBootProgram tm) tm w
& tmStatus .~ TerminalBusy
torqueCr :: Float -> Int -> World -> World
torqueCr x cid w
| cid == 0 = set randGen g $ over cameraRot (+rot) w
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) w
where
(rot, g) = randomR (-x,x) $ _randGen w
disconnectTerminal :: Terminal -> World -> World
disconnectTerminal tm w = w
& terminals . ix (_tmID tm) . tmStatus .~ TerminalOff
& exitTerminalSubInv
& terminals . ix (_tmID tm) . tmFutureLines .~
[ TerminalLineTerminalEffect 0 TmTmClearDisplayedLines ]
exitTerminalSubInv :: World -> World
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w
damageCodeCommand :: TerminalCommand
damageCodeCommand = TerminalCommand
{ _tcString = "DAMAGECODE"
, _tcAlias = ["DCODE","DC"]
, _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE."
, _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
}
getDamageCoding :: World -> M.Map String [TerminalLine]
getDamageCoding = decodedtmap . _sensorCoding . _genParams
decodedtmap :: M.Map DamageType (PaletteColor,DecorationShape) -> M.Map String [TerminalLine]
decodedtmap = M.mapKeys show . M.map ((:[]) . makeTermLine . show)
sensorCommand :: TerminalCommand
sensorCommand = TerminalCommand
{ _tcString = "SENSOR"
, _tcAlias = ["SEN"]
, _tcHelp = "ACCESS INFORMATION CONCERNING THE CONNECTED SENSOR."
, _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
}
sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine]
sensorInfoMap tm w = M.fromList
[("REQUIREMENT", getSensor _proxRequirement tm w)
,("DISTANCE", getSensor _proxDist tm w)
,("CURRENTSTATUS", getSensor _proxStatus tm w)
,("PASTSTATUS", getSensor _sensToggle tm w)
]
getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine]
getSensor f tm w = maybe [] (makeTermPara . map toUpper . show . f)
(w ^? machines . ix (_tmMachineID tm) . mcSensor)
toggleCommand :: TerminalCommand
toggleCommand = TerminalCommand
{ _tcString = "TOGGLE"
, _tcAlias = ["TOG"]
, _tcHelp = "PERFORMS A REVERSABLE EFFECT."
, _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
}
togglesToEffects :: Terminal -> M.Map String [TerminalLine]
togglesToEffects = fmap f . _tmToggles
where
f tt = [TerminalLineEffect 0 $ TmWdWdfromWdWd $ WdWdNegateTrig (_ttTriggerID tt)]
-- \_ -> triggers . ix (_ttTriggerID tt) %~ not]
infoClearInput :: Terminal -> [TerminalLine] -> World -> World
infoClearInput tm tls = terminals . ix (_tmID tm) %~
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~ tls)
)
argumentHelp :: TerminalCommand -> Terminal -> World -> (String,Maybe [String])
argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
NoArguments {} -> ("ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED.",Nothing)
OneArgument argtype argm -> ("EXPECTS " ++ argtype ++ " AS ARGUMENT. AVAILABLE ARGUMENTS: "
, Just (M.keys argm) )
infoCommand :: String -> TerminalCommand
infoCommand str = TerminalCommand
{ _tcString = "INFORMATION"
, _tcAlias = ["INFO","I"]
, _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
, _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str)
}
singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand
singleCommand followingLines command aliases htext eff = TerminalCommand
{_tcString = command
,_tcAlias = aliases
,_tcHelp = htext
,_tcEffect = TerminalCommandEffectSingleCommand eff followingLines }
guardDisconnected :: Terminal -> World -> World -> World
guardDisconnected tm w w' = case _tmStatus tm of
TerminalOff -> w
TerminalBusy -> w
TerminalReady -> w'
doTerminalEffectLB :: Terminal -> World -> World
doTerminalEffectLB tm w = guardDisconnected tm w $ fromMaybe w $ do
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
if null (words s)
then Just $ defocusTerminalInput w
else return $ terminalReturnEffect tm w
terminalReturnEffect :: Terminal -> World -> World
terminalReturnEffect tm w = guardDisconnected tm w $ fromMaybe w $ do
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText
return $ runTerminalString s tm $ w
& terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>':s)]
commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do
(str,args) <- safeUncons $ words s
command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm)
case doTerminalCommandEffect (_tcEffect command) tm w of
NoArguments tls -> Just tls
OneArgument argtype m -> Just $ fromMaybe [errline $ "^ INVALID ARGUMENT: EXPECTS "++ argtype]
$ safeHead args >>= (m M.!?)
where
errline = makeColorTermLine red
runTerminalString :: String -> Terminal -> World -> World
runTerminalString s tm w = w & terminals . ix (_tmID tm) %~
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~ commandFutureLines s tm w)
. (tmCommandHistory %~ take 10 . (s:))
)
defocusTerminalInput :: World -> World
defocusTerminalInput w = fromMaybe w $ do
tmid <- w ^? hud . hudElement . subInventory . termID
return $ w & terminals . ix tmid . tmInput . tiFocus %~ const False
doCommandInstant :: String -> Terminal -> World -> World
doCommandInstant arg tm w = doLineEffectsInstant tm w $ commandFutureLines arg tm w
-- doesn't do internal terminal effects
doLineEffectsInstant :: Terminal -> World -> [TerminalLine] -> World
doLineEffectsInstant tm = foldr f
where
f tl w = case tl of
TerminalLineEffect _ eff -> doTmWdWd eff tm w
_ -> w
lineOutputTerminal :: [TerminalLine] -> Terminal
lineOutputTerminal tls = defaultTerminal
{_tmDisplayedLines = []
,_tmFutureLines = []
,_tmMaxLines = 14
,_tmTitle = "TERMINAL"
,_tmInput = defaultTerminalInput
,_tmScrollCommands = [quitCommand]
,_tmWriteCommands = [helpCommand,commandsCommand]
,_tmBootProgram = TerminalBootLines $ connectionBlurbLines tls
, _tmDeathEffect = TmWdWdDoDeathTriggers
}
doDeathTriggers :: Terminal -> World -> World
doDeathTriggers tm w = w
& triggers %~ flip (foldl' $ flip doDeathToggle) xs
where
xs = M.elems $ _tmToggles tm
doDeathToggle :: TerminalToggle -> IM.IntMap Bool -> IM.IntMap Bool
doDeathToggle (TerminalToggle trid f) = ix trid %~ doBlBl f
doBlBl :: BlBl -> Bool -> Bool
doBlBl bb = case bb of
BlNegate -> not
BlConst bl -> const bl
BlId -> id
doTerminalBootProgram :: TerminalBootProgram -> Terminal -> World -> [TerminalLine]
doTerminalBootProgram tbp = case tbp of
TerminalBootMempty -> \_ _ -> []
TerminalBootLines ls -> \_ _ -> ls
doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
doTerminalCommandEffect tce = case tce of
TerminalCommandArguments eas -> \_ _ -> eas
TerminalCommandEffectDamageCoding -> \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
TerminalCommandEffectSensorParameter -> \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
TerminalCommandEffectLinkedObject -> \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
TerminalCommandEffectHelp -> \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
TerminalCommandEffectNoArgumentsStr str -> \_ _ -> NoArguments (makeTermPara str)
TerminalCommandEffectCommands -> \tm _ -> NoArguments
( makeTermLine "AVAILABLE COMMANDS:"
: makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm))
)
TerminalCommandEffectSingleCommand eff followingLines -> \_ _ -> NoArguments $ TerminalLineEffect 0 (TmWdWdfromWdWd eff) : map makeTermLine followingLines
TerminalCommandEffectNone -> \_ _ -> NoArguments []
doTmWdWd :: TmWdWd -> Terminal -> World -> World
doTmWdWd tmwdwd = case tmwdwd of
TmWdId -> const id
TmWdWdDisconnectTerminal -> disconnectTerminal
TmWdWdTermSound sid -> \tm w -> let tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos
in soundStart TerminalSound tpos sid Nothing w
TmWdWdDoDeathTriggers -> doDeathTriggers
--TmWdWdfromWdWd f -> \_ -> doWorldEffect f
simpleTermMessage :: [String] -> Terminal
simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs