Work on menus

src/Dodge/Render/MenuScreen.hs

@@ -4,33 +4,32 @@ module Dodge.Render.MenuScreen (
     menuScreen',
 ) where
 
-import Dodge.Menu.Option
-import Dodge.Render.List
+--import LensHelp
+import Dodge.Base.WinScale
 import Dodge.Data.SelectionList
+--import Dodge.Menu.Option
+import Dodge.Render.List
 import qualified Data.Text as T
 import Dodge.Base.Window
 import Dodge.Data.Universe
-import Dodge.WindowLayout
 import Padding
 import Picture
 
-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"
+menuScreen' :: Configuration -> ScreenLayer -> Picture
+menuScreen' cfig screen = case screen of
+    OptionScreen{_scTitle = titf, _scSelectionList = selpos} ->
+        drawOptions cfig titf 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
+    (InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help
     --    (DisplayScreen sd) -> sd w
-    (ColumnsScreen titf pairs) -> drawTwoColumnsScreen (_uvConfig w) (titf w) pairs
+    (ColumnsScreen titf pairs) -> drawTwoColumnsScreen cfig titf pairs
 
-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 :: Configuration -> ScreenLayer -> Picture
+menuScreen cfig screen = case screen of
+    OptionScreen{_scTitle = titf, _scSelectionList = selpos} ->
+        drawOptions cfig titf selpos "Use keys to navigate the menu"
+    (InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help
+    (ColumnsScreen titf pairs) -> drawTwoColumnsScreen cfig titf pairs
 
 --displayStringList :: World -> [String] -> Picture
 --displayStringList w ss = pictures
@@ -51,81 +50,65 @@ drawTwoColumnsScreen cfig title lps =
         ]
 
 drawTwoColumns :: Configuration -> [(String, String)] -> Picture
-drawTwoColumns cfig lps = pictures $ zipWith f [hh -100, hh -130 ..] lps
+drawTwoColumns cfig lps = listPicturesAtScaleOff 30 2 50 50 cfig 0 $ map f lps
   where
-    f y (s1, s2) = placeString (50 - hw) y 0.15 $ rightPad ln '.' s1 ++ s2
-    hh = halfHeight cfig
-    hw = halfWidth cfig
+    f (s1, s2) = color white $ text $ rightPad ln '.' s1 ++ s2
     ln = maximum (map (length . fst) lps) + 3
 
-drawOptions ::
-    Universe ->
+--drawTwoColumns' :: Configuration -> [(String, String)] -> Picture
+--drawTwoColumns' cfig lps = pictures $ zipWith f [hh -100, hh -130 ..] lps
+--  where
+--    f y (s1, s2) = placeString (50 - hw) y 0.15 $ rightPad ln '.' s1 ++ s2
+--    hh = halfHeight cfig
+--    hw = halfWidth cfig
+--    ln = maximum (map (length . fst) lps) + 3
+
+drawInputMenu :: 
+    Configuration ->
     -- | Title
     String ->
-    -- | Options
-    [MenuOption] ->
-    -- | Options offset
-    Int ->
-    -- | Select position
-    Maybe Int ->
     -- | Help Text
     String ->
     Picture
-drawOptions u title ops off mselpos footer =
-    pictures $
+drawInputMenu cfig title footer =
+    pictures 
         [ --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 ..]
-  where
-    --    ++ [color yellow $ concat [line [V2 (negate hw) (hh-y), V2 hw (hh-y)] |
-    --            y <- map (+75) [0,50..hh*2]]
-    --        ]
-
-    maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops')
-    ops' = case availableMenuLines cfig of
-        x | x < length ops -> take (availableMenuLines cfig) (drop off ops)
-        _ -> ops
-    ops'' = case availableMenuLines cfig of
-        x | x < length ops -> zipWith (menuOptionToString u maxOptionLength) ['A'..] ops' ++ [(white, "SPACE: MORE OPTIONS")]
-        _ -> zipWith (menuOptionToString u maxOptionLength) ['A'..] ops'
-    hh = halfHeight cfig
-    hw = halfWidth cfig
-    cfig = _uvConfig u
-
-defaultSelectionItem :: SelectionItem
-defaultSelectionItem =  SelectionItem
-    { _siPictures = [color white $ text "HELLOW"]
-    , _siHeight = 1
-    , _siIsSelectable = True
-    , _siColor = white
-    , _siOffX = 0
-    }
-
-colStrToSelItem :: (Color,String) -> SelectionItem
-colStrToSelItem (col,str) = SelectionItem
-    { _siPictures = [color col $ text str]
-    , _siHeight = 1
-    , _siIsSelectable = True
-    , _siColor = col
-    , _siOffX = 0
-    }
 
+drawOptions ::
+    Configuration ->
+    -- | Title
+    String ->
+    -- | Select position
+    SelectionList ->
+    -- | Help Text
+    String ->
+    Picture
+drawOptions cfig title sl footer =
+    pictures 
+        [ --darkenBackground cfig
+         drawTitle cfig title
+        , drawFooterText cfig red footer
+        , drawSelectionList cfig sl
+        ]
 
 darkenBackground :: Configuration -> Picture
 darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
 
 drawTitle :: Configuration -> String -> Picture
-drawTitle cfig = placeString (- hw + 30) (hh - 50) 0.4
+drawTitle cfig = winScale cfig . translate (30 - hw) (hh-50) . scale 0.4 0.4 . text
   where
     hh = halfHeight cfig
     hw = halfWidth cfig
 
+--drawTitle' :: Configuration -> String -> Picture
+--drawTitle' cfig = placeString (- hw + 30) (hh - 50) 0.4
+--  where
+--    hh = halfHeight cfig
+--    hw = halfWidth cfig
+
 placeString ::
     -- | x distance from center
     Float ->
@@ -137,17 +120,6 @@ placeString ::
     Picture
 placeString x y sc = color white . translate x y . scale sc sc . text
 
-placeColorString ::
-    -- | x distance from center
-    Float ->
-    -- | y distance from center
-    Float ->
-    -- | scale
-    Float ->
-    (Color, String) ->
-    Picture
-placeColorString x y sc (col, str) = color col . translate x y . scale sc sc . text $ str
-
 drawFooterText :: Configuration -> Color -> String -> Picture
 drawFooterText cfig col = color col . placeString (- hw + 30) (- hh + 10) 0.1
   where