Start unifying drawn cursors

src/Dodge/Render/MenuScreen.hs

@@ -1,8 +1,12 @@
 {- The menu picture.  -}
 module Dodge.Render.MenuScreen (
     menuScreen,
+    menuScreen',
 ) where
 
+import Dodge.Data.CardinalPoint
+import Dodge.Render.List
+import Dodge.Data.SelectionList
 import qualified Data.Text as T
 import Dodge.Base.Window
 import Dodge.Data.Universe
@@ -10,6 +14,16 @@ import Dodge.ScodeToChar
 import Dodge.WindowLayout
 import Padding
 import Picture
+import qualified Data.Set as Set
+
+menuScreen' :: Universe -> ScreenLayer -> Picture
+menuScreen' w screen = case screen of
+    OptionScreen{_scTitle = titf, _scOptions = mos, _scOptionsOffset = off, _scSelPos = selpos} ->
+        drawOptions w (titf w) mos off selpos "Use keys to navigate the menu"
+    --    (WaitScreen sf _) -> drawOptions w (sf w) [] 0 ""
+    (InputScreen inputstr help) -> drawOptions w ('>' : T.unpack inputstr) [] 0 Nothing help
+    --    (DisplayScreen sd) -> sd w
+    (ColumnsScreen titf pairs) -> drawTwoColumnsScreen (_uvConfig w) (titf w) pairs
 
 menuScreen :: Universe -> ScreenLayer -> Picture
 menuScreen w screen = case screen of
@@ -64,11 +78,12 @@ drawOptions u title ops off mselpos footer =
         [ darkenBackground cfig
         , drawTitle cfig title
         , drawFooterText cfig red footer
+        , drawSelectionList cfig (makeOptionsSelectionList mselpos u ops)
         ]
-            ++ zipWith
-                (\s vpos -> placeColorString (- hw + 50) vpos 0.2 s)
-                ops''
-                [hh -100, hh -150 ..]
+--            ++ zipWith
+--                (\s vpos -> placeColorString (- hw + 50) vpos 0.2 s)
+--                ops''
+--                [hh -100, hh -150 ..]
   where
     --    ++ [color yellow $ concat [line [V2 (negate hw) (hh-y), V2 hw (hh-y)] |
     --            y <- map (+75) [0,50..hh*2]]
@@ -88,6 +103,45 @@ drawOptions u title ops off mselpos footer =
     hw = halfWidth cfig
     cfig = _uvConfig u
 
+defaultSelectionItem :: SelectionItem
+defaultSelectionItem =  SelectionItem
+    { _siPictures = [color white $ text "HELLOW"]
+    , _siHeight = 1
+    , _siIsSelectable = True
+    , _siColor = white
+    , _siOffX = 0
+    }
+
+makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> SelectionList
+makeOptionsSelectionList mselpos u mos = SelectionList
+    { _slPosX = 50
+    , _slPosY = 50
+    , _slOffset = 0
+    , _slScale = 2
+    , _slVerticalGap = 30
+    , _slItems = optionsToSelections u mos
+    , _slSelPos = mselpos
+    , _slCursorType = BorderCursor (Set.fromList [North,South,West])
+    , _slWidth = FixedSelectionWidth 15
+    }
+colStrToSelItem :: (Color,String) -> SelectionItem
+colStrToSelItem (col,str) = SelectionItem
+    { _siPictures = [color col $ text str]
+    , _siHeight = 1
+    , _siIsSelectable = True
+    , _siColor = col
+    , _siOffX = 0
+    }
+
+optionsToSelections :: Universe -> [MenuOption] -> [SelectionItem]
+optionsToSelections u ops = map colStrToSelItem colstrs
+  where
+    maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) visibleops)
+    colstrs = map (menuOptionToString u maxOptionLength) visibleops
+    visibleops = filter notInvisible ops
+    notInvisible InvisibleToggle{} = False
+    notInvisible _ = True
+
 optionValueOffset :: Universe -> MenuOption -> Int
 optionValueOffset u mo = case _moString mo u of
     MODStringOption s _ -> length s