loop/src/Dodge/Render/MenuScreen.hs

{- 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
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
    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

--displayStringList :: World -> [String] -> Picture
--displayStringList w ss = pictures
--    ( polygon (screenBox w)
--    : zipWith f ys ss
--    )
--  where
--    hw = halfWidth  w
--    ys = [0,22..]
--    f y s = translate (10-hw) y . scale 0.15 0.15 $ text s

drawTwoColumnsScreen :: Configuration -> String -> [(String, String)] -> Picture
drawTwoColumnsScreen cfig title lps =
    pictures
        [ darkenBackground cfig
        , drawTitle cfig title
        , drawTwoColumns cfig lps
        ]

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

drawOptions ::
    Universe ->
    -- | Title
    String ->
    -- | Options
    [MenuOption] ->
    -- | Options offset
    Int ->
    -- | Select position
    Maybe Int ->
    -- | Help Text
    String ->
    Picture
drawOptions u title ops off mselpos 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 visibleops)
        _ -> visibleops
    ops'' = case availableMenuLines cfig of
        x | x < length ops -> map (menuOptionToString u maxOptionLength) ops' ++ [(white, "SPACE: MORE OPTIONS")]
        _ -> map (menuOptionToString u maxOptionLength) ops'
    visibleops = filter notInvisible ops
    notInvisible InvisibleToggle{} = False
    notInvisible _ = True
    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
    }

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
    _ -> 0

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
  where
    hh = halfHeight cfig
    hw = halfWidth cfig

placeString ::
    -- | x distance from center
    Float ->
    -- | y distance from center
    Float ->
    -- | scale
    Float ->
    String ->
    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
    hh = halfHeight cfig
    hw = halfWidth cfig

menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String)
menuOptionToString w padAmount mo = (thecol, theKeys ++ optionText)
  where
    thecol = case _moString mo w of
        MODBlockedString{} -> greyN 0.5
        _ -> white
    optionText = case _moString mo w of
        MODStringOption s t -> rightPad padAmount '.' s ++ t
        x -> _modString x
    theKeys = case mo of
        Toggle{_moKey = k} -> stc k : ":"
        Toggle2{_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
        _ -> undefined
    stc = scodeToChar