Cleanup creature picture

src/Dodge/Render/MenuScreen.hs

@@ -5,56 +5,41 @@ module Dodge.Render.MenuScreen
     ( menuScreen
     )
     where
-import Dodge.Data.Menu
 import Dodge.Data
 --import Dodge.Config.Update
 --import Dodge.Config.Data
 import Dodge.Base.Window
 import Picture
-import Geometry
 import Dodge.Menu
---import Geometry.Data
 
 menuScreen 
     :: World
-    -> [MenuLayer]
+    -> ScreenLayer
     -> Picture
-menuScreen w mLays = case mLays of
-    (LevelMenu x:_)     -> optionsFromList w ("LEVEL"++show x) levelMenuOptions
-    (PauseMenu : _)     -> optionsFromList w "PAUSED" pauseMenuOptions
-    (GameOverMenu : _)  -> optionsFromList w "GAME OVER" pauseMenuOptions
-    (OptionMenu : _)    -> optionsFromList w "OPTIONS" optionsOptions
-    (SoundOptionMenu : _) -> optionsFromList w "OPTIONS:VOLUME" soundMenuOptions
-    (GraphicsOptionMenu : _) -> optionsFromList w "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
-    hh = halfHeight w
-    hw = halfWidth  w
+menuScreen w screen = case screen of
+    OptionScreen {_scTitle = titf, _scOptions = mos} 
+                            -> drawOptions w (titf w) mos
+    (WaitScreen sf _)       -> drawOptions w (sf w) []
+    (InputScreen s)         -> drawOptions w ('>':s) []
+    (TerminalScreen t xs )  -> displayStringList w $ map snd $ filter (( > t) . fst) xs
+    (DisplayScreen sd )     -> sd w
 
-displayStringList :: Float -> Float -> [String] -> Picture
-displayStringList hw hh ss = pictures
-    ( polygon (rectNSEW hh (-hh) hw (-hw))
+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
     
-optionsFromList
+drawOptions
     :: World
-    -> String   -- ^ Title
+    -> String       -- ^ Title
     -> [MenuOption] -- ^ Options
     -> Picture
-optionsFromList w title ops = pictures $
+drawOptions w title ops = pictures $
     [darkenBackground
     ,theTitle]
     ++
@@ -64,59 +49,17 @@ optionsFromList w title ops = pictures $
     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
+    darkenBackground = color (withAlpha 0.5 black) $ polygon $ screenBox w
     theTitle = placeString (-hw + 30) (hh - 50) 0.4 title
     hh = halfHeight w
     hw = halfWidth w
+
 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 ..]
+menuOptionToString w mo = theKeys ++ _moString mo w
   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)
-    ]
-
+    theKeys :: String
+    theKeys = case mo of
+        Toggle  {_moKey = k} -> stc k : ":"
+        Toggle2 {_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
+        _ -> undefined
+    stc = scodeToChar