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

Allow for equipment items to set a minimum view distance

Browse Source
This commit is contained in:
justin
2022-06-05 01:50:18 +01:00
parent 5e144b1cd5
commit 65fcea0f50
13 changed files with 76 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+3 -3
View File
@@ -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
src/Dodge/Creature/State.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/YourControl.hs
+1 -3
View File
@@ -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
src/Dodge/Data.hs
+13 -11
View File
@@ -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
src/Dodge/Default.hs
+1 -7
View File
@@ -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
src/Dodge/Default/Weapon.hs
+6 -1
View File
@@ -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
src/Dodge/Equipment.hs
+9
View File
@@ -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)
src/Dodge/Inventory.hs
+2 -2
View File
@@ -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))
src/Dodge/Item/Equipment.hs
+23 -23
View File
@@ -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
src/Dodge/Item/Weapon/ExtraEffect.hs
+3 -3
View File
@@ -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
src/Dodge/Item/Weapon/Radar.hs
+4 -3
View File
@@ -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
src/Dodge/Item/Weapon/Utility.hs
+3 -2
View File
@@ -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
src/Dodge/Update/Camera.hs
+7 -2
View File
@@ -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