justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Tweak display when equiping

Browse Source
This commit is contained in:
justin
2023-05-12 00:48:07 +01:00
parent 6081f90f90
commit 2d32eeb266
5 changed files with 57 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Display.hs
+1
View File
@@ -2,6 +2,7 @@ module Dodge.Item.Display (
itemDisplay,
selectedItemDisplay,
itemString,
itemBaseName,
) where
import Data.Maybe
src/Dodge/ListDisplayParams.hs
+1 -2
View File
@@ -43,7 +43,7 @@ invDisplayParams w =
secondColumnParams :: ListDisplayParams
secondColumnParams =
defaultListDisplayParams
& ldpPos . spPixelOff .~ V2 subInvX (-61)
& ldpPos . spPixelOff .~ V2 subInvX (-71)
& ldpCursorSides .~ [North, South, West]
subInvX :: Float
@@ -73,4 +73,3 @@ optionListDisplayParams =
& ldpVerticalGap .~ 0
& ldpWidth .~ FixedSelectionWidth 50
& ldpCursorSides .~ [North, South, West]
src/Dodge/Render/HUD.hs
+49 -39
View File
@@ -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))
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 []
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} ->
midtext "MOVE TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp)
"SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp
ReplaceEquipment{_allocRemoveID = rid} ->
midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
RemoveEquipment{} ->
midtext "TAKE OFF"
"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)
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
src/Dodge/Render/List.hs
+1
View File
@@ -10,6 +10,7 @@ module Dodge.Render.List (
drawListYoff,
stackPicturesAt,
toTopLeft,
listCursorChooseBorderScale ,
) where
import Dodge.ScreenPos
src/Dodge/TestString.hs
+4 -3
View File
@@ -18,9 +18,10 @@ import Dodge.Data.Universe
--import qualified Data.Map.Strict as M
--import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u = getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys)
<> ["---"]
<> getPrettyShort ( u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInvHotkeys)
testStringInit _ = mempty
-- getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys)
-- <> ["---"]
-- <> getPrettyShort ( u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInvHotkeys)
-- [show $ u ^. uvWorld . input . smoothScrollAmount
-- , show $ getSmoothScrollValue (u ^. uvWorld . input)