Make combine and tweak menus servicable
This commit is contained in:
+108
-108
@@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Render.HUD
|
||||
( hudDrawings
|
||||
) where
|
||||
@@ -27,77 +27,133 @@ import SDL (MouseButton (..))
|
||||
--import Data.Bifunctor
|
||||
|
||||
hudDrawings :: Configuration -> World -> Picture
|
||||
hudDrawings cfig w = pictures
|
||||
hudDrawings cfig w = if _carteDisplay w
|
||||
then drawCarte cfig w
|
||||
else drawInGameHUD cfig w
|
||||
|
||||
drawInGameHUD :: Configuration -> World -> Picture
|
||||
drawInGameHUD cfig w = pictures
|
||||
[ winScale cfig . dShadCol white $ displayHP 0 cfig w
|
||||
, renderListAt (halfWidth cfig) 0 cfig $ map (,white) (_testString w w)
|
||||
, if _carteDisplay w
|
||||
then drawLocations cfig w
|
||||
else subInventoryDisplay cfig w `appendPic` displayInv 0 cfig w
|
||||
, listTextPicturesAt (halfWidth cfig) 0 cfig $ map text (_testString w w)
|
||||
, inventoryDisplay cfig w
|
||||
, subInventoryDisplay cfig w
|
||||
]
|
||||
|
||||
inventoryDisplay :: Configuration -> World -> Picture
|
||||
inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist
|
||||
<> equipcursor
|
||||
where
|
||||
cr = you w
|
||||
inv = _crInv cr
|
||||
invlist = concatMap itemText (IM.elems inv)
|
||||
++ displayFreeSlots
|
||||
++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
|
||||
floorItemsColor
|
||||
| _inventoryMode w == TopInventory = id
|
||||
| otherwise = color invDimColor
|
||||
nfreeslots = crNumFreeSlots cr
|
||||
displayFreeSlots = case nfreeslots of
|
||||
0 -> [color invDimColor . text $ " INVENTORY FULL"]
|
||||
1 -> [color invDimColor . text $ " +1 FREE SLOT"]
|
||||
x -> [color invDimColor . text $ " +" ++ show x ++ " FREE SLOTS"]
|
||||
equipcursor = case _crLeftInvSel cr of
|
||||
Nothing -> mempty
|
||||
Just invid -> listCursorNES 0 0 cfig (selNumPos invid w) yellow topInvW
|
||||
(selNumSlots invid w)
|
||||
|
||||
|
||||
subInventoryDisplay :: Configuration -> World -> Picture
|
||||
subInventoryDisplay cfig w = case _inventoryMode w of
|
||||
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
|
||||
TopInventory -> pictures
|
||||
[ --closeObjectTexts cfig w
|
||||
selcursor
|
||||
[ selcursor
|
||||
, closeobjectcursor
|
||||
]
|
||||
TweakInventory -> pictures
|
||||
[ mCurs it cfig w
|
||||
, cursorAt 120 col 5 0 cursPos cfig
|
||||
, cursorsZ cfig cursPos it
|
||||
, displayMidList cfig (ammoTweakStrings it) "TWEAK"
|
||||
--[ mCurs it cfig w
|
||||
[ selcursor' listCursorNESW
|
||||
-- , cursorsZ cfig curpos it
|
||||
, fromMaybe mempty $ do
|
||||
tweaki <- it ^? _Just . itTweaks . tweakSel
|
||||
-- consider moving this functionality out into a tweaks module
|
||||
showtweak <- it ^? _Just . itTweaks . tweakParams . ix tweaki . showTweak
|
||||
tweakname <- it ^? _Just . itTweaks . tweakParams . ix tweaki . nameTweak
|
||||
tweakstring <- showtweak <$> (it ^? _Just . itTweaks . tweakParams . ix tweaki . curTweak)
|
||||
return $ lnkMidInvSel cfig w curpos tweaki
|
||||
<> listCursorNSW subInvX 60 cfig tweaki white (length $ tweakstring ++ tweakname) 1
|
||||
, invHead cfig "TWEAK"
|
||||
, listTextPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it)
|
||||
]
|
||||
CombineInventory mi -> pictures
|
||||
[ invHead cfig "COMBINE"
|
||||
, listTextPicturesAt 150 60 cfig $ map text $ combineListStrings w
|
||||
, listTextPicturesAt subInvX 60 cfig $ combineListStringPictures w
|
||||
, fromMaybe mempty $ do
|
||||
i <- mi
|
||||
return $ listCursorAt 150 60 cfig i white 10 1
|
||||
cpos <- combinePoss w !? i
|
||||
csize <- combineSizes w !? i
|
||||
col <- (combineItemListYou w !? i) <&> _itInvColor . snd
|
||||
return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
|
||||
, fromMaybe mempty $ do
|
||||
i <- mi
|
||||
lnks <- combineListLnks w !? i
|
||||
return $ uncurry (lnkMidPosInvSels cfig w) lnks
|
||||
return $ uncurry (lnkMidPosInvSels cfig w) lnks
|
||||
<> foldMap (cursorAtInvSel listCursorNESW cfig w) (snd lnks)
|
||||
]
|
||||
InspectInventory -> invHead cfig "INSPECT"
|
||||
where
|
||||
itCol = fromMaybe (greyN 0.5) . (^? _Just . itInvColor)
|
||||
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
|
||||
col = itCol it
|
||||
cursPos = invSelPos w
|
||||
selcursor
|
||||
| IM.null inv && null (_closeObjects w) = mempty
|
||||
| otherwise = listCursorAt 0 0 cfig curpos white curx cury
|
||||
inv = _crInv cr
|
||||
selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol topInvW cury <$ it
|
||||
selcursor = selcursor' selcursortype
|
||||
selcursortype
|
||||
| ButtonRight `S.member` _mouseButtons w = listCursorNESW
|
||||
| otherwise = listCursorNSW
|
||||
curpos = invSelPos w
|
||||
curx = 10
|
||||
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w)
|
||||
cr = _creatures w IM.! 0
|
||||
|
||||
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 is = winScale cfig . color white
|
||||
. concatMap
|
||||
(zConnect rp) $ map (lp . flip selNumPos w) is
|
||||
lnkMidPosInvSels cfig w i = winScale cfig
|
||||
. color white
|
||||
. concatMap (zConnect rp . selNumMidHeight cfig w)
|
||||
where
|
||||
lp ipos = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
|
||||
rp = (V2 (155 - hw) ( hh - (20 * fromIntegral i + 77.5)))
|
||||
-- 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
|
||||
|
||||
cursorsZ :: Configuration -> Int -> Maybe Item -> Picture
|
||||
cursorsZ cfig ipos it = case it ^? _Just . itTweaks . 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))
|
||||
cursorAtInvSel :: (Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture)
|
||||
-> Configuration -> World -> Int -> Picture
|
||||
cursorAtInvSel ctype cfig w i
|
||||
= ctype 0 0 cfig (selNumPos i w) (selNumCol i w) topInvW (selNumSlots i w)
|
||||
|
||||
--listSelHeight :: Configuration -> World -> Int -> Float
|
||||
--listSelHeight
|
||||
|
||||
combineListStrings :: World -> [String]
|
||||
combineListStrings = map (show . snd) . combineListYou
|
||||
combineListStringPictures :: World -> [Picture]
|
||||
combineListStringPictures w = case concatMap (itemText . snd) . combineItemListYou $ w of
|
||||
[] -> [text "NO POSSIBLE COMBINATIONS"]
|
||||
xs -> xs
|
||||
|
||||
combineListLnks :: World -> [(Int,[Int])]
|
||||
combineListLnks = zip [0..] . map fst . combineListYou
|
||||
@@ -107,61 +163,16 @@ ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of
|
||||
Just l -> map tweakString $ IM.elems l
|
||||
_ -> ["NOT TWEAKABLE"]
|
||||
|
||||
mCurs :: Maybe Item -> Configuration -> World -> Picture
|
||||
mCurs it cfig w = case it ^? _Just . itTweaks . 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
|
||||
|
||||
tweakString :: TweakParam -> String
|
||||
tweakString tp = rightPad 12 ' ' (_nameTweak tp) ++ " " ++ _showTweak tp (_curTweak tp)
|
||||
|
||||
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)
|
||||
. translate (-halfWidth cfig + subInvX + 20) (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 = listTextPicturesAt 0 0 cfig invlist
|
||||
<> equipcursor
|
||||
<> closeobjectcursor
|
||||
where
|
||||
closeobjectcursor = case selectedCloseObject w of
|
||||
Nothing -> mempty
|
||||
Just (i,_) -> listCursorAt 50 0 cfig (selNumPos i w) blue 15 (invSelSize i w)
|
||||
inv = _crInv cr
|
||||
invlist = concatMap itemText (IM.elems inv)
|
||||
++ displayFreeSlots ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)
|
||||
nfreeslots = crNumFreeSlots cr
|
||||
displayFreeSlots = case nfreeslots of
|
||||
0 -> [color invDimColor . text $ " INVENTORY FULL"]
|
||||
1 -> [color invDimColor . text $ " +1 FREE SLOT"]
|
||||
x -> [color invDimColor . text $ " +" ++ show x ++ " FREE SLOTS"]
|
||||
--curpos = invSelPos w
|
||||
--curx = 10
|
||||
--cury = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w)
|
||||
equipcursor = case _crLeftInvSel cr of
|
||||
Nothing -> mempty
|
||||
Just invid -> openCursorAt 20 yellow 0 0 (selNumPos invid w) cfig
|
||||
cr = _creatures w IM.! n
|
||||
invDimColor :: Color
|
||||
invDimColor = greyN 0.7
|
||||
closeObjectToTextPictures :: Int -> Either FloorItem Button -> [Picture]
|
||||
@@ -169,13 +180,19 @@ closeObjectToTextPictures nfreeslots e = case e of
|
||||
Left flit -> let it = _flIt flit in map (applycolor it . textindent) $ _itInvDisplay it it
|
||||
Right bt -> [color yellow $ textindent $ _btText bt]
|
||||
where
|
||||
textindent = text . (" "++)
|
||||
textindent = text . (replicate clObjIntIn ' '++)
|
||||
applycolor it
|
||||
| nfreeslots >= itSlotsTaken it = color $ _itInvColor it
|
||||
| otherwise = color invDimColor
|
||||
|
||||
drawLocations :: Configuration -> World -> Picture
|
||||
drawLocations cfig w = pictures $
|
||||
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
|
||||
@@ -247,12 +264,13 @@ mainListCursor c = openCursorAt 120 c 5 0
|
||||
|
||||
itemText :: Item -> [Picture]
|
||||
{-# INLINE itemText #-}
|
||||
itemText it = case _itCurseStatus it of
|
||||
itemText it = f $ case _itCurseStatus it of
|
||||
UndroppableIdentified -> map (color yellow . text) (_itInvDisplay it it)
|
||||
-- <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
|
||||
_ -> map (color thecolor . text) (_itInvDisplay it it)
|
||||
where
|
||||
thecolor = _itInvColor it
|
||||
f = take (itSlotsTaken it) . (++ replicate 10 (color (_itInvColor it) $ text "*"))
|
||||
|
||||
|
||||
openCursorAt
|
||||
@@ -271,24 +289,6 @@ openCursorAt wth col xoff yoff yint w = winScale w
|
||||
,(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)
|
||||
|
||||
+34
-17
@@ -4,34 +4,51 @@ import Dodge.Base.Window
|
||||
import Dodge.WinScale
|
||||
import Picture
|
||||
import Geometry
|
||||
--import Control.Monad
|
||||
import Data.Maybe
|
||||
|
||||
-- given a list of pictures that are each the size of a "text" call, displays them as
|
||||
-- a list on the screen
|
||||
listTextPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
|
||||
listTextPicturesAt tx ty cfig = mconcat . zipWith (listTextPictureAt tx ty cfig) [0..]
|
||||
|
||||
|
||||
-- displays a cursor that should match up to list text pictures
|
||||
-- the width of a character appears to be 9(?!)
|
||||
listCursorAt :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorAt xoff yoff cfig yint col cursxsize cursysize = winScale cfig
|
||||
. translate (10.5+xoff-halfWidth cfig) (halfHeight cfig - (20* fromIntegral yint + yoff) - 20)
|
||||
$ lineCol
|
||||
[(V2 0 12.5 , col)
|
||||
,(V2 wth 12.5 ,col)
|
||||
] <>
|
||||
lineCol
|
||||
[(V2 0 (12.5 - hgt),col)
|
||||
,(V2 wth (12.5 - hgt),col)
|
||||
]
|
||||
--[(V2 wth 12.5 ,withAlpha 0 col)
|
||||
--,(V2 0 12.5 ,col)
|
||||
--,(V2 0 (12.5 - hgt),col)
|
||||
--,(V2 wth (12.5 - hgt),withAlpha 0 col)
|
||||
--]
|
||||
-- this is probably because it is 8 pixels plus one for the border
|
||||
listCursorChooseBorder :: [Bool] -> Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorChooseBorder borders xoff yoff cfig yint col cursxsize cursysize = winScale cfig
|
||||
. translate (6+xoff-halfWidth cfig)
|
||||
(halfHeight cfig + 12.5 - (20* fromIntegral yint + yoff + 20 + hgt))
|
||||
. color col
|
||||
$ chooseCursorBorders wth hgt borders
|
||||
where
|
||||
x = 9
|
||||
wth = x * fromIntegral cursxsize
|
||||
wth = x * fromIntegral cursxsize + 9
|
||||
hgt = 20 * fromIntegral cursysize
|
||||
-- note we cannot simply scale lines because they are drawn as solid rectangles
|
||||
chooseCursorBorders :: Float -> Float -> [Bool] -> Picture
|
||||
chooseCursorBorders wth hgt = concat . catMaybes . zipWith f
|
||||
[ line [V2 0 hgt , V2 wth hgt ]
|
||||
, line [V2 wth hgt , V2 wth 0 ]
|
||||
, line [V2 wth 0 , V2 0 0 ]
|
||||
, line [V2 0 0 , V2 0 hgt ]
|
||||
]
|
||||
where
|
||||
f _ False = Nothing
|
||||
f a True = Just a
|
||||
|
||||
listCursorNS :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNS = listCursorChooseBorder [True,False,True]
|
||||
|
||||
listCursorNES :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNES = listCursorChooseBorder [True,True,True]
|
||||
|
||||
listCursorNESW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNESW = listCursorChooseBorder [True,True,True,True]
|
||||
|
||||
listCursorNSW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
|
||||
listCursorNSW = listCursorChooseBorder [True,False,True,True]
|
||||
|
||||
listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture
|
||||
listTextPictureAt xoff yoff cfig yint = winScale cfig
|
||||
|
||||
Reference in New Issue
Block a user