74 lines
2.2 KiB
Haskell
74 lines
2.2 KiB
Haskell
module Dodge.Render.HUD.Carte (
|
|
-- drawCarte,
|
|
) where
|
|
|
|
----import Control.Lens
|
|
--import Dodge.Base
|
|
--import Dodge.Data.Config
|
|
--import Dodge.Data.World
|
|
--import Dodge.Render.List
|
|
--import Geometry
|
|
--import qualified IntMapHelp as IM
|
|
--import Picture
|
|
--
|
|
----drawCarte :: Config -> World -> Picture
|
|
----drawCarte cfig w =
|
|
---- fold $
|
|
---- toTopLeft cfig (renderListAt 0 0 locs) :
|
|
---- mapOverlay w
|
|
---- ++ [mainListCursor white iPos cfig]
|
|
---- where
|
|
---- iPos = w ^. cWorld . lWorld . selLocation
|
|
---- locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
|
|
--
|
|
----mapOverlay :: World -> [Picture]
|
|
----mapOverlay w =
|
|
---- (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
|
|
---- [foldMap (drawMapWall (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
|
|
---- where
|
|
---- lw = w ^. cWorld . lWorld
|
|
--
|
|
----(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
|
|
--
|
|
--drawMapWall :: HUD -> Wall -> Picture
|
|
--drawMapWall thehud wl = color c . polygon $ map (cartePosToScreen thehud) [x, x +.+ n2, y +.+ n2, y]
|
|
-- where
|
|
-- t = normalizeV (y -.- x)
|
|
-- n2 = 20 *.* vNormal t
|
|
-- (x, y) = _wlLine wl
|
|
-- c = _wlColor wl
|
|
--
|
|
----mapWall :: Config -> HUD -> Wall -> Maybe Picture
|
|
----mapWall cfig thehud wl
|
|
---- | _wlSeen wl = Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
|
|
---- | otherwise = Nothing
|
|
---- where
|
|
---- t = normalizeV (y -.- x)
|
|
---- n2 = 20 *.* vNormal t
|
|
---- (x, y) = _wlLine wl
|
|
---- c = _wlColor wl
|
|
--
|
|
--mainListCursor :: Color -> Int -> Config -> Picture
|
|
--mainListCursor c = openCursorAt 120 c 5 0
|
|
--
|
|
--openCursorAt ::
|
|
-- -- | Width
|
|
-- Float ->
|
|
-- Color ->
|
|
-- -- | x offset
|
|
-- Float ->
|
|
-- -- | y offset
|
|
-- Float ->
|
|
-- -- | y offset (discrete)
|
|
-- Int ->
|
|
-- Config ->
|
|
-- Picture
|
|
--openCursorAt wth col xoff yoff yint w =
|
|
-- translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20) $
|
|
-- lineCol
|
|
-- [ (V2 wth 12.5, withAlpha 0 col)
|
|
-- , (V2 0 12.5, col)
|
|
-- , (V2 0 (-7.5), col)
|
|
-- , (V2 wth (-7.5), withAlpha 0 col)
|
|
-- ]
|