Add file

src/Dodge/Render/HUD/Carte.hs

@@ -0,0 +1,73 @@
+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 :: Configuration -> World -> Picture
+drawCarte cfig w =
+    pictures $
+        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 :: Configuration -> 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 -> Configuration -> Picture
+mainListCursor c = openCursorAt 120 c 5 0
+
+openCursorAt ::
+    -- | Width
+    Float ->
+    Color ->
+    -- | x offset
+    Float ->
+    -- | y offset
+    Float ->
+    -- | y offset (discrete)
+    Int ->
+    Configuration ->
+    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)
+            ]