Add basic map
This commit is contained in:
+26
-13
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user