From 65fcea0f508cbba8746a8371aff8459ec58c508c Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 5 Jun 2022 01:50:18 +0100 Subject: [PATCH] Allow for equipment items to set a minimum view distance --- src/Dodge/Creature/Impulse/UseItem.hs | 6 ++-- src/Dodge/Creature/State.hs | 2 +- src/Dodge/Creature/YourControl.hs | 4 +-- src/Dodge/Data.hs | 24 +++++++------- src/Dodge/Default.hs | 8 +---- src/Dodge/Default/Weapon.hs | 7 +++- src/Dodge/Equipment.hs | 9 ++++++ src/Dodge/Inventory.hs | 4 +-- src/Dodge/Item/Equipment.hs | 46 +++++++++++++-------------- src/Dodge/Item/Weapon/ExtraEffect.hs | 6 ++-- src/Dodge/Item/Weapon/Radar.hs | 7 ++-- src/Dodge/Item/Weapon/Utility.hs | 5 +-- src/Dodge/Update/Camera.hs | 9 ++++-- 13 files changed, 76 insertions(+), 61 deletions(-) create mode 100644 src/Dodge/Equipment.hs diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 21322f337..b65bce137 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -73,8 +73,8 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of crpoint = creatures . ix (_crID cr) itmat i = _crInv cr IM.! i itm = itmat (_crInvSel cr) - onequip itm' = (_eqOnEquip . _itUse) itm' itm' - onremove itm' = (_eqOnRemove . _itUse) itm' itm' + onequip itm' = (_eqOnEquip . _eqEq . _itUse) itm' itm' + onremove itm' = (_eqOnRemove . _eqEq . _itUse) itm' itm' useLeftItem :: Int -> World -> World useLeftItem cid w @@ -88,7 +88,7 @@ useLeftItem cid w where cr = _creatures w IM.! cid itmShouldBeUsed = isJust (cr ^? crInv . ix (_crInvSel cr) . itUse . cUse) - || ( isJust (cr ^? crInv . ix (_crInvSel cr) . itUse . eqUse) + || ( isJust (cr ^? crInv . ix (_crInvSel cr) . itUse . eqEq . eqUse) && _crLeftInvSel cr /= Just (_crInvSel cr) ) -- TODO determine itmShouldBeUsed with reference to config options diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 8d0ccc386..7d4fd45a2 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -200,7 +200,7 @@ useUpdate = (useHammer . hammerPosition %~ moveHammerUp) . (useDelay . rateTime %~ decreaseToZero) useEquipment :: Creature -> Int -> World -> World -useEquipment cr i = _eqUse (_itUse itm) itm cr +useEquipment cr i = _eqUse (_eqEq $ _itUse itm) itm cr where itm = _crInv cr IM.! i -- a map updating all inventory items diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index a9ca87da8..79eddcdf4 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -54,9 +54,7 @@ wasdWithAiming w speed cr isReloading = _posture (_crStance cr) == Reloading mouseDir = case cr ^? crInv . ix (_crInvSel cr) . itScope . scopePos of Just _ -> argV $ mouseWorldPos w -.- _crPos cr --- Just p -> normalizeAngle $ argV --- $ p +.+ 2 / _cameraZoom w *.* rotateV (_cameraRot w) (_mousePos w) - _ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w + _ -> argV (_mousePos w) + _cameraRot w wasdM :: SDL.Scancode -> Point2 wasdM scancode = case scancode of diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index bcad8fe2a..debee1ee3 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -459,23 +459,24 @@ data ItemUse { _lUse :: Item -> Creature -> World -> World , _useDelay :: UseDelay , _useHammer :: HammerType - , _eqSite :: EquipSite - , _eqUse :: Item -> Creature -> World -> World - , _eqOnEquip :: Item -> Creature -> World -> World - , _eqOnRemove :: Item -> Creature -> World -> World - , _eqParams :: EquipParams + , _eqEq :: Equipment } | ConsumeUse { _cUse :: Item -> Creature -> World -> World } - | EquipUse - { _eqUse :: Item -> Creature -> World -> World - , _eqOnEquip :: Item -> Creature -> World -> World - , _eqOnRemove :: Item -> Creature -> World -> World - , _eqSite :: EquipSite - , _eqParams :: EquipParams + | EquipUse + { _eqEq :: Equipment } | NoUse +data Equipment = Equipment + { _eqUse :: Item -> Creature -> World -> World + , _eqOnEquip :: Item -> Creature -> World -> World + , _eqOnRemove :: Item -> Creature -> World -> World + , _eqSite :: EquipSite + , _eqParams :: EquipParams + , _eqViewDist :: Maybe Float + } + _itUseAimStance :: Item -> AimStance _itUseAimStance = _aimStance . _useAim . _itUse data ItemConsumption @@ -1587,6 +1588,7 @@ makeLenses ''SubInventory makeLenses ''TerminalParams makeLenses ''TerminalLine makeLenses ''ItemValue +makeLenses ''Equipment makeLenses ''ScreenLayer makeLenses ''Sensor makeLenses ''Beam diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 0866afaec..24a706d8e 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -164,13 +164,7 @@ defaultEquipment = Item , _itInvPos = Nothing , _itDimension = defItDimCol yellow , _itConsumption = NoConsumption - , _itUse = EquipUse - {_eqUse = \_ _ -> id - ,_eqOnEquip = \_ _ -> id - ,_eqOnRemove = \_ _ -> id - ,_eqSite = GoesOnSpecial - ,_eqParams = NoEquipParams - } + , _itUse = EquipUse defaultEquip , _itAttachment = NoItAttachment , _itParams = NoParams , _itTweaks = NoTweaks diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 57997dc9c..0d5791f6f 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -68,11 +68,16 @@ defaultlUse = LeftUse { _lUse = \_ _ -> id , _useDelay = FixedRate {_rateMax = 8, _rateTime = 0} , _useHammer = NoHammer - , _eqSite = GoesOnSpecial + , _eqEq = defaultEquip + } +defaultEquip :: Equipment +defaultEquip = Equipment + { _eqSite = GoesOnSpecial , _eqUse = \_ _ -> id , _eqOnEquip = \_ _ -> id , _eqOnRemove = \_ _ -> id , _eqParams = NoEquipParams + , _eqViewDist = Nothing } luseInstantNoH :: (Item -> Creature -> World -> World) -> ItemUse diff --git a/src/Dodge/Equipment.hs b/src/Dodge/Equipment.hs new file mode 100644 index 000000000..0df236357 --- /dev/null +++ b/src/Dodge/Equipment.hs @@ -0,0 +1,9 @@ +module Dodge.Equipment where +import Dodge.Data + +import qualified Data.IntMap.Strict as IM +import Data.IntMap.Merge.Strict + +getCrEquipment :: Creature -> IM.IntMap Item +getCrEquipment cr = merge dropMissing dropMissing (zipWithMatched $ \_ _ -> id) + (_crInvEquipped cr) (_crInv cr) diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 082436c70..d1608e78e 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -67,7 +67,7 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons cr = _creatures w IM.! cid itm = _crInv cr IM.! invid dounequipfunction = fromMaybe id $ do - rmf <- itm ^? itUse . eqOnRemove + rmf <- itm ^? itUse . eqEq . eqOnRemove return $ rmf itm cr doanyitemeffect = fromMaybe id $ do rmf <- itm ^? itEffect . itEffectDrop @@ -196,7 +196,7 @@ updateRBList :: World -> World updateRBList w | w ^? rbOptions . opCurInvPos == Just curinvid = w & setEquipAllocation & setEquipActivation - | otherwise = case cr ^? crInv . ix curinvid . itUse . eqSite of + | otherwise = case cr ^? crInv . ix curinvid . itUse . eqEq . eqSite of Just esite -> w & rbOptions .~ EquipOptions (equipSiteToPositions esite) (chooseEquipmentPosition cr (equipSiteToPositions esite)) diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index b01b4f636..c0837c09b 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -27,8 +27,8 @@ magShield = defaultEquipment , _itID = Nothing , _itAttachment = ItMInt Nothing } - & itUse . eqUse .~ useMagShield - & itUse . eqSite .~ GoesOnWrist + & itUse . eqEq . eqUse .~ useMagShield + & itUse . eqEq . eqSite .~ GoesOnWrist useMagShield :: Item -> Creature -> World -> World useMagShield it cr w = w & magnets . at mgid ?~ themagnet where @@ -49,7 +49,7 @@ flameShield = defaultEquipment , _itName = "FLAMESHIELD" , _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)] , _itID = Nothing - } & itUse . eqSite .~ GoesOnChest + } & itUse . eqEq . eqSite .~ GoesOnChest {- | Slows you down, blocks forward projectiles. -} frontArmour :: Item frontArmour = defaultEquipment @@ -61,7 +61,7 @@ frontArmour = defaultEquipment ]) , _itID = Nothing } - & itUse . eqSite .~ GoesOnChest + & itUse . eqEq . eqSite .~ GoesOnChest where thecol = yellow -- (greyN 0.1) @@ -72,32 +72,32 @@ wristArmour = defaultEquipment , _itEquipPict = spicForWrist mempty , _itID = Nothing } - & itUse . eqSite .~ GoesOnWrist - & itUse . eqOnEquip .~ onEquipWristShield - & itUse . eqUse .~ setWristShieldPos - & itUse . eqOnRemove .~ onRemoveWristShield + & itUse . eqEq . eqSite .~ GoesOnWrist + & itUse . eqEq . eqOnEquip .~ onEquipWristShield + & itUse . eqEq . eqUse .~ setWristShieldPos + & itUse . eqEq . eqOnRemove .~ onRemoveWristShield onEquipWristShield :: Item -> Creature -> World -> World onEquipWristShield itm cr w = w - & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqParams .~ EquipID i + & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqEq . eqParams .~ EquipID i & walls . at i ?~ (shieldWall (_crID cr)) {_wlDraw = True,_wlID = i} - & setWristShieldPos (itm & itUse . eqParams .~ EquipID i) cr + & setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr where i = IM.newKey (_walls w) onRemoveWristShield :: Item -> Creature -> World -> World onRemoveWristShield itm cr w = w - & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqParams .~ NoEquipParams + & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams & deleteWallID i where - i = _eparamID $ _eqParams $ _itUse itm + i = _eparamID $ _eqParams $ _eqEq $ _itUse itm setWristShieldPos :: Item -> Creature -> World -> World setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline -- & testString .~ (\w' -> [shortShow $ _wlLine (_walls w' IM.! i)]) -- & tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 (fst wlline `v2z` 40) where - i = _eparamID $ _eqParams $ _itUse itm + i = _eparamID $ _eqParams $ _eqEq $ _itUse itm wlline = (f (V3 (-10) 7 0), f (V3 10 7 0)) invid = fromJust (_itInvPos itm) --wlline = (V2 10 0, V2 (-10) 100) @@ -222,7 +222,7 @@ jetPack = defaultEquipment $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ] , _itEffect = NoItEffect , _itID = Nothing - } & itUse . eqSite .~ GoesOnBack + } & itUse . eqEq . eqSite .~ GoesOnBack brainHat :: Item brainHat = defaultEquipment @@ -232,7 +232,7 @@ brainHat = defaultEquipment , _itEffect = NoItEffect , _itID = Nothing } - & itUse . eqSite .~ GoesOnHead + & itUse . eqEq . eqSite .~ GoesOnHead headLamp1 :: Item headLamp1 = defaultEquipment @@ -246,8 +246,8 @@ headLamp1 = defaultEquipment , _itEffect = NoItEffect , _itID = Nothing } - & itUse . eqUse .~ createHeadLamp - & itUse . eqSite .~ GoesOnHead + & itUse . eqEq . eqUse .~ createHeadLamp + & itUse . eqEq . eqSite .~ GoesOnHead headLamp :: Item headLamp = defaultEquipment { _itType = HEADLAMP @@ -256,8 +256,8 @@ headLamp = defaultEquipment , _itEffect = NoItEffect , _itID = Nothing } - & itUse . eqUse .~ createHeadLamp - & itUse . eqSite .~ GoesOnHead + & itUse . eqEq . eqUse .~ createHeadLamp + & itUse . eqEq . eqSite .~ GoesOnHead headLampShape :: Shape headLampShape = colorSH yellow $ @@ -278,7 +278,7 @@ powerLegs = defaultEquipment , _itEffect = NoItEffect , _itID = Nothing } - & itUse . eqSite .~ GoesOnLegs + & itUse . eqEq . eqSite .~ GoesOnLegs speedLegs :: Item speedLegs = powerLegs { _itType = SPEEDLEGS @@ -297,9 +297,9 @@ wristInvisibility = defaultEquipment , _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2) , _itID = Nothing } - & itUse . eqSite .~ GoesOnWrist - & itUse . eqOnEquip .~ overCID (crCamouflage .~ Invisible) - & itUse . eqOnRemove .~ overCID (crCamouflage .~ FullyVisible) + & itUse . eqEq . eqSite .~ GoesOnWrist + & itUse . eqEq . eqOnEquip .~ overCID (crCamouflage .~ Invisible) + & itUse . eqEq . eqOnRemove .~ overCID (crCamouflage .~ FullyVisible) overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World overCID f _ cr = creatures . ix (_crID cr) %~ f diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 51691d3e2..09e480a26 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -36,13 +36,13 @@ import qualified Data.Set as S import qualified SDL autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World autoEffect eff t sid itm cr w - | _eparamInt (_eqParams (_itUse itm)) < 1 = eff itm cr w + | _eparamInt (_eqParams (_eqEq $ _itUse itm)) < 1 = eff itm cr w & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm) - . itUse . eqParams . eparamInt .~ t + . itUse . eqEq . eqParams . eparamInt .~ t & soundStart OnceSound (_crPos cr) sid Nothing | otherwise = w & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm) - . itUse . eqParams . eparamInt -~ 1 + . itUse . eqEq . eqParams . eparamInt -~ 1 {- | Automatically send out radar pulses that detect walls. -} autoRadarEffect :: Item -> Creature -> World -> World diff --git a/src/Dodge/Item/Weapon/Radar.hs b/src/Dodge/Item/Weapon/Radar.hs index 4d0207338..8d88270f9 100644 --- a/src/Dodge/Item/Weapon/Radar.hs +++ b/src/Dodge/Item/Weapon/Radar.hs @@ -47,9 +47,10 @@ autoDetector dt = defaultEquipment -- , _itEffect = autoRadarEffect , _itID = Nothing } - & itUse . eqSite .~ GoesOnWrist - & itUse . eqUse .~ autoEffect (detectorEffect dt) 100 click1S - & itUse . eqParams .~ EquipCounter 0 + & itUse . eqEq . eqSite .~ GoesOnWrist + & itUse . eqEq . eqUse .~ autoEffect (detectorEffect dt) 100 click1S + & itUse . eqEq . eqParams .~ EquipCounter 0 + & itUse . eqEq . eqViewDist ?~ 350 detectorColor :: Detector -> Color detectorColor dt = case dt of diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index dab1b063e..40e53e70f 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -32,7 +32,7 @@ rewindGun = defaultGun , _itEffect = ItRewindEffect rewindEffect [] , _itUse = defaultlUse & lUse .~ useRewindGun - & eqSite .~ GoesOnChest + & eqEq . eqSite .~ GoesOnChest } rewindEffect :: Item -> Creature -> World -> World rewindEffect itm cr w @@ -106,7 +106,7 @@ blinkGun = defaultGun , _itUse = defaultlUse & lUse .~ hammerCheckL (shootL $ const blinkAction) & useHammer .~ upHammer - & eqSite .~ GoesOnWrist + & eqEq . eqSite .~ GoesOnWrist -- , _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2 } @@ -115,6 +115,7 @@ unsafeBlinkGun = blinkGun & itName .~ "BLINKER-UNSAFE" & itType .~ BLINKERUNSAFE & itUse . lUse .~ hammerCheckL (shootL $ const unsafeBlinkAction) + & itUse . eqEq . eqViewDist ?~ 400 effectGun :: String -> (Creature -> World -> World) -> Item effectGun name eff = defaultGun diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index e38753030..e647d3506 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -8,6 +8,7 @@ module Dodge.Update.Camera import Dodge.Data import Dodge.Base import Dodge.Zone +import Dodge.Equipment import Dodge.Creature.Test import Geometry --import Geometry.ConvexPoly @@ -110,7 +111,7 @@ zoomInLongGun w wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0) Just currentZoom = wp ^? itScope . scopeZoom - newzoom = fromJust (wp ^? itScope . scopeZoom) / zoomSpeed + newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed mousep = rotateV (_cameraRot w) $ _mousePos w zoomOutLongGun :: World -> World @@ -188,7 +189,9 @@ setViewDistance cfig w = w & viewDistance -- TODO consider adding visible/nearby creatures as view points farWallDist :: Point2 -> Configuration -> World -> Float -farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps +--farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps +farWallDist p cfig w = (winFac /) + . min maxViewDistance $ ssfold (> maxViewDistance) findMax distFromEqmnt vps where findMax curMax pout = max curMax $ dist p $ collidePointUpToIndirectMinDist p pout curMax wos hw = halfWidth cfig @@ -197,6 +200,8 @@ farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDista vps = concatMap _grViewpoints grs ++ extendedViewPoints p grs grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) wos = wallsOnScreen cfig w + distFromEqmnt = foldr max 1 $ IM.mapMaybe (_eqViewDist . _eqEq. _itUse) $ getCrEquipment $ you w + extendedViewPoints :: Point2 -> [GameRoom] -> [Point2] extendedViewPoints p grs = map extend