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.Map as M
|
||||||
import qualified Data.Set as S
|
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 :: World -> Picture
|
||||||
worldPictures w
|
worldPictures w
|
||||||
= pictures $ concat [ IM.elems $ _decorations w
|
= pictures $ concat [ IM.elems $ _decorations w
|
||||||
@@ -44,15 +35,37 @@ worldPictures w
|
|||||||
, map btDraw (IM.elems (_buttons w))
|
, map btDraw (IM.elems (_buttons w))
|
||||||
, map (\pt -> _ptDraw pt pt) $ _particles' w
|
, map (\pt -> _ptDraw pt pt) $ _particles' w
|
||||||
, map drawWallFloor (wallFloorsToDraw w)
|
, map drawWallFloor (wallFloorsToDraw w)
|
||||||
-- , map (drawWallFace w) (wallShadowsToDraw w)
|
|
||||||
, testPic 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 :: World -> [Picture]
|
||||||
testPic w = [blank]
|
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 :: Creature -> Picture
|
||||||
crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c)
|
crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c)
|
||||||
|
|||||||
Reference in New Issue
Block a user