Restruction room code

src/Dodge/Data/DamageType.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+{- 
+Datatypes describing the type of damage effects that are to be applied to
+creatures.
+-}
+module Dodge.Data.DamageType
+    where
+import Geometry
+
+import Control.Lens
+
+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)
+
+makeLenses ''DamageType

src/Dodge/Room/Branch.hs

@@ -0,0 +1,27 @@
+{-
+Collections of rooms that branch into multiple paths.
+-}
+module Dodge.Room.Branch
+    where
+import Geometry
+import Dodge.Room.Data
+import Dodge.Room.Door
+import Dodge.Room.Link
+import Dodge.Room.Procedural
+import Dodge.LevelGen.Data
+import Dodge.Layout.Tree.Polymorphic
+
+import Control.Monad.State
+import System.Random
+import Data.Tree
+
+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

src/Dodge/Room/Door.hs

@@ -0,0 +1,24 @@
+{-
+Rooms that connect other rooms, blocking sight.
+-}
+module Dodge.Room.Door
+    where
+import Geometry
+import Dodge.Room.Data
+import Dodge.LevelGen.Data
+
+--import Control.Monad.State
+--import System.Random
+
+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)
+                 ]