Work on cursor for lists

src/Dodge/Data/SelectionList.hs

@@ -16,7 +16,7 @@ data ListDisplayParams = ListDisplayParams
     , _ldpPosY :: Float
     , _ldpScale :: Float
     , _ldpVerticalGap :: Float
-    , _ldpCursorType :: CursorType
+    , _ldpCursorSides :: [CardinalPoint]
     , _ldpWidth :: SelectionWidth
 --    , _ldpSizeRestriction :: SelectionSizeRestriction
     }

src/Dodge/Debug/Picture.hs

@@ -124,7 +124,7 @@ debugDraw :: Configuration -> World -> Picture
 debugDraw cfig w
     | Enable_debug `S.member` _debug_booleans cfig =
         pic
-            <> setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ listPicturesAt $ map text ts))
+            <> setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ drawList $ map text ts))
     | otherwise = mempty
   where
     pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig)

src/Dodge/ListDisplayParams.hs

@@ -19,14 +19,14 @@ defaultListDisplayParams =
         , _ldpScale = 1
         , _ldpPosX = 0
         , _ldpPosY = 0
-        , _ldpCursorType = NoCursor
+        , _ldpCursorSides = mempty
         , _ldpWidth = FixedSelectionWidth 15
         }
 
 invDisplayParams :: World -> ListDisplayParams
 invDisplayParams w =
     defaultListDisplayParams
-        & ldpCursorType .~ BorderCursor selcursortype
+        & ldpCursorSides .~ selcursortype
         & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
   where
     selcursortype
@@ -41,7 +41,7 @@ secondColumnParams =
     defaultListDisplayParams
         & ldpPosX .~ subInvX
         & ldpPosY .~ 60
-        & ldpCursorType .~ BorderCursor [North, South, West]
+        & ldpCursorSides .~ [North, South, West]
 
 subInvX :: Float
 subInvX = 9 * fromIntegral topInvW + 50

src/Dodge/Menu.hs

@@ -28,7 +28,7 @@ import Text.Read
 
 splashMenu :: Universe -> ScreenLayer
 splashMenu u =
-    initializeOptionMenu "AMNESIS" splashMenuOptions NoPositionedMenuOption u
+    initializeOptionMenu "GAME TITLE" splashMenuOptions NoPositionedMenuOption u
         & scOptionFlag .~ SplashOptions
 
 splashMenuOptions :: [MenuOption]

src/Dodge/Menu/Option.hs

@@ -19,7 +19,7 @@ optionListDisplayParams =
         , _ldpScale = 2
         , _ldpVerticalGap = 30
         , _ldpWidth = FixedSelectionWidth 25
-        , _ldpCursorType = BorderCursor [North, South, West]
+        , _ldpCursorSides = [North, South, West]
         }
 
 initializeOptionMenu :: String -> [MenuOption] -> PositionedMenuOption -> Universe -> ScreenLayer

src/Dodge/Render/HUD.hs

@@ -119,8 +119,8 @@ drawRBOptions cfig w = fromMaybe mempty $ do
     sss <- w ^? hud . hudElement . diSections
     (i', j) <- sss ^? sssExtra . sssSelPos . _Just
     curpos <- selSecSelPos i' j sss
-    let midtext str = toTopLeft cfig $ translate 252 0 $ listTextPictureAtScale 10 1 curpos (text str)
+    let midtext str = toTopLeft cfig $ translate 252 0 $ drawListElement 10 1 curpos (text str)
-    let extratext str = toTopLeft cfig $ translate 432 0 $ listTextPictureAtScale 10 1 curpos (text (str ++ deactivatetext))
+    let extratext str = toTopLeft cfig $ translate 432 0 $ drawListElement 10 1 curpos (text (str ++ deactivatetext))
     return $
         toTopLeft cfig (translate 342 0 $ listPicturesAtOff (curpos - i) (map (text . eqPosText) es))
             <> case ae of

src/Dodge/Render/List.hs

@@ -1,10 +1,10 @@
 module Dodge.Render.List (
     renderListAt,
     listCursorNSW,
-    listPicturesAt,
+    drawList,
     drawSelectionList,
     listPicturesAtScaleOff,
-    listTextPictureAtScale,
+    drawListElement,
     selSecDrawCursor,
     dShadCol,
     listPicturesAtOff,
@@ -26,13 +26,16 @@ import Picture
 
 drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
 drawSelectionList ldps cfig sl =
-    toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesAtScaleOff
+    toTopLeft
-        (_ldpVerticalGap ldps)
+        cfig
-        (_ldpScale ldps)
+        ( ( translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $
-        0
+                listPicturesAtScaleOff
-        (makeSelectionListPictures sl)
+                    (_ldpVerticalGap ldps)
-        )
+                    (_ldpScale ldps)
-        <> drawSelectionCursor ldps sl
+                    0
+                    (makeSelectionListPictures sl)
+          )
+            <> drawSelectionCursor ldps sl
         )
 
 makeSelectionListPictures :: SelectionList a -> [Picture]
@@ -44,12 +47,20 @@ drawCursorAt :: ListDisplayParams -> Maybe Int -> [SelectionItem a] -> Picture
 drawCursorAt ldps mi lis = fromMaybe mempty $ do
     i <- mi
     selit <- lis !? i
-    f <- case _ldpCursorType ldps of
-        BorderCursor cps -> Just $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) cps
-        NoCursor -> Nothing
     let j = sum . map _siHeight $ take i lis
         col = _siColor selit
-    return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) j 0 col wdth (_siHeight selit)
+    return $
+        listCursorChooseBorderScale
+            (_ldpVerticalGap ldps)
+            (_ldpScale ldps)
+            (ldps ^. ldpCursorSides)
+            (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit)))
+            (_ldpPosY ldps)
+            j
+            0
+            col
+            wdth
+            (_siHeight selit)
   where
     wdth = case _ldpWidth ldps of
         FixedSelectionWidth x -> x
@@ -65,18 +76,18 @@ drawSelectionCursor ldps sl = drawCursorAt ldps (f $ sl ^. slSelPos) (getShownIt
         _ -> fmap (+ 1)
 
 listPicturesAtOff :: Int -> [Picture] -> Picture
-listPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i ..]
+listPicturesAtOff = listPicturesAtScaleOff 10 1
 
 listPicturesAtScaleOff :: Float -> Float -> Int -> [Picture] -> Picture
 listPicturesAtScaleOff ygap s i =
     mconcat
-        . zipWith (listTextPictureAtScale ygap s) [i ..]
+        . zipWith (drawListElement ygap s) [i ..]
 
 stackPicturesAt :: [Picture] -> Picture
 stackPicturesAt = stackPicturesAtOff 0
 
 stackPicturesAtOff :: Int -> [Picture] -> Picture
-stackPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i, i -1 ..]
+stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1) [i, i -1 ..]
 
 selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
 selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do
@@ -120,7 +131,7 @@ listCursorChooseBorderScale ::
 listCursorChooseBorderScale ygap s borders xoff yoff yint xint col cursxsize cursysize =
     translate
         (xoff + (10 * s * (fromIntegral xint -1)))
-        ( - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
+        (- (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
         . color col
         $ chooseCursorBorders (s * wth) (s * hgt) borders
   where
@@ -165,18 +176,18 @@ listCursorNSW = listCursorChooseBorder [North, South, West]
 --    thescale = hw * 0.02 / fromIntegral (length str)
 --    hw = halfWidth cfig
 
-listTextPictureAtScale :: Float -> Float -> Int -> Picture -> Picture
+drawListElement :: Float -> Float -> Int -> Picture -> Picture
-listTextPictureAtScale ygap s yint =
+drawListElement ygap s yint =
     translate 0 (negate ((s * 10 + ygap) * (fromIntegral yint + 1)))
         . scale (s * 0.1) (s * 0.1)
 
 renderListAt :: Float -> Float -> [(String, Color)] -> Picture
-renderListAt tx ty = translate tx (-ty) . listPicturesAt . map (\(str, col) -> color col $ text str)
+renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color col $ text str)
 
 -- given a list of pictures that are each the size of a "text" call, displays them as
 -- a list on the screen
-listPicturesAt :: [Picture] -> Picture
+drawList :: [Picture] -> Picture
-listPicturesAt = listPicturesAtScaleOff 10 1 0
+drawList = listPicturesAtScaleOff 10 1 0
 
 --TODO put the following functions in an appropriate place
 
@@ -186,7 +197,7 @@ dShadCol :: Color -> Picture -> Picture
 dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p
 
 toTopLeft :: Configuration -> Picture -> Picture
-toTopLeft cfig = translate (-hw) (hh)
+toTopLeft cfig = translate (- hw) (hh)
   where
     hw = halfWidth cfig
     hh = halfHeight cfig

src/Dodge/Render/MenuScreen.hs

@@ -3,10 +3,10 @@ module Dodge.Render.MenuScreen (
     drawMenuScreen,
 ) where
 
-import Dodge.Data.SelectionList
-import Dodge.Render.List
 import Dodge.Base.Window
+import Dodge.Data.SelectionList
 import Dodge.Data.Universe
+import Dodge.Render.List
 import Picture
 
 drawMenuScreen :: Configuration -> ScreenLayer -> Picture
@@ -38,17 +38,15 @@ drawOptions ::
     SelectionList a ->
     Picture
 drawOptions ldps cfig title sl =
-    pictures 
+    darkenBackground cfig
-        [ darkenBackground cfig
+        <> drawTitle cfig title
-        , drawTitle cfig title
+        <> drawSelectionList ldps cfig sl
-        , drawSelectionList ldps cfig sl
-        ]
 
 darkenBackground :: Configuration -> Picture
 darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
 
 drawTitle :: Configuration -> String -> Picture
-drawTitle cfig =  translate (30 - hw) (hh-50) . scale 0.4 0.4 . text
+drawTitle cfig = translate (- hw) (hh -80) . scale 0.4 0.4 . text
   where
     hh = halfHeight cfig
     hw = halfWidth cfig

src/Dodge/Render/Picture.hs

@@ -19,7 +19,7 @@ fixedCoordPictures u =
     drawMenuOrHUD cfig u
         <> drawConcurrentMessage u
         <> customMouseCursor u
-        <> toTopLeft cfig (translate (halfWidth cfig) 0 $ listPicturesAt (map text (_uvTestString u u)))
+        <> toTopLeft cfig (translate (halfWidth cfig) 0 $ drawList (map text (_uvTestString u u)))
         <> displayFrameTicks u
   where
     cfig = _uvConfig u

src/Dodge/Render/ShapePicture.hs

@@ -143,7 +143,7 @@ extraPics cfig u =
         <> foldMap (`_debugPic` u) (_uvDebug u)
         <> setLayer FixedCoordLayer
             (toTopLeft cfig . translate (1.3* halfWidth cfig) 0 
-                . listPicturesAt 
+                . drawList 
                 . take 50 . drop (u ^. uvDebugMessageOffset)
                 . map text $ foldMap (`_debugMessage` u) (_uvDebug u))
   where

src/Dodge/SelectionSections/Draw.hs

@@ -4,7 +4,6 @@ import Picture.Base
 import Dodge.Data.CardinalPoint
 import Control.Lens
 import Data.Maybe
-import Picture.Data
 import Dodge.Data.Config
 import Dodge.Render.List
 import Dodge.Data.SelectionList