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

Flatten values in creature manipulation data types

Browse Source
This commit is contained in:
justin
2024-09-24 21:50:21 +01:00
parent fe00af0e73
commit 25cec10313
24 changed files with 69 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+1 -1
View File
@@ -1 +1 @@
All good (620 modules, at 21:25:42)
All good (620 modules, at 21:50:15)
saveSlot/LevelStart0
+1 -1
View File
File diff suppressed because one or more lines are too long
src/Dodge/Base/You.hs
+2 -2
View File
@@ -20,12 +20,12 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0
yourSelectedItem :: World -> Maybe Item
yourSelectedItem w = do
i <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
i <- you w ^? crManipulation . manObject . imSelectedItem
_crInv (you w) IM.!? i
yourRootItem :: World -> Maybe Item
yourRootItem w = do
i <- you w ^? crManipulation . manObject . inInventory . imRootItem
i <- you w ^? crManipulation . manObject . imRootItem
_crInv (you w) IM.!? i
--yourScrollAttachment :: World -> Maybe (Int,ScrollAttachParams)
src/Dodge/Creature/Action.hs
+1 -1
View File
@@ -188,7 +188,7 @@ dropItem cr invid = rmInvItem (_crID cr) invid .
youDropItem :: World -> World
youDropItem w = fromMaybe w $ do
curpos <-
you w ^? crManipulation . manObject . inInventory . imSelectedItem
you w ^? crManipulation . manObject . imSelectedItem
<|> fmap fst (IM.lookupMax =<< w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems)
guard $ not $ _crInvLock (you w) || cursed
return $
src/Dodge/Creature/Impulse.hs
+1 -1
View File
@@ -48,7 +48,7 @@ followImpulse cr w imp = case imp of
TurnTo p -> crup $ creatureTurnTo p cr
ChangePosture post -> crup $ cr & crStance . posture .~ post
UseItem -> (useRootItem $ _crID cr, cr)
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ InInventory (SelectedItem i i mempty)
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem i i mempty
Melee cid' ->
( hitCr cid'
, crMvAbsolute (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20
src/Dodge/Creature/Impulse/UseItem.hs
+4 -4
View File
@@ -26,7 +26,7 @@ import qualified IntMapHelp as IM
useRootItem :: Int -> World -> World
useRootItem crid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid
itRef <- cr ^? crManipulation . manObject . inInventory . imRootItem
itRef <- cr ^? crManipulation . manObject . imRootItem
it <- invTrees (_crInv cr) ^? ix itRef
return $
itemEffect cr it w
@@ -89,7 +89,7 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat itRef
itRef = cr ^?! crManipulation . manObject . inInventory . imSelectedItem -- unsafe!! TODO change?
itRef = cr ^?! crManipulation . manObject . imSelectedItem -- unsafe!! TODO change?
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
@@ -98,7 +98,7 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
useItemLeftClick :: Creature -> World -> World
useItemLeftClick cr w = fromMaybe w $ do
guard . not $ _crInvLock cr
invid <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
invid <- cr ^? crManipulation . manObject . imSelectedItem
ituse <- cr ^? crInv . ix invid . itUse
case ituse of
--HeldUse{} -> return $ hammerTest (cWorld . lWorld . creatures . ix (_crID cr) %~ crReloadToggle)
@@ -114,7 +114,7 @@ useItemLeftClick' :: Creature -> World -> World
--useItemLeftClick' cr' w = fromMaybe (f w) $ do
useItemLeftClick' cr' w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
itRef <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
itRef <- cr ^? crManipulation . manObject . imSelectedItem
it <- invTrees (_crInv cr) ^? ix itRef
return $
itemEffect cr it w
src/Dodge/Creature/State.hs
+1 -1
View File
@@ -282,7 +282,7 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
-- in the inventory
crGetTargeting :: Creature -> Maybe TargetType
crGetTargeting cr = do
i <- cr ^? crManipulation . manObject . inInventory . imRootItem
i <- cr ^? crManipulation . manObject . imRootItem
itm <- cr ^? crInv . ix i
itm ^? itType . iyModules . ix ModTarget . imtTargetType
<|> do
src/Dodge/Creature/Statistics.hs
+1 -1
View File
@@ -38,6 +38,6 @@ strFromHeldItem :: Creature -> Int
strFromHeldItem cr
--x--- | _posture (_crStance cr) == Aiming || crIsReloading cr = negate $ fromMaybe 0 $ do
| _posture (_crStance cr) == Aiming = negate $ fromMaybe 0 $ do
i <- cr ^? crManipulation . manObject . inInventory . imRootItem
i <- cr ^? crManipulation . manObject . imRootItem
cr ^? crInv . ix i . itUse . heldAim . aimWeight
| otherwise = 0
src/Dodge/Creature/Test.hs
+1 -1
View File
@@ -91,7 +91,7 @@ crInAimStance as cr =
&& mitstance == Just as
where
mitstance = do
i <- cr ^? crManipulation . manObject . inInventory . imRootItem
i <- cr ^? crManipulation . manObject . imRootItem
cr ^? crInv . ix i . itUse . heldAim . aimStance
oneH :: Creature -> Bool
src/Dodge/Creature/YourControl.hs
+3 -3
View File
@@ -88,7 +88,7 @@ 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 . imSelectedItem
itid <- cr ^? crManipulation . manObject . imSelectedItem
return $ w & cWorld . lWorld . creatures . ix 0 %~ assignHotkey itid (scancodeToHotkey sc)
{- | Turn key presses into creature movement.
@@ -164,7 +164,7 @@ wasdTwist cr
& crDir +~ _crTwist cr'
& crTwist .~ 0
addAnyTwist = fromMaybe id $ do
itRef <- cr ^? crManipulation . manObject . inInventory . imRootItem
itRef <- cr ^? crManipulation . manObject . imRootItem
astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
case (astance, cr ^. crTwist) of
(TwoHandUnder, 0) ->
@@ -190,7 +190,7 @@ aimTurn :: Float -> Creature -> Creature
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
where
x = fromMaybe 1 $ do
itRef <- cr ^? crManipulation . manObject . inInventory . imRootItem
itRef <- cr ^? crManipulation . manObject . imRootItem
cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
-- | Set posture according to mouse presses.
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+5 -23
View File
@@ -19,36 +19,18 @@ data Manipulation -- should be ManipulatedObject?
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ManipulatedObject
= InInventory {_inInventory :: InventoryManipulation}
| SelNothing
| InNearby {_inNearby :: NearbyManipulation}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data NearbyManipulation
= SortNearby
| SelCloseObject {_ispCloseObject :: Int}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data InventoryManipulation
= SortInventory
| SelectedItem
{ _imSelectedItem :: Int
, _imRootItem :: Int
, _imAttachedItems :: IS.IntSet
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data InvSelAction
= NoInvSelAction
deriving (Eq, Ord, Show, Read) --Generic, Flat)
}
| SelNothing
| SortNearby
| SelCloseObject {_ispCloseObject :: Int}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''ManipulatedObject
makeLenses ''Manipulation
makeLenses ''InventoryManipulation
makeLenses ''NearbyManipulation
makeLenses ''InvSelAction
deriveJSON defaultOptions ''InvSelAction
deriveJSON defaultOptions ''InventoryManipulation
deriveJSON defaultOptions ''NearbyManipulation
deriveJSON defaultOptions ''ManipulatedObject
deriveJSON defaultOptions ''Manipulation
src/Dodge/HeldUse.hs
+3 -2
View File
@@ -226,7 +226,7 @@ shootTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt'
dir = _crDir cr
outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
power = _attractionPower . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . manObject . imRootItem -- unsafe!! TODO change
tractorBeamAt' :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
tractorBeamAt' pos outpos dir power =
@@ -471,7 +471,8 @@ shootTeslaArc itm cr mz w =
w'
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
where
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
-- use items item location instead
itRef = cr ^?! crManipulation . manObject . imRootItem -- unsafe!! TODO change
(w', ip) = makeTeslaArc (_itParams itm) pos dir w
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
dir = _crDir cr + _mzRot mz
src/Dodge/Inventory.hs
+7 -7
View File
@@ -82,10 +82,10 @@ rmInvItem cid invid w = w
pointcid = cWorld . lWorld . creatures . ix cid
updateselection
| cid == 0 && cr ^? crManipulation . manObject . inInventory . imSelectedItem == Just invid =
| cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid =
scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems
| otherwise =
pointcid . crManipulation . manObject . inInventory . imSelectedItem %~ g
pointcid . crManipulation . manObject . imSelectedItem %~ g
cr = w ^?! cWorld . lWorld . creatures . ix cid
itm = _crInv cr IM.! invid
@@ -185,7 +185,7 @@ rmInvItem cid invid w = w
-- | otherwise = x
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . imSelectedItem of
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . imSelectedItem of
Just i -> rmInvItem cid i w
Nothing -> w
@@ -198,7 +198,7 @@ updateCloseObjects w =
where
newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose
updatecursorposifnecessary =
case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject of
case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject of
Just i
| i >= length newcloseobjects -> scrollAugInvSel 1
| isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) ->
@@ -237,7 +237,7 @@ changeSwapClose f i w = fromMaybe w $ do
k <- f i ss
return $
w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject
.~ k
& hud . closeObjects %~ swapIndices i k
& hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
@@ -263,7 +263,7 @@ changeSwapInv f i w = fromMaybe w $ do
where
updatecreature k =
(crInv %~ IM.safeSwapKeys i k)
. (crManipulation . manObject . inInventory . imSelectedItem .~ k)
. (crManipulation . manObject . imSelectedItem .~ k)
. (crInvEquipped %~ IM.safeSwapKeys i k)
. swapSite i k
. swapSite k i
@@ -297,6 +297,6 @@ scrollAugInvSel yi w
selectedCloseObject :: World -> Maybe (Either FloorItem Button)
selectedCloseObject w = do
i <-
you w ^? crManipulation . manObject . inNearby . ispCloseObject
you w ^? crManipulation . manObject . ispCloseObject
<|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems)
w ^? hud . closeObjects . ix i
src/Dodge/Inventory/Location.hs
+9 -9
View File
@@ -38,9 +38,9 @@ tryGetRootItemInvID i cr = do
updateRootItemID :: Creature -> Creature
updateRootItemID cr = fromMaybe cr $ do
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
i <- cr ^? crManipulation . manObject . imSelectedItem
j <- tryGetRootItemInvID i cr
return $ cr & crManipulation . manObject . inInventory . imRootItem .~ j
return $ cr & crManipulation . manObject . imRootItem .~ j
-- the following assumes that the crManipulation is correct
crUpdateItemLocations :: Int -> LWorld -> LWorld
@@ -58,9 +58,9 @@ crUpdateInvidLocations mo crid lw invid itm = lw
newloc = InInv
{ _ilCrID = crid
, _ilInvID = invid
, _ilIsRoot = Just invid == mo ^? inInventory . imSelectedItem
, _ilIsSelected = Just invid == mo ^? inInventory . imRootItem
, _ilIsAttached = invid `IS.member` (mo ^. inInventory . imAttachedItems)
, _ilIsRoot = Just invid == mo ^? imSelectedItem
, _ilIsSelected = Just invid == mo ^? imRootItem
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
}
-- this should be looked at, as it is sometimes used in functions that need not
@@ -75,15 +75,15 @@ setInvPosFromSS w =
sss <- w ^? hud . hudElement . diSections
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
case i of
(-1) -> Just $ InInventory SortInventory
(-1) -> Just SortInventory
0 -> do
(rootid,aset) <- tryGetRootAttachedFromInvID j (you w ^. crInv)
return $ InInventory $ SelectedItem
return SelectedItem
{ _imSelectedItem = j
, _imRootItem = rootid
, _imAttachedItems = aset
}
1 -> Just SelNothing
2 -> Just $ InNearby SortNearby
3 -> Just $ InNearby $ SelCloseObject j
2 -> Just SortNearby
3 -> Just $ SelCloseObject j
_ -> error "selection out of bounds"
src/Dodge/Inventory/RBList.hs
+3 -3
View File
@@ -20,7 +20,7 @@ updateRBList w
| otherwise = case w ^. rbOptions of
EquipOptions{} -> w
_ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
i <- cr ^? crManipulation . manObject . imSelectedItem
esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
return $
w
@@ -35,7 +35,7 @@ updateRBList w
-- find a free equipment slot
chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
i <- cr ^? crManipulation . manObject . imSelectedItem
ep <- cr ^? crInvEquipped . ix i
elemIndex ep eps
@@ -46,7 +46,7 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
getEquipmentAllocation :: World -> EquipmentAllocation
getEquipmentAllocation w = fromMaybe DoNotMoveEquipment $ do
curpos <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
curpos <- you w ^? crManipulation . manObject . imSelectedItem
esite <- you w ^? crInv . ix curpos . itUse . equipEffect . eeSite
i <- w ^? rbOptions . opSel
<|> Just (chooseEquipmentPosition (you w) (equipSiteToPositions esite))
src/Dodge/Item/Location.hs
+2 -2
View File
@@ -34,13 +34,13 @@ pointerToItemLocation _ = const pure
pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourSelectedItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . imSelectedItem
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
Just $ pointerToItemLocation (InInv 0 itinvid True True True) f w
-- note the ilIsRoot/Selected/Attached booleans are irrelevant
pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourRootItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . imRootItem
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootItem
Just $ pointerToItemLocation (InInv 0 itinvid True True True) f w
pointerToItem ::
src/Dodge/Item/Weapon/BatteryGuns.hs
+3 -4
View File
@@ -16,7 +16,7 @@ import Dodge.Beam
import Dodge.Data.World
--import Dodge.Item.Weapon.LaserPath
import Geometry
import qualified IntMapHelp as IM
--import qualified IntMapHelp as IM
import LensHelp
--import Picture
@@ -147,15 +147,14 @@ shootLaser it cr =
-- & bmType .~ bt
aTractorBeam :: Item -> Creature -> World -> World
aTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
aTractorBeam itm cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
where
cpos = _crPos cr
spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
dir = _crDir cr
outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
power = _attractionPower . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
power = _attractionPower . _itParams $ itm
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
tractorBeamAt pos outpos dir power =
src/Dodge/Item/Weapon/TriggerType.hs
+3 -2
View File
@@ -193,7 +193,7 @@ withWarmUp soundID f item cr w
where
item' = _ldtValue item
cid = _crID cr
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
itRef = cr ^?! crManipulation . manObject . imRootItem -- unsafe!! TODO change
pointertoitem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
curWarmUp = _warmTime . _heldDelay $ _itUse item'
maxWarmUp = _warmMax . _heldDelay $ _itUse item'
@@ -284,7 +284,8 @@ useTimeCheck f item cr w = case item ^? ldtValue . itUse . heldDelay of
cid = _crID cr
setUseRate = cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTime
+~ userate
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
-- this should use the ITEMS invid location!
itRef = cr ^?! crManipulation . manObject . imRootItem -- unsafe!! TODO change
userate = fromMaybe 0 $ item ^? ldtValue . itUse . heldDelay . rateMax
-- | Applies a world effect after a hammer position check.
src/Dodge/Projectile/Update.hs
+1 -1
View File
@@ -94,7 +94,7 @@ setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj)
--i = _prjID pj
newdir
| SDL.ButtonRight `M.member` _mouseButtons (_input w)
&& w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . imSelectedItem
&& w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . imSelectedItem
== w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
= (w ^. wCam . camRot) + argV (_mousePos (_input w))
| otherwise = _prjDir pj
src/Dodge/Render/HUD.hs
+3 -3
View File
@@ -125,14 +125,14 @@ floorItemPickupInfo n itm
-- it is probably desirable for this to crash hard for now
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
Just (InInventory (SelectedItem i _ _)) -> f $ yourInv w ^?! ix i
Just (InNearby (SelCloseObject i)) -> g $ w ^?! hud . closeObjects . ix i
Just (SelectedItem i _ _) -> f $ yourInv w ^?! ix i
Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix i
_ -> x
drawRBOptions :: Configuration -> World -> Picture
drawRBOptions cfig w = fromMaybe mempty $ do
guard $ ButtonRight `M.member` _mouseButtons (_input w)
invid <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
invid <- you w ^? crManipulation . manObject . imSelectedItem
eslist <- fmap equipSiteToPositions $ you w ^? crInv . ix invid . itUse . equipEffect . eeSite
i <- w ^? rbOptions . opSel
let ae = getEquipmentAllocation w
src/Dodge/TestString.hs
+5 -5
View File
@@ -35,11 +35,11 @@ topTestPart u = [show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra
]
showManObj :: ManipulatedObject -> String
showManObj (InInventory SortInventory) = "SortInventory"
showManObj (InInventory (SelectedItem x y z)) = "SelItem: "++ show x++ " Root: "++show y++" Attached: "++show z
showManObj (SelNothing) = "SelNothing"
showManObj ((InNearby SortNearby)) = "SortNearby"
showManObj (InNearby (SelCloseObject x)) = "Close " ++ show x
showManObj SortInventory = "SortInventory"
showManObj (SelectedItem x y z) = "SelItem: "++ show x++ " Root: "++show y++" Attached: "++show z
showManObj SelNothing = "SelNothing"
showManObj SortNearby = "SortNearby"
showManObj (SelCloseObject x) = "Close " ++ show x
--testStringInit u = fromMaybe mempty $ do
src/Dodge/Update/Camera.hs
+6 -6
View File
@@ -88,26 +88,26 @@ moveZoomCamera cfig theinput cr campos =
where
vfoffset = fromMaybe 0 $ do
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
i <- cr ^? crManipulation . manObject . imSelectedItem
(cr ^? crInv . ix i . itScope . remotePos)
docamrot = rotateV (campos ^. camRot)
offset = fromMaybe noscopeoffset $ do
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
i <- cr ^? crManipulation . manObject . imSelectedItem
(fmap docamrot (cr ^? crInv . ix i . itScope . opticPos))
<|> (cr ^? crInv . ix i . itScope . remotePos)
noscopeoffset = docamrot $
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
i <- cr ^? crManipulation . manObject . imSelectedItem
(cr ^? crInv . ix i . itScope . opticZoom)
idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
i <- cr ^? crManipulation . manObject . imSelectedItem
(cr ^? crInv . ix i . itScope . opticZoom)
idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming cr
i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
i <- cr ^? crManipulation . manObject . imSelectedItem
zoomFromItem <$> (cr ^? crInv . ix i . itUse . heldAim . aimZoom)
newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
changeZoom curZoom idealZoom
@@ -128,7 +128,7 @@ moveZoomCamera cfig theinput cr campos =
-- is wanted
updateScopeZoom :: World -> World
updateScopeZoom w = fromMaybe w $ do
i <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
i <- you w ^? crManipulation . manObject . imSelectedItem
return $ updateScopeZoom' i w
updateScopeZoom' :: Int -> World -> World
src/Dodge/Update/Scroll.hs
+2 -2
View File
@@ -46,7 +46,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
_ -> w
where
rbscrollmax = fromMaybe 1 $ do
invid <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
invid <- you w ^? crManipulation . manObject . imSelectedItem
esite <- you w ^? crInv . ix invid . itUse . equipEffect . eeSite
return $ length $ equipSiteToPositions esite
y = fromIntegral yi
@@ -117,7 +117,7 @@ moveTweakSel i w = case yourSelectedItem w ^? _Just . itTweaks . tweakParams of
changeTweakParam :: Maybe Int -> Int -> World -> World
changeTweakParam mi i w = fromMaybe w $ do
curpos <- you w ^? crManipulation . manObject . inInventory . imSelectedItem
curpos <- you w ^? crManipulation . manObject . imSelectedItem
paramid <- mi
params <- yourSelectedItem w ^? _Just . itTweaks . tweakParams . ix paramid
let x = (_tweakVal params + i) `mod` _tweakMax params
src/Dodge/WorldEffect.hs
+1 -1
View File
@@ -39,7 +39,7 @@ doWdWd we = case we of
WdWdFromItixCrixWdWd _ crid f -> \w -> fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid
--it <- getItem itid w
itRef <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
itRef <- cr ^? crManipulation . manObject . imSelectedItem
it <- invTrees (_crInv cr) ^? ix itRef
return $ doItCrWdWd f it cr w
WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do