Remove cursor type from ListDisplayParams

2024-10-25 17:41:37 +01:00
parent bd505b072a
commit 6424899afd
7 changed files with 252 additions and 208 deletions
@@ -19,10 +19,13 @@ data ListDisplayParams = ListDisplayParams
    { _ldpPos :: ScreenPos
    , _ldpScale :: Float
    , _ldpVerticalGap :: Float
-    , _ldpCursorSides :: [CardinalPoint]
    , _ldpWidth :: SelectionWidth
    }

+data CursorDisplay = CursorDisplay
+    { _cursSides :: [CardinalPoint]
+    }
+
 data SelectionList a = SelectionList
    { _slItems :: [SelectionItem a]
    , _slSelPos :: Maybe Int
@@ -67,10 +70,6 @@ data SelectionWidth
    | VariableSelectionWidth (Int -> Int)
    | UseMaxSelectionItemWidth

-data CursorType
-    = NoCursor
-    | BorderCursor [CardinalPoint]
-
 data SelectionItem a
    = SelectionItem
        { _siPictures :: [String]
@@ -95,6 +94,7 @@ makeLenses ''SelectionSection
 makeLenses ''SelectionSections
 makeLenses ''SSSExtra
 makeLenses ''SectionCursor
+makeLenses ''CursorDisplay

 --deriveJSON defaultOptions ''SelectionItem
 --deriveJSON defaultOptions ''SelectionList
@@ -1,5 +1,6 @@
 module Dodge.ListDisplayParams 
    ( invDisplayParams
+    , invCursorParams
    , secondColumnParams
    , subInvX
    , defaultListDisplayParams
@@ -22,18 +23,23 @@ defaultListDisplayParams =
        , _ldpScale = 1
        , _ldpPos = ScreenPos {_spScreenOff = V2 (-0.5) 0.5 -- top left
            , _spPixelOff = 0}
-        , _ldpCursorSides = mempty
        , _ldpWidth = FixedSelectionWidth 15
        }

 invDisplayParams :: World -> ListDisplayParams
 invDisplayParams w =
    defaultListDisplayParams
-        & ldpCursorSides .~ selcursortype
+--        & ldpCursorSides .~ selcursortype
        & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
        & ldpPos . spPixelOff .~ V2 6 (-1)
-  where
-    selcursortype = case w ^? hud . hudElement . subInventory of
+--  where
+--    selcursortype = case w ^? hud . hudElement . subInventory of
+--        _ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West]
+--        Just ExamineInventory{} -> [North, South, East, West]
+--        Just CombineInventory{} -> []
+--        _ -> [North, South, West]
+invCursorParams :: World -> CursorDisplay
+invCursorParams w = CursorDisplay $ case w ^? hud . hudElement . subInventory of
        _ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West]
        Just ExamineInventory{} -> [North, South, East, West]
        Just CombineInventory{} -> []
@@ -43,7 +49,7 @@ secondColumnParams :: ListDisplayParams
 secondColumnParams =
    defaultListDisplayParams
        & ldpPos . spPixelOff .~ V2 subInvX (-81)
-        & ldpCursorSides .~ [North, South, West]
+--        & ldpCursorSides .~ [North, South, West]

 subInvX :: Float
 subInvX = 10 * fromIntegral topInvW + 70
@@ -71,4 +77,4 @@ optionListDisplayParams =
        & ldpScale .~ 2
        & ldpVerticalGap .~ 0
        & ldpWidth .~ FixedSelectionWidth 50
-        & ldpCursorSides .~ [North, South, West]
+--        & ldpCursorSides .~ [North, South, West]
@@ -58,7 +58,8 @@ drawHP cfig =

 drawInventory :: SelectionSections () -> World -> Configuration -> Picture
 drawInventory sss w cfig =
-    drawSelectionSections sss (w ^? hud . hudElement . diSelection . _Just) ldp cfig
+    drawSelectionSections sss ldp cfig
+    <> drawSSCursor sss (w ^? hud . hudElement . diSelection . _Just) ldp curs cfig
        <> iextra
        <> translateScreenPos
            cfig
@@ -68,6 +69,7 @@ drawInventory sss w cfig =
        <> drawDISelections' w cfig
  where
    ldp = invDisplayParams w
+    curs = invCursorParams w
    iextra = fromMaybe mempty $ do
        inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
        let x = case invAdj inv of
@@ -80,7 +82,9 @@ drawDIMouseOver w = fromMaybe mempty $ do
    (_, i) <- w ^? hud . hudElement . subInventory . nsMouseOver . _Just
    sss <- w ^? hud . hudElement . diSections
    let idp = invDisplayParams w
-    return . color (withAlpha 0.5 white) $ selSecDrawCursorAt (0, i) 10 idp sss
+    return . color (withAlpha 0.5 white) $ selSecDrawCursorAt (0, i) 10 idp curs sss
+  where
+    curs = CursorDisplay [North,South]

 getMouseInvSel :: World -> Maybe ((Int, Int), (Int, Int))
 getMouseInvSel w = case w ^? hud . hudElement . subInventory . nsSelected of
@@ -122,9 +126,11 @@ drawSubInventory subinv cfig w = case subinv of
 drawCombineInventory :: Configuration -> SelectionSections CombinableItem -> World -> Picture
 drawCombineInventory cfig sss w =
    invHead cfig "COMBINE"
-        <> drawSelectionSections sss msel secondColumnParams cfig
+        <> drawSelectionSections sss secondColumnParams cfig
+        <> drawSSCursor sss msel secondColumnParams curs cfig
        <> combineInventoryExtra sss msel cfig w
  where
+    curs = CursorDisplay [North,South,West]
    msel = w ^? hud . hudElement . subInventory . ciSelection . _Just

 drawExamineInventory :: Configuration -> World -> Picture
@@ -273,10 +279,11 @@ combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
  where
    invcursor i = do
        sss' <- w ^? hud . hudElement . diSections
-        let idp = invDisplayParams w & ldpCursorSides .~ [North, South, East, West]
+        let idp = invDisplayParams w
        return $
            translateScreenPos cfig (idp ^. ldpPos) $
-                selSecDrawCursor 17 idp sss' (Just (0, i))
+                selSecDrawCursor 17 idp (CursorDisplay [North, South, East, West])
+                    sss' (Just (0, i))

 displayTerminal :: Int -> Configuration -> LWorld -> Picture
 displayTerminal tid cfig w = fromMaybe mempty $ do
@@ -36,9 +36,12 @@ drawSelectionList ldps cfig sl =
            (_ldpScale ldps)
            0
            (makeSelectionListPictures sl)
-            <> drawSelectionCursor sl ldps
+            <> drawSelectionCursor sl ldps (CursorDisplay [North,West,South])

-drawSelectionCursor :: SelectionList a -> ListDisplayParams -> Picture
+drawSelectionCursor :: SelectionList a 
+    -> ListDisplayParams 
+    -> CursorDisplay 
+    -> Picture
 drawSelectionCursor sl = drawCursorAt (f $ sl ^. slSelPos) (getShownItems sl)
  where
    -- the following is quite hacky
@@ -53,15 +56,18 @@ makeSelectionListPictures = concatMap f . getShownItems
    f si = map (color (_siColor si) . text) $ _siPictures si
    --f si = map ((flip inverseText) ((_siColor si))) $ _siPictures si

-drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> Picture
-drawCursorAt mi lis ldps = fromMaybe mempty $ do
+drawCursorAt :: Maybe Int -> [SelectionItem a] 
+    -> ListDisplayParams 
+    -> CursorDisplay
+    -> Picture
+drawCursorAt mi lis ldps curs = fromMaybe mempty $ do
    i <- mi
    selit <- lis !? i
    return $
        listCursorChooseBorderScale
            (_ldpVerticalGap ldps)
            (_ldpScale ldps)
-            (ldps ^. ldpCursorSides)
+            (curs ^. cursSides)
            (sum . map _siHeight $ take i lis)
            (_siOffX selit)
            (_siColor selit)
@@ -85,8 +91,14 @@ stackPicturesAt = stackPicturesAtOff 0
 stackPicturesAtOff :: Int -> [Picture] -> Picture
 stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..]

-selSecDrawCursorAt :: (Int,Int) -> Int -> ListDisplayParams -> SelectionSections a -> Picture
-selSecDrawCursorAt (i,j) xsize ldp sss = fromMaybe mempty $ do
+selSecDrawCursorAt 
+    :: (Int,Int) 
+    -> Int 
+    -> ListDisplayParams 
+    -> CursorDisplay
+    -> SelectionSections a 
+    -> Picture
+selSecDrawCursorAt (i,j) xsize ldp curs sss = fromMaybe mempty $ do
    yint <- selSecYint i j sss
    xint <- sss ^? sssSections . ix i . ssIndent
    si <- sss ^? sssSections . ix i . ssItems . ix j
@@ -94,17 +106,19 @@ selSecDrawCursorAt (i,j) xsize ldp sss = fromMaybe mempty $ do
        listCursorChooseBorderScale
            (ldp ^. ldpVerticalGap)
            (ldp ^. ldpScale)
-            (ldp ^. ldpCursorSides)
+            (curs ^. cursSides)
            yint
            (xint + _siOffX si)
            (_siColor si)
            xsize
            (_siHeight si)

-selSecDrawCursor :: Int -> ListDisplayParams -> SelectionSections a -> 
+selSecDrawCursor :: Int -> ListDisplayParams 
+    -> CursorDisplay
+    -> SelectionSections a -> 
    Maybe (Int,Int) -> Picture
-selSecDrawCursor xsize ldp sss msel = maybe mempty 
-    (\x -> selSecDrawCursorAt x xsize ldp sss)
+selSecDrawCursor xsize ldp curs sss msel = maybe mempty 
+    (\x -> selSecDrawCursorAt x xsize ldp curs sss)
    msel

 -- displays a cursor that should match up to list text pictures
@@ -1,4 +1,7 @@
-module Dodge.SelectionSections.Draw where
+module Dodge.SelectionSections.Draw 
+    ( drawSelectionSections
+    , drawSSCursor
+    ) where

 import Control.Lens
 import Dodge.Data.Config
@@ -7,14 +10,26 @@ import Dodge.Render.List
 import Dodge.ScreenPos
 import Picture.Base

-drawSelectionSections :: SelectionSections a -> Maybe (Int,Int) -> ListDisplayParams -> Configuration -> Picture
-drawSelectionSections sss msel ldp cfig =
+drawSelectionSections 
+    :: SelectionSections a 
+    -> ListDisplayParams 
+    -> Configuration 
+    -> Picture
+drawSelectionSections sss ldp cfig =
    translateScreenPos cfig (ldp ^. ldpPos) $
        drawListYgapScaleYoff
            (_ldpVerticalGap ldp)
            (_ldpScale ldp)
            0
-            pics
-            <> selSecDrawCursor 15 ldp sss msel
-  where
-    pics = foldMap _ssShownItems (_sssSections sss)
+            (foldMap _ssShownItems (_sssSections sss))
+
+drawSSCursor 
+    :: SelectionSections a 
+    -> Maybe (Int,Int) 
+    -> ListDisplayParams 
+    -> CursorDisplay
+    -> Configuration 
+    -> Picture
+drawSSCursor sss msel ldp curs cfig =
+    translateScreenPos cfig (ldp ^. ldpPos) $
+            selSecDrawCursor 15 ldp curs sss msel