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

Hlinting

Browse Source
This commit is contained in:
justin
2021-04-27 11:45:43 +02:00
parent f8351fb150
commit 64b5b9e2a5
34 changed files with 974 additions and 761 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+48 -46
View File
@@ -67,7 +67,7 @@ drawLocations w = displayListTopLeft locs w
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
locPoss = map (cartePosToScreen w . ($ w) . fst) . IM.elems . _seenLocations $ w
zoom = _carteZoom w
locTexts = fst . unzip $ locs
locTexts = map fst locs
bFunc (x,y) (z,w) = pictures
[ bezierQuad (withAlpha 0.0 white) (withAlpha 0.2 white) 0.050 0.010 (x,y) (0,y) (z,w)
, bezierQuad (withAlpha 0.0 white) (withAlpha 0.5 white) 0.045 0.005 (x,y) (0,y) (z,w)
@@ -104,63 +104,65 @@ mapWall w wl =
t = normalizeV (y -.- x)
-- n2 = 2 *.* vNormal t
n2 = 20 *.* vNormal t
(x:y:_) = (_wlLine wl)
(x:y:_) = _wlLine wl
c = _wlColor wl
{- Pictures of popup text for items close to your position.-}
closeObjectTexts :: World -> Picture
closeObjectTexts w = pictures $ (zipWith renderList [0..] $ map colAndText $ _closeActiveObjects w)
closeObjectTexts w = pictures $ zipWith renderList [0..] (map colAndText $ _closeActiveObjects w)
++ maybeToList maybeLine
where colAndText (Left x) = (_itInvColor $ _flIt x, _itName $ _flIt x)
colAndText (Right x) = (white, _btText x)
renderList i (c,t) = scale (2/_windowX w) (2/_windowY w)
. tran
. translate (xtran i) (0 - 20 * fromIntegral i)
. scale 0.1 0.1
. color c
$ text t
tran = translate (pushout - halfWidth w) (halfHeight w - 20* (fromIntegral invPos +1))
youSel = _crInvSel $ you w
freeSlot = mayIt >>= \it -> checkInvSlotsYou (_flIt it) w
invPos = fromMaybe youSel freeSlot
mayObj = listToMaybe $ _closeActiveObjects w
mayIt = mayObj >>= maybeLeft
maybeLeft (Left x) = Just x
maybeLeft _ = Nothing
pushout = 140
xtran 0 = case mayIt of Nothing -> 25
_ -> -25
xtran _ = 0
objPos obj = case obj of Left flit -> _flItPos flit
Right bt -> _btPos bt
mayScreenPos = mayObj >>= (\theObj -> Just (worldPosToScreen w $ objPos theObj))
sc (x, y) = (x*2/_windowX w, y*2/_windowY w)
maybeLine = do
itScreenPos <- mayScreenPos
theText <- fmap (snd . colAndText) mayObj
let textWidth = 9 * fromIntegral (length theText)
let col = fromMaybe white $ fmap (_itInvColor . _flIt) mayIt
let p = (textWidth + xtran 0 + pushout - halfWidth w
, halfHeight w - 20* (fromIntegral invPos +1) + 2.5
)
let p' = ( pushout - halfWidth w + 130
, halfHeight w - 20* (fromIntegral invPos +1) + 2.5
)
return $ lineCol
[(itScreenPos, withAlpha 0 col)
,(sc p' , col)
,(sc p , col)
]
where
colAndText (Left x) = (_itInvColor $ _flIt x, _itName $ _flIt x)
colAndText (Right x) = (white, _btText x)
renderList i (c,t) = scale (2/_windowX w) (2/_windowY w)
. tran
. translate (xtran i) (0 - 20 * fromIntegral i)
. scale 0.1 0.1
. color c
$ text t
tran = translate (pushout - halfWidth w) (halfHeight w - 20* (fromIntegral invPos +1))
youSel = _crInvSel $ you w
freeSlot = mayIt >>= \it -> checkInvSlotsYou (_flIt it) w
invPos = fromMaybe youSel freeSlot
mayObj = listToMaybe $ _closeActiveObjects w
mayIt = mayObj >>= maybeLeft
maybeLeft (Left x) = Just x
maybeLeft _ = Nothing
pushout = 140
xtran 0 = case mayIt of Nothing -> 25
_ -> -25
xtran _ = 0
objPos obj = case obj of Left flit -> _flItPos flit
Right bt -> _btPos bt
mayScreenPos = mayObj >>= (\theObj -> Just (worldPosToScreen w $ objPos theObj))
sc (x, y) = (x*2/_windowX w, y*2/_windowY w)
maybeLine = do
itScreenPos <- mayScreenPos
theText <- fmap (snd . colAndText) mayObj
let textWidth = 9 * fromIntegral (length theText)
let col = maybe white (_itInvColor . _flIt) mayIt
let p = (textWidth + xtran 0 + pushout - halfWidth w
, halfHeight w - 20* (fromIntegral invPos +1) + 2.5
)
let p' = ( pushout - halfWidth w + 130
, halfHeight w - 20* (fromIntegral invPos +1) + 2.5
)
return $ lineCol
[(itScreenPos, withAlpha 0 col)
,(sc p' , col)
,(sc p , col)
]
{- Add coloured drop shadow. -}
dShadCol :: Color -> Picture -> Picture
dShadCol c p = pictures $
dShadCol c p = pictures
[ color black $ uncurry translate (1.2,-1.2) p
, color c p
]
drawListCursor :: Color -> Int -> World -> Picture
drawListCursor c iPos w = scale (2 / _windowX w) (2 / _windowY w)
. translate (105-halfWidth w) (halfHeight w - (20* (fromIntegral iPos)) - 20)
. translate (105-halfWidth w) (halfHeight w - (20* fromIntegral iPos) - 20)
$ lineCol [(( 100,12.5) ,withAlpha 0 c)
,((-100,12.5) ,c)
,((-100,-7.5) ,c)