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

Allow for selection of equipment position

Browse Source
This commit is contained in:
justin
2022-05-24 14:03:18 +01:00
parent fa82923a12
commit 7f55ba117f
14 changed files with 221 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+37 -18
View File
@@ -22,8 +22,10 @@ itemEffect :: Creature -> Item -> World -> World
itemEffect cr it w = case it ^? itUse of
Just RightUse {_rUse = eff,_useMods = usemods}
-> hammerTest $ foldr ($) eff usemods it cr
Just LeftUse {} -> setuhamdown $ lhammer (setEquipLeftItem)
Just EquipUse{} -> setuhamdown $ lhammer $ toggleEquipmentAt (_crInvSel cr) it
Just LeftUse {} -> setuhamdown $ lhammer $ (toggleEquipmentAt (_rbOptions w) (_crInvSel cr)
. activateEquipmentAt (_rbOptions w))
Just EquipUse{} -> setuhamdown $ lhammer $ (toggleEquipmentAt (_rbOptions w) (_crInvSel cr)
. activateEquipmentAt (_rbOptions w))
-- ConsumeUse will cause problems if the item is not selected
Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ eff it cr . rmInvItem (_crID cr) (_crInvSel cr)
Just NoUse -> setuhamdown w
@@ -35,24 +37,41 @@ itemEffect cr it w = case it ^? itUse of
lhammer f' = w & case _crHammerPosition cr of
HammerUp -> creatures . ix (_crID cr) %~ f'
_ -> id
setEquipLeftItem cr' = case _crLeftInvSel cr' of
Just i | i == _crInvSel cr' -> cr' & crLeftInvSel .~ Nothing
& crInvEquipped . at i .~ Nothing
-- if the following causes an exception we have reached a state that
-- should not be possible
& crEquipment . at (_crInvEquipped cr' IM.! i) .~ Nothing
-- Just i -> cr' & crLeftInvSel ?~ _crInvSel cr'
-- should left use equipment be removed if replaced by left use
-- equipment that uses a different site?
_ -> cr' & crLeftInvSel ?~ _crInvSel cr'
& equipUsingSiteCheck (_crInvSel cr') it
setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
toggleEquipmentAt :: Int -> Item -> Creature -> Creature
toggleEquipmentAt invid itm cr = case cr ^? crInvEquipped . ix invid of
Just epos -> cr & crInvEquipped . at invid .~ Nothing
& crEquipment . at epos .~ Nothing
Nothing -> equipUsingSite invid itm cr
activateEquipmentAt :: RightButtonOptions -> Creature -> Creature
activateEquipmentAt rbo = case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
(Just i,_) -> crLeftInvSel ?~ i
(_,Just _) -> crLeftInvSel .~ Nothing
_ -> id
toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> Creature
toggleEquipmentAt rbops invid cr = case rbops ^? opAllocateEquipment of
Just DoNotMoveEquipment -> cr
Just PutOnEquipment {_allocNewPos = newp}
-> cr & crEquipment . at newp ?~ invid
& crInvEquipped . at invid ?~ newp
Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp }
-> cr & crEquipment . at newp ?~ invid
& crEquipment . at oldp .~ Nothing
& crInvEquipped . at invid ?~ newp
Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid }
-> cr & crEquipment . at newp ?~ invid
& crEquipment . at oldp ?~ sid
& crInvEquipped . at invid ?~ newp
& crInvEquipped . at sid ?~ oldp
Just ReplaceEquipment {_allocNewPos = newp, _allocRemoveID = rid }
-> cr & crEquipment . at newp ?~ invid
& crInvEquipped . at invid ?~ newp
& crInvEquipped . at rid .~ Nothing
Just RemoveEquipment {_allocOldPos = oldp }
-> cr & crEquipment . at oldp .~ Nothing
& crInvEquipped . at invid .~ Nothing
Nothing -> error "tried to toggle equipment whilst not prepared"
-- case cr ^? crInvEquipped . ix invid of
-- Just epos -> cr & crInvEquipped . at invid .~ Nothing
-- & crEquipment . at epos .~ Nothing
-- Nothing -> equipUsingSite invid itm cr
-- | First check if the item is already equiped, then do nothing
equipUsingSiteCheck :: Int -> Item -> Creature -> Creature
src/Dodge/Data.hs
+43 -1
View File
@@ -121,6 +121,7 @@ data World = World
, _lightSources :: IM.IntMap LightSource
, _tempLightSources :: [TempLightSource]
, _closeObjects :: [Either FloorItem Button]
, _rbOptions :: RightButtonOptions
, _seenLocations :: IM.IntMap (World -> Point2,String)
, _selLocation :: Int
, _sideEffects :: Universe -> IO Universe
@@ -139,6 +140,44 @@ data HUDElement = DisplayInventory {_subInventory :: SubInventory}
| DisplayCarte
-- deriving (Eq,Ord,Show)
data RightButtonOptions
= NoRightButtonOptions
| EquipOptions
{_opEquip :: [EquipPosition]
,_opSel :: Int
,_opCurInvPos :: Int
,_opAllocateEquipment :: AllocateEquipment
,_opActivateEquipment :: ActivateEquipment
}
data ActivateEquipment
= ActivateEquipment {_activateEquipment :: Int }
| DeactivateEquipment {_deactivateEquipment :: Int}
| ActivateDeactivateEquipment {_activateEquipment :: Int ,_deactivateEquipment :: Int}
| NoChangeActivateEquipment
data AllocateEquipment
= DoNotMoveEquipment
| PutOnEquipment
{ _allocNewPos :: EquipPosition
}
| MoveEquipment
{ _allocNewPos :: EquipPosition
, _allocOldPos :: EquipPosition
}
| SwapEquipment
{ _allocNewPos :: EquipPosition
, _allocOldPos :: EquipPosition
, _allocSwapID :: Int
}
| ReplaceEquipment
{ _allocNewPos :: EquipPosition
, _allocRemoveID :: Int
}
| RemoveEquipment
{ _allocOldPos :: EquipPosition
}
data SubInventory
= NoSubInventory
| TweakInventory
@@ -372,6 +411,7 @@ data ItemUse
, _useMods :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World]
, _useHammer :: HammerType
, _useAim :: AimParams
, _heldScroll :: Float -> Creature -> Item -> Item
}
| LeftUse
{ _lUse :: Item -> Creature -> World -> World
@@ -431,7 +471,6 @@ data Item = Item
, _itConsumption :: ItemConsumption
, _itUse :: ItemUse
, _itEquipPict :: Creature -> Item -> SPic
, _itScroll :: Float -> Creature -> Item -> Item
, _itType :: CombineType
, _itAttachment :: ItAttachment
, _itID :: Maybe Int
@@ -1318,3 +1357,6 @@ makeLenses ''BeamType
makeLenses ''WorldBeams
makeLenses ''ArcStep
makeLenses ''CreatureStatistics
makeLenses ''RightButtonOptions
makeLenses ''AllocateEquipment
makeLenses ''ActivateEquipment
src/Dodge/Default.hs
-2
View File
@@ -164,7 +164,6 @@ defaultEquipment = Item
,_eqOnRemove = \_ _ -> id
,_eqSite = GoesOnSpecial
}
, _itScroll = \ _ _ -> id
, _itAttachment = NoItAttachment
, _itParams = NoParams
, _itTweaks = NoTweaks
@@ -190,7 +189,6 @@ defaultConsumable = Item
, _itInvColor = blue
, _itInvDisplay = \it -> [_itName it ++ " x" ++ show (_itAmount $ _itConsumption it)]
, _itEffect = NoItEffect
, _itScroll = \_ _ -> id
, _itAttachment = NoItAttachment
, _itType = NoCombineType
, _itParams = NoParams
src/Dodge/Default/Weapon.hs
+3 -2
View File
@@ -37,6 +37,7 @@ ruseRate i f ht usemods = RightUse
, _useMods = usemods
, _useHammer = ht
, _useAim = defaultAimParams
, _heldScroll = \_ _ -> id
}
ruseInstant
@@ -50,6 +51,7 @@ ruseInstant f ht usemods = RightUse
, _useMods = usemods
, _useHammer = ht
, _useAim = defaultAimParams
, _heldScroll = \_ _ -> id
}
defaultrUse :: ItemUse
@@ -59,6 +61,7 @@ defaultrUse = RightUse
, _useMods = []
, _useHammer = HasHammer HammerUp
, _useAim = defaultAimParams
, _heldScroll = \_ _ -> id
}
defaultlUse :: ItemUse
defaultlUse = LeftUse
@@ -94,7 +97,6 @@ defaultGun = Item
, _itUse = defaultrUse
, _itDimension = defItDimCol white
, _itEquipPict = pictureWeaponOnAim
, _itScroll = \_ _ -> id
, _itAttachment = NoItAttachment
, _itID = Nothing
, _itInvPos = Nothing
@@ -125,7 +127,6 @@ defaultCraftable = Item
, _itConsumption = NoConsumption
, _itUse = NoUse
, _itEquipPict = pictureWeaponOnAim
, _itScroll = \_ _ -> id
, _itAttachment = NoItAttachment
, _itID = Nothing
, _itInvPos = Nothing
src/Dodge/Default/World.hs
+1
View File
@@ -77,6 +77,7 @@ defaultWorld = World
, _lightSources = IM.empty
, _tempLightSources = [youLight]
, _closeObjects = []
, _rbOptions = NoRightButtonOptions
, _seenLocations = IM.fromList
[(0, (_crPos . you, "CURRENT POSITION"))
,(1, (const (V2 0 0) , "START POSITION"))
src/Dodge/Event.hs
+10 -3
View File
@@ -126,9 +126,10 @@ wheelEvent y w = case _hudElement $ _hud w of
-- functions that modify the inventory should be centralised so that
-- this lock can be sensibly applied, perhaps
| _crInvLock (_creatures w IM.! _yourID w) -> w
| rbDown -> case yourItem w ^? _Just . itScroll of
Nothing -> closeObjScrollDir y w
Just f -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w)
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of
(_,EquipOptions{}) -> scrollRBOption y w
(Nothing,_) -> closeObjScrollDir y w
(Just f,_) -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w)
| lbDown -> w & cameraZoom +~ y
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
@@ -148,6 +149,12 @@ wheelEvent y w = case _hudElement $ _hud w of
lbDown = ButtonLeft `S.member` _mouseButtons w
invKeyDown = ScancodeCapsLock `S.member` _keys w
scrollRBOption :: Float -> World -> World
scrollRBOption y w
| y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1))
| y > 0 = w & rbOptions . opSel %~ (max 0 . (subtract 1))
| otherwise = w
-- nice idea, but the chain of setters and getters seems prohibitive
--scrollOver :: Foldable t
-- => ASetter s s Int Int -- index setter
src/Dodge/Inventory.hs
+79
View File
@@ -12,6 +12,7 @@ module Dodge.Inventory
, augmentedInvSizes
, rmInvItem
, updateCloseObjects
, updateRBList
, updateTerminal
, closeObjScrollDir
, closeObjectCol
@@ -38,7 +39,10 @@ import ListHelp
import LensHelp
--import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Data.Maybe
import SDL
--import Data.List
--import System.Random
@@ -169,6 +173,81 @@ updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered c
oldClose = filt $ _closeObjects w
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
updateRBList :: World -> World
updateRBList w
| ButtonRight `S.member` _mouseButtons w && w ^? rbOptions . opCurInvPos == Just curinvid
= w & setEquipAllocation & setEquipActivation
| ButtonRight `S.member` _mouseButtons w = case cr ^? crInv . ix (_crInvSel cr) . itUse . eqSite of
Just esite -> w & rbOptions .~ EquipOptions (equipSiteToPositions esite) 0 curinvid DoNotMoveEquipment NoChangeActivateEquipment
& setEquipAllocation & setEquipActivation
Nothing -> w & rbOptions .~ NoRightButtonOptions
| otherwise = w & rbOptions .~ NoRightButtonOptions
where
curinvid = _crInvSel cr
cr = you w
setEquipAllocation :: World -> World
setEquipAllocation w = case _rbOptions w of
EquipOptions {_opEquip = es,_opSel=i} ->
case you w ^? crInvEquipped . ix (_crInvSel (you w)) of
Just epos | es !! i == epos
-> w & rbOptions . opAllocateEquipment .~ RemoveEquipment
{_allocOldPos = epos}
Just epos | isJust (you w ^? crEquipment . ix (es !! i))
-> w & rbOptions . opAllocateEquipment .~ SwapEquipment
{_allocOldPos = epos
,_allocNewPos = es !! i
,_allocSwapID = _crEquipment (you w) M.! (es !! i)
}
Just epos -> w & rbOptions . opAllocateEquipment .~ MoveEquipment
{_allocOldPos = epos
,_allocNewPos = es !! i
}
Nothing | isJust (you w ^? crEquipment . ix (es !! i))
-> w & rbOptions . opAllocateEquipment .~ ReplaceEquipment
{_allocNewPos = es !! i
,_allocRemoveID = _crEquipment (you w) M.! (es !! i)
}
Nothing -> w & rbOptions . opAllocateEquipment .~ PutOnEquipment
{_allocNewPos = es !! i}
_ -> w
-- where
-- curpos = invSelPos w
setEquipActivation :: World -> World
setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
Just DoNotMoveEquipment -> w
Just RemoveEquipment { }
-> case _crLeftInvSel (you w) of
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment
{_deactivateEquipment = i}
_ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just rbos
-> case _crLeftInvSel (you w) of
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment
{_activateEquipment = invsel,_deactivateEquipment = i}
Just i | Just i == rbos ^? allocSwapID || Just i == rbos ^? allocRemoveID
-> w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment
{_activateEquipment = invsel}
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
where
invsel = _crInvSel (you w)
invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . lUse)
equipSiteToPositions :: EquipSite -> [EquipPosition]
equipSiteToPositions es = case es of
GoesOnHead -> [OnHead]
GoesOnChest -> [OnChest]
GoesOnBack -> [OnBack]
GoesOnWrist -> [OnLeftWrist,OnRightWrist]
GoesOnLegs -> [OnLegs]
GoesOnSpecial -> [OnSpecial]
closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x
| x > 0 = over closeObjects rotU
src/Dodge/Item/Equipment.hs
+3 -3
View File
@@ -115,6 +115,7 @@ flatShield = defaultEquipment
, _aimZoom = ItZoom 20 0.2 1
, _aimStance = TwoHandFlat
}
, _heldScroll = \_ _ -> id
}
, _itInvSize = 3
, _itInvDisplay = \it -> head (basicItemDisplay it) :
@@ -236,9 +237,8 @@ headLamp = defaultEquipment
& itUse . eqSite .~ GoesOnHead
createHeadLamp :: Creature -> Int -> World -> World
createHeadLamp cr _ w = w
& tempLightSources .:~ tlsTimeRadColPos 1 200 0.5
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
createHeadLamp cr _ = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
powerLegs :: Item
powerLegs = defaultEquipment
src/Dodge/Item/Weapon/AmmoParams.hs
+1
View File
@@ -25,6 +25,7 @@ ruseAmmoParamsRate rate ht usemods = RightUse
, _useMods = usemods
, _useHammer = ht
, _useAim = defaultAimParams
, _heldScroll = \_ _ -> id
}
defaultAimParams :: AimParams
defaultAimParams = AimParams
src/Dodge/Item/Weapon/BulletGun/Rod.hs
+1 -1
View File
@@ -128,7 +128,7 @@ sniperRifle = elephantGun
& itType .~ SNIPERRIFLE
& itParams . gunBarrels .~ SingleBarrel 0
& itUse . useAim . aimZoom .~ defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}
& itScroll .~ zoomLongGun
& itUse . heldScroll .~ zoomLongGun
& itScope .~ ZoomScope (V2 0 0) 0 1 False
& itTargeting .~ targetLaser
machineGun :: Item
src/Dodge/Item/Weapon/BulletGuns.hs
+2 -2
View File
@@ -80,7 +80,6 @@ autoGun = defaultAutoGun
-- , _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim
, _itAttachment = ItCharMode $ Seq.fromList "MS"
, _itScroll = scrollCharMode
, _itParams = BulletShooter
{ _muzVel = 1
, _rifling = 0.9
@@ -91,6 +90,7 @@ autoGun = defaultAutoGun
, _randomOffset = 0
}
}
& itUse . heldScroll .~ scrollCharMode
autoGunPic :: Item -> SPic
autoGunPic it = noPic $
colorSH red (prismPoly
@@ -295,7 +295,7 @@ longGun = defaultGun
& useAim . aimRange .~ 1
& useAim . aimStance .~ TwoHandTwist
& useAim . aimZoom .~ defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}
, _itScroll = zoomLongGun
& heldScroll .~ zoomLongGun
, _itAttachment = NoItAttachment
, _itScope = ZoomScope (V2 0 0) 0 1 False
-- , _itEffect = itemLaserScopeEffect
src/Dodge/Render/HUD.hs
+38 -5
View File
@@ -62,8 +62,9 @@ subInventoryDisplay subinv cfig w = case subinv of
NoSubInventory -> pictures
[ selcursor
, closeobjectcursor
, equipcursor
, equipcursors
, equipcursor -- the order is important, this should go on top of the other equipcursors
, rboptions
]
TweakInventory -> pictures
--[ mCurs it cfig w
@@ -126,11 +127,43 @@ subInventoryDisplay subinv cfig w = case subinv of
curpos = invSelPos w
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w)
equipcursor = case _crLeftInvSel cr of
Nothing -> mempty
Just invid -> f' cyan invid
Just invid | _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w)
-> f cyan invid (_crInvEquipped cr IM.! invid)
_ -> mempty
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
f' col invid = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text "EQUIPPED"
f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
f col invid epos
| _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w)
= listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
| otherwise = mempty
--rboptions = listTextPicturesAtOffset 200 0 cfig (selNumPos invid w) ["TEST","ME"]
rboptions = drawRBOptions cfig w (_rbOptions w)
drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=ae} =
listTextPicturesAtOffset 252 0 cfig (curpos-i) (map (text . eqPosText) es)
<> case ae of
DoNotMoveEquipment -> mempty
PutOnEquipment {}
-> putontext
MoveEquipment {_allocOldPos = oldp }
-> putontext <> extratext ("MOVES FROM "++eqPosText oldp)
SwapEquipment { _allocOldPos = oldp, _allocSwapID = sid }
-> putontext <> extratext ("SWAPS "++otheritem sid ++ " ONTO " ++eqPosText oldp)
ReplaceEquipment { _allocRemoveID = rid }
-> putontext <> extratext ("REMOVES " ++ otheritem rid)
RemoveEquipment { }
-> takeofftext
where
takeofftext = listTextPictureAt 144 0 cfig curpos (text " TAKE OFF")
putontext = listTextPictureAt 144 0 cfig curpos (text " PUT ONTO")
extratext str = listTextPictureAt 350 0 cfig curpos (text (str ++ deactivatetext))
deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
Just k -> " DEACTIVATES " ++ _itName (_crInv (you w) IM.! k)
Nothing -> ""
curpos = invSelPos w
otheritem j = _itName (_crInv (you w) IM.! j)
drawRBOptions _ _ _ = mempty
eqPosText :: EquipPosition -> String
eqPosText ep = case ep of
src/Dodge/Update.hs
+1
View File
@@ -80,6 +80,7 @@ functionalUpdate cfig w = checkEndGame
. updateSeenWalls
-- . (youHammerPosition %~ moveHammerUp)
. updateTerminal
. updateRBList
$ updateCloseObjects w
where
--updatedLightSources = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w
src/Dodge/Update/UsingInput.hs
+2
View File
@@ -25,6 +25,7 @@ updatePressedButtons pkeys w
= useLeftItem (_yourID w) w
| isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame)
= w & doubleMouseHammer .~ HammerDown
| isDown ButtonRight && inTopInv = w
| isDown ButtonMiddle
= w & cameraRot -~ rotation
& clickMousePos .~ _mousePos w
@@ -36,6 +37,7 @@ updatePressedButtons pkeys w
isDown but = but `S.member` pkeys
rotation = angleBetween (_mousePos w) (_clickMousePos w)
updatePressedButtonsCarte :: S.Set MouseButton -> World -> World
updatePressedButtonsCarte pkeys w
| isDown ButtonRight = w