Add file

src/Dodge/Creature/ChaseCrit.hs

@@ -45,16 +45,16 @@ chaseCrit =
 
 chaseCritVocalization :: Vocalization
 chaseCritVocalization =
-            Vocalization
-                seagullChatterS
-                [ seagullBarkS
-                , seagullChatterS
-                , seagullChatter1S
-                , seagullWhistleS
-                , seagullWhistle1S
-                , seagullCryS
-                , seagullCry1S
-                , seagullCry2S
-                ]
-                (50,100)
-                0
+    Vocalization
+        seagullChatterS
+        [ seagullBarkS
+        , seagullChatterS
+        , seagullChatter1S
+        , seagullWhistleS
+        , seagullWhistle1S
+        , seagullCryS
+        , seagullCry1S
+        , seagullCry2S
+        ]
+        (50, 200)
+        0

src/Dodge/Data/Terminal.hs

@@ -31,7 +31,7 @@ data TerminalBootProgram
 
 data Terminal = Terminal
     { _tmID :: Int
-    , _tmBootProgram :: TerminalBootProgram -- Terminal -> World -> [TerminalLine]
+    , _tmBootProgram :: TerminalBootProgram
     , _tmButtonID :: Int
     , _tmMachineID :: Int
     , _tmName :: String
@@ -46,6 +46,7 @@ data Terminal = Terminal
     , _tmStatus :: TerminalStatus
     , _tmCommandHistory :: [String]
     , _tmToggles :: M.Map String TerminalToggle
+    , _tmPartialCommand :: Maybe String
     }
     --deriving (Eq, Show, Read) --, Generic)
     --h--deriving (Eq, Show, Read) --Generic, Flat)
@@ -57,6 +58,7 @@ data TmTm
     = TmId
     | TmTmClearDisplayedLines
     | TmTmSetStatus TerminalStatus
+    | TmTmSetPartialCommand (Maybe String)
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data TerminalLine

src/Dodge/Default/Terminal.hs

@@ -1,6 +1,7 @@
-module Dodge.Default.Terminal where
+module Dodge.Default.Terminal 
+    ( defaultTerminal
+    ) where
 
-import qualified Data.Map.Strict as M
 import Dodge.Data.Terminal
 import Dodge.Data.WorldEffect
 
@@ -22,7 +23,8 @@ defaultTerminal =
         , _tmDeathEffect = TmWdId
         , _tmStatus = TerminalOff
         , _tmCommandHistory = []
-        , _tmToggles = M.empty
+        , _tmToggles = mempty
+        , _tmPartialCommand = mempty
         }
 
 defaultTerminalInput :: TerminalInput

src/Dodge/Inventory.hs

@@ -10,7 +10,7 @@ module Dodge.Inventory (
     rmInvItem,
     updateCloseObjects,
     updateRBList,
-    updateTerminal,
+    checkTermDist,
     closeObjScrollDir,
     changeSwapSel,
     scrollAugInvSel,
@@ -21,6 +21,7 @@ module Dodge.Inventory (
     setInvPosFromSS,
 ) where
 
+import Control.Monad
 import Color
 import Control.Applicative
 import qualified Data.Map.Strict as M
@@ -155,16 +156,20 @@ selNumEndMidHeight cfig ldp sss i j = do
 selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
 selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor
 
-updateTerminal :: World -> World
-updateTerminal = checkTermDist
-
 checkTermDist :: World -> World
-checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
-    Just tmid -> fromMaybe (w & hud . hudElement . subInventory .~ NoSubInventory) $ do
-        btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
-        btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
-        if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
-    Nothing -> w
+--checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
+--    Just tmid -> fromMaybe (w & hud . hudElement . subInventory .~ NoSubInventory) $ do
+--        btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
+--        btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
+--        guard $ dist btpos (_crPos $ you w) < 40
+--        return w
+--    Nothing -> w
+checkTermDist w = fromMaybe w $ do
+    tmid <- w ^? hud . hudElement . subInventory . termID
+    btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
+    btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
+    guard $ dist btpos (_crPos $ you w) > 40
+    return (w & hud . hudElement . subInventory .~ NoSubInventory)
 
 -- this looks ugly...
 updateCloseObjects :: World -> World

src/Dodge/Render/HUD.hs

@@ -3,8 +3,8 @@ module Dodge.Render.HUD (
     drawHUD,
 ) where
 
-import Dodge.SelectionSections.Draw
 import Control.Lens
+import Data.Foldable
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.Vector as V
@@ -22,8 +22,8 @@ import Dodge.Item.Info
 import Dodge.ListDisplayParams
 import Dodge.Render.Connectors
 import Dodge.Render.List
+import Dodge.SelectionSections.Draw
 import Dodge.Tweak.Show
---import Dodge.WorldPos
 import Geometry
 import qualified IntMapHelp as IM
 import Justify
@@ -41,11 +41,10 @@ drawHUD cfig w = case w ^. hud . hudElement of
             <> drawSubInventory subinv cfig w
 
 drawHP :: Configuration -> World -> Picture
-drawHP cfig w = dShadCol white $ displayHP 0 cfig w
-
+drawHP cfig = dShadCol white . displayHP 0 cfig
 
 drawInventory :: SelectionSections () -> World -> Configuration -> Picture
-drawInventory sss w = drawSelectionSections sss (invDisplayParams w)
+drawInventory sss = drawSelectionSections sss . invDisplayParams
 
 drawSubInventory :: SubInventory -> Configuration -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
@@ -55,7 +54,6 @@ drawSubInventory subinv cfig w = case subinv of
     DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
     CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
 
-
 drawCombineInventory :: Configuration -> SelectionSections CombinableItem -> World -> Picture
 drawCombineInventory cfig sss w =
     invHead cfig "COMBINE"
@@ -66,11 +64,20 @@ drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture
 drawExamineInventory cfig mtweaki w =
     invHead cfig "EXAMINE"
         <> examineInventoryExtra mtweaki itm cfig
-        <> drawSelectionList secondColumnParams 
-        cfig
-        ( defaultSelectionList & slItems .~ ammoTweakSelectionItems itm
-            ++ map f (makeParagraph 60 $ yourAugmentedItem itemInfo (yourInfo (you w)) (closeObjectInfo (crNumFreeSlots (you w))) w)
-        )
+        <> drawSelectionList
+            secondColumnParams
+            cfig
+            ( defaultSelectionList & slItems .~ ammoTweakSelectionItems itm
+                ++ map
+                    f
+                    ( makeParagraph 60 $
+                        yourAugmentedItem
+                            itemInfo
+                            (yourInfo (you w))
+                            (closeObjectInfo (crNumFreeSlots (you w)))
+                            w
+                    )
+            )
   where
     itm = yourItem w
     f str =
@@ -78,8 +85,7 @@ drawExamineInventory cfig mtweaki w =
             { _siPictures = [str]
             , _siHeight = 1
             , _siIsSelectable = True
-            , --, _siWidth = length str
-              _siColor = white
+            , _siColor = white
             , _siOffX = 0
             , _siPayload = ()
             }
@@ -104,7 +110,7 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
 
 drawNoSubInventory :: Configuration -> World -> Picture
 drawNoSubInventory cfig w =
-    pictures
+    fold
         [ equipcursors
         , equipcursor -- the order is important, this should go on top of the other equipcursors
         , rboptions
@@ -134,8 +140,6 @@ examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
     tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
     return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15
 
---        , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
-
 combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
 combineInventoryExtra sss cfig w = fromMaybe mempty $ do
     (i, j) <- sss ^? sssExtra . sssSelPos . _Just
@@ -199,18 +203,11 @@ displayTerminal :: Int -> Configuration -> LWorld -> Picture
 displayTerminal tid cfig w = fromMaybe mempty $ do
     tm <- w ^? terminals . ix tid
     return $
-        pictures
-            [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
-            , drawSelectionList secondColumnParams cfig (thesellist tm)
-            ]
+        invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
+            <> drawSelectionList secondColumnParams cfig (thesellist tm)
   where
-    --toselitm (str, col) = SelectionItem [str] 1 True (length str) col 0 ()
     toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
-    thesellist tm =
-        defaultSelectionList
-            { _slItems = thelist tm
-            --        , _slLength = length (thelist tm)
-            }
+    thesellist tm = defaultSelectionList & slItems .~ thelist tm
     thelist tm =
         map toselitm . displayTermInput tm
             . reverse
@@ -218,11 +215,12 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
             $ _tmDisplayedLines tm
     displayTermInput tm = case _tmInput tm of
         TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
+    partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just
     displayInputText tm s
-        | _tmStatus tm == TerminalReady = '>' : s
+        | _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s
         | otherwise = ""
     displayBlinkCursor hasfoc
-        | hasfoc = clockCycle 10 (V.fromList ["_", ""]) w
+        | hasfoc = clockCycle 10 (V.fromList ["_", "."]) w
         | otherwise = []
 
 drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
@@ -276,8 +274,7 @@ combineCounts cfig w = foldMap f . group
     f _ = mempty
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
-lnkMidPosInvSelsCol cfig w i col =
-        foldMap f
+lnkMidPosInvSelsCol cfig w i col = foldMap f
   where
     f j = fromMaybe mempty $ do
         sss <- w ^? hud . hudElement . diSections
@@ -301,7 +298,7 @@ tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
 
 invHead :: Configuration -> String -> Picture
 invHead cfig =
-        translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
+    translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
         . dShadCol white
         . scale 0.4 0.4
         . text
@@ -310,15 +307,16 @@ drawCarte :: Configuration -> World -> Picture
 drawCarte cfig w =
     pictures $
         renderListAt 0 0 cfig locs :
-       -- zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
-       --     ++ 
+        -- zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
+        --     ++
         mapOverlay w
             ++ [mainListCursor white iPos cfig]
   where
     iPos = w ^. cWorld . lWorld . selLocation
     locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
-    --locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
-    --locTexts = map fst locs
+
+--locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
+--locTexts = map fst locs
 
 --displayListEndCoords :: Configuration -> [String] -> [Point2]
 --displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1 ..]
@@ -399,8 +397,7 @@ picsToSelectable pics =
         { _siPictures = pics
         , _siHeight = length pics
         , _siIsSelectable = True
-        , --, _siWidth = wdth
-          _siColor = white
+        , _siColor = white
         , _siOffX = 0
         , _siPayload = ()
         }
@@ -418,8 +415,8 @@ openCursorAt ::
     Configuration ->
     Picture
 openCursorAt wth col xoff yoff yint w =
-        translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20)
-        $ lineCol
+    translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20) $
+        lineCol
             [ (V2 wth 12.5, withAlpha 0 col)
             , (V2 0 12.5, col)
             , (V2 0 (-7.5), col)

src/Dodge/Terminal.hs

@@ -1,6 +1,5 @@
 module Dodge.Terminal (
     doTerminalCommandEffect,
-    guardDisconnected,
     makeTermLine,
     commandFutureLines,
     quitCommand,
@@ -22,7 +21,6 @@ import Data.Char
 import Data.Foldable
 import qualified Data.Map.Strict as M
 import Data.Maybe
---import qualified Data.Text as T
 import Dodge.Data.World
 import Dodge.Default
 import Dodge.SoundLogic
@@ -38,7 +36,6 @@ basicTerminal =
         , _tmFutureLines = []
         , _tmMaxLines = 14
         , _tmTitle = "TERMINAL"
-        , _tmInput = defaultTerminalInput
         , _tmScrollCommands = [quitCommand]
         , _tmWriteCommands = [helpCommand, commandsCommand]
         , _tmBootProgram = TerminalBootLines connectionBlurb
@@ -48,9 +45,9 @@ basicTerminal =
 connectionBlurbLines :: [TerminalLine] -> [TerminalLine]
 connectionBlurbLines tls =
     [ termSoundLine computerBeepingS
-    , TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor)
+    , TerminalLineDisplay 0 (TerminalLineConst "Connecting" termTextColor)
     , TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor)
-    , TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor)
+    , TerminalLineDisplay 10 (TerminalLineConst "Connected" termTextColor)
     ]
         ++ tls
         ++ [TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady)]
@@ -58,18 +55,18 @@ connectionBlurbLines tls =
 quitCommand :: TerminalCommand
 quitCommand =
     TerminalCommand
-        { _tcString = "QUIT"
-        , _tcAlias = ["Q", "EXIT", "X", "SHUTDOWN", ""]
-        , _tcHelp = "DISCONNECTS THE TERMINAL."
+        { _tcString = "quit"
+        , _tcAlias = ["q", "exit", "x", "shutdown", ""]
+        , _tcHelp = "Disconnects the terminal."
         , _tcEffect = TerminalCommandArguments $ NoArguments [TerminalLineEffect 0 TmWdWdDisconnectTerminal]
         }
 
 helpCommand :: TerminalCommand
 helpCommand =
     TerminalCommand
-        { _tcString = "HELP"
-        , _tcAlias = ["H", "MAN"]
-        , _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND."
+        { _tcString = "help"
+        , _tcAlias = ["h", "man"]
+        , _tcHelp = "Displays help for a specific command."
         , _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
         }
 
@@ -79,9 +76,9 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm
     f tc =
         M.insert
             (_tcString tc)
-            ( [ makeTermLine "COMMAND:"
+            ( [ makeTermLine "Command:"
               , makeColorTermLine commandColor (_tcString tc)
-              , makeTermLine "ALIASES:"
+              , makeTermLine "Aliases:"
               , makeColorTermLine commandColor (unwords (_tcAlias tc))
               ]
                 ++ case argumentHelp tc tm w of
@@ -94,29 +91,24 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm
 commandsCommand :: TerminalCommand
 commandsCommand =
     TerminalCommand
-        { _tcString = "COMMANDS"
-        , _tcAlias = ["COMMAND", "COM"]
-        , _tcHelp = "DISPLAYS AVAILABLE COMMANDS."
+        { _tcString = "commands"
+        , _tcAlias = ["command", "com"]
+        , _tcHelp = "Displays available commands."
         , _tcEffect = TerminalCommandEffectCommands
         }
 
 connectionBlurb :: [TerminalLine]
 connectionBlurb =
     [ termSoundLine computerBeepingS
-    , TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor)
+    , TerminalLineDisplay 0 (TerminalLineConst "Connecting" termTextColor)
     , TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor)
-    , TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" 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
 
@@ -141,14 +133,14 @@ 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
+    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:" :
+            ( makeTermLine "Available commands:" :
               makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm))
             )
     TerminalCommandEffectSingleCommand eff followingLines -> \_ _ -> NoArguments $ TerminalLineEffect 0 (TmWdWdfromWdWd eff) : map makeTermLine followingLines
@@ -156,9 +148,9 @@ doTerminalCommandEffect tce = case tce of
 
 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)
+    NoArguments{} -> ("Any arguments provided to this command are ignored.", Nothing)
     OneArgument argtype argm ->
-        ( "EXPECTS " ++ argtype ++ " AS ARGUMENT. AVAILABLE ARGUMENTS: "
+        ( "Expects " ++ argtype ++ " as argument. Available arguments: "
         , Just (M.keys argm)
         )
 
@@ -180,37 +172,31 @@ argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
 --        , _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 . _cwgParams . _cwGen . _cWorld
 
 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)
+        [ ("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)
+        (makeTermPara . map toLower . show . f)
         (w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
 
 toggleCommand :: TerminalCommand
 toggleCommand =
     TerminalCommand
-        { _tcString = "TOGGLE"
-        , _tcAlias = ["TOG"]
-        , _tcHelp = "PERFORMS A REVERSABLE EFFECT."
+        { _tcString = "toggle"
+        , _tcAlias = ["tog"]
+        , _tcHelp = "Performs a reversable effect."
         , _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
         }
 
@@ -220,19 +206,19 @@ decodedtmap = M.mapKeys show . M.map ((: []) . makeTermLine . show)
 sensorCommand :: TerminalCommand
 sensorCommand =
     TerminalCommand
-        { _tcString = "SENSOR"
-        , _tcAlias = ["SEN"]
-        , _tcHelp = "ACCESS INFORMATION CONCERNING THE CONNECTED SENSOR."
+        { _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
-        & cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff
-        & exitTerminalSubInv
-        & cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
-            .~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines]
+disconnectTerminal tm =
+    (cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
+        . exitTerminalSubInv
+        . ( cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
+                .~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines]
+          )
 
 exitTerminalSubInv :: World -> World
 exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
@@ -242,9 +228,9 @@ exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
 damageCodeCommand :: TerminalCommand
 damageCodeCommand =
     TerminalCommand
-        { _tcString = "DAMAGECODE"
-        , _tcAlias = ["DCODE", "DC"]
-        , _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE."
+        { _tcString = "damagecode"
+        , _tcAlias = ["dcode", "dc"]
+        , _tcHelp = "Displays the shape and color associated with a given damage type."
         , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
         }
 
@@ -260,19 +246,21 @@ 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
 
 commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
-commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do
+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.!?)
+            let setpartial =
+                    TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str)) :
+                    makeTermPara ("expects " ++ argtype ++ " as an argument")
+             in Just $
+                    fromMaybe setpartial $
+                        safeHead args >>= (m M.!?)
   where
     errline = makeColorTermLine red

src/Dodge/Terminal/LeftButton.hs

@@ -1,36 +1,23 @@
-module Dodge.Terminal.LeftButton where
+module Dodge.Terminal.LeftButton (
+    doTerminalEffectLB,
+    terminalReturnEffect,
+) where
 
+import Control.Monad
 import Data.Maybe
 import Dodge.Data.World
-import Dodge.Terminal--oops
+import Dodge.Terminal.ReturnEffect
 import LensHelp
 
 doTerminalEffectLB :: Terminal -> World -> World
-doTerminalEffectLB tm w = guardDisconnected tm w $
-    fromMaybe w $ do
-        s <- w ^? cWorld . lWorld . 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 <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
-        return $
-            runTerminalString s tm $
-                w
-                    & cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>' : s)]
+doTerminalEffectLB tm w = fromMaybe w $ do
+    guard (_tmStatus tm == TerminalReady)
+    s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
+    if null (words s)
+        then Just $ defocusTerminalInput w
+        else return $ terminalReturnEffect tm w
 
 defocusTerminalInput :: World -> World
 defocusTerminalInput w = fromMaybe w $ do
     tmid <- w ^? hud . hudElement . subInventory . termID
     return $ w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
-
-runTerminalString :: String -> Terminal -> World -> World
-runTerminalString s tm w =
-    w & cWorld . lWorld . terminals . ix (_tmID tm)
-        %~ ( (tmInput .~ TerminalInput mempty True (0, 0))
-                . (tmFutureLines ++.~ commandFutureLines s tm w)
-                . (tmCommandHistory %~ take 10 . (s :))
-           )

src/Dodge/Terminal/ReturnEffect.hs

@@ -0,0 +1,28 @@
+module Dodge.Terminal.ReturnEffect
+    where
+
+import Control.Monad
+import Data.Maybe
+import Dodge.Data.World
+import LensHelp
+import Dodge.Terminal -- this should be rethought
+
+terminalReturnEffect :: Terminal -> World -> World
+terminalReturnEffect tm w = fromMaybe w $ do
+    guard $ _tmStatus tm == TerminalReady
+    s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
+    let pc = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just
+    return $
+        runTerminalString (pc ++ s) tm $
+            w
+                & cWorld . lWorld . terminals . ix (_tmID tm) . tmPartialCommand .~ Nothing
+                & cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines .~ 
+                    [makeTermLine (pc ++ "> " ++ s)]
+
+runTerminalString :: String -> Terminal -> World -> World
+runTerminalString s tm w =
+    w & cWorld . lWorld . terminals . ix (_tmID tm)
+        %~ ( (tmInput .~ TerminalInput mempty True (0, 0))
+                . (tmFutureLines ++.~ commandFutureLines s tm w)
+                . (tmCommandHistory %~ take 10 . (s :))
+           )

src/Dodge/TmTm.hs

@@ -8,3 +8,4 @@ doTmTm tmtm = case tmtm of
     TmTmClearDisplayedLines -> tmDisplayedLines .~ []
     TmTmSetStatus s -> tmStatus .~ s
     TmId -> id
+    TmTmSetPartialCommand ms -> tmPartialCommand .~ ms

src/Dodge/Update.hs

@@ -227,7 +227,6 @@ scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of
         i <- w ^? timeFlow . scrollItemLocation
         return $ pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount
 
-
 -- | The update step.
 functionalUpdate :: Universe -> Universe
 functionalUpdate w =
@@ -271,7 +270,7 @@ functionalUpdate w =
         . over uvWorld updateCreatureGroups
         . over uvWorld updateWallDamages
         . over uvWorld updateSeenWalls
-        . over uvWorld updateTerminal
+        . over uvWorld checkTermDist
         . over uvWorld updateRBList
         . over uvWorld updateCloseObjects
         . over uvWorld updateWheelEvents

src/Dodge/Update/Camera.hs

@@ -5,13 +5,7 @@ module Dodge.Update.Camera (
     updateCamera,
 ) where
 
-import Dodge.WASD
-import Dodge.SmoothScroll
-import SDL (MouseButton (..))
-import Dodge.Base.Coordinate
-import Dodge.InputFocus
 import Bound
-import Dodge.Viewpoints
 import Control.Monad
 import Data.Foldable
 import qualified Data.Map.Strict as M
@@ -21,10 +15,15 @@ import Dodge.Creature.Test
 import Dodge.Data.Config
 import Dodge.Data.World
 import Dodge.Equipment
+import Dodge.InputFocus
+import Dodge.SmoothScroll
+import Dodge.Viewpoints
+import Dodge.WASD
 import Dodge.Zoning.Wall
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
+import SDL (MouseButton (..))
 import qualified SDL
 
 {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
@@ -35,12 +34,13 @@ updateCamera cfig w = case w ^. wCam . camControl of
     CamFloat -> updateFloatingCamera cfig w
 
 updateFloatingCamera :: Configuration -> World -> World
-updateFloatingCamera cfig w = w 
-    & updateBounds cfig
-    & wCam %~ setViewDistance cfig
-    & wCam %~ translateFloatingCamera theinput
-    & wCam %~ translateFloatingCameraKeys theinput
-    & wCam %~ zoomFloatingCamera theinput
+updateFloatingCamera cfig w =
+    w
+        & updateBounds cfig
+        & wCam %~ setViewDistance cfig
+        & wCam %~ translateFloatingCamera theinput
+        & wCam %~ translateFloatingCameraKeys theinput
+        & wCam %~ zoomFloatingCamera theinput
   where
     theinput = w ^. input
 
@@ -49,24 +49,25 @@ translateFloatingCamera theinput cam = fromMaybe cam $ do
     presstime <- theinput ^. mouseButtons . at ButtonLeft
     guard $ presstime > 0
     hpos <- theinput ^? heldPos . ix ButtonLeft
-    let thetran = 
+    let thetran =
             screenToWorldPos cam hpos
-            -.-
-            screenToWorldPos cam (theinput ^. mousePos) 
-    return $ cam & camCenter +~ thetran
-        & camViewFrom +~ thetran
+                -.- screenToWorldPos cam (theinput ^. mousePos)
+    return $
+        cam & camCenter +~ thetran
+            & camViewFrom +~ thetran
 
 translateFloatingCameraKeys :: Input -> Camera -> Camera
-translateFloatingCameraKeys theinput =  (camCenter -~ thetran)
+translateFloatingCameraKeys theinput =
+    (camCenter -~ thetran)
         . (camViewFrom -~ thetran)
   where
     thetran = 10 *.* wasdDir theinput
 
 zoomFloatingCamera :: Input -> Camera -> Camera
-zoomFloatingCamera theinput cam 
-    | ButtonRight `M.member` (theinput ^. mouseButtons) = cam
-        & camZoom *~ (zoomSpeed ^^ negate (getSmoothScrollValue theinput))
-    | otherwise =  cam
+zoomFloatingCamera theinput
+    | ButtonRight `M.member` (theinput ^. mouseButtons) =
+        camZoom *~ (zoomSpeed ^^ negate (getSmoothScrollValue theinput))
+    | otherwise = id
 
 updateInGameCamera :: Configuration -> World -> World
 updateInGameCamera cfig w =
@@ -100,8 +101,9 @@ moveZoomCamera cfig theinput cr campos =
         guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
         mitm ^? _Just . itScope . scopePos
     newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
-    offset = rotateV (campos ^. camRot) 
-        $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
+    offset =
+        rotateV (campos ^. camRot) $
+            ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
     newzoom = case mitm ^? _Just . itScope of
         Just zs@ZoomScope{} -> _scopeZoom zs
         _ -> newDefaultZoom * newItemZoom
@@ -123,7 +125,6 @@ moveZoomCamera cfig theinput cr campos =
     distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment cr
     hw = halfWidth cfig
     hh = halfHeight cfig
-    --            = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom
     -- these speeds are inverted, larger means slower
     zoomInSpeed = 25
     zoomOutSpeed = 15
@@ -135,8 +136,8 @@ updateScopeZoom w = fromMaybe w $ do
 
 updateScopeZoom' :: Int -> World -> World
 updateScopeZoom' i w
-    | SDL.ButtonRight `M.member` _mouseButtons (_input w) 
-        = w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount)  mp
+    | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
+        w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) mp
     | otherwise = w & wppointer %~ resetscope
   where
     wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope
@@ -152,35 +153,27 @@ doScopeZoom scrollamount mp sc = case scrollamount of
         | x > 0 -> zoomInLongGun mp sc
         | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc
         | x < -5 -> (zoomOutLongGun . zoomOutLongGun) sc
-        | x < 0 ->  zoomOutLongGun sc
+        | x < 0 -> zoomOutLongGun sc
         | otherwise -> sc
 
 zoomSpeed :: Float
 zoomSpeed = 39 / 40
 
 zoomInLongGun :: Point2 -> Scope -> Scope
-zoomInLongGun mousep sc
-    | currentZoom < 8 =
-        sc
-            & scopePos .+.+~ (1 - zoomSpeed) / newzoom *.* mousep
+zoomInLongGun mousep sc = fromMaybe sc $ do
+    curzoom <- sc ^? scopeZoom
+    guard $ curzoom < 8
+    return $
+        sc & scopePos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep
             & scopeZoom %~ (/ zoomSpeed)
-    | otherwise = sc
-  where
-    Just currentZoom = sc ^? scopeZoom
-    newzoom = (sc ^?! scopeZoom) / zoomSpeed
 
 zoomOutLongGun :: Scope -> Scope
-zoomOutLongGun sc
-    | currentzoom > 0.5 =
-        sc
-            & scopePos %~ (\p -> p +.+ (zoomSpeed-1) / currentzoom *.* p)
---            & scopePos .*.*~ 1 - ((newzoom * 2) ** zoomSpeed)
+zoomOutLongGun sc = fromMaybe sc $ do
+    curzoom <- sc ^? scopeZoom
+    guard $ curzoom > 0.5
+    return $
+        sc & scopePos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p)
             & scopeZoom *~ zoomSpeed
-    | otherwise = sc
-        & scopePos .~ V2 0 0
-  where
-    Just currentzoom = sc ^? scopeZoom
-    --newzoom = (sc ^?! scopeZoom) / zoomSpeed
 
 ifConfigWallRotate :: Configuration -> World -> World
 ifConfigWallRotate cfig w
@@ -207,7 +200,6 @@ doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. wC
         | b - b' < negate 0.01 = w & wCam . camRot -~ 0.01
         | otherwise = w
       where
-        --b = a * (2 / pi)
         b = a * (4 / pi)
         b' = fromIntegral (round b :: Int)
 
@@ -218,8 +210,9 @@ rotateCameraBy x w =
         & cWorld %~ rotateanyscope
   where
     rotateanyscope = fromMaybe id $ do
-            i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
-            return $ lWorld . creatures . ix 0 . crInv . ix i
+        i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
+        return $
+            lWorld . creatures . ix 0 . crInv . ix i
                 . itScope
                 . scopePos
                 %~ rotateV x
@@ -262,7 +255,6 @@ farWallDistDirection p w =
 findBoundDists :: Configuration -> World -> (Float, Float, Float, Float)
 findBoundDists cfig w
     | debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw)
---    | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . camPos . camCenter) w
     | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. wCam . camViewFrom) w
   where
     hw = halfWidth cfig

src/Dodge/Update/Input/InGame.hs

@@ -90,10 +90,9 @@ updatePressedButtonsCarte' pkeys w
 
 updateKeysInTerminal :: Int -> Universe -> Universe
 updateKeysInTerminal tmid u =
-    u & doTextInputOver tmpoint
+    u & doTextInputOver (uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText)
         & checkEndStatus
   where
-    tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText
     pkeys = u ^. uvWorld . input . pressedKeys
     checkEndStatus
         | pkeys ^. at ScancodeReturn == Just InitialPress =
@@ -110,7 +109,6 @@ updateInitialPressInGame :: Universe -> Scancode -> Universe
 updateInitialPressInGame uv sc = case sc of
     ScancodeF1 -> useNormalCamera uv
     ScancodeF2 -> pauseAndFloatCam uv
---    ScancodeF3 -> pauseAndPanCam uv
     ScancodeF5 -> doQuicksave uv
     ScancodeF9 -> doQuickload uv
     ScancodeEscape -> pauseGame uv
@@ -152,7 +150,7 @@ doRegexInput u i sss
         any
             ((== Just InitialPress) . (`M.lookup` pkeys))
             [ScancodeReturn, ScancodeSlash]
-    endmouse = (Just 0 == ) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft
+    endmouse = (Just 0 ==) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft
     backspacetonothing =
         sss ^? sssExtra . sssFilters . ix i . _Just == Just ""
             && ScancodeBackspace `M.lookup` pkeys == Just InitialPress

src/Dodge/Update/Input/Text.hs

@@ -4,7 +4,7 @@ module Dodge.Update.Input.Text (
 ) where
 
 import Data.Either
-import Data.Char
+--import Data.Char
 import Dodge.Data.Universe
 import LensHelp
 import SDL
@@ -14,7 +14,8 @@ doTextInputOver p u = doTextInputOver' u p u
 
 doTextInputOver' :: Universe -> ASetter' a String -> a -> a
 doTextInputOver' u p x =
-    x & p %~ (++ map toUpper (rights str))
+    --x & p %~ (++ map toUpper (rights str))
+    x & p %~ (++ rights str)
         & checkBackspace
   where
     str = u ^. uvWorld . input . textInput

src/Dodge/WorldEffect.hs

@@ -1,4 +1,9 @@
-module Dodge.WorldEffect where
+module Dodge.WorldEffect (
+    doWdWd,
+    accessTerminal,
+    doTmWdWd,
+    lineOutputTerminal,
+) where
 
 import Data.Foldable
 import qualified Data.Map.Strict as M
@@ -41,20 +46,20 @@ doItCrWdWd icww = case icww of
     ItCrWdItemEffect -> flip itemEffect
 
 accessTerminal :: Maybe Int -> World -> World
-accessTerminal mtmid w = case mtmid of
-    Nothing -> w
-    Just tmid ->
+accessTerminal mtmid w = fromMaybe w $ do
+    tmid <- mtmid
+    return $
         w & hud . hudElement . subInventory .~ DisplayTerminal tmid
             & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus .~ True
             & cWorld . lWorld . 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
+  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
@@ -63,17 +68,6 @@ torqueCr x cid w
   where
     (rot, g) = randomR (- x, x) $ _randGen w
 
-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
@@ -81,7 +75,6 @@ lineOutputTerminal tls =
         , _tmFutureLines = []
         , _tmMaxLines = 14
         , _tmTitle = "TERMINAL"
-        , _tmInput = defaultTerminalInput
         , _tmScrollCommands = [quitCommand]
         , _tmWriteCommands = [helpCommand, commandsCommand]
         , _tmBootProgram = TerminalBootLines $ connectionBlurbLines tls
@@ -89,9 +82,7 @@ lineOutputTerminal tls =
         }
 
 doDeathTriggers :: Terminal -> World -> World
-doDeathTriggers tm w =
-    w
-        & cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs
+doDeathTriggers tm = cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs
   where
     xs = M.elems $ _tmToggles tm
 

src/Picture/Base.hs

@@ -201,7 +201,6 @@ stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..]
 
 text :: String -> Picture
 {-# INLINE text #-}
---text = translate (-50) (-100) . drawText (10)
 text = translate (-50) (-100) . drawText (-10)
 
 drawText :: Float -> String -> [Verx]
@@ -209,7 +208,6 @@ drawText gap = map f . stringToList gap
   where
     f (pos, col, V3 a b c) = Verx pos col [a, b, c, 1] BottomLayer textNum
 
-
 line :: [Point2] -> Picture
 {-# INLINE line #-}
 line = thickLine 1