Allow for different item drops on creature death

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
 

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

src/Dodge/Creature/Action.hs

@@ -1,12 +1,13 @@
+{- Actions performed by creatures within the world
+ -}
 {-# LANGUAGE BangPatterns #-}
-module Dodge.CreatureAction 
+module Dodge.Creature.Action 
-    ( module Dodge.CreatureAction
+    ( module Dodge.Creature.Action
     , useItem
     , tryUseItem
     )
     where
--- imports {{{
+import Dodge.Creature.Action.UseItem
-import Dodge.CreatureAction.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/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

src/Dodge/Creature/Data.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Creature.Data
+  where
+import Control.Lens

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 
+stateUpdate u w (f,g) cr = 
-                           in case u w (f,g'') cr' of
+    let (cr', g'') = updateMovement g cr 
-        ((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . dropifdead . f'
+    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   
+  where   
-        crOrCorpse cr | cr ^. crHP > 0 = Just cr
+    crOrCorpse cr | cr ^. crHP > 0 = Just cr
-                      | otherwise      = Nothing
+                  | otherwise      = Nothing
-        dropifdead | cr ^.crHP > 0 = id
+    deathEff | cr ^.crHP > 0 = id
-                   | otherwise = stopSoundFrom (CrWeaponSound (_crID cr)) 
+             | otherwise = stopSoundFrom (CrWeaponSound (_crID cr)) 
-                                    . over decorations addCorpse 
+                                . over decorations addCorpse 
-                                    . insertIt
+                                . dropByState cr
-        crBeforeDeath = colCrWall w $ cr
+    crBeforeDeath = colCrWall w $ cr
-        addCorpse = insertNewKey $ uncurry translate (_crOldPos cr) 
+    addCorpse = insertNewKey $ uncurry translate (_crOldPos cr) 
-                                 $ rotate (_crDir cr)
+                             $ rotate (_crDir cr)
-                                 (_crCorpse cr)
+                             (_crCorpse cr)
-        maybeIt = evalState (maybeTakeOne $ IM.elems (_crInv cr)) (_randGen w)
+--    maybeIt = evalState (maybeTakeOne $ IM.elems (_crInv cr)) (_randGen w)
-        insertIt = case maybeIt of 
+--    insertIt = case maybeIt of 
---                      Just it -> createItemAt (offset +.+ _crPos crBeforeDeath) 
+--                  Just it -> createItemAt (offset +.+ _crOldPos cr) 
-                      Just it -> createItemAt (offset +.+ _crOldPos cr) 
+--                                          (FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0})
-                                              (FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0})
+--                  Nothing -> id
-                      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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -49,10 +49,13 @@ numInventorySlots = 9
 itNotFull :: Item -> Bool
 itNotFull it = _itMaxStack it > _itAmount it
 
-rmInvItem :: Int -> World -> World
+rmInvItem 
-rmInvItem n w = 
+    :: Int      -- ^ Creature id
-    let i = _crInvSel (_creatures w IM.! n)
+    -> Int      -- ^ Inventory position
-        item = _crInv (_creatures w IM.! n) IM.! i
+    -> 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

@@ -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
+aRocketWithPayload
-aRocket' :: (Int -> Int -> Point2 -> Float -> Projectile) -> Int -> World -> World
+    :: (Point2 -> World -> World) 
-aRocket' shell cid w
+                -- ^ Payload
-        = soundOnce (fromIntegral launcherSound)
+    -> Int      -- ^ Creature id
-            $ over projectiles (IM.insert i (shell i cid pos dir)) w
+    -> World
-    where i = newProjectileKey w
+    -> World
-          cr  = (_creatures w IM.! cid)
+aRocketWithPayload pl cid w = over projectiles (IM.insert i theShell) w
-          pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
+  where 
-          dir = _crDir cr
+    i = newProjectileKey w
-
+    cr  = (_creatures w IM.! cid)
-aRocket :: Int -> World -> World
+    pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
-aRocket = aRocket' (makeShellAt shellExplosionAt)
+    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)
+        else w
-                        $ set (projectiles . ix i . pjPict) piclow
+            & projectiles . ix i . pjPos    %~ (+.+ vel)
-                        $ set (projectiles . ix i . pjUpdate) 
+            & projectiles . ix i . pjPict   .~ piclow
-                                  (moveShell (time-1) i cid rot (rotateV rot accel))
+            & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel)
-                          w
+    | isJust thingHit = doExplode
-    | time == 35 = case thingHit of
+    | time == 35 = w
-        Just p  -> doExplode
+        & projectiles . ix i . pjPos    %~ (+.+ vel)
-        Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
+        & projectiles . ix i . pjPict   .~ pic
-                   $ set (projectiles . ix i . pjPict) pic
+        & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid spin accel
-                   $ set (projectiles . ix i . pjUpdate) 
+    | time >= 20 = w
-                             (moveShell (time-1) i cid spin accel)
+        & projectiles . ix i . pjPos    %~ (+.+ vel)
-                     w
+        & projectiles . ix i . pjPict   .~ pic
-    | time >= 20 = case thingHit of
+        & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel)
-        Just p  -> projectileExplosion oldPos
+    | time > -99 = w
-                     $ over projectiles (IM.delete i) w
+        & projectiles . ix i . pjPos    %~ (+.+ vel)
-        Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
+        & randGen .~ g
-                   $ set (projectiles . ix i . pjPict) pic
+        & projectiles . ix i . pjPict   .~ pic
-                   $ set (projectiles . ix i . pjUpdate) 
+        & projectiles . ix i . pjUpdate .~ (moveShell (time-1) i cid rot (rotateV rot accel))
-                             (moveShell (time-1) i cid rot (rotateV rot accel))
+        & projectiles . ix i . pjVel    %~ (\v -> accel +.+ frict *.* v)
-                     w
+        & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250
-    | time > -99 = case thingHit of
+        & makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
-        Just p  -> doExplode
+        & smokeGen
-        Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
+    | time > -200 = w
-                   $ set randGen g
+        & projectiles . ix i . pjPos    %~ (+.+ vel)
-                   $ set (projectiles . ix i . pjPict) pic
+        & projectiles . ix i . pjPict   .~ pic
-                   $ set (projectiles . ix i . pjUpdate) 
+        & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel)
-                             (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
     | otherwise = doExplode
   where 
-    doExplode = projectileExplosion oldPos 
+    doExplode = w
-        $ stopSoundFrom (ShellSound i)
+        & projectileExplosion oldPos 
-        $ over projectiles (IM.delete i) w
+        & 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
+    (frict,g)  = randomR (0.6,0.9) $ _randGen w
-    (sparkD,_) = randomR (-0.5,0.5) $ _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

@@ -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

@@ -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 (fx,fx) 0 $ putLamp
-        ,PS (10-x,x-10) 0 $ putLamp
+        ,PS (-fx,fx) 0 $ putLamp
-        ,PS (10-x,10-x) 0 $ putLamp
+        ,PS (fx,-fx) 0 $ putLamp
-        ,PS (x-10,10-x) 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

@@ -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

@@ -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.Creature.Action.UseItem
-import Dodge.CreatureAction.UseItem
-
 import Geometry
 
 import SDL
-
 import qualified Data.Set as S
 import Control.Lens