524 lines
19 KiB
Haskell
524 lines
19 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Render.HUD (
|
|
hudDrawings,
|
|
) where
|
|
|
|
import Dodge.Data.CardinalPoint
|
|
import Dodge.Data.SelectionList
|
|
import Control.Lens
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
import qualified Data.Text as T
|
|
import qualified Data.Vector as V
|
|
import Dodge.Base
|
|
import Dodge.Clock
|
|
import Dodge.Combine
|
|
import Dodge.Data.Universe
|
|
import Dodge.Inventory
|
|
import Dodge.Inventory.ItemSpace
|
|
import Dodge.Item.Display
|
|
import Dodge.Render.Connectors
|
|
import Dodge.Render.List
|
|
import Dodge.Tweak.Show
|
|
import Dodge.WorldPos
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import ListHelp
|
|
import Padding
|
|
import Picture
|
|
import SDL (MouseButton (..))
|
|
import qualified Data.Set as Set
|
|
|
|
hudDrawings :: Universe -> Picture
|
|
hudDrawings uv = case w ^. cWorld . lWorld . hud . hudElement of
|
|
DisplayCarte -> drawCarte cfig w
|
|
DisplayInventory subinv ->
|
|
drawInGameHUD subinv uv
|
|
<> subInventoryDisplay subinv cfig w
|
|
where
|
|
w = _uvWorld uv
|
|
cfig = _uvConfig uv
|
|
|
|
drawInGameHUD :: SubInventory -> Universe -> Picture
|
|
drawInGameHUD subinv uv =
|
|
pictures
|
|
[ winScale cfig . dShadCol white $ displayHP 0 cfig w
|
|
, listPicturesAt (halfWidth cfig) 0 cfig $ map text (_uvTestString uv uv)
|
|
, inventoryDisplay subinv cfig w
|
|
]
|
|
where
|
|
w = _uvWorld uv
|
|
cfig = _uvConfig uv
|
|
|
|
defaultSelectionList :: SelectionList
|
|
defaultSelectionList = SelectionList
|
|
{ _slVerticalGap = 10
|
|
, _slScale = 1
|
|
, _slPosX = 0
|
|
, _slPosY = 0
|
|
, _slOffset = 0
|
|
, _slItems = []
|
|
, _slSelPos = Nothing
|
|
, _slCursorType = NoCursor
|
|
, _slWidth = FixedSelectionWidth 15
|
|
}
|
|
|
|
subInvSelectionList :: SelectionList
|
|
subInvSelectionList = SelectionList
|
|
{ _slVerticalGap = 10
|
|
, _slScale = 1
|
|
, _slPosX = subInvX
|
|
, _slPosY = 60
|
|
, _slOffset = 0
|
|
, _slItems = []
|
|
, _slSelPos = Nothing
|
|
, _slCursorType = NoCursor
|
|
, _slWidth = FixedSelectionWidth 15
|
|
}
|
|
|
|
inventorySelectionList :: World -> [SelectionItem]
|
|
inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
|
|
++ [SelectionItem displayFreeSlots 1 False (length thetext) white 0]
|
|
++ map (closeObjectToSelectionItem nfreeslots) (w ^. cWorld . lWorld . closeObjects)
|
|
where
|
|
cr = you w
|
|
inv = _crInv cr
|
|
nfreeslots = crNumFreeSlots cr
|
|
thetext = case nfreeslots of
|
|
0 -> " INVENTORY FULL"
|
|
1 -> " +1 FREE SLOT"
|
|
x -> " +" ++ show x ++ " FREE SLOTS"
|
|
displayFreeSlots = [color invDimColor $ text thetext]
|
|
|
|
inventoryCursorPos :: SubInventory -> World -> Maybe Int
|
|
inventoryCursorPos subinv w = case subinv of
|
|
CombineInventory {} -> Nothing
|
|
_ -> Just $ yourInvSel w
|
|
|
|
inventoryDisplay :: SubInventory -> Configuration -> World -> Picture
|
|
inventoryDisplay subinv cfig w = drawSelectionList cfig $
|
|
defaultSelectionList & slItems .~ inventorySelectionList w
|
|
& slWidth .~ FixedSelectionWidth topInvW
|
|
& slCursorType .~ BorderCursor (Set.fromList selcursortype)
|
|
& slSelPos .~ inventoryCursorPos subinv w
|
|
& slWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
|
|
where
|
|
selcursortype
|
|
| ButtonRight `M.member` _mouseButtons (_input w) = [North,South,East,West]
|
|
| otherwise = [North,South,West]
|
|
|
|
subInventoryDisplay :: SubInventory -> Configuration -> World -> Picture
|
|
subInventoryDisplay subinv cfig w = case subinv of
|
|
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
|
|
NoSubInventory ->
|
|
pictures
|
|
[ closeobjectcursor
|
|
, equipcursors
|
|
, equipcursor -- the order is important, this should go on top of the other equipcursors
|
|
, rboptions
|
|
]
|
|
TweakInventory mtweaki ->
|
|
titledSub "TWEAK" (subInvSelectionList & slItems .~ ammoTweakSelectionItems it)
|
|
[ selcursor' listCursorNESW
|
|
, fromMaybe mempty $ do
|
|
tweaki <- mtweaki
|
|
-- consider moving this functionality out into a tweaks module
|
|
tparam <- it ^? _Just . itTweaks . tweakParams . ix tweaki
|
|
return $
|
|
lnkMidInvSel cfig w curpos tweaki
|
|
<> listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 1
|
|
]
|
|
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
|
|
CombineInventory mi ->
|
|
titledSub "COMBINE" (combineListSelection w)
|
|
[ fromMaybe mempty $ do
|
|
i <- mi
|
|
cpos <- combinePoss w !? i
|
|
col <- (combineItemListYou w !? i) <&> _itInvColor . snd
|
|
return $
|
|
pictures
|
|
[ fromMaybe mempty $ do
|
|
strs <- fmap (fst . snd) (combineListInfo w !? i)
|
|
return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
|
|
, fromMaybe mempty $ do
|
|
csize <- combineSizes w !? i
|
|
return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
|
|
, fromMaybe mempty $ do
|
|
lnks <- map fst (combineItemListYou w) !? i
|
|
return $
|
|
lnkMidPosInvSelsCol cfig w cpos col lnks
|
|
<> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
|
|
<> combineCounts cfig w lnks
|
|
]
|
|
]
|
|
InspectInventory ->
|
|
titledSub "INSPECT" (subInvSelectionList & slItems .~ textSelItems (itmInfo it))
|
|
[ selcursor' listCursorNESW
|
|
]
|
|
where
|
|
titledSub subtitle subitems extrapics = pictures $ [invHead cfig subtitle
|
|
,drawSelectionList cfig subitems] <>
|
|
extrapics
|
|
closeobjectcursor = case selectedCloseObject w of
|
|
Nothing -> mempty
|
|
Just (i, co) ->
|
|
listCursorNS
|
|
clObjFloatIn
|
|
0
|
|
cfig
|
|
(selNumPos i w)
|
|
(closeObjectCol co)
|
|
topInvW
|
|
(invSelSize i w)
|
|
itcol = fromMaybe (greyN 0.5) (it ^? _Just . itInvColor)
|
|
cr = you w
|
|
it = yourItem w
|
|
selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it
|
|
curpos = invSelPos w
|
|
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w)
|
|
equipcursor = case _crLeftInvSel cr of
|
|
Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
|
|
_ -> mempty
|
|
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
|
|
f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
|
|
rboptions =
|
|
if ButtonRight `M.member` _mouseButtons (_input w)
|
|
then drawRBOptions cfig w (_rbOptions w)
|
|
else mempty
|
|
|
|
itmInfo :: Maybe Item -> [String]
|
|
itmInfo mit = fromMaybe [] $ do
|
|
itm <- mit
|
|
return (map show . M.assocs . _iyModules $ _itType itm)
|
|
|
|
displayTerminal :: Int -> Configuration -> LWorld -> Picture
|
|
displayTerminal tid cfig w = fromMaybe mempty $ do
|
|
tm <- w ^? terminals . ix tid
|
|
return $
|
|
pictures
|
|
[ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
|
|
, renderListAt subInvX 60 cfig
|
|
. displayTermInput tm
|
|
. reverse
|
|
. take (_tmMaxLines tm)
|
|
$ _tmDisplayedLines tm
|
|
]
|
|
where
|
|
displayTermInput tm = case _tmInput tm of
|
|
TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
|
|
displayInputText tm s
|
|
| _tmStatus tm == TerminalReady = '>' : T.unpack s
|
|
| otherwise = ""
|
|
displayBlinkCursor hasfoc
|
|
| hasfoc = clockCycle 10 (V.fromList ["_", ""]) w
|
|
| otherwise = []
|
|
|
|
drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
|
|
drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} =
|
|
listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
|
|
<> case ae of
|
|
DoNotMoveEquipment -> mempty
|
|
PutOnEquipment{} ->
|
|
midtext "PUT ONTO"
|
|
MoveEquipment{} ->
|
|
midtext "MOVE TO" <> extratext []
|
|
SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
|
|
midtext "MOVE TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp)
|
|
ReplaceEquipment{_allocRemoveID = rid} ->
|
|
midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
|
|
RemoveEquipment{} ->
|
|
midtext "TAKE OFF"
|
|
where
|
|
midtext str = listTextPictureAt 252 0 cfig curpos (text str)
|
|
extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
|
|
deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
|
|
Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
|
|
Nothing -> ""
|
|
curpos = invSelPos w
|
|
otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)
|
|
drawRBOptions _ _ _ = mempty
|
|
|
|
eqPosText :: EquipPosition -> String
|
|
eqPosText ep = case ep of
|
|
OnHead -> "HEAD"
|
|
OnChest -> "CHEST"
|
|
OnBack -> "BACK"
|
|
OnLeftWrist -> "L.WRIST"
|
|
OnRightWrist -> "R.WRIST"
|
|
OnLegs -> "LEGS"
|
|
OnSpecial -> "EQUIPPED"
|
|
|
|
topInvW :: Int
|
|
topInvW = 15
|
|
|
|
subInvX :: Float
|
|
subInvX = 9 * fromIntegral topInvW + 50
|
|
|
|
lnkMidInvSel :: Configuration -> World -> Int -> Int -> Picture
|
|
lnkMidInvSel cfig w lefti midi =
|
|
winScale cfig
|
|
. color white
|
|
. zConnect rp
|
|
$ selNumMidHeight cfig w lefti
|
|
where
|
|
-- lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
|
|
rp = V2 (190 - hw) (hh - (20 * fromIntegral midi + 77.5))
|
|
hh = halfHeight cfig
|
|
hw = halfWidth cfig
|
|
|
|
--lnkMidPosInvSels :: Configuration -> World -> Int -> [Int] -> Picture
|
|
--lnkMidPosInvSels cfig w i = winScale cfig
|
|
-- . color white
|
|
-- . concatMap (zConnect rp . selNumMidHeight cfig w)
|
|
-- where
|
|
---- lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
|
|
-- rp = V2 (190 - hw) ( hh - (20 * fromIntegral i + 77.5))
|
|
-- hh = halfHeight cfig
|
|
-- hw = halfWidth cfig
|
|
|
|
combineCounts :: Configuration -> World -> [Int] -> Picture
|
|
combineCounts cfig w = winScale cfig . foldMap f . group
|
|
where
|
|
f (i : is) = case yourInv w ^? ix i . itUse . useAmount of
|
|
Just _ -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
|
|
_ -> mempty
|
|
f _ = mempty
|
|
|
|
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
|
|
lnkMidPosInvSelsCol cfig w i col =
|
|
winScale cfig
|
|
. foldMap (\j -> zConnectCol rp (V2 18 0 + selNumMidHeight cfig w j) col white white (selNumCol j w))
|
|
where
|
|
-- lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
|
|
rp = V2 (190 - hw) (hh - (20 * fromIntegral i + 77.5))
|
|
hh = halfHeight cfig
|
|
hw = halfWidth cfig
|
|
|
|
topCursorTypeWidth ::
|
|
(Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture) ->
|
|
Int ->
|
|
Configuration ->
|
|
World ->
|
|
Int ->
|
|
Picture
|
|
topCursorTypeWidth ctype width cfig w i =
|
|
ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (selNumSlots i w)
|
|
|
|
determineInvSelCursorWidth :: World -> Int
|
|
determineInvSelCursorWidth w = case _rbOptions w of
|
|
NoRightButtonOptions -> topInvW
|
|
EquipOptions{} ->
|
|
if ButtonRight `M.member` _mouseButtons (_input w)
|
|
then 47
|
|
else topInvW
|
|
|
|
combineListSelection :: World -> SelectionList
|
|
combineListSelection w = subInvSelectionList & slItems .~ combineListSelectionItems w
|
|
|
|
combineListSelectionItems :: World -> [SelectionItem]
|
|
combineListSelectionItems w = case combineListSelectionItems' w of
|
|
[] -> [SelectionItem [text thetext] 1 False (length thetext) white 0]
|
|
xs -> xs
|
|
where
|
|
thetext = "NO POSSIBLE COMBINATIONS"
|
|
|
|
|
|
combineListSelectionItems' :: World -> [SelectionItem]
|
|
combineListSelectionItems' w = map (picsToSelectable 15 . itemText . snd) $ combineItemListYou w
|
|
|
|
ammoTweakSelectionItems :: Maybe Item -> [SelectionItem]
|
|
ammoTweakSelectionItems = textSelItems . ammoTweakStrings
|
|
|
|
ammoTweakStrings :: Maybe Item -> [String]
|
|
ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of
|
|
Just l -> map tweakString $ IM.elems l
|
|
_ -> ["NOT TWEAKABLE"]
|
|
|
|
tweakString :: TweakParam -> String
|
|
tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
|
|
|
|
invHead :: Configuration -> String -> Picture
|
|
invHead cfig s =
|
|
winScale cfig
|
|
. translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
|
|
. dShadCol white
|
|
. scale 0.4 0.4
|
|
$ text s
|
|
|
|
invDimColor :: Color
|
|
invDimColor = greyN 0.7
|
|
|
|
closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem
|
|
closeObjectToSelectionItem n e = SelectionItem
|
|
{ _siPictures = pics
|
|
, _siHeight = length pics
|
|
, _siIsSelectable = True
|
|
, _siWidth = 15
|
|
, _siColor = col
|
|
, _siOffX = 2
|
|
}
|
|
where
|
|
(pics,col) = closeObjectToTextPictures' n e
|
|
|
|
closeObjectToTextPictures' :: Int -> Either FloorItem Button -> ([Picture],Color)
|
|
closeObjectToTextPictures' nfreeslots e = case e of
|
|
Left flit -> let it = _flIt flit
|
|
in (map (applycolor it . textindent) $ itemDisplay it, thecol it)
|
|
Right bt -> ([color yellow $ textindent $ _btText bt], yellow)
|
|
where
|
|
textindent = text . (replicate clObjIntIn ' ' ++)
|
|
applycolor it
|
|
| nfreeslots >= itSlotsTaken it = color $ _itInvColor it
|
|
| otherwise = color invDimColor
|
|
thecol it
|
|
| nfreeslots >= itSlotsTaken it = _itInvColor it
|
|
| otherwise = invDimColor
|
|
|
|
clObjIntIn :: Int
|
|
clObjIntIn = 2
|
|
|
|
clObjFloatIn :: Float
|
|
clObjFloatIn = fromIntegral clObjIntIn * 9
|
|
|
|
drawCarte :: Configuration -> World -> Picture
|
|
drawCarte cfig w =
|
|
pictures $
|
|
renderListAt 0 0 cfig locs :
|
|
zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
|
|
++ mapOverlay cfig w
|
|
++ [mainListCursor white iPos cfig]
|
|
where
|
|
iPos = w ^. cWorld . lWorld . selLocation
|
|
locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
|
|
locPoss = map (cartePosToScreen cfig (w ^. cWorld . lWorld . hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld 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 $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
|
|
(mapMaybe (mapWall cfig (w ^. cWorld . lWorld . hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
|
|
|
|
mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
|
|
mapWall cfig thehud wl =
|
|
if _wlSeen wl
|
|
then Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
|
|
else Nothing
|
|
where
|
|
t = normalizeV (y -.- x)
|
|
n2 = 20 *.* vNormal t
|
|
(x, y) = _wlLine wl
|
|
c = _wlColor wl
|
|
|
|
--selectedCloseObjectLink :: Configuration -> World -> Picture
|
|
--selectedCloseObjectLink cfig w = mempty
|
|
|
|
-- | 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
|
|
|
|
picsToSelectable :: Int -> [Picture] -> SelectionItem
|
|
picsToSelectable wdth pics = SelectionItem
|
|
{ _siPictures = pics
|
|
, _siHeight = length pics
|
|
, _siIsSelectable = True
|
|
, _siWidth = wdth
|
|
, _siColor = white
|
|
, _siOffX = 0
|
|
}
|
|
|
|
textSelItems :: [String] -> [SelectionItem]
|
|
textSelItems = map (picsToSelectable 15 . (:[]) . text)
|
|
|
|
invSelectionItem :: Creature -> (Int,Item) -> SelectionItem
|
|
invSelectionItem cr (i,it) = SelectionItem
|
|
{ _siPictures = pics
|
|
, _siHeight = length pics
|
|
, _siIsSelectable = True
|
|
, _siWidth = 15
|
|
, _siColor = col
|
|
, _siOffX = 0
|
|
}
|
|
where
|
|
col = _itInvColor it
|
|
pics = take (itSlotsTaken it) . (++ replicate 10 (color col $ text "*")) $ case _itCurseStatus it of
|
|
UndroppableIdentified -> map (color yellow . text) (itemDisplay it)
|
|
_ | crSel cr == i -> map (color col . text) (selectedItemDisplay cr it)
|
|
_ -> map (color col . text) (itemDisplay it)
|
|
|
|
itemText :: Item -> [Picture]
|
|
{-# INLINE itemText #-}
|
|
itemText it = f $ case _itCurseStatus it of
|
|
UndroppableIdentified -> map (color yellow . text) (itemDisplay it)
|
|
-- <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
|
|
_ -> map (color thecolor . text) (itemDisplay it)
|
|
where
|
|
thecolor = _itInvColor it
|
|
f = take (itSlotsTaken it) . (++ replicate 10 (color (_itInvColor it) $ text "*"))
|
|
|
|
openCursorAt ::
|
|
-- | Width
|
|
Float ->
|
|
Color ->
|
|
-- | x offset
|
|
Float ->
|
|
-- | y offset
|
|
Float ->
|
|
-- | y offset (discrete)
|
|
Int ->
|
|
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)
|
|
]
|
|
|
|
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
|
|
$ w ^?! cWorld . lWorld . creatures . ix cid . crHP
|