Cleanup, fix broken records in LeftUse

This commit is contained in:
2024-10-03 10:34:17 +01:00
parent e88b3c7443
commit 1953fb2d0c
19 changed files with 71 additions and 114 deletions
+2 -2
View File
@@ -92,8 +92,8 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
itmat i = _crInv cr IM.! i
itm = itmat itRef
itRef = cr ^?! crManipulation . manObject . imSelectedItem -- unsafe!! TODO change?
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
onequip itm' = useE ((_eeOnEquip . _uequipEffect . _itUse) itm') itm'
onremove itm' = useE ((_eeOnRemove . _uequipEffect . _itUse) itm') itm'
-- need to make sure that the root item is not erroneously selected in the
-- following
+1 -1
View File
@@ -142,7 +142,7 @@ applyPastDamages cr w
| otherwise = w
useEquipment :: Creature -> Int -> World -> World
useEquipment cr i = useE (_eeUse (_equipEffect $ _itUse itm)) itm cr
useEquipment cr i = useE (_eeUse (_uequipEffect $ _itUse itm)) itm cr
where
itm = _crInv cr IM.! i
+1 -1
View File
@@ -46,7 +46,7 @@ data ItemUse
{ _leftUse :: Luse
, _leftDelay :: UseDelay
, _leftHammer :: HammerPosition
, _equipEffect :: EquipEffect
, _uequipEffect :: EquipEffect
, _leftConsumption :: LeftConsumption
}
| UseConsume { _cUse :: Cuse }
+1 -1
View File
@@ -16,7 +16,7 @@ defaultLeftUse = UseHotkey
{ _leftUse = LDoNothing
, _leftDelay = FixedRate{_rateMax = 8, _rateTime = 0}
, _leftHammer = HammerUp
, _equipEffect = defaultEquip
, _uequipEffect = defaultEquip
, _leftConsumption = defaultLeftLoadable
}
+5 -5
View File
@@ -83,24 +83,24 @@ useMagShield it cr w = w & cWorld . lWorld . magnets . at mgid ?~ themagnet
onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w =
w
& pointerToItem itm . itUse . equipEffect . eeParams .~ EquipID i
& pointerToItem itm . itUse . uequipEffect . eeParams .~ EquipID i
& cWorld . lWorld . walls . at i ?~ forceField{_wlID = i}
& setWristShieldPos (itm & itUse . equipEffect . eeParams .~ EquipID i) cr
& setWristShieldPos (itm & itUse . uequipEffect . eeParams .~ EquipID i) cr
where
i = IM.newKey (w ^. cWorld . lWorld . walls)
onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm _ =
(pointerToItem itm . itUse . equipEffect . eeParams .~ NoEquipParams) . mremovewall
(pointerToItem itm . itUse . uequipEffect . eeParams .~ NoEquipParams) . mremovewall
where
mremovewall = fromMaybe id $ do
i <- itm ^? itUse . equipEffect . eeParams . eparamID
i <- itm ^? itUse . uequipEffect . eeParams . eparamID
return $ deleteWallID i
setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
where
i = _eparamID $ _eeParams $ _equipEffect $ _itUse itm
i = _eparamID $ _eeParams $ _uequipEffect $ _itUse itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
invid = _ilInvID (_itLocation itm)
handtrans = case cr ^? crInvEquipped . ix invid of
+1 -1
View File
@@ -90,7 +90,7 @@ rmInvItem cid invid w = w
cr = w ^?! cWorld . lWorld . creatures . ix cid
itm = _crInv cr IM.! invid
dounequipfunction = fromMaybe id $ do
rmf <- itm ^? itUse . equipEffect . eeOnRemove
rmf <- itm ^? itUse . uequipEffect . eeOnRemove
return $ useE rmf itm cr
doanyitemeffect = fromMaybe id $ do
rmf <- itm ^? itEffect . ieOnDrop
+2 -2
View File
@@ -21,7 +21,7 @@ updateRBList w
EquipOptions{} -> w
_ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
esite <- cr ^? crInv . ix i . itUse . uequipEffect . eeSite
return $
w
& rbOptions
@@ -47,7 +47,7 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
getEquipmentAllocation :: World -> EquipmentAllocation
getEquipmentAllocation w = fromMaybe DoNotMoveEquipment $ do
curpos <- you w ^? crManipulation . manObject . imSelectedItem
esite <- you w ^? crInv . ix curpos . itUse . equipEffect . eeSite
esite <- you w ^? crInv . ix curpos . itUse . uequipEffect . eeSite
i <- w ^? rbOptions . opSel
<|> Just (chooseEquipmentPosition (you w) (equipSiteToPositions esite))
es <- equipSiteToPositions esite ^? ix i
+1 -1
View File
@@ -132,7 +132,7 @@ showEquipmentNumber _ itm = case _eeUse ee of
EBatterySource{_euseBatteryAmount = x} -> [show x]
_ -> [""]
where
ee = itm ^?! itUse . equipEffect
ee = itm ^?! itUse . uequipEffect
maybeWarmupStatus :: Item -> Maybe String
maybeWarmupStatus it = case it ^? itUse . heldDelay . warmMax of
+1 -1
View File
@@ -21,7 +21,7 @@ itemEquipPict cr itmtree = case itm ^. itUse of
UseHeld{} | itm ^? itLocation . ilIsRoot == Just True
-> overPosSP (heldItemOffset itm cr) (itemTreeSPic itmtree)
ituse -> fromMaybe mempty $ do
attachpos <- ituse ^? equipEffect . eeAttachPos
attachpos <- ituse ^? uequipEffect . eeAttachPos
i <- itm ^? itLocation . ilInvID
epos <- cr ^? crInvEquipped . ix i
return $ equipPosition epos cr attachpos (itemSPic itm)
+28 -37
View File
@@ -28,95 +28,86 @@ magShield :: Item
magShield =
defaultEquipment
& itParams .~ MagShieldParams Nothing
& itUse . equipEffect . eeUse .~ EMagShield
& itUse . equipEffect . eeSite .~ GoesOnWrist
& itUse . uequipEffect . eeUse .~ EMagShield
& itUse . uequipEffect . eeSite .~ GoesOnWrist
& itType .~ EQUIP MAGSHIELD
flameShield :: Item
flameShield =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnChest
& itUse . uequipEffect . eeSite .~ GoesOnChest
& itType .~ EQUIP FLAMESHIELD
frontArmour :: Item
frontArmour =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnChest
& itUse . uequipEffect . eeSite .~ GoesOnChest
& itType .~ EQUIP FRONTARMOUR
wristArmour :: Item
wristArmour =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnWrist
& itUse . equipEffect . eeOnEquip .~ EonWristShield
& itUse . equipEffect . eeUse .~ EWristShield
& itUse . equipEffect . eeOnRemove .~ EoffWristShield
& itUse . uequipEffect . eeSite .~ GoesOnWrist
& itUse . uequipEffect . eeOnEquip .~ EonWristShield
& itUse . uequipEffect . eeUse .~ EWristShield
& itUse . uequipEffect . eeOnRemove .~ EoffWristShield
& itType .~ EQUIP WRISTARMOUR
batteryPack :: Item
batteryPack =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnBack
& itUse . uequipEffect . eeSite .~ GoesOnBack
& itUse . uequipEffect . eeAttachPos .~ V3 (-8) 0 10
& itUse . uequipEffect . eeUse .~ EBatterySource 10000 10000
& itType .~ EQUIP BATTERYPACK
& itUse . equipEffect . eeAttachPos .~ V3 (-8) 0 10
& itUse . equipEffect . eeUse .~ EBatterySource 10000 10000
fuelPack :: Item
fuelPack =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnBack
& itUse . uequipEffect . eeSite .~ GoesOnBack
& itUse . uequipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . uequipEffect . eeUse .~ EFuelSource 10000 10000
& itType .~ EQUIP FUELPACK
& itUse . equipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . equipEffect . eeUse .~ EFuelSource 10000 10000
bulletBeltPack :: Item
bulletBeltPack =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnBack
& itUse . uequipEffect . eeSite .~ GoesOnBack
& itUse . uequipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . uequipEffect . eeUse .~ EAmmoSource 2000 2000 Nothing
& itType .~ EQUIP BULLETBELTPACK
& itUse . equipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . equipEffect . eeUse .~ EAmmoSource 2000 2000 --BulletSource
Nothing
bulletBeltBracer :: Item
bulletBeltBracer =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnWrist
& itUse . uequipEffect . eeSite .~ GoesOnWrist
& itUse . uequipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . uequipEffect . eeUse .~ EAmmoSource 100 100 Nothing
& itType .~ EQUIP BULLETBELTBRACER
& itUse . equipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . equipEffect . eeUse .~ EAmmoSource 100 100 --BulletSource
Nothing
brainHat :: Item
brainHat =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnHead
& itUse . uequipEffect . eeSite .~ GoesOnHead
& itType .~ EQUIP BRAINHAT
hat :: Item
hat =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnHead
& itUse . uequipEffect . eeSite .~ GoesOnHead
& itType .~ EQUIP HAT
--targetingHat :: TargetingType -> Item
--targetingHat tt =
-- defaultEquipment
-- & itUse . equipEffect . eeSite .~ GoesOnHead
-- & itType .~ EQUIP (TARGETINGHAT tt)
-- & itUse . equipTargeting ?~ tt
headLamp :: Item
headLamp =
defaultEquipment
& itUse . equipEffect . eeUse .~ EHeadLamp
& itUse . equipEffect . eeSite .~ GoesOnHead
& itUse . uequipEffect . eeUse .~ EHeadLamp
& itUse . uequipEffect . eeSite .~ GoesOnHead
& itType .~ EQUIP HEADLAMP
powerLegs :: Item
powerLegs =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnLegs
& itUse . uequipEffect . eeSite .~ GoesOnLegs
& itType .~ EQUIP POWERLEGS
speedLegs :: Item
@@ -128,7 +119,7 @@ jumpLegs = powerLegs & itType .~ EQUIP JUMPLEGS
wristInvisibility :: Item
wristInvisibility =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnWrist
& itUse . equipEffect . eeOnEquip .~ ECamouflage Invisible --overCID (crCamouflage .~ Invisible)
& itUse . equipEffect . eeOnRemove .~ ECamouflage FullyVisible --overCID (crCamouflage .~ FullyVisible)
& itUse . uequipEffect . eeSite .~ GoesOnWrist
& itUse . uequipEffect . eeOnEquip .~ ECamouflage Invisible
& itUse . uequipEffect . eeOnRemove .~ ECamouflage FullyVisible
& itType .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
+1 -1
View File
@@ -219,7 +219,7 @@ aimStanceInfo as = case as of
OneHand -> "It is held in one hand."
itmEquipSiteInfo :: Item -> String
itmEquipSiteInfo = maybe "" equipSiteInfo . (^? itUse . equipEffect . eeSite)
itmEquipSiteInfo = maybe "" equipSiteInfo . (^? itUse . uequipEffect . eeSite)
equipSiteInfo :: EquipSite -> String
equipSiteInfo es = case es of
+3 -3
View File
@@ -17,11 +17,11 @@ import Sound.Data
autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
autoEffect eff t sid itm cr w
| _eparamInt (_eeParams (_equipEffect $ _itUse itm)) < 1 =
| _eparamInt (_eeParams (_uequipEffect $ _itUse itm)) < 1 =
eff itm cr w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse
. equipEffect
. uequipEffect
. eeParams
. eparamInt
.~ t
@@ -30,7 +30,7 @@ autoEffect eff t sid itm cr w
w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse
. equipEffect
. uequipEffect
. eeParams
. eparamInt
-~ 1
+8 -7
View File
@@ -1,4 +1,7 @@
module Dodge.Item.Weapon.Radar where
module Dodge.Item.Weapon.Radar
( autoDetector
, detectorEffect
) where
import Control.Lens
import Dodge.Data.World
@@ -8,14 +11,12 @@ import Dodge.RadarSweep
autoDetector :: Detector -> Item
autoDetector dt =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnWrist
& itUse . equipEffect . eeUse .~ EDetector dt --autoEffect (detectorEffect dt) 100 click1S
& itUse . equipEffect . eeParams .~ EquipCounter 0
& itUse . equipEffect . eeViewDist ?~ 350
& itUse . uequipEffect . eeSite .~ GoesOnWrist
& itUse . uequipEffect . eeUse .~ EDetector dt --autoEffect (detectorEffect dt) 100 click1S
& itUse . uequipEffect . eeParams .~ EquipCounter 0
& itUse . uequipEffect . eeViewDist ?~ 350
& itType .~ EQUIP (AUTODETECTOR dt)
-- , _itEffect = autoRadarEffect
detectorEffect :: Detector -> Item -> Creature -> World -> World
detectorEffect dt = case dt of
ITEMDETECTOR -> const (aRadarPulse ObItem)
+5 -27
View File
@@ -17,7 +17,7 @@ stopWatch =
& itUse
.~ ( defaultLeftUse
& leftUse .~ LTimePause
& equipEffect . eeSite .~ GoesOnWrist
& uequipEffect . eeSite .~ GoesOnWrist
)
& itEffect . ieInv .~ ChargeIfEquipped
& itEffect . ieOnDrop .~ SetCharge 0
@@ -53,9 +53,8 @@ blinkGun =
defaultLeftItem
{ _itUse =
defaultLeftUse
& leftUse .~ LBlink --hammerCheckL (shootL $ const blinkAction)
& equipEffect . eeSite .~ GoesOnWrist
-- , _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2
& leftUse .~ LBlink
& uequipEffect . eeSite .~ GoesOnWrist
}
& itType .~ LEFT BLINKER
@@ -63,26 +62,5 @@ unsafeBlinkGun :: Item
unsafeBlinkGun =
blinkGun
& itType .~ LEFT BLINKERUNSAFE
& itUse . leftUse .~ LUnsafeBlink --hammerCheckL (shootL $ const unsafeBlinkAction)
& itUse . equipEffect . eeViewDist ?~ 400
-- grapGun = defaultGun
-- { _itName = "grapGun"
-- , _itIdentity = GrapGun
-- , _wpMaxAmmo = 1
-- , _wpLoadedAmmo = 1
-- , _wpReloadTime = 40
-- , _wpReloadState = 0
-- , _itUseRate = 10
-- , _itUseTime = 0
-- , _itUse = grapFire
-- , _wpSpread = 0.002
-- , _wpRange = 20
-- , _wpIsAuto = False
-- , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
-- , _itAmount = 1
-- , _itMaxStack = 1
-- , _itAimingSpeed = 1
-- , _itAimingRange = 0.5
-- }
& itUse . leftUse .~ LUnsafeBlink
& itUse . uequipEffect . eeViewDist ?~ 400
+1 -1
View File
@@ -133,7 +133,7 @@ drawRBOptions :: Configuration -> World -> Picture
drawRBOptions cfig w = fromMaybe mempty $ do
guard $ ButtonRight `M.member` _mouseButtons (_input w)
invid <- you w ^? crManipulation . manObject . imSelectedItem
eslist <- fmap equipSiteToPositions $ you w ^? crInv . ix invid . itUse . equipEffect . eeSite
eslist <- fmap equipSiteToPositions $ you w ^? crInv . ix invid . itUse . uequipEffect . eeSite
i <- w ^? rbOptions . opSel
let ae = getEquipmentAllocation w
sss <- w ^? hud . hudElement . diSections
+7 -20
View File
@@ -2,15 +2,12 @@ module Dodge.Targeting.Draw (
drawTargeting,
) where
import Dodge.Base.Coordinate
import Data.Maybe
import Control.Lens
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Data.Universe
import Geometry.Data
--import Geometry.Vector
--import LensHelp
import Picture
--import ShortShow
-- it would be nice to get rid of some redundant checks here
drawTargeting :: Item -> World -> Picture
@@ -19,24 +16,14 @@ drawTargeting itm w = fromMaybe mempty $ do
let thepic = case itm ^? itUse . tgActive of
Just True -> activeTargetCursorPic
_ -> targetCursorPic
return .
setLayer FixedCoordLayer $
color white $
uncurryV translate (worldPosToScreen (w ^. wCam) p) thepic
return
. setLayer FixedCoordLayer
. color white
$ uncurryV translate (worldPosToScreen (w ^. wCam) p) thepic
activeTargetCursorPic :: Picture
activeTargetCursorPic =
fold
[rotate a $ line [V2 15 0, V2 10 0] <> targCorner | a <- [0, 0.5 * pi, pi, 1.5 * pi]]
--transMidLine :: Point2 -> Point2 -> Picture -> Picture
--transMidLine p1 p2 = translate 20 (f p1 p2) . uncurryV translate (0.5 *.* (p1 +.+ p2))
-- where
-- f (V2 x y) (V2 x' y')
-- | y > y' && x > x' = max (-10) (x' - x)
-- | y > y' && x < x' = min 10 (x' - x)
-- | x > x' = min 10 (x - x')
-- | otherwise = max (-10) (x - x')
fold [rotate (a * pi) $ line [V2 15 0, V2 10 0] <> targCorner | a <- [0, 0.5, 1, 1.5]]
targCorner :: Picture
targCorner = line [V2 (x - y) x, V2 x x, V2 x (x - y)]
+1 -1
View File
@@ -116,7 +116,7 @@ moveZoomCamera cfig theinput cr w campos =
wallZoom = min4 (campos ^. camBoundDist)
min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
maxd = max distFromEqmnt
distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment cr
distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _uequipEffect . _itUse) $ getCrEquipment cr
hw = halfWidth cfig
hh = halfHeight cfig
-- these speeds are inverted, larger means slower
+1 -1
View File
@@ -48,7 +48,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
where
rbscrollmax = fromMaybe 1 $ do
invid <- you w ^? crManipulation . manObject . imSelectedItem
esite <- you w ^? crInv . ix invid . itUse . equipEffect . eeSite
esite <- you w ^? crInv . ix invid . itUse . uequipEffect . eeSite
return $ length $ equipSiteToPositions esite
y = fromIntegral yi
numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1