diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 258b07a6a..c4931ab6e 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -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 diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index e3b241eb4..b47f7611a 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -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 diff --git a/src/Dodge/CreatureAction.hs b/src/Dodge/Creature/Action.hs similarity index 91% rename from src/Dodge/CreatureAction.hs rename to src/Dodge/Creature/Action.hs index 5935389ca..fb9daee72 100644 --- a/src/Dodge/CreatureAction.hs +++ b/src/Dodge/Creature/Action.hs @@ -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 diff --git a/src/Dodge/CreatureAction/UseItem.hs b/src/Dodge/Creature/Action/UseItem.hs similarity index 94% rename from src/Dodge/CreatureAction/UseItem.hs rename to src/Dodge/Creature/Action/UseItem.hs index 8a2c0fa83..dce71a5bd 100644 --- a/src/Dodge/CreatureAction/UseItem.hs +++ b/src/Dodge/Creature/Action/UseItem.hs @@ -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 diff --git a/src/Dodge/Creature/Data.hs b/src/Dodge/Creature/Data.hs new file mode 100644 index 000000000..98683c024 --- /dev/null +++ b/src/Dodge/Creature/Data.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Creature.Data + where +import Control.Lens diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index b9c6b4331..5d9bbb60a 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -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 diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs new file mode 100644 index 000000000..e43ed0188 --- /dev/null +++ b/src/Dodge/Creature/State/Data.hs @@ -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 diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index f99e144b1..04c4a55fb 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 0bb2daa4c..137c4e7b1 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index c76a6de24..773138aa3 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index ce38cab4c..d252ac422 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -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 diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index f3c09259e..08e4764a5 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -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 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 020ae8463..6a2d91013 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -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] diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 663effcae..336247c03 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -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 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 3ebcf8fe7..7f1ea0ec2 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 543a304cc..a9e94827f 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -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 diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs index a11c3743e..1b166403b 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -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) :) diff --git a/src/Dodge/Room/Treasure.hs b/src/Dodge/Room/Treasure.hs new file mode 100644 index 000000000..f274997d2 --- /dev/null +++ b/src/Dodge/Room/Treasure.hs @@ -0,0 +1,6 @@ +{- +Rooms that contain valuable items, typically protected in some manner. +-} +module Dodge.Room.Treasure + where +import Geometry diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 76bf88ef8..c276f4348 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -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