Work on inventory ui
This commit is contained in:
+61
-58
@@ -3,7 +3,6 @@ module Dodge.Render.HUD (
|
||||
drawHUD,
|
||||
) where
|
||||
|
||||
import Dodge.Item.Display
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import qualified Data.Map.Strict as M
|
||||
@@ -20,6 +19,7 @@ import Dodge.Data.World
|
||||
import Dodge.Default.SelectionList
|
||||
import Dodge.Equipment.Text
|
||||
import Dodge.Inventory
|
||||
import Dodge.Item.Display
|
||||
import Dodge.Item.Info
|
||||
import Dodge.ListDisplayParams
|
||||
import Dodge.Render.Connectors
|
||||
@@ -74,14 +74,14 @@ drawCombineInventory cfig sss w =
|
||||
drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture
|
||||
drawExamineInventory cfig mtweaki w =
|
||||
invHead cfig "EXAMINE"
|
||||
<> examineInventoryExtra mtweaki itm cfig
|
||||
<> examineInventoryExtra mtweaki cfig
|
||||
<> drawSelectionList
|
||||
secondColumnParams
|
||||
cfig
|
||||
( defaultSelectionList & slItems .~ ammoTweakSelectionItems itm
|
||||
( defaultSelectionList & slItems .~ tweakItems itm
|
||||
++ map
|
||||
f
|
||||
( makeParagraph 60 $
|
||||
( makeParagraph 55 $
|
||||
yourAugmentedItem
|
||||
itemInfo
|
||||
(yourInfo (you w))
|
||||
@@ -127,8 +127,8 @@ drawRBOptions cfig w = fromMaybe mempty $ do
|
||||
ae <- w ^? rbOptions . opAllocateEquipment
|
||||
sss <- w ^? hud . hudElement . diSections
|
||||
(i', j) <- sss ^? sssExtra . sssSelPos . _Just
|
||||
curpos <- selSecSelPos i' j sss
|
||||
let ytext = drawListElement 0 1 curpos . text
|
||||
curpos <- selSecYint i' j sss
|
||||
let ytext = drawListElement 0 1 0 curpos . text
|
||||
midstr = case ae of
|
||||
DoNotMoveEquipment -> ""
|
||||
PutOnEquipment{} -> " PUT ON"
|
||||
@@ -143,62 +143,71 @@ drawRBOptions cfig w = fromMaybe mempty $ do
|
||||
"REMOVES " ++ otheritem rid
|
||||
_ -> ""
|
||||
return $
|
||||
toTopLeft cfig
|
||||
$ translate 290 (-1) (ytext midstr)
|
||||
<> translate 160 (-1) (listCursorChooseBorderScale 0 1 [North,South] curpos 0 white 21 1)
|
||||
<> translate 380 (-1) (drawListYoff (curpos - i) (map (text . eqPosText) es))
|
||||
<> translate 380 (-1) (listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length es))
|
||||
<> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length es - (i+1)))
|
||||
<> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i)
|
||||
<> translate 380 (-1) (maybetopborder i curpos)
|
||||
<> translate 380 (-1) (maybebottomborder i (length es) curpos)
|
||||
<> translate 460 (-1) (ytext extrastr)
|
||||
toTopLeft cfig $
|
||||
translate 290 (-1) (ytext midstr)
|
||||
<> translate 160 (-1) (listCursorChooseBorderScale 0 1 [North, South] curpos 0 white 21 1)
|
||||
<> translate
|
||||
380
|
||||
(-1)
|
||||
( drawListYoff (curpos - i) (map (text . eqPosText) es)
|
||||
<> listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length es)
|
||||
<> listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length es - (i + 1))
|
||||
<> listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i
|
||||
<> maybetopborder i curpos
|
||||
<> maybebottomborder i (length es) curpos
|
||||
)
|
||||
<> translate 460 (-1) (ytext extrastr)
|
||||
where
|
||||
maybetopborder 0 curpos= listCursorChooseBorderScale 0 1 [North] curpos 0 white 7 1
|
||||
maybetopborder 0 curpos = listCursorChooseBorderScale 0 1 [North] curpos 0 white 7 1
|
||||
maybetopborder _ _ = mempty
|
||||
maybebottomborder a b curpos
|
||||
| a == b - 1
|
||||
= listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1
|
||||
maybebottomborder a b curpos
|
||||
| a == b - 1 =
|
||||
listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1
|
||||
| otherwise = mempty
|
||||
otheritem j = fromMaybe "" $ do
|
||||
itm <- you w ^? crInv . ix j
|
||||
return $ itemBaseName itm
|
||||
|
||||
examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
|
||||
examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
|
||||
examineInventoryExtra :: Maybe Int -> Configuration -> Picture
|
||||
examineInventoryExtra mtweaki cfig = fromMaybe mempty $ do
|
||||
tweaki <- mtweaki
|
||||
-- consider moving this functionality out into a tweaks module
|
||||
tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
|
||||
--tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
|
||||
return $
|
||||
toTopLeft cfig $
|
||||
translate subInvX (-60) $
|
||||
listCursorNSW tweaki 0 white (length $ showTweak tparam) 15
|
||||
translate subInvX (-71) $
|
||||
--listCursorChooseBorderScale 0 1 [North,South,West] tweaki 0 white (length $ showTweak tparam) 1
|
||||
listCursorChooseBorderScale 0 1 [North, South, West] tweaki 0 white 10 1
|
||||
|
||||
combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
|
||||
combineInventoryExtra sss cfig w = fromMaybe mempty $ do
|
||||
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
|
||||
cpos <- selSecYint i j sss
|
||||
si <- sss ^? sssSections . ix i . ssItems . ix j
|
||||
cpos <- selSecSelPos i j sss
|
||||
let col = _siColor si
|
||||
return $
|
||||
mconcat
|
||||
[ fromMaybe mempty $ do
|
||||
strs <- si ^? siPayload . ciInfo
|
||||
return $ toTopLeft cfig (translate (subInvX + 150) 60 $ drawListYoff cpos $ map (color red . text) strs)
|
||||
return
|
||||
. translate 160 0
|
||||
-- it would be better to get the width of the selection list from elsewhere
|
||||
. translateScreenPos cfig (secondColumnParams ^. ldpPos)
|
||||
$ drawListYoff cpos $ map (color red . text) strs
|
||||
, fromMaybe mempty $ do
|
||||
lnks <- si ^? siPayload . ciInvIDs
|
||||
return $
|
||||
lnkMidPosInvSelsCol cfig w cpos col lnks
|
||||
lnkMidPosInvSelsCol cfig w j col lnks
|
||||
<> foldMap invcursor lnks
|
||||
<> combineCounts cfig w lnks
|
||||
]
|
||||
where
|
||||
invcursor i = fromMaybe mempty $ do
|
||||
sss' <- w ^? hud . hudElement . diSections
|
||||
let idp = invDisplayParams w
|
||||
let idp = (invDisplayParams w & ldpCursorSides .~ [North, South, East, West])
|
||||
return $
|
||||
translateScreenPos cfig (idp ^. ldpPos) $
|
||||
selSecDrawCursor 17 [North, South, East] idp sss' 0 i
|
||||
selSecDrawCursor 17 idp (sss' & sssExtra . sssSelPos ?~ (0, i))
|
||||
|
||||
displayTerminal :: Int -> Configuration -> LWorld -> Picture
|
||||
displayTerminal tid cfig w = fromMaybe mempty $ do
|
||||
@@ -231,9 +240,16 @@ combineCounts cfig w = foldMap f . group
|
||||
f (i : is) = fromMaybe mempty $ do
|
||||
_ <- yourInv w ^? ix i . itUse . useAmount
|
||||
sss <- w ^? hud . hudElement . diSections
|
||||
p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
|
||||
--p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
|
||||
col <- selSecSelCol 0 i sss
|
||||
return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
|
||||
yint <- selSecYint 0 i sss
|
||||
--return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
|
||||
return
|
||||
. translateScreenPos cfig (invDisplayParams w ^. ldpPos)
|
||||
. color col
|
||||
. drawListElement 0 1 15 yint
|
||||
. text
|
||||
$ ('-' : show (length is + 1))
|
||||
f _ = mempty
|
||||
|
||||
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
|
||||
@@ -241,15 +257,14 @@ lnkMidPosInvSelsCol cfig w i col = foldMap f
|
||||
where
|
||||
f j = fromMaybe mempty $ do
|
||||
sss <- w ^? hud . hudElement . diSections
|
||||
h <- selNumEndMidHeight cfig (invDisplayParams w) sss 0 j
|
||||
combinesss <- w ^? hud . hudElement . subInventory . ciSections
|
||||
lp <- selNumPos cfig (invDisplayParams w) sss 0 j
|
||||
rp <- selNumPos cfig secondColumnParams combinesss 0 i
|
||||
invcol <- selSecSelCol 0 j sss
|
||||
return $ zConnectCol rp (V2 18 0 + h) col white white invcol
|
||||
rp = V2 (190 - hw) (hh - (20 * fromIntegral i + 77.5))
|
||||
hh = halfHeight cfig
|
||||
hw = halfWidth cfig
|
||||
return $ zConnectCol (rp - V2 5 0) (lp + V2 175 0) col white white invcol
|
||||
|
||||
ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()]
|
||||
ammoTweakSelectionItems = textSelItems . ammoTweakStrings
|
||||
tweakItems :: Maybe Item -> [SelectionItem ()]
|
||||
tweakItems = textSelItems . ammoTweakStrings
|
||||
|
||||
ammoTweakStrings :: Maybe Item -> [String]
|
||||
ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of
|
||||
@@ -261,7 +276,7 @@ tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
|
||||
|
||||
invHead :: Configuration -> String -> Picture
|
||||
invHead cfig =
|
||||
translateScreenPos cfig (fromTopLeft (V2 subInvX 80))
|
||||
translateScreenPos cfig (fromTopLeft (V2 (subInvX - 5) 80))
|
||||
. dShadCol white
|
||||
. scale 0.4 0.4
|
||||
. textJustifyLeft
|
||||
@@ -323,34 +338,22 @@ picsToSelectable pics =
|
||||
, _siPayload = ()
|
||||
}
|
||||
|
||||
-- there are still more ListDisplayParams to integrate here
|
||||
selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
|
||||
selNumTextEndPos cfig ldp sss i j = do
|
||||
ipos <- selSecSelPos i j sss
|
||||
return $ V2 (150 - hw) (hh - ((s * 10 + ygap) * (fromIntegral ipos + 1)))
|
||||
where
|
||||
s = _ldpScale ldp
|
||||
ygap = _ldpVerticalGap ldp
|
||||
hh = halfHeight cfig
|
||||
hw = halfWidth cfig
|
||||
|
||||
selNumEndMidHeight ::
|
||||
selNumPos ::
|
||||
Configuration ->
|
||||
ListDisplayParams ->
|
||||
SelectionSections a ->
|
||||
Int ->
|
||||
Int ->
|
||||
Maybe Point2
|
||||
selNumEndMidHeight cfig ldp sss i j = do
|
||||
ipos <- selSecSelPos i j sss
|
||||
selNumPos cfig ldp sss i j = do
|
||||
ipos <- selSecYint i j sss
|
||||
size <- selSecSelSize i j sss
|
||||
--let bump = negate $ (10 * s + ygap) * fromIntegral size
|
||||
return $ V2 (150 - hw) (hh - ((10 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5)))
|
||||
return $
|
||||
screenPosAbs cfig (ldp ^. ldpPos)
|
||||
+ V2 0 (negate (20 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5))
|
||||
where
|
||||
s = _ldpScale ldp
|
||||
ygap = _ldpVerticalGap ldp
|
||||
hh = halfHeight cfig
|
||||
hw = halfWidth cfig
|
||||
|
||||
selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
|
||||
selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor
|
||||
|
||||
Reference in New Issue
Block a user