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

Add basic booster

Browse Source
This commit is contained in:
jgk
2021-05-24 13:59:51 +02:00
parent cda035b1d1
commit 968273bf25
20 changed files with 276 additions and 324 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+2 -6
View File
@@ -19,7 +19,7 @@ hasLOS p1 p2 w = not $ pointHitsWalls p1 p2 $ wallsAlongLine p1 p2 w
reflectPointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
reflectPointWalls p1 p2 ws
= listToMaybe
. sortOn f
. sortOn (dist p1 . fst)
. IM.elems
$ IM.mapMaybe
(( \(x,y) ->
@@ -29,8 +29,6 @@ reflectPointWalls p1 p2 ws
(intersectSegSeg' p1 p2 x y)
)
. _wlLine) ws
where
f (a,_) = magV (p1 -.- a)
-- | Looks for first collision of a point with walls.
-- If found, gives point and reflection velocity, reflection damped in normal.
reflectPointWallsDamped
@@ -41,7 +39,7 @@ reflectPointWallsDamped
-> Maybe (Point2,Point2)
reflectPointWallsDamped dfact p1 p2 ws
= listToMaybe
. sortOn f
. sortOn (dist p1 . fst)
. IM.elems
$ IM.mapMaybe
(( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1))
@@ -49,8 +47,6 @@ reflectPointWallsDamped dfact p1 p2 ws
(intersectSegSeg' p1 p2 x y))
. _wlLine
) ws
where
f (a,_) = magV (p1 -.- a)
-- | Test if a point collides with walls
pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
pointHitsWalls p1 p2
src/Dodge/Config/KeyConfig.hs
+2 -2
View File
@@ -46,7 +46,7 @@ data KeyConfigSDL = KeyConfigSDL
rotateCameraMinusKey :: SDL.Scancode,
zoomInKey :: SDL.Scancode,
zoomOutKey :: SDL.Scancode,
newKey :: SDL.Scancode
newMapKey :: SDL.Scancode
}
deriving (Generic, Show)
@@ -68,7 +68,7 @@ defaultKeyConfigSDL =
rotateCameraMinusKey = SDL.ScancodeE,
zoomInKey = SDL.ScancodeJ,
zoomOutKey = SDL.ScancodeK,
newKey = SDL.ScancodeN
newMapKey = SDL.ScancodeN
}
--instance ToJSON KeyConfig where
src/Dodge/Creature.hs
+2 -1
View File
@@ -156,9 +156,10 @@ startInventory :: IM.IntMap Item
startInventory = IM.fromList (zip [0..20]
(
[blinkGun
,miniGun
,bezierGun
,multGun
,hvAutoGun
,boosterGun
,remoteLauncher
,grenade
,spawnGun lamp
src/Dodge/Creature/Action.hs
+10 -19
View File
@@ -57,18 +57,17 @@ blinkAction
:: Creature
-> World
-> World
blinkAction cr w
= soundOnce teleSound
. set (creatures . ix n . crPos) p3
. blinkShockwave n p3
$ inverseShockwaveAt cp 40 2 2 2 w
blinkAction cr w = soundOnce teleSound
. set (creatures . ix cid . crPos) p3
. blinkShockwave cid p3
$ inverseShockwaveAt cpos 40 2 2 2 w
where
n = _crID cr
p1 = _cameraCenter w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
cp = _crPos $ _creatures w IM.! n
p2 = reflectPointWalls cp p1 $ wallsAlongLine cp p1 w
r = 1.5 * _crRad (_creatures w IM.! n)
p3 = maybe p1 ((\p -> moveAmountToward p r cp) . fst) p2
cid = _crID cr
p1 = mouseWorldPos w
cpos = _crPos cr
p2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
r = 1.5 * _crRad cr
p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2
blinkShockwave
:: Int -- ^ Blinking creature ID.
@@ -77,14 +76,6 @@ blinkShockwave
-> World
blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan
moveAmountToward
:: Point2 -- ^ Start point
-> Float -- ^ Fraction to move along
-> Point2 -- ^ End point
-> Point2
moveAmountToward p1 am p2
= p1 +.+ am *.* errorNormalizeV 44 (p2 -.- p1)
{- | Get your creature to drop the item under the cursor. -}
youDropItem :: World -> World
youDropItem w = case yourItem w of
src/Dodge/Creature/Boid.hs
+3 -3
View File
@@ -15,7 +15,7 @@ interpWith x a b = x *.* a +.+ (1 - x) *.* b
invertEncircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2
invertEncircleDistP d tcr cenp cr = ypos +.+
d *.* (reflectIn (cenp -.- ypos) $ safeNormalizeV (cpos -.- cenp))
d *.* reflectIn (cenp -.- ypos) (safeNormalizeV (cpos -.- cenp))
where
cpos = _crPos cr
ypos = _crPos tcr
@@ -226,7 +226,7 @@ flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg
where
cenp = _crGroupCenter $ _creatureGroups w IM.! (_crGroupID (_crGroup cr))
cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr)
p = f crTarg cenp cr
flockCenterFunc
@@ -238,7 +238,7 @@ flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg
where
cenp = _crGroupCenter $ _creatureGroups w IM.! (_crGroupID (_crGroup cr))
cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr)
p = f crTarg cenp cr
flockPointTargetR
src/Dodge/Creature/SwarmCrit.hs
+1 -1
View File
@@ -31,7 +31,7 @@ import Control.Monad.Reader
swarmCrit :: Creature
swarmCrit = defaultCreature
{ _crUpdate = stateUpdate $ impulsiveAIR $
flockToPointUsing (encircleDistP (100)) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
flockToPointUsing (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
>=> return . (crMeleeCooldown . _Just %~ max 0 . subtract 1)
>=> basicPerceptionUpdateR [0]
>=> doStrategyActionsR
src/Dodge/Data.hs
+7 -1
View File
@@ -384,7 +384,7 @@ data Projectile
{ _pjPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _pjPict :: Picture
, _pjDraw :: Picture
, _pjID :: Int
, _pjUpdate :: World -> World
}
@@ -397,6 +397,12 @@ data Projectile
, _pjUpdate :: World -> World
, _pjPayload :: Point2-> World -> World
}
| BoostShockwave
{ _pjID :: Int
, _pjPict :: Picture
, _pjUpdate :: World -> World
, _pjPoints :: [Point2]
}
data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
data Wall
= Wall
src/Dodge/Item/Weapon.hs
+79 -109
View File
@@ -19,6 +19,7 @@ import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.UseEffect
import Dodge.Item.Weapon.Laser
import Dodge.Item.Weapon.Booster
import Dodge.Item.Weapon.Grenade
import Dodge.Item.Attachment.Data
import Dodge.Item.Attachment
@@ -41,26 +42,7 @@ import System.Random
import qualified Data.Set as S
--import qualified Data.Map as M
pistol
,lasGun
,tractorGun
,launcher
,ltAutoGun
,hvAutoGun
,miniGun
,teslaGun
,spreadGun
,multGun
,defaultGun
,defaultAutoGun
,rezGun
,flameLauncher
,poisonLauncher
,teslaLauncher
,remoteLauncher
,defaultThrowable
-- ,shatterGun
,longGun,flamer,blinkGun,forceFieldGun :: Item
pistol :: Item
pistol = Weapon
{ _itName = "PISTOL"
, _itIdentity = Pistol
@@ -95,8 +77,9 @@ pistol = Weapon
, _itInvDisplay = basicWeaponDisplay
, _itInvColor = white
}
defaultGun :: Item
defaultGun = pistol
defaultAutoGun :: Item
defaultAutoGun = autoGun
{ _itScrollUp = const id
, _itScrollDown = const id
@@ -130,8 +113,6 @@ autoGun = defaultGun
, _wpRange = 20
, _itHammer = HammerUp
, _itFloorPict = onLayer FlItLayer $ color red $ pictures [polygon [(-4,-4),(-4,4),(4,4),(4,-4)]]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
@@ -152,7 +133,7 @@ autoGunNonTwistEff = withRecoil 40
. withMuzFlare
. withVelWthHiteff (50,0) 3
$ destroyOnImpact bulHitCr bulHitWall' bulHitFF'
rezGun :: Item
rezGun = defaultGun
{ _itName = "REANIMATOR"
, _wpMaxAmmo = 50
@@ -168,8 +149,6 @@ rezGun = defaultGun
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ color chartreuse $ pictures
@@ -177,6 +156,7 @@ rezGun = defaultGun
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
}
teslaGun :: Item
teslaGun = defaultAutoGun
{ _itName = "TESLA"
, _itIdentity = TeslaGun
@@ -193,8 +173,6 @@ teslaGun = defaultAutoGun
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itZoom = defaultItZoom
, _itAimingRange = 0
@@ -203,6 +181,7 @@ teslaGun = defaultAutoGun
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
}
lasGun :: Item
lasGun = defaultAutoGun
{ _itName = "LASGUN ////"
, _itIdentity = LasGun
@@ -216,8 +195,6 @@ lasGun = defaultAutoGun
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 3 3 (-3) (-3)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 3 3 (-3) (-3)
@@ -226,6 +203,7 @@ lasGun = defaultAutoGun
, _itScrollDown = decCharMode
, _itInvDisplay = basicWeaponDisplay
}
forceFieldGun :: Item
forceFieldGun = defaultGun
{ _itName = "FORCEFIELD"
, _itIdentity = ForceFieldGun
@@ -239,8 +217,6 @@ forceFieldGun = defaultGun
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 0.5
}
@@ -263,6 +239,7 @@ forceFieldGun = defaultGun
-- , _itAimingSpeed = 1
-- , _itAimingRange = 0.5
-- }
tractorGun :: Item
tractorGun = defaultAutoGun
{ _itName = "TRACTORGUN"
, _itIdentity = TractorGun
@@ -276,12 +253,11 @@ tractorGun = defaultAutoGun
, _wpSpread = 0.00001
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
}
launcher :: Item
launcher = defaultGun
{ _itName = "ROCKO"
, _itIdentity = Launcher
@@ -295,24 +271,25 @@ launcher = defaultGun
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.2
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itHammer = NoHammer
, _itEffect = NoItEffect
}
flameLauncher :: Item
flameLauncher = launcher
{ _itName = "FLROCKO"
, _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt
}
poisonLauncher :: Item
poisonLauncher = launcher
{ _itName = "POISROCK"
, _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt
}
teslaLauncher :: Item
teslaLauncher = launcher
{ _itName = "TESLROCK"
, _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt
@@ -326,8 +303,6 @@ useTargetPos
useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itTargetPos of
Nothing -> w
Just p -> f p cr w
where
cid = _crID cr
bezierGun :: Item
bezierGun = defaultAutoGun
@@ -372,7 +347,7 @@ removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachmen
where
cr = _creatures w IM.! i
itRef = _crInvSel cr
remoteLauncher :: Item
remoteLauncher = defaultGun
{ _itName = "ROCKO-REM"
, _itIdentity = RemoteLauncher
@@ -386,13 +361,12 @@ remoteLauncher = defaultGun
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.2
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAttachment = Just $ ItScope (0,0) 0 1 True
}
hvAutoGun :: Item
hvAutoGun = defaultAutoGun
{ _itName = "AUTO-HV"
, _itIdentity = HvAutoGun
@@ -402,11 +376,9 @@ hvAutoGun = defaultAutoGun
, _wpReloadState = 0
, _itUseRate = 25
, _itUseTime = 0
, _itUse = rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul
, _itUse = rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
@@ -417,7 +389,7 @@ hvAutoGun = defaultAutoGun
. withMuzFlare
. withVelWthHiteff (80,0) 6
$ penWalls hvBulHitCr' hvBulHitWall' bulHitFF'
ltAutoGun :: Item
ltAutoGun = defaultAutoGun
{ _itName = "AUTO-LT"
, _itIdentity = LtAutoGun
@@ -434,8 +406,6 @@ ltAutoGun = defaultAutoGun
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0
,circleSolid 4
]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom
@@ -443,6 +413,7 @@ ltAutoGun = defaultAutoGun
,circleSolid 4
]
}
miniGun :: Item
miniGun = defaultAutoGun
{ _itName = "MINI-G"
, _itIdentity = MiniGun
@@ -460,12 +431,11 @@ miniGun = defaultAutoGun
$ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF'
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
}
spreadGun :: Item
spreadGun = defaultGun
{ _itName = "SPREAD"
, _itIdentity = SpreadGun
@@ -482,12 +452,11 @@ spreadGun = defaultGun
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ]
}
multGun :: Item
multGun = defaultGun
{ _itName = "MULTGUN"
, _itIdentity = MultGun
@@ -504,8 +473,6 @@ multGun = defaultGun
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer multGunPic
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
@@ -520,6 +487,7 @@ multGun = defaultGun
, polygon $ rectNSEW (-8) (-12) 2 (-2)
, polygon [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)]
]
longGun :: Item
longGun = defaultGun
{ _itName = "LONGGUN"
, _itIdentity = LongGun
@@ -537,8 +505,6 @@ longGun = defaultGun
$ penWalls hvBulHitCr' hvBulHitWall' bulHitFF'
, _wpRange = 200
, _itFloorPict = onLayer FlItLayer $ pictures [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}
@@ -570,14 +536,12 @@ poisonSprayer = defaultAutoGun
, _wpSpread = 0.3
, _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.2
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
}
flamer :: Item
flamer = defaultAutoGun
{ _itName = "FLAMER"
, _itIdentity = Flamethrower
@@ -587,18 +551,17 @@ flamer = defaultAutoGun
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = shoot $ withSidePush 5 $ withSidePushAfter 10 $ randWalkAngle 0.5 0.05 aFlame
, _itUse = shoot $ withSidePush 5 $ withSidePushAfter 10 $ randWalkAngle 0.2 0.01 aFlame
, _wpSpread = 0
, _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 0.5
, _itAimingRange = 0
, _itZoom = defaultItZoom {_itAimZoomMax = 5, _itAimZoomMin = 1.5}
, _itEquipPict = pictureWeaponOnAim $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAttachment = Nothing
}
blinkGun :: Item
blinkGun = defaultGun
{ _itName = "BLINKER"
, _itIdentity = Blinker
@@ -608,16 +571,30 @@ blinkGun = defaultGun
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = shoot aSelf
, _itUse = hammerCheck $ shoot aSelf
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAimingSpeed = 1
, _itAimingRange = 0
}
boosterGun :: Item
boosterGun = defaultGun
{ _itName = "BOOSTER"
, _itIdentity = Blinker
, _wpMaxAmmo = 100
, _wpLoadedAmmo = 100
, _wpReloadTime = 20
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = shoot $ boostSelf Nothing 20
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 1
, _itAimingRange = 0
}
aTeslaArc :: Creature -> World -> World
aTeslaArc cr w = aTeslaArc' cr $ soundFrom (CrWeaponSound cid) 25 1 0 w
@@ -630,7 +607,6 @@ aTeslaArc' cr w
$ over projectiles (IM.insert i (makeTeslaArcAt i pos dir))
$ set randGen g w
where
cid = _crID cr
i = newProjectileKey w
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
+.+ sideOffset *.* vNormal (unitVectorAtAngle dir)
@@ -733,15 +709,17 @@ moveShell time i cid rot accel w
shellPic :: Picture
shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
remoteShellPic :: Int -> Picture
remoteShellPic i
| rem (i+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
remoteShellPic
:: Int -- ^ Timer
-> Picture
remoteShellPic t
| rem (t+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
| otherwise = pictures
[ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
, color col $ circleSolid 3
[ onLayer UPtLayer $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
, setLayer 1 $ onLayer HPtLayer $ color col $ circleSolid 3
]
where
col | i > (-99) = green
col | t > (-99) = green
| otherwise = red
shellExplosionAt :: Point2 -> World -> World
@@ -751,23 +729,19 @@ aGasCloud :: Creature -> World -> World
aGasCloud cr w = insertCloud $ set randGen g w
where
(a,g) = randomR (-0.1,0.1) (_randGen w)
cid = _crID cr
dir = _crDir cr + a
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
--pos2 = (0.5 *.* vel) +.+
-- _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir
insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid)
insertCloud = makeGasCloud pos vel
aFlame :: Creature -> World -> World
aFlame cr w = insertFlame w
aFlame cr w = w & particles %~ (aFlameParticle t pos vel (Just cid) :)
where
(t,_) = randomR (99,101) (_randGen w)
cid = _crID cr
dir = _crDir cr
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
aSelf :: Creature -> World -> World
aSelf = blinkAction
@@ -862,7 +836,7 @@ moveRemoteBomb itid time pID w
(50 *.* unitVectorAtAngle (negate $ degToRad (10 * fromIntegral time)))
[-0.2,-0.15,-0.1,-0.05,0,0.05,0.1,0.15,0.2]
grenade,remoteBomb :: Item
grenade :: Item
grenade = Throwable
{ _itName = "GRENADE " ++ show fuseTime
, _itIdentity = Grenade
@@ -909,7 +883,9 @@ teslaGrenade = grenade {
fuseTime = 50 :: Int
--f x = 50 / fromIntegral x
defaultThrowable :: Item
defaultThrowable = grenade
remoteBomb :: Item
remoteBomb = defaultThrowable
{ _itName = "REMOTEBOMB"
, _itIdentity = RemoteBomb
@@ -923,8 +899,6 @@ remoteBomb = defaultThrowable
, _itEquipPict = pictureWeaponOnAim remoteBombUnarmedPic
}
fireRemoteLauncher :: Creature -> World -> World
fireRemoteLauncher cr w = setLocation
$ resetFire
@@ -944,11 +918,11 @@ fireRemoteLauncher cr w = setLocation
, _pjID = i
, _pjUpdate = moveRemoteShell 50 i cid itid dir
}
j = _crInvSel $ _creatures w IM.! cid
j = _crInvSel cr
newitid = IM.newKey $ _itemPositions w
maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just
maybeitid = cr ^? crInv . ix j . itID . _Just
resetFire = set (creatures . ix cid . crInv . ix j . itUse)
$ hammerCheck $ \cr -> explodeRemoteRocket itid i
$ hammerCheck $ \_ -> explodeRemoteRocket itid i
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET"
setLocation :: World -> World
setLocation w' = case maybeitid of
@@ -1015,7 +989,7 @@ moveRemoteShell time i cid itid _ w
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w
dir = argV vel
pic = onLayer PtLayer $ uncurry translate newPos
pic = uncurry translate newPos
$ rotate (argV accel) $ remoteShellPic time
piclow = onLayerL [levLayer CrLayer - 2]
$ uncurry translate newPos $ rotate (argV accel)
@@ -1049,10 +1023,13 @@ explodeRemoteRocket itid pjid w
itPoint = pointToItem $ _itemPositions w IM.! itid
throwRemoteBomb :: Creature -> World -> World
throwRemoteBomb cr w = setLocation $ removePict $ resetFire
$ resetName $ over projectiles addG w
throwRemoteBomb cr w = setLocation
$ removePict
$ resetFire
$ resetName
$ over projectiles addG w
where
n = _crID cr -- to change to cid
cid = _crID cr
addG = IM.insert i $ Projectile
{ _pjPos = p
, _pjStartPos = p
@@ -1062,29 +1039,23 @@ throwRemoteBomb cr w = setLocation $ removePict $ resetFire
, _pjUpdate = moveRemoteBomb itid 50 i
}
i = newProjectileKey w
-- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraCenter w -.- yourPos)
--d = argV $ _mousePos w
--(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w)
--(a, g) = randomR (-grenadeAccA,grenadeAccA) (_randGen w)
v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w)
v | magV v' > 6 = 6 *.* normalizeV v'
| otherwise = v'
-- zoom = 1 / _cameraZoom w
j = _crInvSel $ _creatures w IM.! n
resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTE"
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
resetFire = set (creatures . ix n . crInv . ix j . itUse)
j = _crInvSel cr
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE"
removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> blank
resetFire = set (creatures . ix cid . crInv . ix j . itUse)
$ hammerCheck $ explodeRemoteBomb itid i
cr = _creatures w IM.! n
p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0)
p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0)
| otherwise = p'
maybeitid = w ^? creatures . ix n . crInv . ix j . itID . _Just
maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just
setLocation :: World -> World
setLocation w' = case maybeitid of
Nothing -> w' & creatures . ix n . crInv . ix j . itID ?~ newitid
& itemPositions %~ IM.insert newitid (InInv n j)
_ -> w'
Nothing -> w' & creatures . ix cid . crInv . ix j . itID ?~ newitid
& itemPositions %~ IM.insert newitid (InInv cid j)
_ -> w'
newitid = IM.newKey $ _itemPositions w
itid = fromMaybe newitid maybeitid
@@ -1092,19 +1063,19 @@ explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
explodeRemoteBomb itid pjid cr w
= set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid)
$ set (projectiles . ix pjid . pjPict) blank
$ set (creatures . ix n . crInv . ix j . itUse) (const id)
$ set (creatures . ix cid . crInv . ix j . itUse) (const id)
$ resetName
$ resetPict
-- $ resetScope
$ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
-- - $ makeShrapnelBombAt (_pjPos (_projectiles w IM.! pjid)) w
where
n = _crID cr
resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB"
resetPict = set (creatures . ix n . crInv . ix j . itEquipPict )
cid = _crID cr
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict )
(pictureWeaponOnAim remoteBombUnarmedPic)
-- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
j = _crInvSel $ _creatures w IM.! n
-- resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
j = _crInvSel $ _creatures w IM.! cid
remoteBombPic
:: Int -- ^ time
-> Picture
@@ -1227,7 +1198,6 @@ spawnCrNextTo
spawnCrNextTo cr sCr w = w & creatures %~ IM.insert k newCr
where
k = IM.newKey $ _creatures w
i = _crID cr
newCr = cr
& crID .~ k
& crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
src/Dodge/Item/Weapon/Booster.hs
+49
View File
@@ -0,0 +1,49 @@
module Dodge.Item.Weapon.Booster
where
import Dodge.Data
import Dodge.Base
import Geometry
import IntMapHelp
import Data.Maybe
import Control.Lens
{- | Move a creature towards the mouse position, with shockwave -}
boostPoint
:: Float -- ^ boost amount
-> Creature
-> World
-> Either Point2 Point2
boostPoint x cr w = case mayp2 of
Nothing -> Right p1
Just p2 -> Left $ mvPointTowardAtSpeed r cpos $ fst p2
where
cpos = _crPos cr
r = 1.5 * _crRad cr
p1 = cpos +.+ x *.* normalizeV (mouseWorldPos w -.- cpos)
mayp2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
boostSelf
:: Maybe Int -- ^ shockwave projectile id
-> Float -- ^ boost amount
-> Creature
-> World
-> World
boostSelf mpid x cr w = case boostPoint x cr w of
Left p -> wWithShock
& creatures . ix cid %~ ( (crPos .~ p) . (crInv . ix (_crInvSel cr) . wpLoadedAmmo .~ 1))
Right p -> wWithShock & creatures . ix cid . crPos .~ p
where
cid = _crID cr
cpos = _crPos cr
r = _crRad cr
pid = fromMaybe (newKey $ _projectiles w) mpid
wWithShock = addBoostShockwave pid cpos (vNormal $ r *.* unitVectorAtAngle (_crDir cr)) w
addBoostShockwave
:: Int
-> Point2
-> Point2
-> World
-> World
addBoostShockwave _ _ _ w = w
src/Dodge/Item/Weapon/Laser.hs
+11 -14
View File
@@ -21,15 +21,14 @@ import Data.Tuple
import Data.List (find)
import Data.Maybe (fromMaybe)
import qualified Data.Sequence as Seq
import qualified Data.IntMap.Strict as IM
--import qualified Data.IntMap.Strict as IM
aLaser :: Creature -> World -> World
aLaser cr w = over particles (makeLaserAt phaseV pos dir (Just cid) : )
aLaser cr w = over particles (makeLaserAt phaseV pos dir : )
$ soundFrom LasSound 24 1 0
$ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
w
where
cid = _crID cr
pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir)
dir = _crDir cr
phaseV = charToPhaseV
@@ -42,21 +41,20 @@ charToPhaseV '/' = 1
charToPhaseV 'Z' = 5
charToPhaseV _ = error "Trying to set an undefined phaseV"
makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle
makeLaserAt phaseV pos dir mcid = Particle
makeLaserAt :: Float -> Point2 -> Float -> Particle
makeLaserAt phaseV pos dir = Particle
{ _ptDraw = const blank
, _ptUpdate' = moveLaser phaseV pos dir mcid
, _ptUpdate' = moveLaser phaseV pos dir
}
moveLaser
:: Float -- ^ Phase velocity, controls deflection in windows
:: Float -- ^ Phase velocity, controls deflection through windows
-> Point2
-> Float
-> Maybe Int
-> World
-> Particle
-> (World, Maybe Particle)
moveLaser phaseV pos dir _ w pt
moveLaser phaseV pos dir w pt
= ( set randGen g $ hitEffect w
, Just pt {_ptDraw = const $ onLayer PtLayer pic ,_ptUpdate' = ptTimer' 0 }
)
@@ -68,15 +66,14 @@ moveLaser phaseV pos dir _ w pt
f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2])
f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of
Just (p,E3x2 wl)
| _wlIsSeeThrough wl -> f' p $ f (wl:seenWs)
p
(h x y wl p)
| _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) p (h x y wl p)
| otherwise -> (Just (p,E3x2 wl), [p])
Just (p,obj) -> (Just (p,obj), [p])
Nothing -> (Nothing, [y])
f' p (x,ps') = (x,p:ps')
h x y wl p | isEntering = p +.+ rotateV angleRef normalDist
| otherwise = p +.+ rotateV angleRef' normalDist'
h x y wl p
| isEntering = p +.+ rotateV angleRef normalDist
| otherwise = p +.+ rotateV angleRef' normalDist'
where
wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
normalDist = magV (p -.- y) *.* normalizeV wlNormal
src/Dodge/Item/Weapon/TriggerType.hs
+51 -88
View File
@@ -52,16 +52,16 @@ rateIncAB
-> World
-> World
rateIncAB startRate fastRate shooteff1 shooteff2 cr w
| repeatFire = set (pointItem . itUseRate) (max fastRate (currentRate - 1))
$ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointItem . itUseTime) currentRate
$ shooteff2 cr
w
| firstFire = set (pointItem . itUseRate) (startRate - 1)
$ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointItem . itUseTime) startRate
$ shooteff1 cr
w
| repeatFire = w
& pointItem %~ ( (itUseRate .~ max fastRate (currentRate - 1))
. (wpLoadedAmmo -~ 1)
. (itUseTime .~ currentRate) )
& shooteff2 cr
| firstFire = w
& pointItem %~ ( (itUseRate .~ startRate - 1)
. (wpLoadedAmmo -~ 1)
. (itUseTime .~ startRate) )
& shooteff1 cr
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w
where
@@ -90,22 +90,17 @@ withWarmUp
withWarmUp t f cr w
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| _wpReloadState item /= 0 = w
| fState == 0 = set (pointerToItem . itUse) (withWarmUp 100 f)
$ set (pointerToItem . itUseTime) 2
w
| t > 2 = set (pointerToItem . itUse) (withWarmUp (t-1) f)
$ set (pointerToItem . itUseTime) 2
$ soundFrom (CrWeaponSound cid) 26 2 0
w
| t > 0 = set (pointerToItem . itUse) (withWarmUp (t-1) f)
$ set (pointerToItem . itUseTime) 2
w
| otherwise = set (pointerToItem . itUse) (withWarmUp 1 f)
$ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointerToItem . itUseTime) 2
$ f cr
$ soundFrom (CrWeaponSound cid) 28 2 0
w
| fState == 0 = w
& pointerToItem %~ ( (itUse .~ withWarmUp 100 f) . (itUseTime .~ 2) )
| t > 2 = w
& pointerToItem %~ ( (itUse .~ withWarmUp (t-1) f) . (itUseTime .~ 2) )
& soundFrom (CrWeaponSound cid) 26 2 0
| t > 0 = w
& pointerToItem %~ ( (itUse .~ withWarmUp (t-1) f) . (itUseTime .~ 2) )
| otherwise = w
& pointerToItem %~ ( (itUse .~ withWarmUp 1 f) . (wpLoadedAmmo -~ 1) . (itUseTime .~ 2) )
& f cr
& soundFrom (CrWeaponSound cid) 28 2 0
where
cid = _crID cr
itRef = _crInvSel cr
@@ -113,18 +108,14 @@ withWarmUp t f cr w
pointerToItem = creatures . ix cid . crInv . ix itRef
fState = _itUseTime item
reloadCondition = _wpLoadedAmmo item == 0
{- |
Adds a sound to a creature based world effect.
{- | Adds a sound to a creature based world effect.
The sound is emitted from the creature's position. -}
withSound
:: Int -- ^ Sound id
-> (Creature -> World -> World) -- ^ Underlying effect
-> Creature
-> World -> World
withSound soundid f cr w = (soundOncePos soundid p . f cr) w
where
cid = _crID cr
p = _crPos (_creatures w IM.! cid)
withSound soundid f cr = soundOncePos soundid (_crPos cr) . f cr
withRecoil
:: Float -- ^ Recoil amount
@@ -135,9 +126,8 @@ withRecoil
withRecoil recoilAmount eff cr = eff cr . over (creatures . ix cid) pushback
where
cid = _crID cr
pushback cr = over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0)) cr
{- |
Pushes a creature sideways by a random amount.
pushback = over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0))
{- | Pushes a creature sideways by a random amount.
Applied before the underlying effect. -}
withSidePush
:: Float -- ^ Maximal possible side push amount
@@ -148,10 +138,9 @@ withSidePush
withSidePush maxSide eff cr w = eff cr . over (creatures . ix cid) push $ w
where
cid = _crID cr
push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr
push = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr))
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
{- |
Pushes a creature sideways by a random amount.
{- | Pushes a creature sideways by a random amount.
Applied after the underlying effect. -}
withSidePushAfter
:: Float -- ^ Maximal possible side push amount
@@ -162,7 +151,7 @@ withSidePushAfter
withSidePushAfter maxSide eff cr w = over (creatures . ix cid) push . eff cr $ w
where
cid = _crID cr
push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr
push = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr))
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
{- |
Applies a world effect and sound effect after an ammo check. -}
@@ -171,7 +160,8 @@ shootWithSound
-> (Creature -> World -> World)
-- ^ Shoot effect, takes creature id as input
-> Creature
-> World -> World
-> World
-> World
shootWithSound soundid f cr w
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ soundOncePos soundid (_crPos cr)
@@ -225,9 +215,8 @@ shoot
-> World
-> World
shoot f cr w
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ set (pointerToItem . itUseTime) (_itUseRate item)
$ f cr w
| fireCondition = f cr w & pointerToItem %~
( (wpLoadedAmmo -~ 1) . (itUseTime .~ _itUseRate item) )
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w
where
@@ -247,11 +236,9 @@ withMuzFlare
-> World
withMuzFlare f cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cr w
where
cid = _crID cr
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
{- |
Rotates the creature randomly, applies the effect, rotates the creature back. -}
{- | Applies the effect to a randomly rotated creature. -}
withRandomDir
:: Float -- ^ Max possible rotation
-> (Creature -> World -> World)
@@ -259,16 +246,10 @@ withRandomDir
-> Creature
-> World
-> World
withRandomDir acc f cr w = over (creatures . ix cid . crDir) (\d -> d - a)
. f cr
. over (creatures . ix cid . crDir) (+ a)
$ set randGen g
w
withRandomDir acc f cr w = f (cr & crDir +~ a) $ set randGen g w
where
cid = _crID cr
(a, g) = randomR (-acc,acc) $ _randGen w
{- |
Creates a bullet with a given velocity, width, and 'HitEffect' -}
{- | Creates a bullet with a given velocity, width, and 'HitEffect' -}
withVelWthHiteff
:: Point2 -- ^ Velocity, x direction is forward with respect to the creature
-> Float -- ^ Bullet width
@@ -276,32 +257,23 @@ withVelWthHiteff
-> Creature -- ^ Creature id
-> World
-> World
withVelWthHiteff vel width hiteff cr w
= over particles (newbul : ) $ set randGen g w
withVelWthHiteff vel width hiteff cr = over particles (newbul : )
where
cid = _crID cr
newbul = aGenBulAt (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
(colid, g) = randomR (0,11) $ _randGen w
newbul = aGenBulAt (Just cid) pos (rotateV dir vel) hiteff width
dir = _crDir cr
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
{- |
Translate the creature sideways a random amount, apply the effect, translate back. -}
{- | Apply the effect to a translated creature. -}
withRandomOffset
:: Float -- ^ Max possible translate
-> (Creature -> World -> World)
-- ^ Underlying effect
-> Creature -- ^ Creature id
-> Creature
-> World
-> World
withRandomOffset offsetAmount f cr w
= over (creatures . ix cid . crPos) (-.- offV)
. f cr
. over (creatures . ix cid . crPos) (+.+ offV)
$ set randGen g
w
withRandomOffset offsetAmount f cr w = f (cr & crPos %~ (+.+ offV)) $ set randGen g w
where
(offsetVal , g) = randomR (-offsetAmount,offsetAmount) $ _randGen w
cid = _crID cr
offV = rotateV (_crDir cr) (0,offsetVal)
-- | Rotates a creature with minimum rotation at least 0.1.
-- Rotates the player creature before applying the effect, other creatures after.
@@ -313,7 +285,7 @@ torqueBeforeForced
-> World
-> World
torqueBeforeForced torque feff cr w
| cid == 0 = feff cr $ w
| cid == 0 = feff (cr & crDir +~ rot') $ w
& randGen .~ g
& creatures . ix cid . crDir +~ rot'
& cameraRot +~ rot'
@@ -332,7 +304,7 @@ torqueBefore
-> World
-> World
torqueBefore torque feff cr w
| cid == 0 = feff cr $ w
| cid == 0 = feff (cr & crDir +~ rot) $ w
& randGen .~ g
& creatures . ix cid . crDir +~ rot
& cameraRot +~ rot
@@ -369,15 +341,14 @@ spreadNumVelWthHiteff
spreadNumVelWthHiteff spread num vel wth eff cr w = over particles (newbuls ++) w
where
cid = _crID cr
newbuls = zipWith3
(\pos d colid -> aGenBulAt (Just cid) (numColor colid) pos (rotateV d vel) eff wth)
poss dirs colids
newbuls = zipWith
(\pos d -> aGenBulAt (Just cid) pos (rotateV d vel) eff wth)
poss dirs
poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
$ (replicateM num . randInCirc) 5 & evalState $ _randGen w
dirs = map (_crDir cr +) $ zipWith (+)
[-spread,-spread+(2*spread/fromIntegral num)..]
(randomRs (0,spread/5) (_randGen w))
colids = take num $ randomRs (0,11) (_randGen w)
{- | Create a number of bullets side by side with a given velocity,
given width and given 'HitEffect'. -}
numVelWthHitEff
@@ -385,25 +356,19 @@ numVelWthHitEff
-> Point2 -- ^ Velocity, x axis is direction of creature
-> Float -- ^ Bullet width
-> HitEffect -- ^ Effect when hitting creature, wall etc
-> Creature -- ^ Creature id
-> Creature
-> World
-> World
numVelWthHitEff num vel wth eff cr w = over particles (newbuls ++) w
numVelWthHitEff num vel wth eff cr = over particles (newbuls ++)
where
cid = _crID cr
newbuls = zipWith
(\p colid -> aGenBulAt (Just cid) (numColor colid) p (rotateV d vel) eff wth)
poss
colids
newbuls = map (\p -> aGenBulAt (Just cid) p (rotateV d vel) eff wth) poss
d = _crDir cr
poss = map (+.+ pos) offsets
poss = map (+.+ pos) $ take num offsets
maxOffset = fromIntegral num * 2.5 - 2.5
offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..]
colids = take num $ randomRs (0,11) (_randGen w)
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d
{- |
Uses '_wpSpread' as a parameter for the current offset angle. -}
{- | Uses '_wpSpread' as a parameter for the current offset angle. -}
randWalkAngle
:: Float -- ^ Max offset angle
-> Float -- ^ Walk speed
@@ -412,9 +377,7 @@ randWalkAngle
-> World
-> World
randWalkAngle ma aspeed f cr w = w
& creatures . ix cid . crDir -~ a
& f cr
& creatures . ix cid . crDir +~ a
& f (cr & crDir +~ a)
& creatures . ix cid . crInv . ix i . wpSpread .~ newa
where
cid = _crID cr
src/Dodge/Item/Weapon/UseEffect.hs
+16 -24
View File
@@ -16,21 +16,13 @@ import Geometry
import Data.Maybe
import Control.Lens
import qualified Data.IntMap.Strict as IM
{- |
Creates an outwardly increasing circle that draws creatures, even those behind walls. -}
{- | Creates an outwardly increasing circle that draws creatures, even those behind walls. -}
aSonarPulse :: Creature -> World -> World
aSonarPulse cr w = over particles ((:) $ sonarPulseAt (_crPos cr)) w
{- |
Creates an outwardly increasing circle that displays walls, even those behind other walls. -}
aSonarPulse cr = over particles (sonarPulseAt (_crPos cr) :)
{- | Creates an outwardly increasing circle that displays walls, even those behind other walls. -}
aRadarPulse :: Creature -> World -> World
aRadarPulse cr w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w
where
cid = _crID cr
{- |
Radar blip at a point.
-}
aRadarPulse cr = over particles (radarPulseAt (_crPos cr) :)
{- | Radar blip at a point. -}
blipAt :: Point2 -> Color -> Int -> Particle
blipAt p col i = Particle
{_ptDraw = const blank
@@ -42,17 +34,17 @@ mvBlip :: Point2 -> Color
-> Int -- ^ Current timer value
-> World -> Particle -> (World, Maybe Particle)
mvBlip _ _ _ 0 w _ = (w, Nothing)
mvBlip p col maxt t w pt
= (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
& ptDraw .~ (const . setDepth (-0.5)
. setLayer 1
$ uncurry translate p
$ color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid 2)
)
{- |
An outwardly increasing circle that draws creatures, even those behind walls. -}
mvBlip p col maxt t w pt =
(w
, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
& ptDraw .~ ( const
. setDepth (-0.5)
. setLayer 1
. uncurry translate p
. color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid 2 )
)
{- | An outwardly increasing circle that draws creatures, even those behind walls. -}
sonarPulseAt :: Point2 -> Particle
sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate' = mvSonar 100 p }
src/Dodge/LevelGen/StaticWalls.hs
+2 -2
View File
@@ -235,7 +235,7 @@ brokenWalls =
[((330.12192,3032.2456),(190.52365,2995.8352)),((190.52365,2995.8352),(203.94716,2945.9377)),((214.33855,2907.311),(230.12193,2859.0405)),((230.12193,2859.0405),(366.7245,2895.643)),((366.7245,2895.643),(330.12192,3032.2456)),((366.7245,2895.643),(230.12193,2859.0405)),((230.12193,2859.0405),(266.7245,2722.438)),((266.7245,2722.438),(403.32703,2759.0405)),((403.32703,2759.0405),(503.32703,2932.2456)),((466.72446,3068.8481),(330.12192,3032.2456)),((330.12192,3032.2456),(366.7245,2895.643)),((503.32703,2932.2456),(466.72446,3068.8481)),((203.94716,2945.9377),(145.99155,2930.4084)),((156.38292,2891.7817),(214.33855,2907.311)),((107.47222,2920.979),(34.06077,2901.2295)),((34.06077,2901.2295),(52.571453,2832.4224)),((70.17772,2796.55),(174.45558,2824.6025)),((174.45558,2824.6025),(156.38292,2891.7817)),((100.76944,2955.4202),(107.47222,2920.979)),((145.99155,2930.4084),(140.79587,2949.722)),((52.571453,2832.4224),(35.882084,2827.9504)),((31.745949,2785.4312),(70.17772,2796.55)),((88.14497,3002.5354),(100.76944,2955.4202)),((140.79587,2949.722),(120.21855,3027.0303)),((35.882084,2827.9504),(-22.07344,2812.4214)),((-31.039248,2768.608),(31.745949,2785.4312)),((-261.32483,3408.5737),(-303.9881,3451.237)),((-303.9881,3451.237),(-332.27234,3422.9526)),((-332.27234,3422.9526),(-289.84595,3380.5264)),((-261.56174,3352.242),(88.14497,3002.5354)),((120.21855,3027.0303),(-233.27742,3380.5264)),((-289.84595,3380.5264),(-332.2724,3338.0999)),((-332.2724,3338.0999),(-303.9881,3309.8157)),((-303.9881,3309.8157),(-261.56174,3352.242)),((-22.07344,2812.4214),(-89.68823,2794.304)),((-79.335526,2755.667),(-31.039248,2768.608)),((-210.16953,3456.4133),(-261.32483,3408.5737)),((-233.27742,3380.5264),(-194.64026,3419.1633)),((-128.32533,2783.9514),(-200.79468,3054.4106)),((-200.79468,3054.4106),(-780.35016,2899.1191)),((-780.35016,2899.1191),(-625.05865,2319.5635)),((-625.05865,2319.5635),(-45.503174,2474.855)),((-45.503174,2474.855),(-117.97253,2745.3142)),((-89.68823,2794.304),(-128.32533,2783.9514)),((-117.97253,2745.3142),(-79.335526,2755.667)),((-178.49438,3590.2566),(-241.50847,3573.372)),((-241.50847,3573.372),(-210.16953,3456.4133)),((-194.64026,3419.1633),(-136.80266,3434.6611)),((-98.165634,3445.014),(-139.85736,3600.6094)),((-92.98925,3425.6953),(-98.165634,3445.014)),((-136.80266,3434.6611),(-127.74397,3400.8535)),((-187.553,3624.064),(-178.49438,3590.2566)),((-139.85736,3600.6094),(-148.91603,3634.4167)),((-127.74397,3400.8535),(-111.20285,3339.121)),((-78.55679,3371.8325),(-92.98925,3425.6953)),((-349.5008,4383.0093),(-388.13782,4372.6563)),((-388.13782,4372.6563),(-485.18823,3653.0168)),((-485.18823,3653.0168),(-477.42368,3624.039)),((-477.42368,3624.039),(-206.96445,3696.5085)),((-168.32744,3706.861),(102.131805,3779.3306)),((102.131805,3779.3306),(94.36725,3808.308)),((94.36725,3808.308),(-349.5008,4383.0093)),((-206.96445,3696.5085),(-187.553,3624.064)),((-148.91603,3634.4167),(-168.32744,3706.861)),((299.35522,3346.2668),(97.2383,3547.9797)),((97.2383,3547.9797),(-78.55679,3371.8325)),((-111.20285,3339.121),(116.74672,3110.6904)),((116.74672,3110.6904),(320.08704,3314.438)),((352.084,3395.578),(299.35522,3346.2668)),((320.08704,3314.438),(367.6133,3358.328)),((495.06226,3666.979),(293.8115,3613.054)),((293.8115,3613.054),(352.084,3395.578)),((367.6133,3358.328),(563.6875,3410.866)),((563.6875,3410.866),(495.06226,3666.979))]
intersectingBrokenWalls :: [(Point2,Point2)]
intersectingBrokenWalls = filter (\(a,b) -> test a b) brokenWalls
intersectingBrokenWalls = filter (uncurry test) brokenWalls
where
polyPairs = zip brokenPoly (tail brokenPoly ++ [head brokenPoly])
test a b = any (isJust . uncurry (myIntersectSegSeg a b)) polyPairs
@@ -300,7 +300,7 @@ findShadowWalls :: WallP -> [WallP] -> [WallP]
findShadowWalls (p1,p2) wls = hitWls
where
p3 = 0.5 *.* (p1 +.+ p2)
p4 = p3 +.+ 10000 *.* rotateV (0) (vNormal (p2 -.- p1))
p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
f = uncurry $ myIntersectSegSeg p3 p4
src/Dodge/Particle/Bullet/HitEffect.hs
+3 -3
View File
@@ -60,7 +60,7 @@ bulBounceArmCr' bt p cr w
pOut = p +.+ 2 *.* newDir
reflectVel = magV bulVel *.* newDir
addBouncer = worldEvents %~ ( over particles (bouncer :) . )
bouncer = (aGenBulAt Nothing (_btColor' bt) pOut reflectVel
bouncer = (aGenBulAt Nothing pOut reflectVel
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
{- | Bullet pass through creatures. -}
@@ -83,7 +83,7 @@ bulPenCr' bt p cr w
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
addPiercer = over particles (piercer :)
piercer = (aGenBulAt (Just cid) (_btColor' bt) p (_btVel' bt)
piercer = (aGenBulAt (Just cid) p (_btVel' bt)
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
{- | Heavy bullet effects when hitting creature:
@@ -149,7 +149,7 @@ bulBounceWall' bt p wl w = damageBlocksBy 5 wl $ over worldEvents addBouncer w
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
bouncer = (aGenBulAt Nothing (_btColor' bt) pOut reflectVel
bouncer = (aGenBulAt Nothing pOut reflectVel
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
wallV = uncurry (-.-) (_wlLine wl)
src/Dodge/Particle/Bullet/Spawn.hs
+3 -4
View File
@@ -10,15 +10,14 @@ import Control.Lens
aGenBulAt
:: Maybe Int -- ^ Pass-through creature id
-> Color
-> Point2 -- ^ Start position
-> Point2 -- ^ Velocity
-> HitEffect
-> Float -- ^ Bullet width
-> Particle
aGenBulAt maycid _ pos vel hiteff width = Bul'
aGenBulAt maycid pos vel hiteff width = Bul'
{ _ptDraw = drawBul
, _ptUpdate' = mvGenBullet'
, _ptUpdate' = mvGenBullet
, _btVel' = vel
, _btColor' = white
, _btTrail' = [pos]
@@ -39,7 +38,7 @@ aCurveBulAt
-> Particle
aCurveBulAt maycid col pos control targ hiteff width = Bul'
{ _ptDraw = drawBul
, _ptUpdate' = \w -> mvGenBullet' w . setVel
, _ptUpdate' = \w -> mvGenBullet w . setVel
, _btVel' = (0,0)
, _btColor' = col
, _btTrail' = [pos]
src/Dodge/Particle/Bullet/Update.hs
+2 -2
View File
@@ -18,8 +18,8 @@ import Control.Lens
{-
Update for a generic bullet.
-}
mvGenBullet' :: World -> Particle -> (World, Maybe Particle)
mvGenBullet' w bt
mvGenBullet :: World -> Particle -> (World, Maybe Particle)
mvGenBullet w bt
| t <= 0 = (w, Nothing)
| t < 4 = (w, Just $ set btPassThrough' Nothing
$ set btTrail' (p:p:ps)
src/Dodge/Render/Picture.hs
+4 -4
View File
@@ -19,8 +19,8 @@ worldPictures w = pictures $ concat
, map _pjPict . IM.elems $ _projectiles w
, map drawItem . IM.elems $ _floorItems w
, map crDraw . IM.elems $ _creatures w
, map clDraw . IM.elems $ _clouds w
, map ppDraw . IM.elems $ _pressPlates w
, map clDraw . reverse . IM.elems $ _clouds w
, map ppDraw . IM.elems $ _pressPlates w
, map btDraw (IM.elems (_buttons w))
, map (\pt -> _ptDraw pt pt) $ _particles w
, map drawWallFloor (wallFloorsToDraw w)
@@ -47,7 +47,8 @@ customMouseCursor w =
testPic :: World -> [Picture]
testPic w =
[ setDepth (-1) . translate 0 0.8
. scale 0.001 0.001 . text . show . length . IM.elems . IM.filter ( (== 3) . _crRad ) $ _creatures w
. scale 0.001 0.001 . text . show . length . IM.elems
. IM.filter ( (== 3) . _crRad ) $ _creatures w
]
crDraw :: Creature -> Picture
@@ -60,7 +61,6 @@ btDraw c = uncurry translate (_btPos c) $ rotate (_btRot c) (_btPict c)
clDraw :: Cloud -> Picture
clDraw c = uncurry translate (_clPos c) (_clPict c c)
wallFloorsToDraw :: World -> [Wall]
wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
where
src/Dodge/WorldEvent.hs
+1 -1
View File
@@ -35,7 +35,7 @@ createBarrelSpark pos dir maycid time colid w
where
spark = Bul'
{ _ptDraw = drawBul
, _ptUpdate' = mvGenBullet'
, _ptUpdate' = mvGenBullet
, _btVel' = rotateV dir (5,0)
, _btColor' = numColor colid
, _btTrail' = [pos]
src/Dodge/WorldEvent/Cloud.hs
+18 -18
View File
@@ -10,26 +10,26 @@ import qualified IntMapHelp as IM
import Control.Lens
makeCloudAt :: Float -> Int -> (Cloud -> Picture) -> Point2 -> World -> World
makeCloudAt rad t drawFunc p w
= w & clouds %~ IM.insert i theCloud
where i = IM.newKey $ _clouds w
theCloud = Cloud { _clID = i
, _clPos = p
, _clVel = (0,0)
, _clPict = drawFunc
, _clRad = rad
, _clTimer = t
, _clEffect = const id
}
makeCloudAt rad t drawFunc p w = w & clouds %~ IM.insert i theCloud
where
i = IM.newKey $ _clouds w
theCloud = Cloud
{ _clID = i
, _clPos = p
, _clVel = (0,0)
, _clPict = drawFunc
, _clRad = rad
, _clTimer = t
, _clEffect = const id
}
drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
drawCloudWith radMult fadet col cl
= setLayer 2
. setDepth (-0.5)
$ circleSolidCol (withAlpha 0 col) (withAlpha a col) (radMult * _clRad cl)
-- . color (withAlpha a col)
-- $ circleSolid (radMult * _clRad cl)
where a = min 1 $ fromIntegral (_clTimer cl) / fadet
. setDepth (-0.5)
$ circleSolidCol (withAlpha 0 col) (withAlpha a col) (radMult * _clRad cl)
where
a = min 1 $ fromIntegral (_clTimer cl) / fadet
makeThickSmokeAt :: Point2 -> World -> World
makeThickSmokeAt = makeCloudAt 3 50 (drawCloudWith 4 50 black)
@@ -41,8 +41,8 @@ makeSmokeCloudAt :: Point2 -> World -> World
--makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
makeSmokeCloudAt = makeCloudAt 15 400 (drawCloudWith (4/3) 800 (greyN 0.5))
makeFlamerSmokeAt :: Point2 -> World -> World
makeFlamerSmokeAt = makeCloudAt 3 200 (drawCloudWith 4 200 (greyN 0.5))
makeFlamerSmokeAt :: Float -> Point2 -> World -> World
makeFlamerSmokeAt x = makeCloudAt 6 200 (drawCloudWith 4 300 (greyN x))
spawnSmokeAtCursor :: World -> World
spawnSmokeAtCursor w = makeSmokeCloudAt (mouseWorldPos w) w
src/Dodge/WorldEvent/SpawnParticle.hs
+10 -22
View File
@@ -36,7 +36,7 @@ aFlameParticle
-> Maybe Int -- ^ Creature id
-> Particle
aFlameParticle t pos vel maycid = Pt'
{ _ptDraw = drawFlame vel
{ _ptDraw = drawFlame vel
, _ptUpdate' = moveFlame vel
, _btVel' = vel
, _btColor' = red
@@ -47,15 +47,6 @@ aFlameParticle t pos vel maycid = Pt'
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
}
makeFlame
:: Int -- ^ Timer
-> Point2 -- ^ Position
-> Point2 -- ^ Velocity
-> Maybe Int -- ^ Creature id
-> World
-> World
makeFlame t pos vel maycid = over particles (aFlameParticle t pos vel maycid : )
drawFlame
:: Point2 -- ^ Rotate direction
-> Particle -> Picture
@@ -87,9 +78,7 @@ drawFlame rotd pt = thePic
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (0,1)
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
{-
TODO: add generalised area damage particles/hiteffects.
-}
{- TODO: add generalised area damage particles/hiteffects. -}
moveFlame
:: Point2 -- ^ Rotation direction
-> World
@@ -98,13 +87,12 @@ moveFlame
moveFlame rotd w pt
| time <= 0 = (smokeGen w, Nothing)
| otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
((_,E3x1 _):_) -> (soundAndGlare damcrs , mvPt')
(thing@(p,E3x2 wl):_) -> (fst $ hiteff [thing] damcrs , rfl wl p)
_ -> (soundAndGlare damcrs , mvPt)
((_,E3x1 _):_) -> (soundAndGlare damcrs , mvPt')
(thing@(p,E3x2 wl):_) -> (fst $ hiteff [thing] damcrs , rfl wl p)
_ -> (soundAndGlare damcrs , mvPt)
where
time = _btTimer' pt
soundAndGlare = soundFrom Flame fireSound 2 500
. over worldEvents ((.) $ flameGlareAt ep)
soundAndGlare = soundFrom Flame fireSound 2 500 . over worldEvents ((.) $ flameGlareAt ep)
sp = _btPos' pt
vel = _btVel' pt
ep = sp +.+ vel
@@ -130,8 +118,8 @@ moveFlame rotd w pt
pOut p = p +.+ safeNormalizeV (sp -.- p)
reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
+.+ (0.2 *.* vel)
smokeGen = makeFlamerSmokeAt ep
smokeCol = fst $ randomR (0.2,0.5) (_randGen w)
smokeGen = makeFlamerSmokeAt smokeCol ep
makeFlameletTimed
:: Point2 -- ^ Position
-> Point2 -- ^ Velocity
@@ -404,7 +392,7 @@ createSpark time colid pos dir maycid w
where
spark = Bul'
{ _ptDraw = drawBul
, _ptUpdate' = mvGenBullet'
, _ptUpdate' = mvGenBullet
, _btVel' = rotateV dir (5,0)
, _btColor' = numColor colid
, _btTrail' = [pos]
@@ -425,7 +413,7 @@ createSparkCol time col pos dir maycid w
where
spark = Bul'
{ _ptDraw = drawBul
, _ptUpdate' = mvGenBullet'
, _ptUpdate' = mvGenBullet
, _btVel' = rotateV dir (5,0)
, _btColor' = col
, _btTrail' = [pos]