262 lines
8.5 KiB
Haskell
262 lines
8.5 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Render.HUD
|
|
( hudDrawings
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.WinScale
|
|
import Dodge.Base
|
|
import Dodge.Base.Window
|
|
import Dodge.Inventory
|
|
import Dodge.Render.Connectors
|
|
import Dodge.Render.List
|
|
import Picture
|
|
import Geometry
|
|
import Padding
|
|
|
|
import Data.Maybe
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.Set as S
|
|
import Control.Lens
|
|
import SDL (MouseButton (..))
|
|
--import Data.Bifunctor
|
|
|
|
hudDrawings :: Configuration -> World -> Picture
|
|
hudDrawings cfig w = pictures
|
|
[ winScale cfig . dShadCol white $ displayHP 0 cfig w
|
|
, renderListAt (halfWidth cfig) 0 cfig $ map (,white) (_testString w w)
|
|
, selectionText
|
|
]
|
|
where
|
|
selectionText = if _carteDisplay w
|
|
then drawLocations cfig w
|
|
else drawInventory cfig w
|
|
|
|
|
|
drawInventory :: Configuration -> World -> Picture
|
|
drawInventory cfig w = subInventoryDisplay cfig w `appendPic` displayInv 0 cfig w
|
|
|
|
subInventoryDisplay :: Configuration -> World -> Picture
|
|
subInventoryDisplay cfig w = case _inventoryMode w of
|
|
LockedInventory -> topInvCursor col iPos cfig w
|
|
TopInventory -> pictures
|
|
[ closeObjectTexts cfig w
|
|
, topInvCursor col iPos cfig w
|
|
]
|
|
TweakInventory -> pictures
|
|
[ mCurs it cfig w
|
|
, cursorAt 120 col 5 0 iPos cfig
|
|
, cursorsZ cfig iPos it
|
|
, displayMidList cfig (ammoTweakStrings it) "TWEAK"
|
|
]
|
|
CombineInventory -> invHead cfig "COMBINE"
|
|
InspectInventory -> invHead cfig "INSPECT"
|
|
where
|
|
itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
|
|
iPos = _crInvSel $ _creatures w IM.! _yourID w
|
|
it = yourItem w
|
|
col = itCol it
|
|
|
|
cursorsZ :: Configuration -> Int -> Item -> Picture
|
|
cursorsZ cfig ipos it = case it ^? itParams . tweakSel of
|
|
Nothing -> f $ zConnect sp (V2 (155- hw) ( hh - 77.5))
|
|
Just jpos -> f $ zConnect sp (V2 (155 - hw) ( hh - (20 * fromIntegral jpos + 77.5)))
|
|
where
|
|
f = winScale cfig . color white
|
|
hh = halfHeight cfig
|
|
hw = halfWidth cfig
|
|
sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
|
|
|
|
topInvCursor :: Color -> Int -> Configuration -> World -> Picture
|
|
topInvCursor col iPos cfig w
|
|
| ButtonRight `S.member` _mouseButtons w =
|
|
cursorAt 100 col 5 0 iPos cfig
|
|
`appendPic` openCursorAt 20 col 105 0 iPos cfig
|
|
| otherwise = mainListCursor col iPos cfig
|
|
|
|
ammoTweakStrings :: Item -> [String]
|
|
ammoTweakStrings it = case it ^? itParams . tweakParams of
|
|
Just l -> map pjTweakString $ IM.elems l
|
|
_ -> ["NOT TWEAKABLE"]
|
|
|
|
mCurs :: Item -> Configuration -> World -> Picture
|
|
mCurs it cfig w = case it ^? itParams . tweakSel of
|
|
Nothing -> []
|
|
Just i
|
|
| ButtonRight `S.member` _mouseButtons w ->
|
|
pictures
|
|
[cursorAt x white y 60 i cfig
|
|
,openCursorAt 20 white (x+y) 60 i cfig
|
|
]
|
|
| otherwise -> openCursorAt 140 white 155 60 i cfig
|
|
where
|
|
x = 117.5
|
|
y = 155
|
|
|
|
pjTweakString :: TweakParam -> String
|
|
pjTweakString pj = _showTweak pj $ _curTweak pj
|
|
|
|
displayMidList :: Configuration -> [String] -> String -> Picture
|
|
displayMidList cfig strs s = invHead cfig s
|
|
`appendPic` renderListAt 150 (-60) cfig (strs <&> (,white))
|
|
|
|
invHead :: Configuration -> String -> Picture
|
|
invHead cfig s = winScale cfig
|
|
. translate (-130) (halfHeight cfig - 40)
|
|
. dShadCol white
|
|
. scale 0.4 0.4
|
|
$ text s
|
|
|
|
renderItemMapAt :: Float -> Float -> Configuration -> IM.IntMap Item -> Picture
|
|
{-# INLINE renderItemMapAt #-}
|
|
renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList
|
|
|
|
displayInv :: Int -> Configuration -> World -> Picture
|
|
displayInv n cfig w = renderItemMapAt 0 0 cfig (_crInv cr)
|
|
<> equipcursor
|
|
where
|
|
equipcursor = case _crLeftInvSel cr of
|
|
Nothing -> mempty
|
|
Just invid -> openCursorAt 20 yellow 105 0 invid cfig
|
|
cr = _creatures w IM.! n
|
|
|
|
drawLocations :: Configuration -> World -> Picture
|
|
drawLocations cfig w = pictures $
|
|
renderListAt 0 0 cfig locs
|
|
: zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
|
|
++ mapOverlay cfig w
|
|
++ [mainListCursor white iPos cfig]
|
|
where
|
|
iPos = _selLocation w
|
|
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
|
|
locPoss = map (cartePosToScreen cfig w . ($ w) . fst) . IM.elems . _seenLocations $ w
|
|
locTexts = map fst locs
|
|
|
|
displayListEndCoords :: Configuration -> [String] -> [Point2]
|
|
displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1..]
|
|
where
|
|
f :: Int -> Point2
|
|
f i = V2 ( 15 - halfWidth cfig ) ( 2.5 + halfHeight cfig - (20 * fromIntegral i))
|
|
h :: String -> Point2 -> Point2
|
|
h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
|
|
|
|
|
|
mapOverlay :: Configuration -> World -> [Picture]
|
|
mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ rectNSEW 1 (-1) (-1) 1) :
|
|
(mapMaybe (mapWall cfig w) . IM.elems $ _walls w)
|
|
|
|
mapWall :: Configuration -> World -> Wall -> Maybe Picture
|
|
mapWall cfig w wl =
|
|
if _wlSeen wl
|
|
then Just . color c . polygon $ map (cartePosToScreen cfig 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 :: Configuration -> World -> Picture
|
|
closeObjectTexts cfig w = pictures $
|
|
renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)
|
|
: maybeToList maybeLine
|
|
where
|
|
colAndText (Left x) = ( _itName $ _flIt x, _itInvColor $ _flIt x)
|
|
colAndText (Right x) = (_btText x,yellow)
|
|
youSel = _crInvSel $ you w
|
|
freeSlot = mayIt >>= \it -> checkInvSlotsYou (_flIt it) w
|
|
invPos = fromMaybe youSel freeSlot
|
|
mayObj = listToMaybe $ _closeObjects w
|
|
mayIt = mayObj >>= maybeLeft
|
|
maybeLeft (Left x) = Just x
|
|
maybeLeft _ = Nothing
|
|
pushout = 120
|
|
objPos obj = case obj of
|
|
Left flit -> _flItPos flit
|
|
Right bt -> _btPos bt
|
|
mayScreenPos = fmap (worldPosToScreen w . objPos) mayObj
|
|
maybeLine = do
|
|
itScreenPos <- mayScreenPos
|
|
(theText,col) <- fmap colAndText mayObj
|
|
let textWidth = 9 * fromIntegral (length theText)
|
|
let p = V2 (textWidth + 15 + pushout - halfWidth cfig)
|
|
( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5)
|
|
return . winScale cfig . color col $ lConnect p itScreenPos
|
|
|
|
mainListCursor :: Color -> Int -> Configuration -> Picture
|
|
mainListCursor c = openCursorAt 120 c 5 0
|
|
|
|
listItemAt
|
|
:: Float -- ^ x offset
|
|
-> Float -- ^ y offset
|
|
-> Configuration
|
|
-> Int -- ^ y offset (discrete)
|
|
-> Item -- ^ The item
|
|
-> Picture
|
|
{-# INLINE listItemAt #-}
|
|
listItemAt xoff yoff w yint
|
|
= winScale w
|
|
. translate (xoff + 15 - hw) (yoff + hh - (20 * (fromIntegral yint+1)))
|
|
. scale 0.1 0.1
|
|
. itemText
|
|
where
|
|
hw = halfWidth w
|
|
hh = halfHeight w
|
|
|
|
itemText :: Item -> Picture
|
|
{-# INLINE itemText #-}
|
|
--itemText NoItem = dShadCol (greyN 0.5) $ text "----"
|
|
--itemText it = dShadCol (_itInvColor it) $ text (_itInvDisplay it it)
|
|
itemText NoItem = text "----"
|
|
itemText it = case _itCurseStatus it of
|
|
UndroppableIdentified -> color black (text (_itInvDisplay it it))
|
|
<> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
|
|
_ -> color thecolor $ text (_itInvDisplay it it)
|
|
where
|
|
thecolor = _itInvColor it
|
|
|
|
|
|
openCursorAt
|
|
:: Float -- ^ Width
|
|
-> Color
|
|
-> Float -- ^ x offset
|
|
-> Float -- ^ y offset
|
|
-> Int -- ^ y offset (discrete)
|
|
-> Configuration
|
|
-> 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)
|
|
-> Configuration
|
|
-> Picture
|
|
cursorAt wth col xoff yoff yint cfig = winScale cfig
|
|
. translate (xoff-halfWidth cfig) (halfHeight cfig - (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 -> Configuration -> World -> Picture
|
|
displayHP cid cfig w = translate (halfWidth cfig-80) (halfHeight cfig-20)
|
|
. scale 0.2 0.2
|
|
. text
|
|
. leftPad 5 ' '
|
|
. show
|
|
. _crHP
|
|
$ _creatures w IM.! cid
|