Improve terminal color possibilities

src/Dodge/Render/HUD.hs

@@ -145,7 +145,7 @@ drawSubInventory subinv cfig w = case subinv of
     LockedInventory -> mempty -- topInvCursor col cursPos cfig w
     NoSubInventory{} -> drawRBOptions cfig w
     ExamineInventory -> drawExamineInventory cfig w
-    DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
+    DisplayTerminal tid -> drawTerminalDisplay tid cfig (w ^. cWorld . lWorld)
     CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
 
 drawCombineInventory ::
@@ -343,12 +343,14 @@ combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
                     sss'
                     (Just (0, i))
 
-displayTerminal :: Int -> Configuration -> LWorld -> Picture
-displayTerminal tid cfig w = fromMaybe mempty $ do
+drawTerminalDisplay :: Int -> Configuration -> LWorld -> Picture
+drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
     tm <- w ^? terminals . ix tid
     return $
         invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
             <> drawSelectionList secondColumnParams cfig (thesellist tm)
+            <> color (withAlpha 0.5 green) (drawSelectionListBackground secondColumnParams cfig 15)
+            <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
   where
     toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
     thesellist tm = defaultSelectionList & slItems .~ thelist tm
@@ -382,7 +384,7 @@ lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
 
 invHead :: Configuration -> String -> Picture
 invHead cfig =
-    translateScreenPos cfig (fromTopLeft (V2 (subInvX - 5) 80))
+    translateScreenPos cfig (fromTopLeft (V2 subInvX 80))
         . dShadCol white
         . scale 0.4 0.4
         . textJustifyLeft

src/Dodge/Render/List.hs

@@ -3,6 +3,7 @@ module Dodge.Render.List (
     renderListAt,
     drawList,
     drawSelectionList,
+    drawSelectionListBackground,
     drawListYgapScaleYoff,
     drawListElement,
     selSecDrawCursor,
@@ -12,8 +13,10 @@ module Dodge.Render.List (
     toTopLeft,
     listCursorChooseBorderScale,
     selSecDrawCursorAt,
+    drawTitleBackground, -- should be renamed, made sensible
 ) where
 
+import Dodge.ListDisplayParams
 import qualified Data.IntMap.Strict as IM
 import Data.Maybe
 import Dodge.Base.Window
@@ -41,6 +44,20 @@ drawSelectionList ldps cfig sl =
                 ldps
                 (BoundaryCursor [North, South])
 
+drawTitleBackground :: Configuration -> Picture
+drawTitleBackground cfig =
+    translateScreenPos cfig (fromTopLeft (V2 (subInvX - 5) 75))
+    . polygon . reverse $ rectNSWE 70 0 0 560
+
+drawSelectionListBackground :: ListDisplayParams -> Configuration ->
+    Int -- list length
+    -> Picture
+drawSelectionListBackground ldp cfig l = translateScreenPos cfig (ldp ^. ldpPos) .
+    polygon . reverse $ rectNSWE 5 s (-5) e
+  where
+    s = - (5 + fromIntegral l * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap))
+    e = 555 -- HACK
+
 makeSelectionListPictures :: SelectionList a -> [Picture]
 makeSelectionListPictures = concatMap f . _slItems
   where

src/Dodge/Render/ShapePicture.hs

@@ -31,7 +31,7 @@ worldSPic cfig u =
         <> foldup drawCreature (filtOn _crPos _creatures)
         <> foldup floorItemSPic (filtOn _flItPos (_unNIntMap . _floorItems))
         <> foldup btSPic (filtOn _btPos _buttons)
-        <> foldup mcSPic (filtOn _mcPos _machines)
+        <> foldup (mcSPic (u ^. uvWorld . cWorld . lWorld)) (filtOn _mcPos _machines)
   where
     w = _uvWorld u
     foldup = foldMap'
@@ -128,7 +128,7 @@ btSPic bt =
     uncurryV translateSPxy (_btPos bt) $
         rotateSP (_btRot bt) (drawButton (_btPict bt) bt)
 
-mcSPic :: Machine -> SPic
-mcSPic mc =
+mcSPic :: LWorld -> Machine -> SPic
+mcSPic lw mc =
     uncurryV translateSPxy (_mcPos mc) $
-        rotateSP (_mcDir mc) (drawMachine mc)
+        rotateSP (_mcDir mc) (drawMachine lw mc)