Add basic map

This commit is contained in:
jgk
2021-03-25 15:34:12 +01:00
parent d0986d0922
commit d1a4dad3c0
+26 -13
View File
@@ -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)