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

Further strictifying

Browse Source
This commit is contained in:
justin
2021-07-30 00:23:02 +02:00
parent bd8ef3f416
commit 2d8b27746c
33 changed files with 228 additions and 211 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+28 -30
View File
@@ -51,12 +51,12 @@ drawInventory w = case _inventoryMode w of
cursorsZ :: World -> Int -> Item -> Picture
cursorsZ w ipos it = case it ^? wpAmmo . amParamSel of
Nothing -> winScale w $ zDraw sp (155- hw, hh - 77.5)
Just jpos -> winScale w $ zDraw sp (155 - hw, hh - (20 * fromIntegral jpos + 77.5))
Nothing -> winScale w $ zDraw sp (V2 (155- hw) ( hh - 77.5))
Just jpos -> winScale w $ zDraw sp (V2 (155 - hw) ( hh - (20 * fromIntegral jpos + 77.5)))
where
hh = halfHeight w
hw = halfWidth w
sp = (125 - hw, hh - (20 * fromIntegral ipos + 17.5))
sp = (V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5)))
topInvCursor :: Color -> Int -> World -> [Picture]
topInvCursor col iPos w
@@ -84,7 +84,7 @@ mCurs it w = case it ^? wpAmmo . amParamSel of
y = 155
zDraw :: Point2 -> Point2 -> Picture
zDraw (x,y) (a,b) = line
zDraw (V2 x y) (V2 a b) = line $ map toV2
[(x,y)
,(0.5 * (x+a), y)
,(0.5 * (x+a), b)
@@ -97,7 +97,7 @@ pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj
displayMidList :: World -> [String] -> String -> [Picture]
displayMidList w strs s =
invHead w s
++ renderListAt (150,-60) (map (,white) strs) w
++ renderListAt (V2 (150) (-60)) (map (,white) strs) w
invHead :: World -> String -> [Picture]
invHead w s = [winScale w . translate (-130) (halfHeight w - 40)
@@ -105,10 +105,10 @@ invHead w s = [winScale w . translate (-130) (halfHeight w - 40)
]
displayListTopLeft :: [(String,Color)] -> World -> [Picture]
displayListTopLeft = renderListAt (0,0)
displayListTopLeft = renderListAt (V2 0 0)
renderListAt :: Point2 -> [(String,Color)] -> World -> [Picture]
renderListAt (tx,ty) scols w =
renderListAt (V2 tx ty) scols w =
map (winScale w) $ zipWith
(translate (tx + 15-halfWidth w))
( map (\x -> ty + halfHeight w - (20 * (fromIntegral x+1))) ([0..]::[Int]) )
@@ -133,29 +133,29 @@ drawLocations wrld = displayListTopLeft locs wrld
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ wrld
locPoss = map (cartePosToScreen wrld . ($ wrld) . fst) . IM.elems . _seenLocations $ wrld
locTexts = map fst locs
bFunc (x,y) (z,w) = pictures
bFunc (V2 x y) (V2 z w) = pictures
[ bline 0.2 0.050 0.010
, bline 0.5 0.045 0.005
, bline 0.5 0.035 0.002
] --cheapo antialiasing
where
bline alph lwidth rwidth
= bezierQuad (withAlpha 0.0 white) (withAlpha alph white) lwidth rwidth (x,y) (0,y) (z,w)
= bezierQuad (withAlpha 0.0 white) (withAlpha alph white) lwidth rwidth (V2 x y) (V2 0 y) (V2 z w)
displayListCoords :: World -> [Point2]
displayListCoords w = map (g . f) [(1::Int)..]
where
f i = ( 15 - halfWidth w , halfHeight w - (20 * fromIntegral i) )
g (x,y) = (2*x / getWindowX w, 2*y / getWindowY w)
f i = (V2 ( 15 - halfWidth w ) ( halfHeight w - (20 * fromIntegral i)) )
g (V2 x y) = (V2 (2*x / getWindowX w) ( 2*y / getWindowY w))
displayListEndCoords :: World -> [String] -> [Point2]
displayListEndCoords w ss = map g $ zipWith h ss $ map f [1..]
where
f :: Int -> Point2
f i = ( 15 - halfWidth w , 2.5 + halfHeight w - (20 * fromIntegral i) )
g (x,y) = (2*x / getWindowX w, 2*y / getWindowY w)
f i = (V2 ( 15 - halfWidth w ) ( 2.5 + halfHeight w - (20 * fromIntegral i)) )
g (V2 x y) = (V2 (2*x / getWindowX w) ( 2*y / getWindowY w))
h :: String -> Point2 -> Point2
h s (x,y) = (x + 9 * fromIntegral (length s), y)
h s (V2 x y) = (V2 (x + 9 * fromIntegral (length s)) ( y))
--bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
@@ -202,18 +202,16 @@ closeObjectTexts w = pictures $ zipWith renderList [(0::Int)..] (map colAndText
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/getWindowX w, y*2/getWindowY w)
sc (V2 x y) = (V2 (x*2/getWindowX w) ( y*2/getWindowY 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
)
let p = V2 (textWidth + xtran 0 + pushout - halfWidth w)
( halfHeight w - 20* (fromIntegral invPos +1) + 2.5)
let p' = V2 ( pushout - halfWidth w + 130)
( halfHeight w - 20* (fromIntegral invPos +1) + 2.5)
return $ flip thickLineCol (1 / halfWidth w)
[(itScreenPos, withAlpha 0 col)
,(sc p' , col)
@@ -240,10 +238,10 @@ openCursorAt
openCursorAt wth col xoff yoff yint w = winScale w
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
$ lineCol
[(( wth,12.5) ,withAlpha 0 col)
,(( 0,12.5) ,col)
,(( 0,-7.5) ,col)
,(( wth,-7.5) ,withAlpha 0 col)
[((V2 wth 12.5) ,withAlpha 0 col)
,((V2 0 12.5) ,col)
,((V2 ( 0) (-7.5)) ,col)
,((V2 ( wth) (-7.5)) ,withAlpha 0 col)
]
cursorAt
:: Float -- ^ Width
@@ -257,11 +255,11 @@ cursorAt wth col xoff yoff yint w = winScale w
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
. color col
$ line
[( wth,12.5)
,( 0,12.5)
,( 0,-7.5)
,( wth,-7.5)
,( wth,12.5)
[(V2 wth 12.5)
,(V2 0 12.5)
,(V2 ( 0) (-7.5))
,(V2 ( wth) (-7.5))
,(V2 wth 12.5)
]
displayHP :: Int -> World -> Picture