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

Add boss room, tweak launchers

Browse Source
This commit is contained in:
jgk
2021-04-24 22:39:45 +02:00
parent 24ea24cd6d
commit 94ff3d6593
7 changed files with 347 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+1 -2
View File
@@ -261,8 +261,7 @@ Items you start with.
-}
startInventory = IM.fromList (zip [0..20]
(
[
--[pistol
[launcher
--,blinkGun
--,spawnGun lamp
--,poisonSprayer
src/Dodge/Creature/State.hs
+247
View File
@@ -0,0 +1,247 @@
module Dodge.Creature.State where
import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic
import Dodge.RandomHelp
import Dodge.WorldEvent
import Dodge.WallCreatureCollisions
import Dodge.CreatureAction
import Geometry
import Picture
import Data.List
import Data.Char
import Data.Maybe
import Data.Function
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.PatriciaTree
import Data.Graph.Inductive.Query.SP
import Codec.BMP
import qualified Data.ByteString as B
import Control.Lens
import Control.Applicative
import Control.Monad.State
import Control.Monad
import qualified SDL as SDL
import qualified SDL.Mixer as Mix
import System.Random
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
import Foreign.ForeignPtr
import Control.Concurrent
type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
-- | The movement is updated before the ai in order to correctly set the oldpos.
-- the whole of this update cycle could do with a rethink, it is becoming
-- convoluted
stateUpdate :: CRUpdate -> CRUpdate
stateUpdate u w (f,g) cr = let (cr', g'') = updateMovement g cr
in case u w (f,g'') cr' of
((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . dropifdead . f'
, g')
, fmap (updateReloadCounter . reducePastDamage . doDamage)
$ crOrCorpse =<< maybeCr
)
where
crOrCorpse cr | cr ^. crHP > 0 = Just cr
| otherwise = Nothing
dropifdead | cr ^.crHP > 0 = id
| otherwise = stopSoundFrom (CrWeaponSound (_crID cr))
. over decorations addCorpse
. insertIt
crBeforeDeath = colCrWall w $ cr
addCorpse = insertNewKey $ uncurry translate (_crOldPos cr)
$ rotate (_crDir cr)
(_crCorpse cr)
maybeIt = evalState (maybeTakeOne $ IM.elems (_crInv cr)) (_randGen w)
insertIt = case maybeIt of
-- Just it -> createItemAt (offset +.+ _crPos crBeforeDeath)
Just it -> createItemAt (offset +.+ _crOldPos cr)
(FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0})
Nothing -> id
offset = _crRad cr *.* unitVectorAtAngle rot
(rot,_) = randomR (-pi,pi) g
setOldPos :: Creature -> Creature
setOldPos cr = set crOldPos (_crPos cr) cr
{-
Given a creature and a velocity, applies friction to that creature and evaluates a
velocity to carry across frames.
-}
crFriction :: Creature -> Point2 -> Point2
crFriction cr vel = (0,0)
doDamage :: Creature -> Creature
doDamage cr = set (crState . crDamage) [] $ over (crState . crPastDamage) (+ hpLost)
damagedCr
where dams = _crDamage $ _crState cr
startHP = _crHP cr
damagedCr = snd $ (_crApplyDamage (_crState cr)) dams cr
afterHP = _crHP damagedCr
hpLost = startHP - afterHP -- note this can be negative
sumDamage :: Creature -> DamageType -> Int -> Int
sumDamage cr dm x = x + _dmAmount dm
reducePastDamage :: Creature -> Creature
reducePastDamage = over (crState . crPastDamage) rdpdam
where rdpdam x | x > 500 = x - 55
| x > 200 = x - 25
| x > 20 = x - 5
| x > 0 = x - 1
| otherwise = 0
movementSideEff :: Creature -> World -> World
movementSideEff cr w
| hasJetPack
= case cr ^? crState . stance . carriage of
Just (Boosting v)
-> makeFlameletTimed
(oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi))
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
Nothing
1
20
$ set randGen g
w
_ -> w
| otherwise = case cr ^? crState . stance . carriage of
Just (Walking x y) -> takeStep x y w
_ -> w
where hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
oldPos = _crOldPos cr
momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum'
| otherwise = momentum'
momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
(randDir,g) = randomR (-0.5,0.5) $ _randGen w
(randAng,_) = randomR (0,2*pi) $ _randGen w
(v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w
(r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[])
crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5
takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0
| crHasMoved && x < 80 && x + y >= 80 = soundMultiFrom footor 23 3 0
| otherwise = id
footor = [FootstepSound 0,FootstepSound 1]
invSideEff :: Creature -> World -> World
invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
where f i it w' = case it ^? itEffect . itInvEffect of
Nothing -> w'
Just g -> g cr i w'
weaponReloadSounds :: Creature -> World -> World
weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
Just (Weapon {_wpReloadState = 0})
-> w
Just (Weapon {_wpReloadState = 1})
-> stopSoundFrom (CrReloadSound cid) w
Just (Weapon {})
-> soundFrom (CrReloadSound cid) reloadSound (1) 0 w
_
-> w
where cid = _crID cr
updateMovement :: StdGen -> Creature -> (Creature, StdGen)
updateMovement g cr
| isFrictionless cr
= (over crPos (+.+ momentum) $ setOldPos cr, g')
| otherwise
= case cr ^? crState . stance . carriage of
Just (Walking x y)
-> (set (crState . stance . carriage) (Walking ((x+y)`mod`120) 0)
$ setOldPos
cr, g)
_ -> (set (crState . stance . carriage) (Walking 0 0)
$ setOldPos
cr, g)
where
momentum' = 0.98 *.* (_crPos cr -.- _crOldPos cr)
momentum'' | magV momentum' > 1 = 1 *.* normalizeV momentum'
| otherwise = momentum'
momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
(randAng,g') = randomR (0,2*pi) g
isFrictionless :: Creature -> Bool
isFrictionless cr = case cr ^? crState . stance . carriage of
Just (Boosting _) -> True
Just (Floating) -> True
_ -> False
updateReloadCounter :: Creature -> Creature
updateReloadCounter cr = over (crInv . ix iSel . wpFireState) decreaseToZero
. over (crInv . ix iSel . wpReloadState) decreaseToZero
$ cr
where iSel = _crInvSel cr
decreaseToZero :: Int -> Int
decreaseToZero x | x > 0 = x - 1
| otherwise = 0
--comb :: (StdGen -> Creature -> World -> World) -> (StdGen -> Creature -> Maybe Creature)
-- -> CRUpdate
--comb
onDeath :: (Creature -> World -> World) -> CRUpdate -> CRUpdate
onDeath h u w (f,g) cr
| _crHP cr > 0 = u w (f,g) cr
| otherwise = ( ( h cr . f, g ) , Nothing )
updateBarrel ::
World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature)
updateBarrel w (f,g) cr | _crHP cr > 0 = ((f, g), newCr)
| otherwise = ((f, g), Nothing)
where damages = _crDamage $ _crState cr
newCr = Just $ doDamage cr
-- it is easy to leave off the "f" here
-- should find some better way of doing all this that is less prone to error
updateExpBarrel ::
World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature)
updateExpBarrel w (f,g) cr
| _crHP cr > 0 = ((f . foldr (.) id pierceSparks . hiss, g'), newCr)
| otherwise = ((f . makeExplosionAt (_crPos cr) . stopSounds , g'), Nothing)
where damages = _crDamage $ _crState cr
pierceSparks :: [World -> World]
pierceSparks
= zipWith4 (\p a colid time-> (createBarrelSpark time colid (_crPos cr +.+ p) (a + argV p))
(Just $ _crID cr))
poss as colids times
as = randomRs (-0.7,0.7) $ g
colids = randomRs (0,11) $ g
times = randomRs (2,5) $ g
(g',_) = split g
poss = _piercedPoints $ _crSpState $ _crState cr
--newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr
perforate :: DamageType -> Creature -> Creature
perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints)
((:) $ int -.- _crPos cr) cr
perforate _ cr = cr
applyFuseDamage cr = over crHP (\hp -> hp - length (_piercedPoints
$ _crSpState $ _crState cr))
cr
hiss | poss == [] = id
| otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1
stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
damToExpBarrel :: [DamageType] -> Creature -> Creature
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
where (pierceDam,otherDam) = partition isPierce ds
isPierce (Piercing {}) = True
isPierce _ = False
damToExpBarrel' :: DamageType -> Creature -> Creature
damToExpBarrel' (Piercing amount sp int ep) cr
= over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr)
$ over crHP (\hp -> hp - div amount 200) cr
damToExpBarrel' (PoisonDam {}) cr = cr
damToExpBarrel' (SparkDam {}) cr = cr
damToExpBarrel' (PushDam {_dmPushBack = v}) cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
damToExpBarrel' dt cr = cr Control.Lens.& crHP -~ _dmAmount dt
src/Dodge/Floor.hs
+3
View File
@@ -36,6 +36,9 @@ roomTreex = do
let t' = padCorridors struct
t = treeTrunk
[[StartRoom]
,[Corridor]
,[BossAno launcherCrit]
,[Corridor]
,[OrAno [[DoorAno]
,[Corridor]
,[DoorNumAno 0,AirlockAno]]
src/Dodge/Item/Weapon.hs
+24 -61
View File
@@ -334,17 +334,17 @@ launcher = defaultGun
}
flameLauncher = launcher
{ _itName = "FLROCKO"
, _wpFire = shoot $ aRocket' makeFlameShellAt
, _wpFire = shoot . aRocket' $ makeShellAt makeFlameExplosionAt
}
poisonLauncher = launcher
{ _itName = "POISROCK"
, _wpFire = shoot $ aRocket' makePoisonShellAt
, _wpFire = shoot . aRocket' $ makeShellAt makePoisonExplosionAt
}
teslaLauncher = launcher
{ _itName = "TESLROCK"
, _wpFire = shoot $ aRocket' makeTeslaShellAt
, _wpFire = shoot . aRocket' $ makeShellAt makeTeslaExplosionAt
}
bezierGun = defaultAutoGun
@@ -712,7 +712,7 @@ aTractorBeam col cid w
dir = _crDir cr
itRef = _crInvSel cr
-- |The aRocket' function allows us to define the shell to be used
-- | The aRocket' function allows us to define the shell to be used
aRocket' :: (Int -> Int -> Point2 -> Float -> Projectile) -> Int -> World -> World
aRocket' shell cid w
= soundOnce (fromIntegral launcherSound)
@@ -723,70 +723,36 @@ aRocket' shell cid w
dir = _crDir cr
aRocket :: Int -> World -> World
aRocket = aRocket' makeShellAt
-- = soundOnce (fromIntegral launcherSound)
-- $ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w
-- where i = newProjectileKey w
-- cr = (_creatures w IM.! cid)
-- pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
-- dir = _crDir cr
aRocket = aRocket' (makeShellAt shellExplosionAt)
makeShellAt :: Int -> Int -> Point2 -> Float -> Projectile
makeShellAt i cid pos dir = Shell
makeShellAt
:: (Point2 -> World -> World) -- ^ Payload
-> Int -- ^ Projectile id
-> Int -- ^ Creature id
-> Point2 -- ^ Start position
-> Float -- ^ Direction
-> Projectile
makeShellAt pl i cid pos dir = Shell
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
, _pjID = i
, _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
, _pjPayload = shellExplosionAt
}
makeFlameShellAt :: Int -> Int -> Point2 -> Float -> Projectile
makeFlameShellAt i cid pos dir = Shell
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
, _pjID = i
, _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
, _pjPayload = makeFlameExplosionAt
}
makePoisonShellAt :: Int -> Int -> Point2 -> Float -> Projectile
makePoisonShellAt i cid pos dir = Shell
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
, _pjID = i
, _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
, _pjPayload = makePoisonExplosionAt
}
makeTeslaShellAt :: Int -> Int -> Point2 -> Float -> Projectile
makeTeslaShellAt i cid pos dir = Shell
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
, _pjID = i
, _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
, _pjPayload = makeTeslaExplosionAt
, _pjUpdate = moveShell 50 i cid 0 (rotateV dir (3,0))
, _pjPayload = pl
}
moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World
moveShell time i cid rot accel w
| time > 40 = if circOnSomeWall oldPos 4 w
then projectileExplosion oldPos $ over projectiles (IM.delete i) w
then doExplode
else over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) piclow
$ set (projectiles . ix i . pjUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel))
w
| time == 35 = case thingHit of
Just p -> projectileExplosion oldPos
$ over projectiles (IM.delete i) w
Just p -> doExplode
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . pjUpdate)
@@ -801,9 +767,7 @@ moveShell time i cid rot accel w
(moveShell (time-1) i cid rot (rotateV rot accel))
w
| time > -99 = case thingHit of
Just p -> projectileExplosion oldPos
$ stopSoundFrom (ShellSound i)
$ over projectiles (IM.delete i) w
Just p -> doExplode
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set randGen g
$ set (projectiles . ix i . pjPict) pic
@@ -816,18 +780,17 @@ moveShell time i cid rot accel w
$ smokeGen
w
| time > -200 = case thingHit of
Just p -> projectileExplosion oldPos
$ stopSoundFrom (ShellSound i)
$ over projectiles (IM.delete i) w
Just p -> doExplode
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . pjUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel))
w
| otherwise = projectileExplosion oldPos
$ stopSoundFrom (ShellSound i)
$ over projectiles (IM.delete i) w
| otherwise = doExplode
where
doExplode = projectileExplosion oldPos
$ stopSoundFrom (ShellSound i)
$ over projectiles (IM.delete i) w
pj = _projectiles w IM.! i
oldPos = _pjPos pj
vel = _pjVel pj
@@ -843,7 +806,7 @@ moveShell time i cid rot accel w
hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w
thingHit = hitCr <|> hitWl
spin = case w ^? creatures . ix cid of
Just cr -> min 0.1 $ max (-0.1)
Just cr -> min 0.2 $ max (-0.2)
$ (normalizeAnglePi (dir - _crDir cr)) / 20
_ -> 0
r1 = _randGen w & evalState (randInCirc 10)
src/Dodge/Layout/Tree/Annotate.hs
+4 -1
View File
@@ -3,15 +3,16 @@ Annotating tree structures with desired properties for rooms.
-}
module Dodge.Layout.Tree.Annotate
where
import Dodge.Data
import Dodge.RandomHelp
import Dodge.Layout.Tree.Polymorphic
import Dodge.Layout.Tree.Either
import Dodge.Room.Procedural
import Dodge.Room.Boss
import Dodge.Room.Link
import Dodge.Room.Data
import Dodge.Room
import Dodge.Room.Teleport
--import Dodge.Floor
import Data.Tree
import Control.Monad.State
@@ -30,6 +31,7 @@ data Annotation g
| EndRoom
| OrAno [[Annotation g]]
| SpecificRoom (State g (Tree (Either Room Room)))
| BossAno Creature
addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
addLock i t = do
@@ -68,6 +70,7 @@ annoToRoomTree [StartRoom] = do
h <- state $ randomR (200,400)
fmap (pure . Right) $ randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h)
annoToRoomTree (SpecificRoom rt:_) = rt
annoToRoomTree (BossAno cr : _) = branchRectWith . fmap (pure . Left) $ bossRoom cr
annoToRoomTree _ = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
src/Dodge/Room/Boss.hs
+40
View File
@@ -0,0 +1,40 @@
{-
Rooms containing particularly challenging creatures.
-}
module Dodge.Room.Boss
where
import Dodge.Data
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.LevelGen.Data
import Geometry
import Control.Monad.State
import Control.Lens
import System.Random
roomOctogon
:: Float -- ^ Size
-> Room
roomOctogon x = Room
{ _rmPolys = [rectNSWE x (-x) (-x) x
,rectNSWE 0 (-(x + 40)) (-20) 20
]
, _rmLinks = [((0,x),0),((0,-(x+40)),pi)]
, _rmPath = [((0,x),(0,-(x+40)))
,((0,-(x+40)),(0,x))]
, _rmPS =
[PS (x-10,x-10) 0 $ putLamp
,PS (10-x,x-10) 0 $ putLamp
,PS (10-x,10-x) 0 $ putLamp
,PS (x-10,10-x) 0 $ putLamp
,crystalLine (-x,x/2) (negate (x/2), x)
,crystalLine (x,x/2) (x/2, x)
,crystalLine (x/2,-x) (x,negate (x/2))
,crystalLine (negate $ x/2,-x) (-x,negate (x/2))
,blockLine (-40,40-x) (40,40-x)
]
, _rmBound = rectNSWE x (-x) (-x) x
}
bossRoom :: RandomGen g => Creature -> State g Room
bossRoom cr = pure $ roomOctogon 300 & rmPS %~ ( PS (0,100) (pi/2) (PutCrit cr) :)
src/Dodge/Room/Placement.hs
+28
View File
@@ -15,6 +15,10 @@ singleBlock :: Point2 -> [PlacementSpot]
singleBlock a = [PS a 0 $ PutBlock [5,20,20] (greyN 0.5)
$ reverse $ rectNSWE 10 (-10) (-10) 10]
{-
Places a line of blocks between two points.
Width 9, also extends out from each point by 9.
-}
blockLine :: Point2 -> Point2 -> PlacementSpot
blockLine a b = PS
{ _psPos = (0,0)
@@ -22,6 +26,10 @@ blockLine a b = PS
, _psType = PutLineBlock baseBlockPane 9 9 a b
}
{-
Places an breakable window between two points.
Width 8, also extends out from each point by 8.
-}
windowLine :: Point2 -> Point2 -> PlacementSpot
windowLine a b = PS
{ _psPos = (0,0)
@@ -29,6 +37,26 @@ windowLine a b = PS
, _psType = PutLineBlock baseWindowPane 8 8 a b
}
{-
Places an unbreakable window between two points.
Width 7, also extends out from each point by 7.
-}
crystalLine :: Point2 -> Point2 -> PlacementSpot
crystalLine a b = PS
{ _psPos = (0,0)
, _psRot = 0
, _psType = PutWindow ps $ withAlpha 0.5 aquamarine
}
where
ps =
[ a +.+ left +.+ up
, (a +.+ left) -.- up
, (b -.- left) -.- up
, (b -.- left) +.+ up
]
left = 7 *.* normalizeV (a-.-b)
up = vNormal left
windowLineType :: Point2 -> Point2 -> PSType
windowLineType a b = PutLineBlock baseWindowPane 8 8 a b