Add border to terminal display

.hlint.yaml

@@ -44,16 +44,16 @@
 # Turn on hints that are off by default
 #
 # Ban "module X(module X) where", to require a real export list
-- warn: {name: Use explicit module export list}
+#- warn: {name: Use explicit module export list} # TODO uncomment
 #
 # Replace a $ b $ c with a . b $ c
-- group: {name: dollar, enabled: true}
+#- group: {name: dollar, enabled: true} # TODO uncomment
 #
 # Generalise map to fmap, ++ to <>
-- group: {name: generalise, enabled: true}
+#- group: {name: generalise, enabled: true} # TODO uncomment
 #
 # Warn on use of partial functions
-# - group: {name: partial, enabled: true}
+# - group: {name: partial, enabled: true} # possibly uncomment
 
 - group: {name: use-lens, enabled: true}
 

src/Color.hs

@@ -1,11 +1,38 @@
 module Color (
-    module Color,
+    withAlpha,
+    red,
+    green,
+    blue,
+    yellow,
+    cyan,
+    magenta,
+    rose,
+    violet,
+    azure,
+    aquamarine,
+    chartreuse,
+    orange,
+    white,
+    black,
+    greyN,
+    mixColors,
+    brightX,
+    mixColorsLinear,
+    mixColorsFrac,
+    dim,
+    bright,
+    light,
+    dark,
+    paletteToColor,
+    lightx4,
+    toColor8,
+    normalizeColor,
     module Color.Data,
 ) where
 
 import Color.Data
-import Geometry
 import Control.Lens
+import Geometry
 
 withAlpha :: Float -> RGBA -> RGBA
 {-# INLINE withAlpha #-}
@@ -125,23 +152,6 @@ greyN :: Float -> Color
 {-# INLINE greyN #-}
 greyN x = toV4 (x, x, x, 1)
 
-numColor :: Int -> Color
-{-# INLINE numColor #-}
-numColor 0 = toV4 (1, 0, 0, 1)
-numColor 1 = toV4 (0, 1, 0, 1)
-numColor 2 = toV4 (0, 0, 1, 1)
-numColor 3 = toV4 (1, 1, 0, 1)
-numColor 4 = toV4 (0, 1, 1, 1)
-numColor 5 = toV4 (1, 0, 1, 1)
-numColor 6 = toV4 (1, 0, 0.5, 1)
-numColor 7 = toV4 (0.5, 0, 1, 1)
-numColor 8 = toV4 (0, 0.5, 1, 1)
-numColor 9 = toV4 (0, 1, 0.5, 1)
-numColor 10 = toV4 (0.5, 1, 0, 1)
-numColor 11 = toV4 (1, 0.5, 0, 1)
-numColor 12 = toV4 (1, 1, 1, 1)
-numColor _ = toV4 (1, 1, 1, 1)
-
 lightx4 :: Color -> Color
 lightx4 = light . light . light . light
 

src/Dodge/Data/SelectionList.hs

@@ -14,6 +14,7 @@ data ListDisplayParams = ListDisplayParams
     { _ldpPos :: ScreenPos
     , _ldpScale :: Float
     , _ldpVerticalGap :: Float
+    , _ldpBorder :: Maybe (Int,Int) -- the Ints give height and width for a border
     }
 
 data CursorDisplay

src/Dodge/HeldUse.hs

@@ -717,13 +717,8 @@ basicMuzFlare pos dir =
 isAmmoIntLink :: Int -> ItemSF -> Bool
 isAmmoIntLink i sf = Just i == sf ^? amsfLink
 
-useLoadedAmmo ::
+useLoadedAmmo 
-    LocationDT OItem ->
+    :: LocationDT OItem -> Creature -> Muzzle -> Maybe (Int, DTree OItem) -> World -> World
-    Creature ->
-    Muzzle ->
-    Maybe (Int, DTree OItem) ->
-    World ->
-    World
 useLoadedAmmo loc cr mz m w =
     makeMuzzleFlare pq loc (mz ^. mzFlareType) $ case _mzEffect mz of
         MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
@@ -905,7 +900,8 @@ shootPulseBall (p, q) w =
     i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
 
 removeAmmoFromMag :: Int -> Int -> World -> World
-removeAmmoFromMag x magid = cWorld . lWorld . items . ix magid . itConsumables . _Just -~ x
+removeAmmoFromMag x magid 
+    = cWorld . lWorld . items . ix magid . itConsumables . _Just -~ x
 
 getBulletType :: DTree OItem -> Maybe Bullet
 getBulletType magtree =
@@ -960,12 +956,8 @@ magAmmoParams itm = case itm ^. itType of
 --        Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
 --        _ -> 0
 
-shootBullets ::
+shootBullets 
-    LocationDT OItem ->
+    :: LocationDT OItem -> Creature -> (Muzzle, Int, DTree OItem) -> World -> World
-    Creature ->
-    (Muzzle, Int, DTree OItem) ->
-    World ->
-    World
 shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do
     thebullet <- getBulletType magtree
     return $ foldl' (&) w (replicate x (shootBullet thebullet loc cr mz))

src/Dodge/ListDisplayParams.hs

@@ -26,13 +26,11 @@ defaultListDisplayParams =
                 { _spScreenOff = V2 (-0.5) 0.5 -- top left
                 , _spPixelOff = 0
                 }
+        , _ldpBorder = Nothing
         }
 
 invDP :: ListDisplayParams
-invDP =
+invDP = defaultListDisplayParams & ldpPos . spPixelOff .~ V2 6 0
-    defaultListDisplayParams
---        & ldpPos . spPixelOff .~ V2 6 (-1)
-        & ldpPos . spPixelOff .~ V2 6 0
 
 invCursorParams :: World -> CursorDisplay
 invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
@@ -43,7 +41,9 @@ invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
 
 secondColumnLDP :: ListDisplayParams
 --secondColumnLDP = defaultListDisplayParams & ldpPos . spPixelOff .~ V2 subInvX (-20)
-secondColumnLDP = defaultListDisplayParams & ldpPos . spPixelOff .~ V2 subInvX 0
+secondColumnLDP = defaultListDisplayParams 
+    & ldpPos . spPixelOff .~ V2 subInvX (-16)
+    & ldpBorder ?~ (49, 16)
 
 subInvX :: Float
 subInvX = 10 * fromIntegral topInvW + 170

src/Dodge/Render/HUD.hs

@@ -2,20 +2,17 @@
 
 module Dodge.Render.HUD (drawHUD) where
 
-import Linear
-import Dodge.Clock
-import qualified Data.Vector as V
-import Dodge.Terminal
-import Dodge.Inventory.CheckSlots
 import Control.Applicative
 import Control.Lens
 import Control.Monad
 import qualified Data.IntSet as IS
 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.CharacterEnums
+import Dodge.Clock
 -- import Dodge.Clock
 import Dodge.Creature.Info
 import Dodge.Creature.Test
@@ -30,6 +27,7 @@ import Dodge.Data.World
 import Dodge.DoubleTree
 import Dodge.Equipment.Text
 import Dodge.Inventory
+import Dodge.Inventory.CheckSlots
 import Dodge.Item.Display
 import Dodge.Item.Grammar
 import Dodge.Item.Info
@@ -41,10 +39,12 @@ import Dodge.Render.List
 import Dodge.ScreenPos
 import Dodge.SelectionSections
 import Dodge.SelectionSections.Draw
+import Dodge.Terminal
 import Dodge.Terminal.Type
 import Geometry
 import qualified IntMapHelp as IM
 import Justify
+import Linear
 import NewInt
 import Picture
 import SDL (MouseButton (..))
@@ -59,7 +59,8 @@ drawHUD cfig w = case w ^. hud of
 drawInventory :: IM.IntMap (SelSection ()) -> World -> Config -> SubInventory -> Picture
 drawInventory sss w cfig = \case
     --    DisplayTerminal {} -> mempty
-    _ -> drawSelectionSections sss invDP cfig
+    _ ->
+        drawSelectionSections sss invDP cfig
             <> drawSSCursor sss invDP curs cfig (f $ w ^? hud . diSelection . _Just)
             <> drawRootCursor w sss (f $ w ^? hud . diSelection . _Just) invDP cfig
             <> itemconnections
@@ -118,7 +119,8 @@ drawMouseOver cfig w =
             w ^? input . mouseContext . mcoInvSelect
                 <|> w ^? input . mouseContext . mcoInvFilt
         sss <- w ^? hud . diSections
-        return . translateScreenPos cfig (invDP ^. ldpPos)
+        return
+            . translateScreenPos cfig (invDP ^. ldpPos)
             . color (0.3 *^ white)
             --            . color white
             $ selSecDrawCursorAt invDP curs sss (j, i)
@@ -130,7 +132,8 @@ drawMouseOver cfig w =
                 <|> (w ^? input . mouseContext . mcoCombCombine)
         sss <- w ^? hud . subInventory . ciSections
         let idp = secondColumnLDP
-        return . translateScreenPos cfig (idp ^. ldpPos)
+        return
+            . translateScreenPos cfig (idp ^. ldpPos)
             . color (0.3 * white)
             $ selSecDrawCursorAt idp curs sss (j, i)
 
@@ -146,7 +149,8 @@ drawDragSelected cfig w = do
     Sel i _ _ <- w ^? hud . diSelection . _Just
     sss <- w ^? hud . diSections
     let f x = (selSecDrawCursorAt invDP BackdropCursor sss (i, x) <>)
-    return . translateScreenPos cfig (invDP ^. ldpPos)
+    return
+        . translateScreenPos cfig (invDP ^. ldpPos)
         . color (0.2 *^ white)
         . IS.foldr f mempty
         $ ys
@@ -156,7 +160,8 @@ drawDragSelecting cfig w = do
     OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
     sss <- w ^? hud . diSections
     let f x = selSecDrawCursorAt invDP BackdropCursor sss (i, x)
-    return . translateScreenPos cfig (invDP ^. ldpPos)
+    return
+        . translateScreenPos cfig (invDP ^. ldpPos)
         . color (0.2 *^ white)
         . foldMap f
         $ [min j b .. max j b]
@@ -166,7 +171,9 @@ drawSubInventory subinv cfig w = case subinv of
     --    LockedInventory -> mempty -- topInvCursor col cursPos cfig w
     NoSubInventory{} -> drawRBOptions cfig w
     ExamineInventory -> drawExamineInventory cfig w
-    DisplayTerminal tid -> foldMap (drawTerminalDisplay (w ^.cWorld.lWorld) cfig) 
+    DisplayTerminal tid ->
+        foldMap
+            (drawTerminalDisplay (w ^. cWorld . lWorld) cfig)
             (w ^? cWorld . lWorld . terminals . ix tid)
     CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
     MapperInventory _ _ itid -> drawMapperInventory itid w
@@ -180,21 +187,16 @@ drawMapperInventory itid w = fold $ do
   where
     f = worldPosToScreen (w ^. wCam)
 
-drawCombineInventory ::
+drawCombineInventory :: Config -> IM.IntMap (SelSection CombItem) -> World -> Picture
-    Config ->
-    IM.IntMap (SelSection CombItem) ->
-    World ->
-    Picture
 drawCombineInventory cfig sss w =
---    invHead cfig "COMBINE"
     drawSelectionSections sss secondColumnLDP cfig
         <> drawSSCursor sss secondColumnLDP curs cfig msel
         <> combineInventoryExtra sss msel cfig w
   where
     curs = BoundaryCursor [North, South, West]
     msel =
-        fmap (\(Sel x y _) -> (x, y)) $
+        (\(Sel x y _) -> (x, y)) <$>
-            w ^? hud . subInventory . ciSelection . _Just
+            (w ^? hud . subInventory . ciSelection . _Just)
 
 drawExamineInventory :: Config -> World -> Picture
 drawExamineInventory cfig w =
@@ -336,12 +338,8 @@ drawItemChildrenConnect sss cfig i is = fromMaybe mempty $ do
   where
     snum = selNumPos cfig invDP sss 0
 
-combineInventoryExtra ::
+combineInventoryExtra 
-    IM.IntMap (SelSection CombItem) ->
+    :: IM.IntMap (SelSection CombItem) -> Maybe (Int, Int) -> Config -> World -> Picture
-    Maybe (Int, Int) ->
-    Config ->
-    World ->
-    Picture
 combineInventoryExtra sss msel cfig w = fold $ do
     (i, j) <- msel
     si <- sss ^? ix i . ssItems . ix j
@@ -360,30 +358,31 @@ combineInventoryExtra sss msel cfig w = fold $ do
                     (Just (0, i))
 
 drawTerminalDisplay :: LWorld -> Config -> Terminal -> Picture
-drawTerminalDisplay lw cfig tm =
+drawTerminalDisplay lw cfig tm = drawSelectionList secondColumnLDP cfig f
-        drawSelectionList secondColumnLDP cfig f
+  where
     --        <> invHead cfig ("TERMINAL-" ++ show tid)
     --        <> color
     --            (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
     --            (drawSelectionListBackground secondColumnLDP cfig tsize)
     --        <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
-  where
+
     tid = tm ^. tmID
     --    tsize = getMaxLinesTM + 1
     toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing NoSIDisplayMod
     -- not sure if the width (55) is correct here
-    f = toselitm ("TERMINAL " ++ show tid,white) :
+    f =
-        (map (toselitm . (_1 %~ ("  "<>))) . displayTermInput
+        toselitm ("TERMINAL " ++ show tid, white)
+            : ( map (toselitm . (_1 %~ ("  " <>)))
+                    . displayTermInput
                     . reverse
-            $ _tmDisplayedLines tm)
+                    $ _tmDisplayedLines tm
+              )
     displayTermInput = case _tmStatus tm of
         TerminalOff -> id
         TerminalDeactivated -> id
         TerminalLineRead -> (++ [(spincurs, termTextColor)])
-        TerminalTextInput s ->
+        TerminalTextInput s -> (++ [(getPromptTM ++ s ++ [cFilledRect], white)])
-            (++ [(getPromptTM ++ s ++ [cFilledRect], white)])
+        TerminalPressTo s -> (++ [(s, white)])
-        TerminalPressTo s ->
-            (++ [(s, white)])
     spincurs = clockCycle 4 (V.fromList ["/", "-", "\\", "|"]) lw
 
 lnkMidPosInvSelsCol :: Config -> World -> Int -> Color -> [Int] -> Picture

src/Dodge/Render/List.hs

@@ -41,6 +41,9 @@ drawSelectionList ldps cfig sl =
             (ldps ^. ldpScale)
             0
             (makeSelectionListPictures sl)
+        <> foldMap (color white . polygonWire . f) (ldps ^. ldpBorder)
+  where
+    f (x,y) = rectNSWE 5 (negate $ 20 * fromIntegral y + 5) (-5) (10 * fromIntegral x)
 
 drawTitleBackground :: Config -> Picture
 drawTitleBackground cfig =

src/Loop.hs

@@ -209,7 +209,10 @@ setupConLoop' ::
     (world -> Event ->  world) ->
     IO ()
 setupConLoop' spf title winconfig paramCleanup ioStartWorld coneffs sideEffects eventFn = do
+    bracket_
         initializeAll
+        (putStrLn "Quit SDL" >> quit)
+        $ do
             themvar <- newEmptyMVar
             bracket
                 (createWindow title winconfig)

src/Picture/Base.hs

@@ -63,7 +63,7 @@ blank = mempty
 
 polygonWire :: [Point2] -> Picture
 {-# INLINE polygonWire #-}
-polygonWire ps = line (ps ++ [head ps])
+polygonWire ps = line (ps <> [head ps])
 
 picMap :: (Verx -> Verx) -> Picture -> Picture
 {-# INLINE picMap #-}