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

Allow for different item drops on creature death

Browse Source
This commit is contained in:
jgk
2021-04-25 02:16:31 +02:00
parent 94ff3d6593
commit 30736997c3
19 changed files with 336 additions and 229 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/AIs.hs
+1 -1
View File
@@ -3,7 +3,7 @@ import Dodge.Data
import Dodge.Base
import Dodge.Path
import Dodge.SoundLogic
import Dodge.CreatureAction
import Dodge.Creature.Action
import Dodge.RandomHelp
import Dodge.WorldEvent
src/Dodge/Creature.hs
+2 -2
View File
@@ -110,7 +110,7 @@ launcherCrit :: Creature
launcherCrit = defaultCreature
{ _crPict = enemyPict red
, _crUpdate = stateUpdate (launcherAI 150 200)
, _crInv = IM.fromList [(0,launcher),(1,medkit 100)]
, _crInv = IM.fromList [(0,launcher)]
, _crInvSel = 0
, _crRad = 10
, _crState = defaultState {_goals = [[Init]]}
@@ -261,7 +261,7 @@ Items you start with.
-}
startInventory = IM.fromList (zip [0..20]
(
[launcher
[pistol
--,blinkGun
--,spawnGun lamp
--,poisonSprayer
src/Dodge/CreatureAction.hs → src/Dodge/Creature/Action.hs
+39 -17
View File
@@ -1,12 +1,13 @@
{- Actions performed by creatures within the world
-}
{-# LANGUAGE BangPatterns #-}
module Dodge.CreatureAction
( module Dodge.CreatureAction
module Dodge.Creature.Action
( module Dodge.Creature.Action
, useItem
, tryUseItem
)
where
-- imports {{{
import Dodge.CreatureAction.UseItem
import Dodge.Creature.Action.UseItem
import Dodge.WorldEvent.Shockwave
import Dodge.Data
import Dodge.Base
@@ -14,22 +15,17 @@ import Dodge.SoundLogic
import Dodge.WorldEvent
import Dodge.Inventory
import Dodge.LightSources
import Geometry
import Picture
import Control.Lens
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.List
import System.Random
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
-- }}}
moveForwardSpeed :: Float -> Int -> World -> World
moveForwardSpeed x n w = over (creatures . ix n . crPos) (+.+ p) w
@@ -216,11 +212,6 @@ crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
where reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo
createItemAt :: Point2 -> FloorItem -> World -> World
createItemAt p it w = over floorItems (IM.insert i (set flItPos p
$ set flItID i it)) w
where i = newKey (_floorItems w)
blinkAction :: Int -> World -> World
blinkAction n w = soundOnce teleSound $ set (creatures . ix n . crPos) p3
$ blinkShockwave n p3
@@ -254,10 +245,13 @@ reverseDir n = over (creatures . ix n . crDir) (+ pi)
turnBy :: Float -> Int -> World -> World
turnBy a n = over (creatures . ix n . crDir) (+ a)
dropItem :: World -> World
dropItem w = case yourItem w of
{-
Get your creature to drop the item under the cursor.
-}
youDropItem :: World -> World
youDropItem w = case yourItem w of
NoItem -> w
it -> rmInvItem (_yourID w) $ over floorItems (IM.insert flid theflit)
it -> rmSelectedInvItem (_yourID w) $ over floorItems (IM.insert flid theflit)
$ updateLocation
$ soundOnce putDownSound
$ set randGen g w
@@ -272,6 +266,34 @@ dropItem w = case yourItem w of
,_flItRot = rot
,_flItID = flid}
{- Drop an item silently. -}
dropItem
:: Int -- ^ Creature id
-> Int -- ^ Inventory position
-> World
-> World
dropItem cid i w = case _crInv cr IM.! i of
NoItem -> w
it -> rmInvItem cid i
. over floorItems (IM.insert flid theflit)
. updateLocation
$ set randGen g w
where
(rot, g) = randomR (-pi,pi) $ _randGen w
offset = _crRad cr *.* unitVectorAtAngle rot
updateLocation w = case it ^? itID of
Just (Just i) -> w & itemPositions . ix i .~ OnFloor flid
_ -> w
flid = newKey $ _floorItems w
theflit = FlIt
{_flIt = set itAmount 1 it
,_flItPos = offset +.+ _crPos cr
,_flItRot = rot
,_flItID = flid
}
where
cr = _creatures w IM.! cid
pickUpItem' :: FloorItem -> World -> World
pickUpItem' flit w = case maybeInvSlot of
Nothing -> w
src/Dodge/CreatureAction/UseItem.hs → src/Dodge/Creature/Action/UseItem.hs
+2 -2
View File
@@ -1,4 +1,4 @@
module Dodge.CreatureAction.UseItem
module Dodge.Creature.Action.UseItem
where
import Dodge.Data
@@ -29,7 +29,7 @@ equippedItemEffect n w = itemEffect n it w
it = _crInv c IM.! _crInvSel c
itemEffect :: Int -> Item -> World -> World
itemEffect n (Consumable {_cnEffect=eff }) w = fromMaybe w $ fmap (rmInvItem n) $ eff n w
itemEffect n (Consumable {_cnEffect=eff }) w = fromMaybe w $ fmap (rmSelectedInvItem n) $ eff n w
itemEffect n (Weapon {_wpFire=eff}) w = eff n w
itemEffect n (Throwable {_twFire = eff}) w = eff n w
itemEffect _ _ w = w
src/Dodge/Creature/Data.hs
+5
View File
@@ -0,0 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Creature.Data
where
import Control.Lens
src/Dodge/Creature/State.hs
+64 -28
View File
@@ -5,7 +5,7 @@ import Dodge.SoundLogic
import Dodge.RandomHelp
import Dodge.WorldEvent
import Dodge.WallCreatureCollisions
import Dodge.CreatureAction
import Dodge.Creature.Action
import Geometry
import Picture
@@ -13,7 +13,7 @@ import Data.List
import Data.Char
import Data.Maybe
import Data.Function
import Data.Graph.Inductive.Graph
--import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.PatriciaTree
import Data.Graph.Inductive.Query.SP
import Codec.BMP
@@ -37,32 +37,73 @@ type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World
-- 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'
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 . deathEff . 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
where
crOrCorpse cr | cr ^. crHP > 0 = Just cr
| otherwise = Nothing
deathEff | cr ^.crHP > 0 = id
| otherwise = stopSoundFrom (CrWeaponSound (_crID cr))
. over decorations addCorpse
. dropByState cr
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 +.+ _crOldPos cr)
-- (FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0})
-- Nothing -> id
-- offset = _crRad cr *.* unitVectorAtAngle rot
-- (rot,_) = randomR (-pi,pi) g
-- | Drop items accoring to the creature state.
dropByState :: Creature -> World -> World
dropByState cr w = foldr (copyItemToFloor cr) w is
where
is :: [Int]
is = case cr ^. crState . crDropsOnDeath of
DropAll -> IM.keys $ _crInv cr
DropSpecific xs -> xs
DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
{- Copy an inventory item to the floor. -}
copyItemToFloor
:: Creature
-> Int -- ^ Inventory position
-> World
-> World
copyItemToFloor cr i w = case _crInv cr IM.! i of
NoItem -> w
it -> over floorItems (IM.insert flid theflit)
. updateLocation
$ set randGen g w
where
(rot, g) = randomR (-pi,pi) $ _randGen w
offset = _crRad cr *.* unitVectorAtAngle rot
(rot,_) = randomR (-pi,pi) g
updateLocation w = case it ^? itID of
Just (Just i) -> w & itemPositions . ix i .~ OnFloor flid
_ -> w
flid = newKey $ _floorItems w
theflit = FlIt
{_flIt = set itAmount 1 it
,_flItPos = offset +.+ _crPos cr
,_flItRot = rot
,_flItID = flid
}
createItemAt :: Point2 -> FloorItem -> World -> World
createItemAt p it w = over floorItems (IM.insert i (set flItPos p
$ set flItID i it)) w
where i = newKey (_floorItems w)
setOldPos :: Creature -> Creature
setOldPos cr = set crOldPos (_crPos cr) cr
@@ -183,11 +224,6 @@ 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
src/Dodge/Creature/State/Data.hs
+95
View File
@@ -0,0 +1,95 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Creature.State.Data
where
import Geometry
import Control.Lens
data ItemDropType
= DropAll
| DropAmount Int
| DropSpecific [Int]
data CrSpState
= Barrel { _piercedPoints :: [Point2]}
| GenCr
deriving (Eq,Show,Ord)
data Goal
= MoveTo Point2
| MoveToFor Point2 Int
| MoveFire Point2 Point2
| PathTo Point2
| PathAlong [Point2]
| SubPathTo Point2 Int Point2
| Wait
| WaitFor Int
| WaitForID Int Int
| FireAt Point2
| FireAtID Int Point2
| Fire
| Reload
| IncreaseAlert Int
| Guard Point2 Point2
| Search Int
| SearchNear Point2
| AimAt Point2 Int
| InitGuard
| Init
| MeleeAttack Int
| InitTrackYou
| TrackYou
| Track Int
| TrackFor Int Int
| TurnByFor Float Int
| TurnTo Point2
| TurnToward Point2
| TurnTowardAngle Float
| StrafeLeftAround Int Point2
| StrafeRightAround Int Point2
| StrafeLeftFor Int
| StrafeRightFor Int
| StrafeLeftForSpeed Int Float
| StrafeRightForSpeed Int Float
| StrafeLeftFire
| StrafeRightFire
| MoveForwardFor Int
| MoveForwardFire
| MoveBackwardFor Int
| MoveByFor Point2 Int
| MoveBackwardFire
| GoalID Int Goal
| AtRange Float
| AtRanges Float Float
| RepeatAction Int Goal
| MakeJudgement
| SetPosture Posture
deriving (Eq,Show)
data Stance = Stance
{_carriage :: Carriage
,_posture :: Posture
}
deriving (Eq,Show)
data Carriage
= Walking { _stepCycle :: Int, _stepToAdd :: Int }
| Standing
| Floating
| Boosting Point2
deriving (Eq,Show)
data Posture = Aiming | AtEase
deriving (Eq,Show)
data Mind = ZombieMind | HumanMind
deriving (Eq,Show)
data Faction
= GenericFaction Int
| ZombieFaction
| EncircleFlock
| ChaseCritters
| SpawnedBy Int
| NoFaction
deriving (Eq,Show)
makeLenses ''CrSpState
makeLenses ''Goal
makeLenses ''Carriage
makeLenses ''Posture
src/Dodge/Creature/YourControl.hs
+1 -1
View File
@@ -3,7 +3,7 @@ module Dodge.Creature.YourControl
import Dodge.Data
import Dodge.Base
import Dodge.CreatureAction
import Dodge.Creature.Action
import Dodge.Creature.State
import Dodge.Update.UsingInput
import Dodge.Config.KeyConfig
src/Dodge/Data.hs
+14 -91
View File
@@ -5,11 +5,15 @@ module Dodge.Data
( module Dodge.Data
, module Dodge.Data.Menu
, module Dodge.Data.SoundOrigin
, module Dodge.Creature.Data
, module Dodge.Creature.State.Data
, Point2 (..)
, Sound (..)
, soundTime
)
where
import Dodge.Creature.Data
import Dodge.Creature.State.Data
import Dodge.Data.Menu
import Dodge.Data.SoundOrigin
import Dodge.Config.Data
@@ -161,93 +165,6 @@ data Creature = Creature
, _crIsAnimate :: Bool
}
data CreatureState = CrSt
{ _goals :: [[Goal]]
, _stance :: Stance
, _faction :: Faction
, _crDamage :: [DamageType]
, _crPastDamage :: Int
, _crSpState :: CrSpState
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
}
data CrSpState
= Barrel { _piercedPoints :: [Point2]}
| GenCr
deriving (Eq,Show,Ord)
data Goal
= MoveTo Point2
| MoveToFor Point2 Int
| MoveFire Point2 Point2
| PathTo Point2
| PathAlong [Point2]
| SubPathTo Point2 Int Point2
| Wait
| WaitFor Int
| WaitForID Int Int
| FireAt Point2
| FireAtID Int Point2
| Fire
| Reload
| IncreaseAlert Int
| Guard Point2 Point2
| Search Int
| SearchNear Point2
| AimAt Point2 Int
| InitGuard
| Init
| MeleeAttack Int
| InitTrackYou
| TrackYou
| Track Int
| TrackFor Int Int
| TurnByFor Float Int
| TurnTo Point2
| TurnToward Point2
| TurnTowardAngle Float
| StrafeLeftAround Int Point2
| StrafeRightAround Int Point2
| StrafeLeftFor Int
| StrafeRightFor Int
| StrafeLeftForSpeed Int Float
| StrafeRightForSpeed Int Float
| StrafeLeftFire
| StrafeRightFire
| MoveForwardFor Int
| MoveForwardFire
| MoveBackwardFor Int
| MoveByFor Point2 Int
| MoveBackwardFire
| GoalID Int Goal
| AtRange Float
| AtRanges Float Float
| RepeatAction Int Goal
| MakeJudgement
| SetPosture Posture
deriving (Eq,Show)
data Stance = Stance
{_carriage :: Carriage
,_posture :: Posture
}
deriving (Eq,Show)
data Carriage
= Walking { _stepCycle :: Int, _stepToAdd :: Int }
| Standing
| Floating
| Boosting Point2
deriving (Eq,Show)
data Posture = Aiming | AtEase
deriving (Eq,Show)
data Mind = ZombieMind | HumanMind
deriving (Eq,Show)
data Faction
= GenericFaction Int
| ZombieFaction
| EncircleFlock
| ChaseCritters
| SpawnedBy Int
| NoFaction
deriving (Eq,Show)
data WorldState
= DoorNumOpen Int
@@ -583,18 +500,24 @@ data ForceField = FF
}
data FFState = FFDestroyable { _ffsHP :: Int }
data CreatureState = CrSt
{ _goals :: [[Goal]]
, _stance :: Stance
, _faction :: Faction
, _crDamage :: [DamageType]
, _crPastDamage :: Int
, _crSpState :: CrSpState
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
, _crDropsOnDeath :: ItemDropType
}
makeLenses ''World
makeLenses ''Cloud
makeLenses ''Creature
makeLenses ''CreatureState
makeLenses ''CrSpState
makeLenses ''Goal
makeLenses ''LightSource
makeLenses ''TempLightSource
makeLenses ''Stance
makeLenses ''Carriage
makeLenses ''Posture
makeLenses ''Item
makeLenses ''ItemPos
makeLenses ''ItEffect
src/Dodge/Default.hs
+11
View File
@@ -24,6 +24,9 @@ import qualified Data.Set as S
import Data.Graph.Inductive.Graph hiding ((&))
import Data.List
{-
Indestructible wall.
-}
defaultWall = Wall
{ _wlLine = [(0,0),(50,0)]
, _wlID = 0
@@ -32,6 +35,10 @@ defaultWall = Wall
, _wlSeen = False
, _wlIsSeeThrough = False
}
{-
Door that opens on approach.
Pathable.
-}
defaultAutoDoor = Door
{ _wlLine = [(0,0),(50,0)]
, _wlID = 0
@@ -42,6 +49,9 @@ defaultAutoDoor = Door
, _wlIsSeeThrough = False
, _doorPathable = True
}
{-
Non-pathable door.
-}
defaultDoor = Door
{ _wlLine = [(0,0),(50,0)]
, _wlID = 0
@@ -79,6 +89,7 @@ defaultState = CrSt
, _crPastDamage = 0
, _crSpState = GenCr
, _crApplyDamage = defaultApplyDamage
, _crDropsOnDeath = DropAmount 1
}
defaultEquipment = Equipment
{ _itIdentity = Generic
src/Dodge/Event.hs
+1 -1
View File
@@ -17,7 +17,7 @@ import Dodge.Event.Keyboard
import Dodge.Event.Menu
import Dodge.Data
import Dodge.Base
import Dodge.CreatureAction
import Dodge.Creature.Action
import Dodge.SoundLogic
import Dodge.Inventory
import Geometry
src/Dodge/Event/Keyboard.hs
+2 -2
View File
@@ -7,7 +7,7 @@ module Dodge.Event.Keyboard
where
import Dodge.Data
import Dodge.Base
import Dodge.CreatureAction
import Dodge.Creature.Action
import Dodge.Config.KeyConfig
import Dodge.Room.Placement
import Dodge.LightSources
@@ -43,7 +43,7 @@ handlePressedKeyInGame :: Scancode -> World -> Maybe World
handlePressedKeyInGame scode w
| scode == escapeKey (_keyConfig w) = Nothing
| scode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w
| scode == dropItemKey (_keyConfig w) = Just $ dropItem w
| scode == dropItemKey (_keyConfig w) = Just $ youDropItem w
| scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
| scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ reloadWeapon (_yourID w) w
| scode == testEventKey (_keyConfig w) = Just $ testEvent w
src/Dodge/Floor.hs
+3 -1
View File
@@ -37,7 +37,9 @@ roomTreex = do
t = treeTrunk
[[StartRoom]
,[Corridor]
,[BossAno launcherCrit]
,[BossAno $ addArmour launcherCrit & crHP +~ 800
& crState . crDropsOnDeath .~ DropSpecific [0]
]
,[Corridor]
,[OrAno [[DoorAno]
,[Corridor]
src/Dodge/Inventory.hs
+16 -4
View File
@@ -49,10 +49,13 @@ numInventorySlots = 9
itNotFull :: Item -> Bool
itNotFull it = _itMaxStack it > _itAmount it
rmInvItem :: Int -> World -> World
rmInvItem n w =
let i = _crInvSel (_creatures w IM.! n)
item = _crInv (_creatures w IM.! n) IM.! i
rmInvItem
:: Int -- ^ Creature id
-> Int -- ^ Inventory position
-> World
-> World
rmInvItem n i w =
let item = _crInv (_creatures w IM.! n) IM.! i
itRef = creatures . ix n . crInv . ix i
in case item of
Consumable {_itAmount = 1} -> set itRef NoItem w
@@ -65,6 +68,15 @@ rmInvItem n w =
Throwable {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w
_ -> set itRef NoItem w
{-
Delete a creature's selected item, the item will no longer exist.
-}
rmSelectedInvItem
:: Int -- ^ Creature id
-> World
-> World
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
-- for now, left are floor items, right are buttons
closestActiveObject :: World -> Maybe (Either FloorItem Button)
closestActiveObject w = listToMaybe $ sortBy (compare `on` dist ypos . pos) $ actObjs
src/Dodge/Item/Weapon.hs
+61 -68
View File
@@ -6,7 +6,7 @@ module Dodge.Item.Weapon
import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic
import Dodge.CreatureAction
import Dodge.Creature.Action
import Dodge.RandomHelp
import Dodge.WorldEvent
import Dodge.Debug
@@ -320,7 +320,7 @@ launcher = defaultGun
, _wpReloadState = 0
, _wpFireRate = 20
, _wpFireState = 0
, _wpFire = shoot $ aRocket
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
@@ -334,17 +334,17 @@ launcher = defaultGun
}
flameLauncher = launcher
{ _itName = "FLROCKO"
, _wpFire = shoot . aRocket' $ makeShellAt makeFlameExplosionAt
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt
}
poisonLauncher = launcher
{ _itName = "POISROCK"
, _wpFire = shoot . aRocket' $ makeShellAt makePoisonExplosionAt
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt
}
teslaLauncher = launcher
{ _itName = "TESLROCK"
, _wpFire = shoot . aRocket' $ makeShellAt makeTeslaExplosionAt
, _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt
}
bezierGun = defaultAutoGun
@@ -700,7 +700,6 @@ aLaser cid w = over particles' ( (:) (makeLaserAt phaseV pos dir (Just cid)))
phaseV = fromMaybe 1 $ cr ^? crInv . ix j . itAttachment . _Just . itPhaseV
j = _crInvSel cr
aTractorBeam :: Int -> Int -> World -> World
aTractorBeam col cid w
= set (creatures . ix cid . crInv . ix itRef . wpFire)
@@ -712,21 +711,23 @@ aTractorBeam col cid w
dir = _crDir cr
itRef = _crInvSel cr
-- | 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)
$ over projectiles (IM.insert i (shell 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 :: Int -> World -> World
aRocket = aRocket' (makeShellAt shellExplosionAt)
aRocketWithPayload
:: (Point2 -> World -> World)
-- ^ Payload
-> Int -- ^ Creature id
-> World
-> World
aRocketWithPayload pl cid w = over projectiles (IM.insert i theShell) w
where
i = newProjectileKey w
cr = (_creatures w IM.! cid)
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
dir = _crDir cr
theShell = makeShellAt pl i cid pos dir
makeShellAt
:: (Point2 -> World -> World) -- ^ Payload
:: (Point2 -> World -> World)
-- ^ Payload
-> Int -- ^ Projectile id
-> Int -- ^ Creature id
-> Point2 -- ^ Start position
@@ -736,68 +737,61 @@ 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
, _pjPict = blank
, _pjID = i
, _pjUpdate = moveShell 50 i cid 0 (rotateV dir (3,0))
, _pjPayload = pl
}
moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World
moveShell
:: Int -- ^ Timer (frames)
-> Int -- ^ Projectile id
-> Int -- ^ Creature id
-> Float -- ^ Rotation
-> Point2 -- ^ Acceleration
-> World -> World
moveShell time i cid rot accel w
| time > 40 = if circOnSomeWall oldPos 4 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 -> doExplode
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . pjUpdate)
(moveShell (time-1) i cid spin accel)
w
| time >= 20 = case thingHit of
Just p -> projectileExplosion oldPos
$ over projectiles (IM.delete i) w
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
| time > -99 = case thingHit of
Just p -> doExplode
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set randGen g
$ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . pjUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel))
$ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v)
$ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250
$ makeFlameletTimed oldPos
(0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
$ smokeGen
w
| time > -200 = case thingHit of
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
else w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjPict .~ piclow
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel)
| isJust thingHit = doExplode
| time == 35 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjPict .~ pic
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid spin accel
| time >= 20 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjPict .~ pic
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel)
| time > -99 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& randGen .~ g
& projectiles . ix i . pjPict .~ pic
& projectiles . ix i . pjUpdate .~ (moveShell (time-1) i cid rot (rotateV rot accel))
& projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
& soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250
& makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
& smokeGen
| time > -200 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjPict .~ pic
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel)
| otherwise = doExplode
where
doExplode = projectileExplosion oldPos
$ stopSoundFrom (ShellSound i)
$ over projectiles (IM.delete i) w
doExplode = w
& projectileExplosion oldPos
& stopSoundFrom (ShellSound i)
& projectiles %~ IM.delete i
pj = _projectiles w IM.! i
oldPos = _pjPos pj
vel = _pjVel pj
projectileExplosion = _pjPayload pj
newPos = oldPos +.+ vel
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.2,0.2) $ _randGen w
dir = argV $ vel
pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic
piclow = onLayerL [levLayer CrLayer - 2]
@@ -812,7 +806,6 @@ moveShell time i cid rot accel w
r1 = _randGen w & evalState (randInCirc 10)
smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos)))
normalizeAnglePi angle | normalizeAngle angle > pi = normalizeAngle angle - 2*pi
| otherwise = normalizeAngle angle
src/Dodge/Item/Weapon/TriggerType.hs
+1 -1
View File
@@ -5,7 +5,7 @@ module Dodge.Item.Weapon.TriggerType
where
import Dodge.Data
import Dodge.SoundLogic
import Dodge.CreatureAction (reloadWeapon)
import Dodge.Creature.Action (reloadWeapon)
import Dodge.WorldEvent (muzzleFlashAt,tempLightForAt)
import Dodge.WorldEvent.Cloud
import Dodge.RandomHelp
src/Dodge/Room/Boss.hs
+8 -6
View File
@@ -1,5 +1,5 @@
{-
Rooms containing particularly challenging creatures.
Rooms containing particularly challenging creatures, that may drop useful loot.
-}
module Dodge.Room.Boss
where
@@ -23,10 +23,10 @@ roomOctogon x = Room
, _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
[PS (fx,fx) 0 $ putLamp
,PS (-fx,fx) 0 $ putLamp
,PS (fx,-fx) 0 $ putLamp
,PS (-fx,-fx) 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))
@@ -35,6 +35,8 @@ roomOctogon x = Room
]
, _rmBound = rectNSWE x (-x) (-x) x
}
where
fx = 4 * x / 5
bossRoom :: RandomGen g => Creature -> State g Room
bossRoom cr = pure $ roomOctogon 300 & rmPS %~ ( PS (0,100) (pi/2) (PutCrit cr) :)
bossRoom cr = pure $ roomOctogon 300 & rmPS %~ ( PS (0,100) (negate $ pi/2) (PutCrit cr) :)
src/Dodge/Room/Treasure.hs
+6
View File
@@ -0,0 +1,6 @@
{-
Rooms that contain valuable items, typically protected in some manner.
-}
module Dodge.Room.Treasure
where
import Geometry
src/Dodge/Update/UsingInput.hs
+4 -4
View File
@@ -1,13 +1,13 @@
{-
Functions that affect the world according to what pressed buttons are stored in a Set.
-}
module Dodge.Update.UsingInput
where
import Dodge.Data
import Dodge.CreatureAction.UseItem
import Dodge.Creature.Action.UseItem
import Geometry
import SDL
import qualified Data.Set as S
import Control.Lens