Simplify item placement during generation

src/Dodge/Creature/Inanimate.hs

@@ -16,7 +16,7 @@ import Picture
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
-defaultInanimate = defaultCreature & crIsAnimate .~ False
+defaultInanimate = defaultCreature & crState . crIsAnimate .~ False
 
 lamp :: Creature
 lamp = defaultInanimate
@@ -72,7 +72,7 @@ explosiveBarrel = defaultInanimate
     , _crState = defaultState {_goals = [[Wait]]
                             ,_faction = ChaseCritters
                             ,_crSpState = Barrel []
-                            ,_crApplyDamage = \_ c -> (id, c)
                             }
     , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+    ,_crApplyDamage = \_ c -> (id, c)
     }

src/Dodge/Creature/State.hs

@@ -56,13 +56,6 @@ stateUpdate u w (f,g) 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
@@ -93,17 +86,12 @@ copyItemToFloor cr i w = case _crInv cr IM.! i of
             _ -> w
         flid = newKey $ _floorItems w
         theflit = FlIt 
-            {_flIt = set itAmount 1 it
+            {_flIt = 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
@@ -120,7 +108,7 @@ doDamage cr = set (crState . crDamage) [] $ over (crState . crPastDamage) (+ hpL
                                             damagedCr
     where dams = _crDamage $ _crState cr
           startHP = _crHP cr
-          damagedCr = snd $ (_crApplyDamage (_crState cr)) dams cr
+          damagedCr = snd $ (_crApplyDamage cr) dams cr
           afterHP = _crHP damagedCr
           hpLost = startHP - afterHP  -- note this can be negative 
 
@@ -269,9 +257,10 @@ updateExpBarrel w (f,g) cr
 
 damToExpBarrel :: [DamageType] -> Creature -> Creature
 damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
-    where (pierceDam,otherDam) = partition isPierce ds
+  where 
-          isPierce (Piercing {}) = True
+    (pierceDam,otherDam) = partition isPierce ds
-          isPierce _             = False
+    isPierce (Piercing {}) = True
+    isPierce _             = False
 
 damToExpBarrel' :: DamageType -> Creature -> Creature
 damToExpBarrel' (Piercing amount sp int ep) cr 

src/Dodge/Creature/State/Data.hs

@@ -3,10 +3,22 @@
 module Dodge.Creature.State.Data
   where
 import Geometry
+import Dodge.Data.DamageType
 
 import Control.Lens
 
-data ItemDropType
+data CreatureState = CrSt 
+    { _goals    :: [[Goal]]
+    , _stance  :: Stance
+    , _faction :: Faction
+    , _crDamage  :: [DamageType]
+    , _crPastDamage :: Int
+    , _crSpState :: CrSpState
+    , _crDropsOnDeath :: CreatureDropType
+    , _crIsAnimate  :: Bool
+    }
+
+data CreatureDropType
     = DropAll
     | DropAmount Int
     | DropSpecific [Int]
@@ -89,6 +101,7 @@ data Faction
     | NoFaction
   deriving (Eq,Show)
 
+makeLenses ''CreatureState
 makeLenses ''CrSpState
 makeLenses ''Goal
 makeLenses ''Carriage

src/Dodge/Data.hs

@@ -4,6 +4,7 @@
 module Dodge.Data 
     ( module Dodge.Data
     , module Dodge.Data.Menu
+    , module Dodge.Data.DamageType
     , module Dodge.Data.SoundOrigin
     , module Dodge.Creature.Data
     , module Dodge.Creature.State.Data
@@ -16,6 +17,7 @@ import Dodge.Creature.Data
 import Dodge.Creature.State.Data
 import Dodge.Data.Menu
 import Dodge.Data.SoundOrigin
+import Dodge.Data.DamageType
 import Dodge.Config.Data
 import Dodge.Config.KeyConfig
 import Preload.Data
@@ -162,10 +164,9 @@ data Creature = Creature
     , _crInvSel     :: Int
     , _crState      :: CreatureState
     , _crCorpse     :: Picture
-    , _crIsAnimate  :: Bool
+    , _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
     }
 
-
 data WorldState 
     = DoorNumOpen Int 
     | CrNumAlive Int
@@ -410,7 +411,6 @@ data Particle'
 type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> World 
                     -> (World,Maybe Particle')
 
-
 data Projectile 
     = Projectile    
         { _pjPos :: Point2
@@ -430,24 +430,6 @@ data Projectile
         , _pjPayload :: Point2-> World -> World
         }
 
-data DamageType
-    = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
-    | Blunt    {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } 
-    | SparkDam {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } 
-    | Flaming  {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
-    | Lasering {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
-    | Concussive 
-        { _dmAmount :: Int 
-        , _dmFrom :: Point2 
-        , _dmPush :: Float 
-        , _dmPushExp :: Float
-        , _dmPushRadius :: Float
-        }
-    | TorqueDam {_dmAmount :: Int , _dmTorque :: Float }
-    | PushDam   {_dmAmount :: Int , _dmPushBack :: Point2 }
-    | PoisonDam {_dmAmount :: Int}
-  deriving (Eq,Ord,Show)
-
 data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
 
 data Wall 
@@ -500,21 +482,9 @@ 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 ''LightSource
 makeLenses ''TempLightSource
 makeLenses ''Stance

src/Dodge/Default.hs

@@ -79,7 +79,7 @@ defaultCreature = Creature
     , _crInvSel = 0
     , _crState  = defaultState
     , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
-    , _crIsAnimate = True
+    , _crApplyDamage = defaultApplyDamage
     }
 defaultState = CrSt 
     { _goals = []
@@ -88,8 +88,8 @@ defaultState = CrSt
     , _crDamage = []
     , _crPastDamage = 0
     , _crSpState = GenCr
-    , _crApplyDamage = defaultApplyDamage
     , _crDropsOnDeath = DropAmount 1
+    , _crIsAnimate = True
     }
 defaultEquipment = Equipment
     { _itIdentity = Generic

src/Dodge/Floor.hs

@@ -8,6 +8,8 @@ import Dodge.Room
 import Dodge.Room.Procedural
 import Dodge.Room.Data
 import Dodge.Room.Link
+import Dodge.Room.Door
+import Dodge.Room.Branch
 import Dodge.Base
 import Dodge.Layout
 import Dodge.Layout.Tree.Polymorphic

src/Dodge/Layout/Tree/Annotate.hs

@@ -8,6 +8,8 @@ import Dodge.RandomHelp
 import Dodge.Layout.Tree.Polymorphic
 import Dodge.Layout.Tree.Either
 import Dodge.Room.Procedural
+import Dodge.Room.Branch
+import Dodge.Room.Door
 import Dodge.Room.Boss
 import Dodge.Room.Link
 import Dodge.Room.Data
@@ -32,6 +34,7 @@ data Annotation g
     | OrAno [[Annotation g]]
     | SpecificRoom (State g (Tree (Either Room Room)))
     | BossAno Creature
+    | TreasureAno [Creature] Item
 
 addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
 addLock i t = do

src/Dodge/LevelGen.hs

@@ -51,8 +51,8 @@ placeSpot :: PlacementSpot -> World -> World
 placeSpot ps w = case ps of
     PS {_psPos = p, _psRot = rot, _psType = PutButton bt} 
         -> placeBt bt p rot w
-    PS {_psPos = p, _psRot = rot, _psType = PutFlIt fi} 
+    PS {_psPos = p, _psRot = rot, _psType = PutFlIt itm} 
-        -> placeFlIt fi p rot w
+        -> placeFlIt itm p rot w
     PS {_psPos = p, _psRot = rot, _psType = PutCrit cr} 
         -> placeCr cr p rot w
     PS {_psPos = p, _psRot = rot, _psType = PutLS ls dec} 
@@ -134,8 +134,15 @@ addPane c (p0,p1) wls = IM.insert (newKey wls) (Wall { _wlLine = [p0,p1]
 
 placeBt bt p rot w = over buttons addBT w
     where addBT bts = IM.insert (newKey bts) (bt {_btPos = p, _btRot = rot, _btID = newKey bts}) bts
-placeFlIt fi p rot w = over floorItems addFI w
+placeFlIt itm p rot w = over floorItems addFI w
-    where addFI fis = IM.insert (newKey fis) (fi {_flItPos = p, _flItRot = rot, _flItID = newKey fis}) fis
+    where addFI fis = IM.insert (newKey fis) 
+            (FlIt
+                {_flItPos = p
+                , _flItRot = rot
+                , _flItID = newKey fis
+                , _flIt = itm
+                }
+            ) fis
 placePressPlate pp p rot w = over pressPlates addPP w
     where addPP pps = IM.insert (newKey pps) (pp {_ppPos = p,_ppRot = rot}) pps
 

src/Dodge/LevelGen/AutoDoor.hs

@@ -71,7 +71,7 @@ autoDoorPane (trigx,trigy) n closedPos openPos = Door
   where 
     a = closedPos !! 0
     b = closedPos !! 1
-    dm w | any (crNearSeg 40 trigx trigy) $ IM.filter (_crIsAnimate) $ _creatures w
+    dm w | any (crNearSeg 40 trigx trigy) $ IM.filter (_crIsAnimate . _crState) $ _creatures w
 --            crsNearLine 40 trigL w 
                      = flip (foldr changeZonedWall) zoneps
                        $ over walls (IM.adjust openDoor n) w

src/Dodge/LevelGen/Data.hs

@@ -12,7 +12,7 @@ import System.Random
 data PSType = PutCrit Creature
     | PutLS LightSource Picture
     | PutButton Button
-    | PutFlIt FloorItem
+    | PutFlIt Item
     | PutPressPlate PressPlate
     | PutAutoDoor Point2 Point2
     | PutBlock [Int] Color [Point2]
@@ -22,14 +22,14 @@ data PSType = PutCrit Creature
     | PutSwitchDoor Color Point2 Float Point2 Point2
     | RandPS (State StdGen PSType)
     | PutNothing
+    | PutID Int
     | CollectivePS 
         { _collectiveID  :: Int 
         , _collectiveNum :: Int 
         , _collectiveFunction :: [Int] -> State StdGen [PSType]
         }
     | LabelPS { _psLabel :: Int, _ps :: PSType}
-    | PutWindow { _pwPoly :: [Point2] , _pwColor :: Color
+    | PutWindow { _pwPoly :: [Point2] , _pwColor :: Color }
-                }
 data PlacementSpot = PS
     { _psPos :: Point2
     , _psRot :: Float

src/Dodge/Room.hs

@@ -25,6 +25,8 @@ import Dodge.Room.Placement
 import Dodge.Room.Procedural
 import Dodge.Room.Corridor
 import Dodge.Room.Link
+import Dodge.Room.Branch
+import Dodge.Room.Door
 import Geometry
 import Picture
 
@@ -112,18 +114,6 @@ roomPadCut ps p = Room
     , _rmPS    = []
     , _rmBound = []
     }
-door :: Room
-door = Room
-    { _rmPolys = [rectNSWE 40 0 0 40]
-    , _rmLinks = lnks
-    , _rmPath  = [((20,35),(20,5))]
--- door extends into side walls (for shadows as rendered 12/03)
-    , _rmPS    = [PS (0,20) 0 $ PutAutoDoor (0,0) (40,0)]
-    , _rmBound = [] 
-    }
-    where lnks = [((20,35),0)
-                 ,((20, 5),pi)
-                 ]
 roomPillars :: Room
 roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
   where 
@@ -313,16 +303,16 @@ randomCorridorFrom xs = do
 
 randFirstWeapon :: State StdGen PSType
 randFirstWeapon = do
-    r <- state $ randomR (-pi,pi)
+--    r <- state $ randomR (-pi,pi)
     takeOne $ map PutFlIt 
-                                    [ defaultFlIt {_flItRot=r,_flIt = pistol}
+                                    [  pistol
-                                    , defaultFlIt {_flItRot=r,_flIt = ltAutoGun}
+                                    ,  ltAutoGun
---                                    , defaultFlIt {_flItRot=r,_flIt = autoGun}
+--                                    ,  autoGun
-                                    , defaultFlIt {_flItRot=r,_flIt = spreadGun}
+                                    ,  spreadGun
-                                    , defaultFlIt {_flItRot=r,_flIt = multGun}
+                                    ,  multGun
-                                    , defaultFlIt {_flItRot=r,_flIt = launcher}
+                                    ,  launcher
---                                    , defaultFlIt {_flItRot=r,_flIt = lasGun}
+--                                    ,  lasGun
---                                    , defaultFlIt {_flItRot=r,_flIt = flamer}
+--                                    ,  flamer
                                     ]
 
 --randC1 :: State StdGen PSType
@@ -457,16 +447,6 @@ roomCCrits = do
         lamps = [PS (50,100) 0 putLamp , PS (175,100) 0 putLamp]
     return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
 
-branchRectWith :: RandomGen g => State g (Tree (Either Room Room)) ->  State g (Tree (Either Room Room))
-branchRectWith t = do
-    x <- state $ randomR (100,200)
-    y <- state $ randomR (100,200)
-    b <- t
-    root <- randomiseOutLinks $ roomRectAutoLinks x y
-    return $ Node (Left root) [Node (Right door) [], fmap rToL $ treeTrunk [Left door] b]
-        where rToL :: Either a a -> Either a a
-              rToL (Right r) = Left r
-              rToL (Left r)  = Left r
 
 slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room))
 slowDoorRoom = do

src/Dodge/Room/Procedural.hs

@@ -212,7 +212,7 @@ shufflePlacements r = do
     return $ r & rmPS .~ newPSs
 
 putDefaultFlIt :: Item -> PSType
-putDefaultFlIt itm = PutFlIt $ defaultFlIt { _flItRot = 0, _flIt = itm }
+putDefaultFlIt itm = PutFlIt itm
 
 testRoom :: RandomGen g => State g Room
 testRoom = do

src/Dodge/Room/Treasure.hs

@@ -1,6 +1,42 @@
 {-
 Rooms that contain valuable items, typically protected in some manner.
+Typically dead ends.
 -}
 module Dodge.Room.Treasure
     where
 import Geometry
+import Dodge.Room.Data
+import Dodge.LevelGen.Data
+
+import Control.Monad.State
+import System.Random
+
+{-
+A triangular room with loot at the top (with 'PutID' 2), 
+creatures in the bottom two corners (with 'PutID' 0), 
+and (single) entrance bottom middle.
+-}
+triLootRoom
+    :: Float    -- Width
+    -> Float    -- Height
+    -> State g Room
+triLootRoom w h = pure $ Room
+    { _rmPolys  = [poly]
+    , _rmLinks  = [((0,10),pi)]
+    , _rmPath   = doublePair ((0,10),(0,h/2))
+    , _rmPS     =
+        [PS (15-w,15) 0 $ PutID 0
+        ,PS (w-15,15) 0 $ PutID 0
+        ,PS (0,h-15) 0   $ PutID 2
+        ]
+    , _rmBound  = poly
+    }
+  where
+    poly = 
+        [ ( -w,30)
+        , ( -w, 0)
+        , (  w, 0)
+        , (  w,30)
+        , ( 20, h)
+        , (-20, h)
+        ]