270 lines
9.2 KiB
Haskell
270 lines
9.2 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Render.HUD
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Base.Window
|
|
import Dodge.Inventory
|
|
import Picture
|
|
import Geometry
|
|
|
|
import Data.Maybe
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.Set as S
|
|
import Control.Lens
|
|
import SDL (MouseButton (..))
|
|
|
|
winScale :: World -> Picture -> Picture
|
|
winScale w = scale (2 / getWindowX w) (2 / getWindowY w)
|
|
|
|
hudDrawings :: World -> Picture
|
|
hudDrawings w = pictures $
|
|
[ winScale w . dShadCol white $ displayHP 0 w
|
|
, winScale w . translate (-390) 20 . scale 0.05 0.05 . dShadCol white $ text (_testString w)
|
|
]
|
|
++ selectionText
|
|
where
|
|
selectionText =
|
|
if _carteDisplay w
|
|
then drawLocations w
|
|
else drawInventory w
|
|
|
|
drawInventory :: World -> [Picture]
|
|
drawInventory w = case _inventoryMode w of
|
|
TopInventory -> [ closeObjectTexts w]
|
|
++ topInvCursor col iPos w
|
|
++ displayInv 0 w
|
|
TweakInventory ->
|
|
mCurs it w
|
|
++ [cursorAt 120 col 5 0 iPos w
|
|
,cursorsZ w iPos it
|
|
]
|
|
++ displayInv 0 w
|
|
++ displayMidList w (ammoTweakStrings it) "TWEAK"
|
|
CombineInventory -> displayInv 0 w ++ invHead w "COMBINE"
|
|
InspectInventory -> displayInv 0 w ++ invHead w "INSPECT"
|
|
where
|
|
itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
|
|
iPos = _crInvSel $ _creatures w IM.! _yourID w
|
|
it = yourItem w
|
|
col = itCol it
|
|
|
|
cursorsZ :: World -> Int -> Item -> Picture
|
|
cursorsZ w ipos it = case it ^? wpAmmo . amParamSel of
|
|
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 = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
|
|
|
|
topInvCursor :: Color -> Int -> World -> [Picture]
|
|
topInvCursor col iPos w
|
|
| ButtonRight `S.member` _mouseButtons w =
|
|
[cursorAt 100 col 5 0 iPos w
|
|
,openCursorAt 20 col 105 0 iPos w]
|
|
| otherwise = [ openCursorAt 120 col 5 0 iPos w ]
|
|
|
|
ammoTweakStrings :: Item -> [String]
|
|
ammoTweakStrings it = case it ^? wpAmmo . amPjParams of
|
|
Just l -> map pjTweakString l
|
|
_ -> ["NOT TWEAKABLE"]
|
|
|
|
mCurs :: Item -> World -> [Picture]
|
|
mCurs it w = case it ^? wpAmmo . amParamSel of
|
|
Nothing -> []
|
|
Just i
|
|
| ButtonRight `S.member` _mouseButtons w ->
|
|
[cursorAt x white y 60 i w
|
|
,openCursorAt 20 white (x+y) 60 i w
|
|
]
|
|
| otherwise -> [openCursorAt 140 white 155 60 i w]
|
|
where
|
|
x = 117.5
|
|
y = 155
|
|
|
|
zDraw :: Point2 -> Point2 -> Picture
|
|
zDraw (V2 x y) (V2 a b) = line $ map toV2
|
|
[(x,y)
|
|
,(0.5 * (x+a), y)
|
|
,(0.5 * (x+a), b)
|
|
,(a, b)
|
|
]
|
|
|
|
pjTweakString :: PjParam -> String
|
|
pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj
|
|
|
|
displayMidList :: World -> [String] -> String -> [Picture]
|
|
displayMidList w strs s =
|
|
invHead w s
|
|
++ renderListAt (V2 150 (-60)) (map (,white) strs) w
|
|
|
|
invHead :: World -> String -> [Picture]
|
|
invHead w s = [winScale w . translate (-130) (halfHeight w - 40)
|
|
. dShadCol white . scale 0.4 0.4 $ text s
|
|
]
|
|
|
|
displayListTopLeft :: [(String,Color)] -> World -> [Picture]
|
|
displayListTopLeft = renderListAt (V2 0 0)
|
|
|
|
renderListAt :: Point2 -> [(String,Color)] -> World -> [Picture]
|
|
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]) )
|
|
( map (\(s,col) -> scale 0.1 0.1 . dShadCol col $ text s) scols )
|
|
|
|
displayInv :: Int -> World -> [Picture]
|
|
displayInv n w = displayListTopLeft scols w
|
|
where
|
|
scols = map itemStringCol . IM.elems . _crInv $ _creatures w IM.! n
|
|
|
|
itemStringCol :: Item -> (String,Color)
|
|
itemStringCol NoItem = ("----", greyN 0.5)
|
|
itemStringCol itm = (_itInvDisplay itm itm, _itInvColor itm)
|
|
|
|
drawLocations :: World -> [Picture]
|
|
drawLocations wrld = displayListTopLeft locs wrld
|
|
++ zipWith bFunc (displayListEndCoords wrld locTexts) locPoss
|
|
++ mapOverlay wrld
|
|
++ [drawListCursor white iPos wrld]
|
|
where
|
|
iPos = _selLocation 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 (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 (V2 x y) (V2 0 y) (V2 z w)
|
|
|
|
displayListCoords :: World -> [Point2]
|
|
displayListCoords w = map (g . f) [(1::Int)..]
|
|
where
|
|
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 = 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 (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
|
|
|
|
--bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
|
|
|
|
mapOverlay :: World -> [Picture]
|
|
mapOverlay w = (color (withAlpha 0.5 black) . polygon $ rectNSEW 1 (-1) (-1) 1) :
|
|
(mapMaybe (mapWall w) . IM.elems $ _walls w)
|
|
|
|
mapWall :: World -> Wall -> Maybe Picture
|
|
mapWall w wl =
|
|
if _wlSeen wl
|
|
then Just . color c . polygon $ map (cartePosToScreen w) [x,x +.+ n2,y +.+ n2, y]
|
|
else Nothing
|
|
where
|
|
t = normalizeV (y -.- x)
|
|
n2 = 20 *.* vNormal t
|
|
(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::Int)..] (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) = winScale w
|
|
. tran
|
|
. translate (xtran i) (negate (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 :: Int -> Float
|
|
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 (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 = 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 $ thickLineCol
|
|
[(itScreenPos, withAlpha 0 col)
|
|
,(sc p' , col)
|
|
,(sc p , col)
|
|
]
|
|
(1 / halfWidth w)
|
|
{- | Colour picture and add black drop shadow. -}
|
|
dShadCol :: Color -> Picture -> Picture
|
|
dShadCol c p = pictures
|
|
[ color black $ uncurry translate (1.2,-1.2) p
|
|
, color c p
|
|
]
|
|
|
|
drawListCursor :: Color -> Int -> World -> Picture
|
|
drawListCursor c = openCursorAt 120 c 5 0
|
|
|
|
openCursorAt
|
|
:: Float -- ^ Width
|
|
-> Color
|
|
-> Float -- ^ x offset
|
|
-> Float -- ^ y offset
|
|
-> Int -- ^ y offset (discrete)
|
|
-> World
|
|
-> Picture
|
|
openCursorAt wth col xoff yoff yint w = winScale 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)
|
|
]
|
|
cursorAt
|
|
:: Float -- ^ Width
|
|
-> Color
|
|
-> Float -- ^ x offset
|
|
-> Float -- ^ y offset
|
|
-> Int -- ^ y offset (discrete)
|
|
-> World
|
|
-> Picture
|
|
cursorAt wth col xoff yoff yint w = winScale w
|
|
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
|
|
. color col
|
|
$ line
|
|
[V2 wth 12.5
|
|
,V2 0 12.5
|
|
,V2 0 (-7.5)
|
|
,V2 wth (-7.5)
|
|
,V2 wth 12.5
|
|
]
|
|
|
|
displayHP :: Int -> World -> Picture
|
|
displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $
|
|
scale 0.2 0.2 $ text $ reverse $ take 5 $ (++ repeat ' ') $ reverse $ show
|
|
$ _crHP $ _creatures w IM.! n
|