Color scroll lines in inventory display

src/Dodge/DisplayInventory.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TupleSections #-}
+
 --{-# OPTIONS_GHC -fno-full-laziness #-}
 
 module Dodge.DisplayInventory (
@@ -8,21 +9,21 @@ module Dodge.DisplayInventory (
     updateCombinePositioning,
 ) where
 
-import Dodge.ListDisplayParams
-import ListHelp
-import Dodge.Data.Combine
 import Control.Monad
 import qualified Data.IntMap.Strict as IM
 import Data.Maybe
 import Dodge.Base.You
 import Dodge.Combine
+import Dodge.Data.Combine
 import Dodge.Data.Config
 import Dodge.Data.SelectionList
 import Dodge.Data.Universe
 import Dodge.Inventory.CheckSlots
 import Dodge.Inventory.SelectionList
+import Dodge.ListDisplayParams
 import Dodge.SelectionList
 import LensHelp
+import ListHelp
 import Picture.Base
 import Regex
 
@@ -32,7 +33,8 @@ toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
     _ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
 
 updateCombinePositioning :: Universe -> Universe
-updateCombinePositioning u = u & uvWorld . hud . hudElement . subInventory . ciSections
+updateCombinePositioning u =
+    u & uvWorld . hud . hudElement . subInventory . ciSections
         %~ updateCombineSections (_uvWorld u) (_uvConfig u)
 
 updateCombineSections :: World -> Configuration -> SelectionSections CombinableItem -> SelectionSections CombinableItem
@@ -64,7 +66,7 @@ updateCombineSections w cfig sss =
 
 regexCombs :: IM.IntMap (SelectionItem ()) -> SelectionItem CombinableItem -> String -> Bool
 regexCombs inv ci str = case str of
-    '<':str' -> f str' ci
+    '<' : str' -> f str' ci
     _ -> (regexList str . _siPictures) ci
   where
     f str' si = any (g str') (_ciInvIDs $ _siPayload si)
@@ -81,7 +83,8 @@ orRegex f x str = case words str of
     xs -> any (f x) xs
 
 updateInventoryPositioning :: Universe -> Universe
-updateInventoryPositioning u = u & uvWorld . hud . hudElement . diSections
+updateInventoryPositioning u =
+    u & uvWorld . hud . hudElement . diSections
         %~ updateDisplaySections (_uvWorld u) (_uvConfig u)
 
 updateDisplaySections :: World -> Configuration -> SelectionSections () -> SelectionSections ()
@@ -129,14 +132,14 @@ updateDisplaySections w cfig sss =
             return $ IM.filter (plainRegex str) itms
         numfiltitems = "  " ++ show (length itms - length itms') ++ " FILTERED"
 
-
 invDimColor :: Color
 invDimColor = greyN 0.7
 
 -- it is annoying that this is necessary
 updateInventorySectionItems :: World -> World
-updateInventorySectionItems w = w 
-    & hud . hudElement . diSections . sssSections . ix 0 . ssItems %~ f
+updateInventorySectionItems w =
+    w
+        & hud . hudElement . diSections . sssSections . ix 0 . ssItems %~ f
   where
     f olditems = fromMaybe olditems $ do
         cr <- w ^? cWorld . lWorld . creatures . ix 0
@@ -197,9 +200,10 @@ updateSection sis mcsel availablelines ss =
             csize = length $ _siPictures si
             ccolor = _siColor si
         return $ SectionCursor (cpos - offset) csize ccolor
-    nocursoroffset = if length allstrings - oldoffset <= availablelines 
-        then max 0 (length allstrings - availablelines)
-        else oldoffset
+    nocursoroffset =
+        if length allstrings - oldoffset <= availablelines
+            then max 0 (length allstrings - availablelines)
+            else oldoffset
     offset = fromMaybe nocursoroffset $ do
         csel <- mcsel
         maxcsel <- fst <$> IM.lookupMax sis
@@ -223,14 +227,20 @@ updateSection sis mcsel availablelines ss =
                     length allstrings - availablelines
             _ -> oldoffset
     tweakfirst (x : xs)
-        | offset > 0 = xtra "<<<" : map h xs
+        --        -- a| offset > 0 = xtra "<<<" : map h xs
+        | offset > 0 =
+            translate 0 (-100) (color moreupcolor $ text (theindent ++ replicate 15 '^')) :
+            map h xs
         | otherwise = map h (x : xs)
     tweakfirst [] = []
+    moreupcolor = fromMaybe white $ allstrings ^? ix offset . _1
     shownitems
         | length shownstrings > availablelines =
             tweakfirst (take (availablelines - 1) shownstrings)
-                ++ [xtra ">>>"]
+                -- ++ [xtra ">>>"]
+                ++ [translate 0 100 . color moredowncolor . vMirrorText $ theindent ++ replicate 15 '^']
         | otherwise = tweakfirst shownstrings
+    moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1
     allstrings :: [(Color, String)]
     allstrings = foldMap g sis
     shownstrings = drop offset allstrings

src/Dodge/ListDisplayParams.hs

@@ -71,6 +71,6 @@ optionListDisplayParams =
         & ldpPos . spPixelOff .~ V2 11 (-70)
         & ldpScale .~ 2
         & ldpVerticalGap .~ 0
-        & ldpWidth .~ FixedSelectionWidth 25
+        & ldpWidth .~ FixedSelectionWidth 50
         & ldpCursorSides .~ [North, South, West]
 

src/Dodge/Render/HUD.hs

@@ -236,7 +236,8 @@ tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
 
 invHead :: Configuration -> String -> Picture
 invHead cfig =
-    translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
+    translateScreenPos cfig (fromTopLeft (V2 (subInvX + 20) 80))
+    -- (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 80)
         . dShadCol white
         . scale 0.4 0.4
         . text

src/Picture/Base.hs

@@ -45,6 +45,7 @@ module Picture.Base (
     mirrorxz,
     overPos,
     picMap,
+    vMirrorText,
 ) where
 
 import Color
@@ -205,6 +206,10 @@ text :: String -> Picture
 text = drawText 0
 --text = drawText (-10)
 
+vMirrorText :: String -> Picture
+{-# INLINE vMirrorText #-}
+vMirrorText = translate 0 200 . scale 1 (-1) . text
+
 drawText :: Float -> String -> [Verx]
 {-# INLINE drawText #-}
 drawText gap = map f . stringToList gap