Work on terminal text display

2025-12-23 22:02:38 +00:00
parent 238d6b8799
commit 9e8b847940
5 changed files with 40 additions and 45 deletions
@@ -44,7 +44,6 @@ drawFlamelet size pt =
    time = _ebTimer pt
    piu =
        translate3 sp
--        setDepth (z + 5)
 --            . uncurryV translate sp
            . color
                ( mixColors
@@ -61,8 +60,6 @@ drawFlamelet size pt =
            $ reverse (rectNSWE siz2 (- siz2) (- siz2) siz2)
    pi2 =
        translate3 sp
-        --setDepth (z + 5)
-        --    . uncurryV translate sp
            . color
                ( mixColors
                    (fromIntegral (max 0 (time -2)))
@@ -79,8 +76,6 @@ drawFlamelet size pt =
            $ rectNSWE siz2 (- siz2) (- siz2) siz2
    pic =
        translate3 sp
-        --setDepth (z + 2)
-        --    . uncurryV translate sp
            . color
                ( mixColors
                    (fromIntegral (max 0 (time -2)))
@@ -16,8 +16,8 @@ import Dodge.Data.World
 import Linear
 import SDL (MouseButton (..))

-defaultListDisplayParams :: ListDisplayParams
-defaultListDisplayParams =
+defaultLDP :: ListDisplayParams
+defaultLDP =
    ListDisplayParams
        { _ldpVerticalGap = 0
        , _ldpScale = 1
@@ -30,7 +30,8 @@ defaultListDisplayParams =
        }

 invDP :: ListDisplayParams
-invDP = defaultListDisplayParams & ldpPos . spPixelOff .~ V2 6 0
+--invDP = defaultLDP & ldpPos . spPixelOff .~ V2 6 0
+invDP = defaultLDP & ldpPos . spPixelOff .~ V2 16 (-20)

 invCursorParams :: World -> CursorDisplay
 invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
@@ -40,10 +41,7 @@ invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
    _ -> [North, South, West]

 secondColumnLDP :: ListDisplayParams
--secondColumnLDP = defaultListDisplayParams & ldpPos . spPixelOff .~ V2 subInvX (-20)
-secondColumnLDP = defaultListDisplayParams 
-    & ldpPos . spPixelOff .~ V2 subInvX (-16)
-    & ldpBorder ?~ (49, 16)
+secondColumnLDP = defaultLDP & ldpPos . spPixelOff .~ V2 subInvX (-20)

 subInvX :: Float
 subInvX = 10 * fromIntegral topInvW + 170
@@ -52,8 +50,4 @@ topInvW :: Int
 topInvW = 15

 menuLDP :: ListDisplayParams
-menuLDP =
-    defaultListDisplayParams
-        & ldpPos . spPixelOff .~ V2 11 (-70)
-        & ldpScale .~ 2
-        & ldpVerticalGap .~ 0
+menuLDP = defaultLDP & ldpPos . spPixelOff .~ V2 11 (-70) & ldpScale .~ 2
@@ -358,7 +358,8 @@ combineInventoryExtra sss msel cfig w = fold $ do
                    (Just (0, i))

 drawTerminalDisplay :: LWorld -> Config -> Terminal -> Picture
-drawTerminalDisplay lw cfig tm = drawSelectionList secondColumnLDP cfig f
+drawTerminalDisplay lw cfig tm 
+    = drawSelectionList (secondColumnLDP & ldpBorder ?~ (49, 16)) cfig f
  where
    --        <> invHead cfig ("TERMINAL-" ++ show tid)
    --        <> color
@@ -36,14 +36,18 @@ import Picture
 drawSelectionList :: ListDisplayParams -> Config -> [SelectionItem a] -> Picture
 drawSelectionList ldps cfig sl =
    translateScreenPos cfig (ldps ^. ldpPos) $
-        drawListYgapScaleYoff
-            (ldps ^. ldpVerticalGap)
-            (ldps ^. ldpScale)
-            0
-            (makeSelectionListPictures sl)
-        <> foldMap (color white . polygonWire . f) (ldps ^. ldpBorder)
+        drawListYgapScaleYoff ygap sf 0 (makeSelectionListPictures sl)
+            <> foldMap (g . f) (ldps ^. ldpBorder)
  where
-    f (x,y) = rectNSWE 5 (negate $ 20 * fromIntegral y + 5) (-5) (10 * fromIntegral x)
+    g xs = color white (polygonWire xs) <> setDepth 0.5 (polygon xs)
+    ygap = ldps ^. ldpVerticalGap
+    sf = ldps ^. ldpScale
+    f (x, y) =
+        rectNSWE
+            5
+            (negate $ (20 * sf + ygap) * fromIntegral y + 5)
+            (-5)
+            (10 * sf * fromIntegral x)

 drawTitleBackground :: Config -> Picture
 drawTitleBackground cfig =
@@ -63,7 +67,7 @@ drawSelectionListBackground ldp cfig l =
        . reverse
        $ rectNSWE 5 s (-5) e
  where
-    s = - (5 + fromIntegral l * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap))
+    s = -(5 + fromIntegral l * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap))
    e = 555 -- HACK isOverTerminalScreen

 makeSelectionListPictures :: [SelectionItem a] -> [Picture]
@@ -103,7 +107,7 @@ stackPicturesAt :: [Picture] -> Picture
 stackPicturesAt = stackPicturesAtOff 0

 stackPicturesAtOff :: Int -> [Picture] -> Picture
-stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..]
+stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i - 1 ..]

 selSecDrawCursorAt ::
    ListDisplayParams ->
@@ -148,7 +152,7 @@ listCursorChooseBorderScale ::
 listCursorChooseBorderScale ygap s curs yint xint col cursxsize cursysize =
    translate
        ((10 * fromIntegral xint - 5) * s)
-        (- (ygap + (s * 20 + ygap) * fromIntegral yint))
+        (-(ygap + (s * 20 + ygap) * fromIntegral yint))
        . color col
        $ chooseCursorBorders (s * wth) (s * hgt) curs
  where
@@ -167,8 +171,8 @@ chooseCursorBorders w h = \case
    toLine South = [V2 w h', V2 0 h']
    toLine West = [V2 0 h', V2 0 0]

--fillScreenText :: Config -> String -> Picture
--fillScreenText cfig str =
+-- fillScreenText :: Config -> String -> Picture
+-- fillScreenText cfig str =
 --    scale wscale hscale
 --        . centerText
 --        $ str
@@ -178,8 +182,8 @@ chooseCursorBorders w h = \case
 --    hw = halfWidth cfig
 --    hh = halfHeight cfig

--fillWidthText :: Config -> String -> Picture
--fillWidthText cfig str =
+-- fillWidthText :: Config -> String -> Picture
+-- fillWidthText cfig str =
 --    scale thescale thescale
 --        . centerText
 --        $ str
@@ -193,12 +197,13 @@ drawListElement ygap s xint yint =
        . scale (s * 0.1) (s * 0.1)

 renderListAt :: Float -> Float -> [(String, Color)] -> Picture
-renderListAt tx ty = translate tx (- ty) 
-    . drawList 
-    . map (\(str, col) -> color col $ text str)
+renderListAt tx ty =
+    translate tx (-ty)
+        . drawList
+        . map (\(str, col) -> color col $ text str)

--inverseText :: String -> Color -> Picture
--inverseText str col =
+-- inverseText :: String -> Color -> Picture
+-- inverseText str col =
 --    translate3 (V3 0 0 (0.5))
 --    (color (V4 0 1 0 0.1) ( text str))
 --    <>
@@ -212,14 +217,14 @@ renderListAt tx ty = translate tx (- ty)
 drawList :: [Picture] -> Picture
 drawList = drawListYgapScaleYoff 0 1 0

-drawLabelledList :: [(String,[String])] -> Picture
-drawLabelledList ((s,ss):xs) 
-    = translate (-10) 0 (drawListYgapScaleYoff 0 1 0 [ textJustifyRight s])
-    <> drawListYgapScaleYoff 0 1 0 (text <$> ss)
-    <> translate 0 (negate $ fromIntegral (max 1 $ length ss) * 20) (drawLabelledList xs)
+drawLabelledList :: [(String, [String])] -> Picture
+drawLabelledList ((s, ss) : xs) =
+    translate (-10) 0 (drawListYgapScaleYoff 0 1 0 [textJustifyRight s])
+        <> drawListYgapScaleYoff 0 1 0 (text <$> ss)
+        <> translate 0 (negate $ fromIntegral (max 1 $ length ss) * 20) (drawLabelledList xs)
 drawLabelledList [] = mempty

--TODO put the following functions in an appropriate place
+-- TODO put the following functions in an appropriate place

 -- | Colour picture and add black drop shadow.
 dShadCol :: Color -> Picture -> Picture
@@ -227,4 +232,4 @@ dShadCol :: Color -> Picture -> Picture
 dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p

 toTopLeft :: Config -> Picture -> Picture
-toTopLeft cfig = translate (- halfWidth cfig) (halfHeight cfig)
+toTopLeft cfig = translate (-halfWidth cfig) (halfHeight cfig)
@@ -84,7 +84,7 @@ drawMouseCursor :: Universe -> Picture
 drawMouseCursor u =
    uncurryV translate (u ^. uvWorld . input . mousePos)
        . color white
-        . setDepth 1
+        . setDepth (-1)
        $ mouseCursorType u

 mouseCursorType :: Universe -> Picture