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/Creature/Impulse/UseItem.hs
+6 -17
View File
@@ -2,8 +2,10 @@ module Dodge.Creature.Impulse.UseItem (
useItem,
doTopInvLeftClick,
itemEffect,
tryUseL,
) where
import Dodge.Hotkey
import Control.Lens
import Control.Monad
import Data.Foldable
@@ -50,7 +52,6 @@ itemEffect cr it w = case it ^. itUse of
setuhamdown $
hammerTest
( toggleEquipmentAt (_rbOptions w) itRef cr
. activateEquipmentAt (_rbOptions w) cr
)
tryReload :: Creature -> Item -> Input -> (World -> World) -> World -> World
@@ -68,13 +69,6 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic)
where
ic = _heldConsumption (_itUse it)
activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
activateEquipmentAt rbo cr =
cWorld . lWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
(Just i, _) -> crLeftInvSel . lisMPos ?~ i
(_, Just _) -> crLeftInvSel . lisMPos .~ Nothing
_ -> id
toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
Just DoNotMoveEquipment -> w
@@ -83,6 +77,7 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp
& onequip itm cr
& assignNewHotkey invid
Just MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
w
& crpoint . crEquipment . at newp ?~ invid
@@ -101,11 +96,14 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
& crpoint . crInvEquipped . at rid .~ Nothing
& onremove (itmat rid) cr
& onequip itm cr
& crpoint %~ removeHotkey rid
& assignNewHotkey invid
Just RemoveEquipment{_allocOldPos = oldp} ->
w
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid .~ Nothing
& onremove itm cr
& crpoint %~ removeHotkey invid
Nothing -> error "tried to toggle equipment when not prepared"
where
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
@@ -118,10 +116,6 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
doTopInvLeftClick :: Creature -> World -> World
doTopInvLeftClick cr w = fromMaybe w $ do
guard . not $ _crInvLock cr
return $ doTopInvLeftClick' cr w
doTopInvLeftClick' :: Creature -> World -> World
doTopInvLeftClick' cr w = fromMaybe (doTopInvLeftClickSearch cr w) $ do
invid <- cr ^? crManipulation . manObject . inInventory . ispItem
ituse <- cr ^? crInv . ix invid . itUse
case ituse of
@@ -136,11 +130,6 @@ equipAndUse useonequip invid cr w = case cr ^? crInvEquipped . ix invid of
| otherwise -> useItem cr w
_ -> tryUseL (_crID cr) invid w
doTopInvLeftClickSearch :: Creature -> World -> World
doTopInvLeftClickSearch cr w = fromMaybe w $ do
invid <- cr ^. crLeftInvSel . lisMPos
return $ tryUseL (_crID cr) invid w
tryUseL :: Int -> Int -> World -> World
tryUseL crid invid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid
src/Dodge/Creature/ReaderUpdate.hs
+2 -2
View File
@@ -56,7 +56,7 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
mtpos = do
tpos <- _crPos <$> _targetCr int
guard $ hasLOSIndirect (_crPos cr) tpos w
return $ tpos
return tpos
mpos = mtpos <|> _mvToPoint int
setViewPos :: World -> Creature -> Creature
@@ -67,7 +67,7 @@ setViewPos w cr = cr & crIntention . viewPoint %~ ((<|> mpos) . (attentionViewPo
attentionViewPoint :: World -> Creature -> Maybe Point2
attentionViewPoint w cr = do
attention <- cr ^? crPerception . cpAttention . getAttentiveTo
cid <- (sortOn snd $ IM.toList attention) ^? ix 0 . _1
cid <- sortOn snd (IM.toList attention) ^? ix 0 . _1
tcr <- w ^? cWorld . lWorld . creatures . ix cid
guard $ visionCheck cr (_crPos tcr) > 0
return (_crPos tcr)
src/Dodge/Creature/YourControl.hs
+73 -17
View File
@@ -2,16 +2,19 @@ module Dodge.Creature.YourControl (
yourControl,
) where
import Dodge.WASD
import Dodge.Base.You
import Dodge.Creature.Impulse.UseItem
import Dodge.Hotkey
import Control.Monad
import Data.Foldable
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Base.You
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Test
import Dodge.Data.World
import Dodge.InputFocus
import Dodge.WASD
import Geometry
import LensHelp
import qualified SDL
@@ -20,13 +23,15 @@ import qualified SDL
yourControl :: Creature -> World -> World
yourControl cr w
| inInputFocus w = w
| not intopinv = w & cWorld . lWorld . creatures . ix (_crID cr)
%~ wasdWithAiming w (_mvSpeed $ _crMvType cr)
| not intopinv =
w & cWorld . lWorld . creatures . ix (_crID cr)
%~ wasdWithAiming w (_mvSpeed $ _crMvType cr)
| otherwise =
w
& cWorld . lWorld . creatures . ix (_crID cr)
%~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w)))
& pressedMBEffectsTopInventory pkeys
& handleHotkeys
where
pkeys = w ^. input . mouseButtons
intopinv = fromMaybe False $ do
@@ -35,12 +40,60 @@ yourControl cr w
NoSubInventory -> True
_ -> False
--dimCreatureLight :: Creature -> World -> World
--dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
handleHotkeys :: World -> World
handleHotkeys w
| SDL.ButtonRight `M.member` _mouseButtons (_input w) = foldl' tryAssignHotkey w allHotkeys
| otherwise = foldl' useHotKey w (M.intersection hotkeys (w ^. input . pressedKeys))
where
hotkeys = M.mapKeys hotkeyToScancode $ w ^?! cWorld . lWorld . creatures . ix 0 . crHotkeys
-- note the order of operation, setting the posture first--this prevents the twist fire bug
useHotKey :: World -> Int -> World
useHotKey w invid = tryUseL 0 invid w
allHotkeys :: [SDL.Scancode]
allHotkeys = map hotkeyToScancode [minBound .. maxBound]
hotkeyToScancode :: Hotkey -> SDL.Scancode
hotkeyToScancode x = case x of
HotkeyQ -> SDL.ScancodeQ
HotkeyE -> SDL.ScancodeE
Hotkey1 -> SDL.Scancode1
Hotkey2 -> SDL.Scancode2
Hotkey3 -> SDL.Scancode3
Hotkey4 -> SDL.Scancode4
Hotkey5 -> SDL.Scancode5
Hotkey6 -> SDL.Scancode6
Hotkey7 -> SDL.Scancode7
Hotkey8 -> SDL.Scancode8
Hotkey9 -> SDL.Scancode9
Hotkey0 -> SDL.Scancode0
scancodeToHotkey :: SDL.Scancode -> Hotkey
scancodeToHotkey x = case x of
SDL.ScancodeQ -> HotkeyQ
SDL.ScancodeE -> HotkeyE
SDL.Scancode1 -> Hotkey1
SDL.Scancode2 -> Hotkey2
SDL.Scancode3 -> Hotkey3
SDL.Scancode4 -> Hotkey4
SDL.Scancode5 -> Hotkey5
SDL.Scancode6 -> Hotkey6
SDL.Scancode7 -> Hotkey7
SDL.Scancode8 -> Hotkey8
SDL.Scancode9 -> Hotkey9
SDL.Scancode0 -> Hotkey0
_ -> undefined
tryAssignHotkey :: World -> SDL.Scancode -> World
tryAssignHotkey w sc = fromMaybe w $ do
pt <- w ^? input . pressedKeys . ix sc
guard (pt == InitialPress)
cr <- w ^? cWorld . lWorld . creatures . ix 0
itid <- cr ^? crManipulation . manObject . inInventory . ispItem
return $ assignHotkey itid (scancodeToHotkey sc) w
-- | Turn key presses into creature movement.
-- | note the order of operation, setting the posture first--this prevents the twist fire bug
wasdWithAiming ::
World ->
-- | Base speed
@@ -63,9 +116,11 @@ wasdWithAiming w speed cr
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
let currenttwistamount = cr ^. crTwist
case (astance,currenttwistamount) of
( TwoHandTwist, 0) -> return $ (crTwist .~ twistamount * pi)
. (crDir -~ twistamount * pi)
case (astance, currenttwistamount) of
(TwoHandTwist, 0) ->
return $
(crTwist .~ twistamount * pi)
. (crDir -~ twistamount * pi)
_ -> Nothing
theMovement
| movDir == V2 0 0 = id
@@ -78,8 +133,8 @@ wasdWithAiming w speed cr
dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir)
movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = fromMaybe
(argV (_mousePos (_input w)) + (w ^. wCam . camRot) )
mouseDir = fromMaybe
(argV (_mousePos (_input w)) + (w ^. wCam . camRot))
$ do
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
_ <- cr ^? crInv . ix itRef . itScope . scopePos
@@ -92,7 +147,6 @@ aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
-- | Set posture according to mouse presses.
mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature
mouseActionsCr pkeys cr
@@ -114,10 +168,12 @@ pressedMBEffectsTopInventory pkeys w
| otherwise = w
where
inTopInv = case w ^. hud . hudElement of
DisplayInventory {_subInventory = NoSubInventory} -> True
DisplayInventory{_subInventory = NoSubInventory} -> True
_ -> False
isDown but = but `M.member` pkeys
theinput = w ^. input
rotation = maybe 0
(angleBetween (theinput ^. mousePos))
(theinput ^. heldPos . at SDL.ButtonMiddle)
rotation =
maybe
0
(angleBetween (theinput ^. mousePos))
(theinput ^. heldPos . at SDL.ButtonMiddle)
src/Dodge/Data/Creature.hs
+1 -1
View File
@@ -56,7 +56,7 @@ data Creature = Creature
, _crInvLock :: Bool
, _crInvEquipped :: IM.IntMap EquipPosition
, _crEquipment :: M.Map EquipPosition Int
, _crLeftInvSel :: LeftInvSel
-- , _crLeftInvSel :: LeftInvSel
, _crInvHotkeys :: IM.IntMap Hotkey
, _crHotkeys :: M.Map Hotkey Int
, _crState :: CreatureState
src/Dodge/Data/Equipment/Misc.hs
+6
View File
@@ -33,6 +33,12 @@ data Hotkey = HotkeyQ
| Hotkey2
| Hotkey3
| Hotkey4
| Hotkey5
| Hotkey6
| Hotkey7
| Hotkey8
| Hotkey9
| Hotkey0
deriving (Eq, Show, Read, Ord, Bounded, Enum) --Generic, Flat)
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
-7
View File
@@ -27,7 +27,6 @@ data Manipulation -- should be ManipulatedObject?
data ManipulatedObject
= InInventory {_inInventory :: InventoryManipulation}
| SelNothing
-- | SelCloseObject {_ispCloseObject :: Int}
| InNearby {_inNearby :: NearbyManipulation}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -46,16 +45,11 @@ data InvSelAction
| ReloadAction {_actionProgress :: Int, _reloadAction :: LoadAction}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data LeftInvSel = LeftInvSel
{ _lisMPos :: Maybe Int
}
makeLenses ''LoadAction
makeLenses ''ManipulatedObject
makeLenses ''Manipulation
makeLenses ''InventoryManipulation
makeLenses ''NearbyManipulation
makeLenses ''LeftInvSel
makeLenses ''InvSelAction
deriveJSON defaultOptions ''LoadAction
deriveJSON defaultOptions ''InvSelAction
@@ -63,4 +57,3 @@ deriveJSON defaultOptions ''InventoryManipulation
deriveJSON defaultOptions ''NearbyManipulation
deriveJSON defaultOptions ''ManipulatedObject
deriveJSON defaultOptions ''Manipulation
deriveJSON defaultOptions ''LeftInvSel
src/Dodge/Default/Creature.hs
-1
View File
@@ -30,7 +30,6 @@ defaultCreature =
, _crManipulation = Manipulator SelNothing
, _crInvCapacity = 25
, _crInvLock = False
, _crLeftInvSel = LeftInvSel Nothing
, _crState = defaultState
, _crCorpse = MakeDefaultCorpse
, _crMaterial = Flesh
src/Dodge/Inventory.hs
+73 -59
View File
@@ -51,13 +51,21 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
_ ->
w
& pointcid %~ crCancelReloading
& removeAnySlotEquipment -- the ordering
& dounequipfunction -- of these is
& pointcid . crInv %~ f -- important
& pointcid . crLeftInvSel . lisMPos %~ g'
& doanyitemeffect
& dounequipfunction --the ordering of these is
& pointcid . crInv %~ f -- important
-- & pointcid . crLeftInvSel . lisMPos %~ g'
& removeAnySlotEquipment
& pointcid . crEquipment . each %~ g
& pointcid . crInvEquipped %~ IM.delete invid
& pointcid . crInvEquipped %~ IM.mapKeys g
& removeanyactivation
& pointcid . crHotkeys . each %~ g
& pointcid . crInvHotkeys %~ IM.delete invid
& pointcid . crInvHotkeys %~ IM.mapKeys g
& updateselection
& worldEventFlags . at InventoryChange ?~ ()
where
@@ -81,6 +89,9 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
removeAnySlotEquipment = fromMaybe id $ do
epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid
return $ pointcid . crEquipment . at epos .~ Nothing
removeanyactivation = fromMaybe id $ do
epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvHotkeys . ix invid
return $ pointcid . crHotkeys . at epos .~ Nothing
maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
f inv =
let (xs, ys) = IM.split invid inv
@@ -89,11 +100,11 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
g x
| x > invid || Just x == maxk = max 0 $ x - 1
| otherwise = x
g' Nothing = Nothing
g' (Just x)
| x == invid = Nothing
| x > invid || Just x == maxk = Just $ max 0 $ x - 1
| otherwise = Just x
-- g' Nothing = Nothing
-- g' (Just x)
-- | x == invid = Nothing
-- | x > invid || Just x == maxk = Just $ max 0 $ x - 1
-- | otherwise = Just x
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem of
@@ -131,7 +142,7 @@ updateCloseObjects w =
updateRBList :: World -> World
updateRBList w
| w ^? rbOptions . opItemID == mcurrentitemid =
w & setEquipAllocationActivation
w & setEquipAllocation
| otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
@@ -146,7 +157,7 @@ updateRBList w
, _opAllocateEquipment = DoNotMoveEquipment
, _opActivateEquipment = NoChangeActivateEquipment
}
& setEquipAllocationActivation
& setEquipAllocation
where
mcurrentitemid = do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
@@ -164,9 +175,6 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
where
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
setEquipAllocationActivation :: World -> World
setEquipAllocationActivation = setEquipActivation . setEquipAllocation
setEquipAllocation :: World -> World
setEquipAllocation w = fromMaybe w $ do
curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
@@ -196,46 +204,46 @@ setEquipAllocation w = fromMaybe w $ do
}
Nothing -> PutOnEquipment{_allocNewPos = es}
setEquipActivation :: World -> World
setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
Just DoNotMoveEquipment -> w
Just RemoveEquipment{} ->
case you w ^. crLeftInvSel . lisMPos of
Just i
| Just i == minvsel ->
w & rbOptions . opActivateEquipment
.~ DeactivateEquipment
{ _deactivateEquipment = i
}
_ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just rbos ->
case you w ^. crLeftInvSel . lisMPos of
Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just i
| invselcanactivate ->
w & rbOptions . opActivateEquipment
.~ ActivateDeactivateEquipment
{ _activateEquipment = fromJust minvsel
, _deactivateEquipment = i
}
Just i
| Just i == rbos ^? allocRemoveID ->
w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing
| invselcanactivate ->
w & rbOptions . opActivateEquipment
.~ ActivateEquipment
{ _activateEquipment = fromJust minvsel
}
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
where
minvsel = cr ^? crManipulation . manObject . inInventory . ispItem
cr = you w
invselcanactivate = isJust $ do
i <- minvsel
return $ cr ^? crInv . ix i . itUse . leftUse
--setEquipActivation :: World -> World
--setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
-- Just DoNotMoveEquipment -> w
-- Just RemoveEquipment{} ->
-- case you w ^. crLeftInvSel . lisMPos of
-- Just i
-- | Just i == minvsel ->
-- w & rbOptions . opActivateEquipment
-- .~ DeactivateEquipment
-- { _deactivateEquipment = i
-- }
-- _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-- Just rbos ->
-- case you w ^. crLeftInvSel . lisMPos of
-- Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-- Just i
-- | invselcanactivate ->
-- w & rbOptions . opActivateEquipment
-- .~ ActivateDeactivateEquipment
-- { _activateEquipment = fromJust minvsel
-- , _deactivateEquipment = i
-- }
-- Just i
-- | Just i == rbos ^? allocRemoveID ->
-- w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
-- Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-- Nothing
-- | invselcanactivate ->
-- w & rbOptions . opActivateEquipment
-- .~ ActivateEquipment
-- { _activateEquipment = fromJust minvsel
-- }
-- Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-- Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-- where
-- minvsel = cr ^? crManipulation . manObject . inInventory . ispItem
-- cr = you w
-- invselcanactivate = isJust $ do
-- i <- minvsel
-- return $ cr ^? crInv . ix i . itUse . leftUse
equipSiteToPositions :: EquipSite -> [EquipPosition]
equipSiteToPositions es = case es of
@@ -288,21 +296,27 @@ changeSwapInv f i w = fromMaybe w $ do
& hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
& worldEventFlags . at InventoryChange ?~ ()
where
updateLeftInvSel k li
| i == li = k
| k == li = i
| otherwise = li
-- updateLeftInvSel k li
-- | i == li = k
-- | k == li = i
-- | otherwise = li
updatecreature k =
(crInv %~ IM.safeSwapKeys i k)
. (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k)
-- . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k)
. (crManipulation . manObject . inInventory . ispItem .~ k)
. (crInvEquipped %~ IM.safeSwapKeys i k)
. swapSite i k
. swapSite k i
. (crInvHotkeys %~ IM.safeSwapKeys i k)
. swapSite' i k
. swapSite' k i
cr = you w
swapSite a b = case cr ^? crInvEquipped . ix a of
Just epos -> crEquipment . ix epos .~ b
Nothing -> id
swapSite' a b = case cr ^? crInvHotkeys . ix a of
Just epos -> crHotkeys . ix epos .~ b
Nothing -> id
changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
changeSwapWith f w = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of
src/Dodge/Inventory/SelectionList.hs
+19 -1
View File
@@ -3,6 +3,7 @@ module Dodge.Inventory.SelectionList (
closeObjectToSelectionItem,
) where
import Dodge.Equipment.Text
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Item.SlotsTaken
@@ -13,7 +14,7 @@ import Picture.Base
invSelectionItem :: Creature -> Int -> Item -> SelectionItem ()
invSelectionItem cr i it =
SelectionItem
{ _siPictures = pics
{ _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
, _siHeight = length pics
, _siIsSelectable = True
, _siColor = col
@@ -21,12 +22,29 @@ invSelectionItem cr i it =
, _siPayload = ()
}
where
anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
anyequippos = maybe [] ((' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
col = _itInvColor it
pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
UndroppableIdentified -> itemDisplay it
_ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it
_ -> itemDisplay it
hotkeyToString :: Hotkey -> String
hotkeyToString x = case x of
HotkeyQ -> "[Q]"
HotkeyE -> "[E]"
Hotkey1 -> "[1]"
Hotkey2 -> "[2]"
Hotkey3 -> "[3]"
Hotkey4 -> "[4]"
Hotkey5 -> "[5]"
Hotkey6 -> "[6]"
Hotkey7 -> "[7]"
Hotkey8 -> "[8]"
Hotkey9 -> "[9]"
Hotkey0 -> "[0]"
closeObjectToSelectionItem :: Either FloorItem Button -> SelectionItem ()
closeObjectToSelectionItem e =
SelectionItem
src/Dodge/ItEffect.hs
+2 -1
View File
@@ -1,5 +1,6 @@
module Dodge.ItEffect where
import qualified IntMapHelp as IM
import Control.Lens
import Dodge.Data.World
import Dodge.Euse
@@ -49,7 +50,7 @@ chargeIfInInventory itm cr w =
chargeIfEquipped :: Item -> Creature -> World -> World
chargeIfEquipped itm cr
| Just invid == cr ^. crLeftInvSel . lisMPos =
| invid `IM.member` (cr ^. crInvHotkeys) =
ptrWpCharge %~ (min maxcharge . (+ 1))
| otherwise = ptrWpCharge .~ 0
where
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
src/Dodge/Terminal.hs
+1 -1
View File
@@ -262,7 +262,7 @@ commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
makeTermPara ("Expects " ++ argtype ++ " as an argument")
| otherwise =
TerminalLineTerminalEffect 0 (TmTmSetPartialCommand Nothing) :
makeTermPara ("No argument input, cancelling")
makeTermPara "No argument input, cancelling"
in Just $
fromMaybe setpartial $
safeHead args >>= (m M.!?)
src/Dodge/TestString.hs
+8 -4
View File
@@ -18,10 +18,14 @@ import Dodge.Data.Universe
--import qualified Data.Map.Strict as M
--import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u = [show $ u ^. uvWorld . input . smoothScrollAmount
, show $ getSmoothScrollValue (u ^. uvWorld . input)
, show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY)
]
testStringInit u = 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)
-- , show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY)
-- ]
-- [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . wCam)
-- (u ^. uvWorld . cWorld . lWorld)
-- , show a