Improve cursor rendering
This commit is contained in:
+10
-7
@@ -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 "----"
|
||||
|
||||
Reference in New Issue
Block a user