justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Tweak display, scrolling of item values

Browse Source
This commit is contained in:
justin
2025-01-07 21:10:29 +00:00
parent b3cf10bd26
commit 5fa5bdf21e
18 changed files with 367 additions and 384 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD/Carte.hs
+65 -65
View File
@@ -1,73 +1,73 @@
module Dodge.Render.HUD.Carte (
drawCarte,
-- 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 =
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 :: 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
----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 =
---- 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
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)
]
--
----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)
-- ]