Reorganise rendering in Dodge

2021-04-01 11:28:53 +02:00
parent e62ff391a5
commit 1e9a07d1c8
13 changed files with 217 additions and 113 deletions
@@ -0,0 +1,58 @@
+module Dodge.Render.MenuScreen
+    ( menuScreen
+    )
+    where
+import Dodge.Data
+import Dodge.Base (halfWidth,halfHeight)
+
+import Picture
+
+menuScreen :: World -> Picture
+menuScreen w = case _menuState w of
+                        InGame -> blank 
+                        LevelMenu x -> 
+                            pictures [--color (withAlpha 0.5 black) $ polygon $ screenBox w
+                            tst (-100) 100 0.4 ("LEVEL "++show x)
+                            ,controlsList
+                            ]
+                        PauseMenu   -> pictures 
+                                    [--color (withAlpha 0.5 black) $ polygon $ screenBox w
+                                    tst (-100) 100 0.4 "PAUSED"
+                                    ,tst (-100) 50 0.2 "n - new level"
+                                    ,tst (-100) 0 0.2 "r - restart"
+                                    , controlsList
+                                    ]
+                        GameOverMenu -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
+                                    ,tst (-100) 100 0.4 "GAME OVER"
+                                    ,tst (-100) 50 0.2 "n - new level"
+                                    ,tst (-100) 0 0.2 "r - restart"
+                                    ,controlsList
+                                    ]
+                where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
+
+controlsList = pictures [tst (-250) (-130) 0.15 "controls:"
+               ,tst (-150) (-130) 0.15 "wasd"
+               ,tst  0   (-130) 0.15 "movement"
+               ,tst (-150) (-160) 0.15 "[rmb]"
+               ,tst  0     (-160) 0.15 "aim"
+               ,tst (-150) (-190) 0.15 "[rmb+lmb]"
+               ,tst  0     (-190) 0.15 "shoot or use item"
+               ,tst (-150) (-220) 0.15 "[wheelscroll]"
+               ,tst  0     (-220) 0.15 "select item"
+               ,tst (-150) (-250) 0.15 "[space]"
+               ,tst 0      (-250) 0.15 "pickup item"
+               ,tst (-150) (-280) 0.15 "f"
+               ,tst 0      (-280) 0.15 "drop item"
+               ,tst (-150) (-310) 0.15 "cp[esc]"
+               ,tst 0      (-310) 0.15 "pause"
+               ,tst (-150) (-340) 0.15 "qe[lmb]"
+               ,tst 0      (-340) 0.15 "rotate camera"
+               ]
+                where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
+
+screenBox w = [  (halfWidth w, halfHeight w)
+              , (-halfWidth w, halfHeight w)
+              , (-halfWidth w,-halfHeight w)
+              , ( halfWidth w,-halfHeight w)
+              ]
+