Improve cursor rendering

This commit is contained in:
2021-03-08 00:25:57 +01:00
parent c9ae76594b
commit 79b6a4fc32
4 changed files with 23 additions and 53 deletions
+10 -7
View File
@@ -207,8 +207,7 @@ hudDrawings w = setLayer 1 $ (onLayer InvLayer)
[ displayInv 0 w
, dShadCol white $ displayHP 0 w
, --color (itCol (yourItem w))
color white
$ drawCursor w
drawCursor (itCol (yourItem w)) w
, translate (-390) 20
$ scale 0.05 0.05 $ dShadCol white $ text (_testString w)
]
@@ -224,12 +223,16 @@ btDraw c = uncurry translate (_btPos c) $ rotate (_btRot c) (_btPict c)
clDraw :: Cloud -> Drawing
clDraw c = uncurry translate (_clPos c) $ (_clPict c c)
drawCursor :: World -> Picture
drawCursor w = setLayer 1
drawCursor :: Color -> World -> Picture
drawCursor c w = setLayer 1
$ translate (105-halfWidth w)
(halfHeight w - (25* (fromIntegral iPos)) - 20
(halfHeight w - (20* (fromIntegral iPos)) - 20
)
$ line [(100,12.5),(-100,12.5),(-100,-12.5),(100,-12.5)]
$ lineCol [(( 100,12.5) ,withAlpha 0 c)
,((-100,12.5) ,c)
,((-100,-7.5) ,c)
,(( 100,-7.5) ,withAlpha 0 c)
]
where iPos = _crInvSel $ _creatures w IM.! _yourID w
@@ -433,7 +436,7 @@ linePointsBetween p p' | d > 99 = map (\m -> p +.+ fromIntegral m *.* p'') [0..n
displayInv :: Int -> World -> Picture
displayInv n w = pictures $ zipWith (translate (15-halfWidth w))
(map (\x-> halfHeight w-(25*(fromIntegral x+1))) ns) $ map dItem' is
(map (\x-> halfHeight w-(20*(fromIntegral x+1))) ns) $ map dItem' is
where (ns,is) = unzip $ IM.toList $ _crInv $ _creatures w IM.! n
dItem' NoItem = scale 0.1 0.1 $ dShadCol (greyN 0.5) $ text "----"