Start to refactor terminals

ghcidOutput

@@ -1,10 +1,14 @@
-/home/justin/Haskell/loop/src/Dodge/Inventory.hs:250:1-16: warning: [-Wunused-top-binds]
+/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:27:1: error:
-    Defined but not used: ‘isConnectedAbove’
+    Could not load module ‘Dodge.Terminal.LeftButton’
-    |
+    It is a member of the hidden package ‘loop-0.1.0.0’.
-250 | isConnectedAbove x = case x ^. locLdtContext of
+    You can run ‘:set -package loop’ to expose it.
-    | ^^^^^^^^^^^^^^^^
+    (Note: this unloads all the modules in the current scope.)
-/home/justin/Haskell/loop/src/Dodge/Inventory.hs:255:1-16: warning: [-Wunused-top-binds]
+    Use -v (or `:set -v` in ghci) to see a list of the files searched for.
-    Defined but not used: ‘isConnectedBelow’
+   |
-    |
+27 | import Dodge.Terminal.LeftButton
-255 | isConnectedBelow x = case x ^. locLdtContext of
+   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-    | ^^^^^^^^^^^^^^^^
+<no location info>: error:
+    Could not load module ‘Dodge.Update’
+    It is a member of the hidden package ‘loop-0.1.0.0’.
+    You can run ‘:set -package loop’ to expose it.
+    (Note: this unloads all the modules in the current scope.)

src/Dodge/Data/Terminal.hs

@@ -47,6 +47,7 @@ data Terminal = Terminal
     , _tmCommandHistory :: [String]
     , _tmToggles :: M.Map String TerminalToggle
     , _tmPartialCommand :: Maybe TerminalCommand
+    , _tmPromptString :: String
     }
     --deriving (Eq, Show, Read) --, Generic)
     --h--deriving (Eq, Show, Read) --Generic, Flat)

src/Dodge/Default/Terminal.hs

@@ -25,6 +25,7 @@ defaultTerminal =
         , _tmCommandHistory = []
         , _tmToggles = mempty
         , _tmPartialCommand = Nothing
+        , _tmPromptString = "$ "
         }
 
 defaultTerminalInput :: TerminalInput

src/Dodge/DisplayInventory.hs

@@ -5,6 +5,7 @@ module Dodge.DisplayInventory (
     updateCombinePositioning,
 ) where
 
+import Dodge.CharacterEnums
 import Control.Applicative
 import Control.Lens
 import Control.Monad
@@ -52,8 +53,8 @@ updateCombineSections w cfig =
         [(0, sclose), (-1, sfclose)]
   where
     filtcurs = case w ^? hud . hudElement . subInventory . ciSelection . _Just . _1 of
-        Just (-1) -> [toEnum 219] -- filled rect
+        Just (-1) -> [cFilledRect]
-        _ -> [toEnum 128] -- wire rect
+        _ -> [cWireRect]
     (sfclose, sclose) =
         filterSectionsPair
             filtcurs

src/Dodge/Inventory.hs

@@ -246,16 +246,6 @@ isConnected x = case x ^. locLdtContext of
         || not (null $ x ^. locLDT . ldtLeft) 
     _ -> True
 
-isConnectedAbove :: LocationLDT b a -> Bool
-isConnectedAbove x = case x ^. locLdtContext of
-    LeftwardLDT {} -> True
-    _ -> not . null $ x ^. locLDT . ldtRight
-    
-isConnectedBelow :: LocationLDT b a -> Bool
-isConnectedBelow x = case x ^. locLdtContext of
-    RightwardLDT {} -> True
-    _ -> not . null $ x ^. locLDT . ldtLeft
-
 changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
 changeSwapWith f w = case w ^? hud . hudElement . diSelection . _Just of
     Just (0, i) -> w & swapInvItems f i

src/Dodge/Render/HUD.hs

@@ -6,6 +6,7 @@ module Dodge.Render.HUD (
     selNumPosCardinal, -- this shoud probably be pushed back here
 ) where
 
+import Dodge.CharacterEnums
 import Dodge.Creature.Test
 import Dodge.DoubleTree
 import Dodge.Data.DoubleTree
@@ -14,9 +15,9 @@ import Control.Lens
 import Control.Monad
 import qualified Data.Map.Strict as M
 import Data.Maybe
-import qualified Data.Vector as V
+--import qualified Data.Vector as V
 import Dodge.Base
-import Dodge.Clock
+--import Dodge.Clock
 import Dodge.Creature.Info
 import Dodge.Data.CardinalPoint
 import Dodge.Data.Combine
@@ -360,11 +361,12 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
             (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
     partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
     displayInputText tm s
-        | _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s
+        | _tmStatus tm == TerminalReady = partcommand tm ++ _tmPromptString tm ++ s
         | otherwise = ""
     displayBlinkCursor hasfoc
-        | hasfoc = clockCycle 10 (V.fromList ["_", "."]) w
+--        | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
-        | otherwise = []
+        | hasfoc = [cFilledRect]
+        | otherwise = [cWireRect]
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
 lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f

src/Dodge/Terminal.hs

@@ -1,4 +1,5 @@
 module Dodge.Terminal (
+    doTerminalEffectLB,
     doTerminalCommandEffect,
     makeTermLine,
     commandFutureLines,
@@ -14,8 +15,10 @@ module Dodge.Terminal (
     makeColorTermLine,
     makeTermPara,
     toggleCommand,
+    terminalReturnEffect,
 ) where
 
+import Control.Monad
 import Color
 import Data.Char
 import Data.Foldable
@@ -55,8 +58,8 @@ connectionBlurbLines tls =
 quitCommand :: TerminalCommand
 quitCommand =
     TerminalCommand
-        { _tcString = "quit"
+        { _tcString = "QUIT"
-        , _tcAlias = ["q", "exit", "x", "shutdown", ""]
+        , _tcAlias = ["Q", "EXIT", "X", "SHUTDOWN", ""]
         , _tcHelp = "Disconnects the terminal."
         , _tcEffect = TerminalCommandArguments $ NoArguments [TerminalLineEffect 0 TmWdWdDisconnectTerminal]
         }
@@ -64,8 +67,8 @@ quitCommand =
 helpCommand :: TerminalCommand
 helpCommand =
     TerminalCommand
-        { _tcString = "help"
+        { _tcString = "HELP"
-        , _tcAlias = ["h", "man"]
+        , _tcAlias = ["H", "MAN"]
         , _tcHelp = "Displays help for a specific command."
         , _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
         }
@@ -91,8 +94,8 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm
 commandsCommand :: TerminalCommand
 commandsCommand =
     TerminalCommand
-        { _tcString = "commands"
+        { _tcString = "COMMANDS"
-        , _tcAlias = ["command", "com"]
+        , _tcAlias = ["COMMAND", "COM"]
         , _tcHelp = "Displays available commands."
         , _tcEffect = TerminalCommandEffectCommands
         }
@@ -119,10 +122,10 @@ makeTermLine :: String -> TerminalLine
 makeTermLine = makeColorTermLine termTextColor
 
 makeTermPara :: String -> [TerminalLine]
-makeTermPara = map makeTermLine . makeParagraph 60
+makeTermPara = makeColorTermPara termTextColor
 
 makeColorTermPara :: Color -> String -> [TerminalLine]
-makeColorTermPara col = map (makeColorTermLine col) . makeParagraph 60
+makeColorTermPara col = map (makeColorTermLine col) . makeParagraph 55
 
 makeColorTermLine :: Color -> String -> TerminalLine
 makeColorTermLine col str = TerminalLineDisplay 0 $ TerminalLineConst str col
@@ -194,8 +197,8 @@ getSensor f tm w =
 toggleCommand :: TerminalCommand
 toggleCommand =
     TerminalCommand
-        { _tcString = "toggle"
+        { _tcString = "TOGGLE"
-        , _tcAlias = ["tog"]
+        , _tcAlias = ["TOG"]
         , _tcHelp = "Performs a reversable effect."
         , _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
         }
@@ -206,8 +209,8 @@ decodedtmap = M.mapKeys show . M.map ((: []) . makeTermLine . show)
 sensorCommand :: TerminalCommand
 sensorCommand =
     TerminalCommand
-        { _tcString = "sensor"
+        { _tcString = "SENSOR"
-        , _tcAlias = ["sen"]
+        , _tcAlias = ["SEN"]
         , _tcHelp = "Access information concerning the connected sensor."
         , _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
         }
@@ -229,8 +232,8 @@ exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
 damageCodeCommand :: TerminalCommand
 damageCodeCommand =
     TerminalCommand
-        { _tcString = "damagecode"
+        { _tcString = "DAMAGECODE"
-        , _tcAlias = ["dcode", "dc"]
+        , _tcAlias = ["DCODE", "DC"]
         , _tcHelp = "Displays the shape and color associated with a given damage type."
         , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
         }
@@ -269,3 +272,36 @@ commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
                         safeHead args >>= (m M.!?)
   where
     errline = makeColorTermLine red
+
+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 . tcString
+    return $
+        runTerminalString (pc ++ s) tm $
+            w
+                & cWorld . lWorld . terminals . ix (_tmID tm) . tmPartialCommand .~ Nothing
+                & cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
+                    .~ [makeTermLine (pc ++ _tmPromptString tm ++ s)]
+
+runTerminalString :: String -> Terminal -> World -> World
+runTerminalString s tm w =
+    w & cWorld . lWorld . terminals . ix (_tmID tm)
+        %~ ( (tmInput .~ TerminalInput{_tiText = mempty, _tiFocus = True, _tiSel = (0, 0)})
+                . (tmFutureLines ++.~ commandFutureLines s tm w)
+                . (tmCommandHistory %~ take 10 . (s :))
+           )
+
+doTerminalEffectLB :: Terminal -> World -> World
+doTerminalEffectLB tm w = fromMaybe w $ do
+    guard (_tmStatus tm == TerminalReady)
+    s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
+    if null (words s) && null (_tmPartialCommand tm)
+        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

src/Dodge/Terminal/LeftButton.hs

@@ -1,23 +0,0 @@
-module Dodge.Terminal.LeftButton (
-    doTerminalEffectLB,
-    terminalReturnEffect,
-) where
-
-import Control.Monad
-import Data.Maybe
-import Dodge.Data.World
-import Dodge.Terminal.ReturnEffect
-import LensHelp
-
-doTerminalEffectLB :: Terminal -> World -> World
-doTerminalEffectLB tm w = fromMaybe w $ do
-    guard (_tmStatus tm == TerminalReady)
-    s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
-    if null (words s) && null (_tmPartialCommand tm)
-        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

src/Dodge/Terminal/ReturnEffect.hs

@@ -1,28 +0,0 @@
-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 . tcString
-    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 {_tiText = mempty, _tiFocus = True, _tiSel = (0, 0)})
-                . (tmFutureLines ++.~ commandFutureLines s tm w)
-                . (tmCommandHistory %~ take 10 . (s :))
-           )

src/Dodge/TestString.hs

@@ -21,7 +21,8 @@ import Dodge.Data.Universe
 import qualified IntMapHelp as IM
 
 testStringInit :: Universe -> [String]
-testStringInit u = fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . ix 0 . crInv . each . itLocation . ilIsRoot
+testStringInit _ = [] 
+--    fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . ix 0 . crInv . each . itLocation . ilIsRoot
 --    , show . fmap (fmap _siPictures) $ u ^? uvWorld . hud . hudElement . diSections . ix (-1) . ssItems
 --    <> [[toEnum (i+j * 32) | i <- [0..31]] | j <- [0..7]]
 --    <> map show (IM.elems (L.postscan (L.premap _siHeight L.sum)