Tweak display when equiping
This commit is contained in:
+50
-40
@@ -3,8 +3,7 @@ module Dodge.Render.HUD (
|
||||
drawHUD,
|
||||
) where
|
||||
|
||||
import Dodge.Render.HUD.Carte
|
||||
import Dodge.ScreenPos
|
||||
import Dodge.Item.Display
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import qualified Data.Map.Strict as M
|
||||
@@ -24,7 +23,9 @@ import Dodge.Inventory
|
||||
import Dodge.Item.Info
|
||||
import Dodge.ListDisplayParams
|
||||
import Dodge.Render.Connectors
|
||||
import Dodge.Render.HUD.Carte
|
||||
import Dodge.Render.List
|
||||
import Dodge.ScreenPos
|
||||
import Dodge.SelectionSections
|
||||
import Dodge.SelectionSections.Draw
|
||||
import Dodge.Tweak.Show
|
||||
@@ -45,7 +46,13 @@ drawHUD cfig w = case w ^. hud . hudElement of
|
||||
<> drawSubInventory subinv cfig w
|
||||
|
||||
drawHP :: Configuration -> World -> Picture
|
||||
drawHP cfig = dShadCol white . displayHP 0 cfig
|
||||
drawHP cfig =
|
||||
dShadCol white
|
||||
. translate (halfWidth cfig) (halfHeight cfig - 40)
|
||||
. scale 0.2 0.2
|
||||
. textRight
|
||||
. show
|
||||
. (^?! cWorld . lWorld . creatures . ix 0 . crHP)
|
||||
|
||||
drawInventory :: SelectionSections () -> World -> Configuration -> Picture
|
||||
drawInventory sss = drawSelectionSections sss . invDisplayParams
|
||||
@@ -121,35 +128,51 @@ drawRBOptions cfig w = fromMaybe mempty $ do
|
||||
sss <- w ^? hud . hudElement . diSections
|
||||
(i', j) <- sss ^? sssExtra . sssSelPos . _Just
|
||||
curpos <- selSecSelPos i' j sss
|
||||
let midtext str = toTopLeft cfig $ translate 252 0 $ drawListElement 10 1 curpos (text str)
|
||||
let extratext str = toTopLeft cfig $ translate 432 0 $ drawListElement 10 1 curpos (text (str ++ deactivatetext))
|
||||
let ytext = drawListElement 0 1 curpos . text
|
||||
midstr = case ae of
|
||||
DoNotMoveEquipment -> ""
|
||||
PutOnEquipment{} -> " PUT ON"
|
||||
MoveEquipment{} -> " MOVE TO"
|
||||
SwapEquipment{} -> " MOVE TO"
|
||||
ReplaceEquipment{} -> " PUT ON"
|
||||
RemoveEquipment{} -> "TAKE OFF"
|
||||
extrastr = case ae of
|
||||
SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
|
||||
"SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp
|
||||
ReplaceEquipment{_allocRemoveID = rid} ->
|
||||
"REMOVES " ++ otheritem rid
|
||||
_ -> ""
|
||||
return $
|
||||
toTopLeft cfig (translate 342 0 $ drawListYoff (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"
|
||||
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)
|
||||
where
|
||||
deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
|
||||
Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
|
||||
Nothing -> ""
|
||||
otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)
|
||||
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
|
||||
| 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
|
||||
tweaki <- mtweaki
|
||||
-- consider moving this functionality out into a tweaks module
|
||||
tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
|
||||
return $ toTopLeft cfig $ translate subInvX (-60)
|
||||
$ listCursorNSW tweaki 0 white (length $ showTweak tparam) 15
|
||||
return $
|
||||
toTopLeft cfig $
|
||||
translate subInvX (-60) $
|
||||
listCursorNSW tweaki 0 white (length $ showTweak tparam) 15
|
||||
|
||||
combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
|
||||
combineInventoryExtra sss cfig w = fromMaybe mempty $ do
|
||||
@@ -173,8 +196,9 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
|
||||
invcursor i = fromMaybe mempty $ do
|
||||
sss' <- w ^? hud . hudElement . diSections
|
||||
let idp = invDisplayParams w
|
||||
return $ translateScreenPos cfig (idp ^. ldpPos)
|
||||
$ selSecDrawCursor 17 [North, South, East] idp sss' 0 i
|
||||
return $
|
||||
translateScreenPos cfig (idp ^. ldpPos) $
|
||||
selSecDrawCursor 17 [North, South, East] idp sss' 0 i
|
||||
|
||||
displayTerminal :: Int -> Configuration -> LWorld -> Picture
|
||||
displayTerminal tid cfig w = fromMaybe mempty $ do
|
||||
@@ -238,12 +262,10 @@ tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
|
||||
invHead :: Configuration -> String -> Picture
|
||||
invHead cfig =
|
||||
translateScreenPos cfig (fromTopLeft (V2 subInvX 80))
|
||||
-- (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 80)
|
||||
. dShadCol white
|
||||
. scale 0.4 0.4
|
||||
. textJustifyLeft
|
||||
|
||||
|
||||
--locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
|
||||
--locTexts = map fst locs
|
||||
|
||||
@@ -255,7 +277,6 @@ invHead cfig =
|
||||
-- h :: String -> Point2 -> Point2
|
||||
-- h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
|
||||
|
||||
|
||||
--selectedCloseObjectLink :: Configuration -> World -> Picture
|
||||
--selectedCloseObjectLink cfig w = mempty
|
||||
|
||||
@@ -288,7 +309,6 @@ invHead cfig =
|
||||
-- ( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5)
|
||||
-- return . winScale cfig . color col $ lConnect p itScreenPos
|
||||
|
||||
|
||||
textSelItems :: [String] -> [SelectionItem ()]
|
||||
textSelItems = map (picsToSelectable . (: []))
|
||||
|
||||
@@ -303,16 +323,6 @@ picsToSelectable pics =
|
||||
, _siPayload = ()
|
||||
}
|
||||
|
||||
|
||||
|
||||
displayHP :: Int -> Configuration -> World -> Picture
|
||||
displayHP cid cfig =
|
||||
translate (halfWidth cfig) (halfHeight cfig -40)
|
||||
. scale 0.2 0.2
|
||||
. textRight
|
||||
. show
|
||||
. (^?! cWorld . lWorld . creatures . ix cid . crHP)
|
||||
|
||||
-- there are still more ListDisplayParams to integrate here
|
||||
selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
|
||||
selNumTextEndPos cfig ldp sss i j = do
|
||||
|
||||
@@ -10,6 +10,7 @@ module Dodge.Render.List (
|
||||
drawListYoff,
|
||||
stackPicturesAt,
|
||||
toTopLeft,
|
||||
listCursorChooseBorderScale ,
|
||||
) where
|
||||
|
||||
import Dodge.ScreenPos
|
||||
|
||||
Reference in New Issue
Block a user