Fix: move terminal functions around

src/Dodge/Event/Keyboard.hs

@@ -4,6 +4,7 @@ module Dodge.Event.Keyboard
     , handleTextInput
     , guardDisconnectedID
     ) where
+import Dodge.Event.Keyboard
 import Dodge.WorldPos
 import Dodge.Button.Event
 import Dodge.Terminal

src/Dodge/Room/LongDoor.hs

@@ -2,6 +2,7 @@
 {- | Rooms containing long doors, probably with a big reveal behind them.
  -}
 module Dodge.Room.LongDoor where
+import Dodge.Terminal
 import Dodge.Data
 import Dodge.Default.Door
 import Dodge.Cleat

src/Dodge/Terminal.hs

@@ -121,3 +121,112 @@ makeColorTermLine col str = TerminalLineDisplay 0 $ TerminalLineConst str col
 
 commandColor :: Color
 commandColor = yellow
+
+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 []
+
+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'
+getDamageCoding :: World -> M.Map String [TerminalLine]
+getDamageCoding = decodedtmap . _sensorCoding . _genParams
+
+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)
+    }
+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
+    }
+
+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
+    }
+
+
+infoClearInput :: Terminal -> [TerminalLine] -> World -> World
+infoClearInput tm tls = terminals . ix (_tmID tm) %~
+    ( (tmInput .~ TerminalInput T.empty True (0,0))
+    . (tmFutureLines ++.~ tls)
+    )
+
+togglesToEffects :: Terminal -> M.Map String [TerminalLine]
+togglesToEffects = fmap f . _tmToggles
+  where
+    f tt = [TerminalLineEffect 0 $ TmWdWdfromWdWd $ WdWdNegateTrig (_ttTriggerID tt)] 
+                                    -- \_ -> triggers . ix (_ttTriggerID tt) %~ not]
+simpleTermMessage :: [String] -> Terminal
+simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs

src/Dodge/Update/UsingInput.hs

@@ -2,6 +2,7 @@
 module Dodge.Update.UsingInput
     ( updateUsingInput
     ) where
+import Dodge.WorldEffect
 import Dodge.Data
 import Dodge.Base.You
 import Dodge.Creature.Impulse.UseItem

src/Dodge/WorldEffect.hs

@@ -61,96 +61,8 @@ torqueCr x cid 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
@@ -234,20 +146,6 @@ doTerminalBootProgram tbp = case tbp of
     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
@@ -258,5 +156,3 @@ doTmWdWd tmwdwd = case tmwdwd of
     TmWdWdDoDeathTriggers -> doDeathTriggers
     --TmWdWdfromWdWd f -> \_ -> doWorldEffect f
 
-simpleTermMessage :: [String] -> Terminal
-simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs