From d1a4dad3c0d4d62038ebe9c66bf39a5c521f970f Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Thu, 25 Mar 2021 15:34:12 +0100
Subject: [PATCH] Add basic map

---
 src/Dodge/Rendering.hs | 39 ++++++++++++++++++++++++++-------------
 1 file changed, 26 insertions(+), 13 deletions(-)

diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs
index a66494835..5659d0241 100644
--- a/src/Dodge/Rendering.hs
+++ b/src/Dodge/Rendering.hs
@@ -25,15 +25,6 @@ import qualified Data.IntMap.Strict as IM
 import qualified Data.Map as M
 import qualified Data.Set as S
 
--- }}}
-fixedCoordPictures :: World -> Picture
-fixedCoordPictures w = pictures
-             [ scaler $ hudDrawings w
-             , scaler . onLayer MenuLayer $ menuScreen w
-             , setDepth (-1) $ closeObjectTexts w
-             ]
-    where scaler = setDepth (-1) . scale (2 / _windowX w) (2 / _windowY w)
-
 worldPictures :: World -> Picture
 worldPictures w
     = pictures $ concat [ IM.elems $ _decorations w 
@@ -44,15 +35,37 @@ worldPictures w
                         , map btDraw (IM.elems (_buttons w))
                         , map (\pt -> _ptDraw pt pt) $ _particles' w
                         , map drawWallFloor (wallFloorsToDraw w)
---                        , map (drawWallFace w) (wallShadowsToDraw w)
                         , testPic w
+                        , mapOverlay w
                         ]
 
+fixedCoordPictures :: World -> Picture
+fixedCoordPictures w = pictures
+             [ hudIfNoMap
+             , scaler . onLayer MenuLayer $ menuScreen w
+             , setDepth (-1) $ closeObjectTexts w
+             ]
+    where scaler = setDepth (-1) . scale (2 / _windowX w) (2 / _windowY w)
+          hudIfNoMap = case _mapDisplay w of
+            (True,_)    -> blank
+            _           -> scaler $ hudDrawings w
+
+
+mapOverlay :: World -> [Picture]
+mapOverlay w = case _mapDisplay w of
+    (True,mapZoom) -> map ( setLayer 1 . setDepth (-1) . doZoom) 
+                        . mapMaybe mapWall 
+                        . IM.elems 
+                        $ _walls w
+      where
+        doZoom = uncurry translate (_cameraPos w) 
+                    . scale zoom zoom 
+                    . uncurry translate ((0,0) -.- _cameraPos w)
+        zoom = 2 * mapZoom / _cameraZoom w
+    _           -> []
+
 testPic :: World -> [Picture]
 testPic w = [blank]
-    -- [setLayer 1 $ onLayerL [99] $ bezierQuad white red 5 5 (00,00) (300,305) (50,000) ]
-    -- $ uncurry translate (mouseWorldPos w) 
-
 
 crDraw :: Creature -> Picture
 crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c)