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

Cleanup, stop assigning hotkeys to unequipped items

Browse Source
This commit is contained in:
justin
2023-05-05 01:59:40 +01:00
parent aeefbd4c40
commit 031af611cd
13 changed files with 227 additions and 215 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+36 -104
View File
@@ -3,9 +3,8 @@ module Dodge.Render.HUD (
drawHUD,
) where
import Dodge.SelectionSections
import Control.Lens
import Data.Foldable
import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Vector as V
@@ -18,11 +17,13 @@ import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Default.SelectionList
import Dodge.Equipment.Text
import Dodge.Inventory
import Dodge.Item.Info
import Dodge.ListDisplayParams
import Dodge.Render.Connectors
import Dodge.Render.List
import Dodge.SelectionSections
import Dodge.SelectionSections.Draw
import Dodge.Tweak.Show
import Geometry
@@ -50,7 +51,7 @@ drawInventory sss = drawSelectionSections sss . invDisplayParams
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
NoSubInventory -> drawNoSubInventory cfig w
NoSubInventory -> drawRBOptions cfig w
ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
@@ -109,30 +110,36 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
Just (InNearby (SelCloseObject i)) -> g $ w ^?! hud . closeObjects . ix i
_ -> x
drawNoSubInventory :: Configuration -> World -> Picture
drawNoSubInventory cfig w =
fold
[ equipcursors
, equipcursor -- the order is important, this should go on top of the other equipcursors
, rboptions
]
drawRBOptions :: Configuration -> World -> Picture
drawRBOptions cfig w = fromMaybe mempty $ do
guard $ ButtonRight `M.member` _mouseButtons (_input w)
es <- w ^? rbOptions . opEquip
i <- w ^? rbOptions . opSel
ae <- w ^? rbOptions . opAllocateEquipment
sss <- w ^? hud . hudElement . diSections
(i', j) <- sss ^? sssExtra . sssSelPos . _Just
curpos <- selSecSelPos i' j sss
let midtext str = listTextPictureAt 252 0 cfig curpos (text str)
let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
return $
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
equipcursor = fromMaybe mempty $ do
invid <- cr ^. crLeftInvSel . lisMPos
sss <- w ^? hud . hudElement . diSections
pos <- selSecSelPos 0 invid sss
return $
listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $
_crInvEquipped cr IM.! invid
f col invid epos = fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections
pos <- selSecSelPos 0 invid sss
return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
cr = you w
rboptions
| ButtonRight `M.member` _mouseButtons (_input w) = drawRBOptions cfig w (_rbOptions w)
| otherwise = mempty
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)
examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
@@ -148,7 +155,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
cpos <- selSecSelPos i j sss
let col = _siColor si
return $
pictures
mconcat
[ fromMaybe mempty $ do
strs <- si ^? siPayload . ciInfo
return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
@@ -164,42 +171,6 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
sss' <- w ^? hud . hudElement . diSections
return $ selSecDrawCursor 17 [North, South, East] cfig (invDisplayParams w) sss' 0 i
-- fromMaybe mempty $ do
-- i <- mi
-- let cpos = getIthPos i (sm ^. smShownItems)
-- col <- sm ^? smShownItems . ix i . siColor
-- return $
-- pictures
-- [ fromMaybe mempty $ do
-- strs <- sm ^? smShownItems . ix i . siPayload . ciInfo
-- return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
-- , fromMaybe mempty $ do
-- lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs
-- return $
-- lnkMidPosInvSelsCol cfig w cpos col lnks
-- -- <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
-- <> foldMap invcursor lnks
-- <> combineCounts cfig w lnks
-- ]
-- where
-- invcursor i = fromMaybe mempty $ do
-- sss <- w ^? hud . hudElement . diSections
-- return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss 0 i
--thirdColumnPara :: [String] -> SelectionList ()
--thirdColumnPara strs = SelectionList (map f strs) Nothing (length strs)
-- where
-- f str =
-- SelectionItem
-- { _siPictures = [text str]
-- , _siHeight = 1
-- , _siIsSelectable = True
-- , _siWidth = length str
-- , _siColor = white
-- , _siOffX = 0
-- , _siPayload = ()
-- }
displayTerminal :: Int -> Configuration -> LWorld -> Picture
displayTerminal tid cfig w = fromMaybe mempty $ do
tm <- w ^? terminals . ix tid
@@ -215,8 +186,8 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
. take (_tmMaxLines tm)
$ _tmDisplayedLines tm
displayTermInput tm = case _tmInput tm of
TerminalInput {_tiText = s, _tiFocus = hasfoc}
-> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
TerminalInput{_tiText = s, _tiFocus = hasfoc} ->
(++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
displayInputText tm s
| _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s
@@ -225,45 +196,6 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
| hasfoc = clockCycle 10 (V.fromList ["_", "."]) w
| otherwise = []
drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} =
fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections
(i', j) <- sss ^? sssExtra . sssSelPos . _Just
curpos <- selSecSelPos i' j sss
let midtext str = listTextPictureAt 252 0 cfig curpos (text str)
let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
return $
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
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)
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"
combineCounts :: Configuration -> World -> [Int] -> Picture
combineCounts cfig w = foldMap f . group
where