{-
The menu picture.
 -}
module Dodge.Render.MenuScreen
    ( menuScreen
    )
    where
import Dodge.Data.Menu
import Dodge.Data
--import Dodge.Config.Update
import Dodge.Config.Data
--import Dodge.Base (halfWidth,halfHeight)
import Picture
import Geometry
import Dodge.Menu
--import Geometry.Data

menuScreen 
    :: World
    -> Configuration 
    -> Float    -- Half width of screen
    -> Float    -- Half height of screen
    -> [MenuLayer]
    -> Picture
menuScreen w cfig hw hh mLays = case mLays of
    (LevelMenu x:_) -> optionsFromList w hw hh ("LEVEL"++show x) levelMenuOptions
    (PauseMenu : _) -> optionsFromList w hw hh "PAUSED" pauseMenuOptions
    (GameOverMenu : _) -> optionsFromList w hw hh "GAME OVER" pauseMenuOptions
    (OptionMenu : _) -> optionsFromList w hw hh "OPTIONS" optionsOptions
    (SoundOptionMenu : _) -> optionsFromList w hw hh "OPTIONS:VOLUME" soundMenuOptions
    (GraphicsOptionMenu : _) -> optionsFromList w hw hh "OPTIONS:GRAPHICS" graphicsMenuOptions
    (ControlList : _) -> pictures 
        [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
        ,tst (-100) 100 0.4 "CONTROLS"
        ,controlsList
        ]
    (WaitMessage s _ : _) -> optionsList hw hh s []
    (Terminal s : _)    -> optionsList hw hh "SCANCODE INPUT" ['>':s ++ "_"]
    (TerminalMessage t xs : _) -> displayStringList hw hh $ map snd $ filter (( > t) . fst) xs
    _ -> blank
  where 
    tst x y sc t = translate x y $ scale sc sc $ color white $ text t

displayStringList :: Float -> Float -> [String] -> Picture
displayStringList hw hh ss = pictures
    ( polygon (rectNSEW hh (-hh) hw (-hw))
    : zipWith f ys ss
    )
  where
    ys = [0,22..]
    f y s = translate (10-hw) y . scale 0.15 0.15 $ text s
    
optionsFromList
    :: World
    -> Float    -- ^ Half screen width
    -> Float    -- ^ Half screen height
    -> String   -- ^ Title
    -> [MenuOption] -- ^ Options
    -> Picture
optionsFromList w hw hh tit ops = pictures $
    [darkenBackground
    ,theTitle]
    ++
    zipWith (\ s vpos -> placeString (-hw + 50) vpos 0.2 s) (map (menuOptionToString w) ops') [hh-100,hh-150 ..]
  where
    ops' = filter notInvisible ops
    notInvisible InvisibleToggle {} = False
    notInvisible _ = True
    placeString x y sc t = translate x y $ scale sc sc $ color white $ text t
    darkenBackground = color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
    theTitle = placeString (-hw + 30) (hh - 50) 0.4 tit
menuOptionToString :: World -> MenuOption -> String
menuOptionToString w mo@(Toggle{})
    = (scodeToChar $ _moKey mo) : ':' : _moString mo w
menuOptionToString w mo@(Toggle2{})
    = (scodeToChar $ _moKey1 mo) : '/' : (scodeToChar $ _moKey2 mo) : ':' : _moString mo w
menuOptionToString _ _ = "undefined option string"


optionsList
    :: Float    -- ^ Half screen width
    -> Float    -- ^ Half screen height
    -> String   -- ^ Title
    -> [String] -- ^ Options
    -> Picture
optionsList hw hh tit ops = pictures $
    [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
    ,placeString (-hw + 30) (hh - 50) 0.4 tit]
    ++
    zipWith (\ s vpos -> placeString (-hw + 50) vpos 0.2 s) ops [hh-100,hh-150 ..]
  where
    placeString x y sc t = translate x y $ scale sc sc $ color white $ text t

controlsList :: Picture
controlsList = pictures $ concat $ zipWith butAndEff
    [("wasd",           "movement")
    ,("[rmb]",          "aim")
    ,("[rmb+lmb]",      "shoot or use item")
    ,("[wheelscroll]" , "select item"  )
    ,("[space]" ,       "pickup item"  )
    ,("m" ,             "display map"    )
    ,("f" ,             "drop item"    )
    ,("c[esc]" ,        "pause"        )
    ,("qe" ,       "rotate camera")
    ]
    [60,30..]
  where
    butAndEff (btext,etext) y = 
        [translate (-250) y $ scale 0.15 0.15 $ color white $ text btext
        ,translate     0  y $ scale 0.15 0.15 $ color white $ text etext
        ]

screenBox 
    :: Float    -- ^ Half screen width
    -> Float    -- ^ Half screen height
    -> [Point2]
screenBox halfW halfH = map toV2
    [  (halfW, halfH)
    , (-halfW, halfH)
    , (-halfW,-halfH)
    , ( halfW,-halfH)
    ]