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

Improve detector equipment, various cleanup

Browse Source
This commit is contained in:
justin
2022-05-27 18:49:54 +01:00
parent 60fc2d44e8
commit 79b3a86520
15 changed files with 180 additions and 138 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Equipment.hs
+15 -18
View File
@@ -1,6 +1,7 @@
module Dodge.Item.Equipment where
import Dodge.Data
import Dodge.Item.Draw
import Dodge.Item.Equipment.Shape
import Dodge.Item.Weapon.InventoryDisplay
import Dodge.LightSource
import Dodge.Default
@@ -58,7 +59,6 @@ frontArmour = defaultEquipment
[color thecol $ thickArc 0 (pi/2) 10 5
,color thecol $ thickArc (3*pi/2) (2*pi) 10 5
])
, _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqSite .~ GoesOnChest
@@ -70,7 +70,6 @@ wristArmour = defaultEquipment
{ _itType = WRISTARMOUR
, _itName = "WRISTARMOUR"
, _itEquipPict = spicForWrist mempty
, _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqSite .~ GoesOnWrist
@@ -109,22 +108,6 @@ setWristShieldPos itm cr w = w
| otherwise = id
f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
spicForWrist :: SPic -> Creature -> Item -> SPic
spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4))
pictureOnEquip :: SPic -> Creature -> Item -> SPic
pictureOnEquip sp cr itm = fromMaybe mempty $ do
i <- _itInvPos itm
epos <- cr^? crInvEquipped . ix i
return $ equipPosition epos cr sp
equipPosition :: EquipPosition -> Creature -> SPic -> SPic
equipPosition epos cr sh = case epos of
OnLeftWrist -> translateToLeftHand cr sh
OnRightWrist -> translateToRightHand cr sh
OnLegs -> translateToLeftLeg cr sh <>
translateToRightLeg cr (mirrorSPxz sh)
OnHead -> translateToHead cr sh
OnChest -> translateToChest cr sh
_ -> sh
flatShield :: Item
flatShield = defaultEquipment
@@ -306,3 +289,17 @@ jumpLegs = powerLegs
{ _itType = JUMPLEGS
, _itName = "JUMPLEGS"
}
wristInvisibility :: Item
wristInvisibility = defaultEquipment
{ _itType = INVISIBILITYEQUIPMENT GoesOnWrist
, _itName = "WRISTINVISIBILITY"
, _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2)
, _itID = Nothing
}
& itUse . eqSite .~ GoesOnWrist
& itUse . eqOnEquip .~ overCID (crCamouflage .~ Invisible)
& itUse . eqOnRemove .~ overCID (crCamouflage .~ FullyVisible)
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
overCID f _ cr = creatures . ix (_crID cr) %~ f
src/Dodge/Item/Equipment/Shape.hs
+29
View File
@@ -0,0 +1,29 @@
module Dodge.Item.Equipment.Shape where
import Dodge.Data
import Dodge.Creature.HandPos
import Shape
import ShapePicture
import Geometry
import LensHelp
import Data.Maybe
shapeForWrist :: Shape -> Creature -> Item -> SPic
shapeForWrist = pictureOnEquip . noPic . translateSH (V3 0 4 (-4))
spicForWrist :: SPic -> Creature -> Item -> SPic
spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4))
pictureOnEquip :: SPic -> Creature -> Item -> SPic
pictureOnEquip sp cr itm = fromMaybe mempty $ do
i <- _itInvPos itm
epos <- cr^? crInvEquipped . ix i
return $ equipPosition epos cr sp
equipPosition :: EquipPosition -> Creature -> SPic -> SPic
equipPosition epos cr sh = case epos of
OnLeftWrist -> translateToLeftHand cr sh
OnRightWrist -> translateToRightHand cr sh
OnLegs -> translateToLeftLeg cr sh <>
translateToRightLeg cr (mirrorSPxz sh)
OnHead -> translateToHead cr sh
OnChest -> translateToChest cr sh
_ -> sh
src/Dodge/Item/Weapon/ExtraEffect.hs
+4 -4
View File
@@ -34,9 +34,9 @@ import Data.Maybe
--import qualified Control.Foldl as L
import qualified Data.Set as S
import qualified SDL
autoEffect :: (Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
autoEffect eff t sid itm cr w
| _eparamInt (_eqParams (_itUse itm)) < 1 = eff cr w
| _eparamInt (_eqParams (_itUse itm)) < 1 = eff itm cr w
& creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
. itUse . eqParams . eparamInt .~ t
& soundStart OnceSound (_crPos cr) sid Nothing
@@ -46,10 +46,10 @@ autoEffect eff t sid itm cr w
{- | Automatically send out radar pulses that detect walls. -}
autoRadarEffect :: Item -> Creature -> World -> World
autoRadarEffect = autoEffect aWallPulse 100 click1S
autoRadarEffect = autoEffect (const aWallPulse) 100 click1S
{- | Automatically send out sonar pulses that detect creatures. -}
autoSonarEffect :: Item -> Creature -> World -> World
autoSonarEffect = autoEffect aSonarPulse 50 click1S
autoSonarEffect = autoEffect (const aSonarPulse) 50 click1S
defaultTargeting :: Targeting
defaultTargeting = Targeting
{ _tgPos = Nothing
src/Dodge/Item/Weapon/Radar.hs
+25 -59
View File
@@ -3,7 +3,8 @@ import Dodge.Data
--import Dodge.Picture.Layer
import Dodge.Default
import Dodge.Item.Draw
import Dodge.Item.Equipment
--import Dodge.Item.Equipment
import Dodge.Item.Equipment.Shape
import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.UseEffect
@@ -14,22 +15,22 @@ import Dodge.SoundLogic
import Geometry
import Picture
import Shape
import ShapePicture
--import ShapePicture
import Control.Lens
{- |
Sends out pulses that display walls. -}
radar :: Item
radar = defaultGun
{ _itName = "RADAR"
, _itType = RADAR
clickDetector :: Detector -> Item
clickDetector dt = defaultGun
{ _itName = show dt
, _itType = CLICKDETECTOR dt
, _itConsumption = defaultAmmo
{ _ammoBaseMax = 100
, _ammoLoaded = 100
, _reloadTime = 200
}
, _itUse = ruseRate 120 (const aWallPulse) upHammer
, _itUse = ruseRate 20 (detectorEffect dt) upHammer
[ ammoUseCheck
]
& useAim . aimRange .~ 1
@@ -37,62 +38,27 @@ radar = defaultGun
-- , _itZoom = defaultItZoom { _itZoomMax = 1}
, _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
}
{- |
Sends out pulses that display creatures. -}
sonar :: Item
sonar = defaultGun
{ _itName = "SONAR"
, _itType = RADAR
, _itConsumption = defaultAmmo
{ _ammoBaseMax = 100
, _ammoLoaded = 100
, _reloadTime = 200
}
, _itUse = ruseRate 120 (const aSonarPulse) upHammer
[ ammoUseCheck
]
& useAim . aimRange .~ 1
& useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1}
, _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
}
{- |
Automatically sends out pulses that display creatures. -}
autoSonar :: Item
autoSonar = defaultEquipment
{ _itType = RADAR
, _itName = "AUTOSONAR"
, _itEquipPict = shapeForWrist (colorSH red $ upperPrismPoly 3 $ rectWH 2 2)
, _itID = Nothing
} & itUse . eqSite .~ GoesOnWrist
& itUse . eqUse .~ autoSonarEffect
& itUse . eqParams .~ EquipCounter 0
{- |
Automatically sends out pulses that display walls. -}
autoRadar :: Item
autoRadar = defaultEquipment
{ _itType = RADAR
, _itName = "WALLFINDER"
, _itEquipPict = shapeForWrist (colorSH red $ upperPrismPoly 3 $ rectWH 2 2)
autoDetector :: Detector -> Item
autoDetector dt = defaultEquipment
{ _itType = AUTODETECTOR dt
, _itName = "AUTO-" ++ show dt
, _itEquipPict = shapeForWrist (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2)
-- , _itEffect = autoRadarEffect
, _itID = Nothing
}
& itUse . eqSite .~ GoesOnWrist
& itUse . eqUse .~ autoRadarEffect
& itUse . eqUse .~ autoEffect (detectorEffect dt) 100 click1S
& itUse . eqParams .~ EquipCounter 0
{- |
Automatically sends out pulses that display walls. -}
itemFinder :: Item
itemFinder = defaultEquipment
{ _itType = ITEMFINDER
, _itName = "ITEMFINDER"
, _itEquipPict = shapeForWrist (colorSH blue $ upperPrismPoly 3 $ rectWH 2 2)
-- , _itEffect = autoRadarEffect
, _itID = Nothing
}
& itUse . eqSite .~ GoesOnWrist
& itUse . eqUse .~ autoEffect anItemFindPulse 100 click1S
& itUse . eqParams .~ EquipCounter 0
detectorColor :: Detector -> Color
detectorColor dt = case dt of
ITEMDETECTOR -> blue
CREATUREDETECTOR -> green
WALLDETECTOR -> red
shapeForWrist :: Shape -> Creature -> Item -> SPic
shapeForWrist = pictureOnEquip . noPic . translateSH (V3 0 4 (-4))
detectorEffect :: Detector -> Item -> Creature -> World -> World
detectorEffect dt = case dt of
ITEMDETECTOR -> const anItemFindPulse
CREATUREDETECTOR -> const aSonarPulse
WALLDETECTOR -> const aWallPulse
src/Dodge/Item/Weapon/UseEffect.hs
+40 -19
View File
@@ -16,17 +16,15 @@ import Data.Maybe
import qualified Data.IntMap.Strict as IM
{- | Creates an outwardly increasing circle that draws creatures, even those behind walls. -}
aSonarPulse :: Creature -> World -> World
--aSonarPulse cr = instantParticles .:~ sonarPulseAt (_crPos cr)
aSonarPulse = aRadarPulse crBlips (blipAt 8) green
aSonarPulse = aRadarPulse crBlips (blipAt 8) (withAlpha 0.2 green)
aWallPulse :: Creature -> World -> World
aWallPulse = aRadarPulse wallBlips (blipAt 2) red
{- | Creates an outwardly increasing circle that displays items. -}
anItemFindPulse :: Creature -> World -> World
anItemFindPulse = aRadarPulse itemBlips (blipAt 6) blue
anItemFindPulse = aRadarPulse itemBlips (openBlipAt 6) blue
{- | Creates an outwardly increasing circle that displays walls, even those behind other walls. -}
aRadarPulse :: (Point2 -> Float -> World -> [Point2])
-> (Point2 -> Color -> Int -> Particle)
-> Color
@@ -37,7 +35,7 @@ aRadarPulse blipsF bf col cr = instantParticles .:~ RadarCircleParticle
, _ptUpdate = mvRadar blipsF bf col (_crPos cr)
, _ptTimer = 100
, _ptRad = 0
, _ptPos = (_crPos cr)
, _ptPos = _crPos cr
}
drawPulse :: Color -> Particle -> Picture
drawPulse col pt = setLayer DebugLayer $ pictures sweepPics
@@ -63,17 +61,39 @@ mvBlip :: Float
-> Int -- ^ Max possible timer value
-> Int -- ^ Current timer value
-> World -> Particle -> (World, Maybe Particle)
mvBlip _ _ _ _ 0 w _ = (w, Nothing)
mvBlip r p col maxt t w pt =
(w
, Just $ pt & ptUpdate .~ mvBlip r p col maxt (t-1)
& ptDraw .~ ( const
. setDepth (-0.5)
. setLayer DebugLayer
. uncurryV translate p
. color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid r )
)
mvBlip r p col maxt t w pt = case t of
0 -> (w, Nothing)
_ -> (w
, Just $ pt & ptUpdate .~ mvBlip r p col maxt (t-1)
& ptDraw .~ ( const
. setDepth (-0.5)
. setLayer DebugLayer
. uncurryV translate p
. color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid r )
)
{- | Radar blip at a point. -}
openBlipAt :: Float -> Point2 -> Color -> Int -> Particle
openBlipAt r p col i = Particle
{_ptDraw = const blank
,_ptUpdate = mvOpenBlip r p col i i
}
mvOpenBlip :: Float
-> Point2 -> Color
-> Int -- ^ Max possible timer value
-> Int -- ^ Current timer value
-> World -> Particle -> (World, Maybe Particle)
mvOpenBlip r p col maxt t w pt = case t of
0 -> (w, Nothing)
_ -> (w
, Just $ pt & ptUpdate .~ mvOpenBlip r p col maxt (t-1)
& ptDraw .~ ( const
. setDepth (-0.5)
. setLayer DebugLayer
. uncurryV translate p
. color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ thickCircle r 3)
)
mvRadar
:: (Point2 -> Float -> World -> [Point2])
@@ -102,13 +122,14 @@ itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems
f q = dist p q <= r && dist p q > r - 4
wallBlips :: Point2 -> Float -> World -> [Point2]
wallBlips p r w = mapMaybe (\wl -> uncurry (intersectCircSegFirst p r) (_wlLine wl))
wallBlips p r w = mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine)
$ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w)
++ IM.elems (wallsAlongCirc p r w)
where
swp (a,b) = (b,a)
crBlips :: Point2 -> Float -> World -> [Point2]
crBlips p r = IM.elems . IM.filter f . fmap _crPos . _creatures
crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures
where
f q = dist p q <= r && dist p q > r - 4
f q = dist p q <= r && dist p q > r - 100
g cr = _crID cr /= 0