Commit before reorganising level generation

shader/lighting/lineShadow.frag

@@ -2,5 +2,5 @@
 out vec4 fColor;
 void main()
 {
-  fColor = vec4 (0.9,0.5,0,0);
+  fColor = vec4 (0,0,0,0);
 }

shader/lighting/lineShadow.geom

@@ -36,7 +36,9 @@ void main()
     // first test if the edge is part of the silhouette
     // that is, if the normals of the faces connected by the edge point in
     // "different directions" wrt the light direction
-    if ( dot(n0 , lightDir) * dot(n1 , lightDir) < 0 )
+    if ( dot(n0 , lightDir) * dot(n1 , lightDir) <= 0 ) 
+                // using <= rather than < seems to get rid of overlapping shadow
+                // artefacts
     {
         vec4 p2 = shiftNear(p0);
         vec4 p3 = shiftNear(p1);

src/Dodge/Creature.hs

@@ -146,8 +146,8 @@ addArmour = over crInv insarmour
 ID 0.  -}
 startCr :: Creature
 startCr = defaultCreature
-    { _crPos = V2 0 0
-    , _crOldPos = V2 0 0
+    { _crPos = V2 20 0
+    , _crOldPos = V2 20 0
     , _crDir = pi/2
     , _crMvDir  = pi/2
     , _crID = 0

src/Dodge/Creature/Property.hs

@@ -1,6 +1,7 @@
 module Dodge.Creature.Property
     ( crIsArmouredFrom
     , crNearSeg
+    , crNearPoint
     ) where
 import Dodge.Data
 import Dodge.Item.Data
@@ -20,3 +21,6 @@ crIsArmouredFrom p cr
 
 crNearSeg :: Float -> Point2 -> Point2 -> Creature -> Bool
 crNearSeg d p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr + d)
+
+crNearPoint :: Float -> Point2 -> Creature -> Bool
+crNearPoint d p cr = dist (_crPos cr) p < d + _crRad cr

src/Dodge/Floor.hs

@@ -10,7 +10,7 @@ import Dodge.Room
 import Dodge.Placements.Button
 import Dodge.Layout.Tree.Polymorphic
 import Dodge.Layout.Tree.Either
-import Dodge.Layout.Tree.Annotate
+import Dodge.Annotation
 import Dodge.Layout.Tree.Shift
 import Dodge.Creature
 import Dodge.LevelGen.Data

src/Dodge/Layout/Tree/Annotate.hs

@@ -1,82 +0,0 @@
-{- | Annotating tree structures with desired properties for rooms.  -}
-module Dodge.Layout.Tree.Annotate where
-import Dodge.Data
-import Dodge.RandomHelp
-import Dodge.Layout.Tree.Polymorphic
-import Dodge.Layout.Tree.Either
-import Dodge.Room
-
-import Data.Tree
-import Control.Monad.State
-import System.Random
-import Control.Lens
-
-data Annotation g
-    = Lock Int
-    | Key  Int
-    | Corridor
-    | AirlockAno
-    | FirstWeapon
-    | StartRoom
-    | EndRoom
-    | OrAno [[Annotation g]]
-    | SpecificRoom (State g (Tree (Either Room Room)))
-    | BossAno Creature
-    | TreasureAno [Creature] [Item]
-    | SetLabel Int (State g Room)
-    | UseLabel Int (State g Room)
-    | ChainAnos [[Annotation g]]
-
-addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
-addLock i t = do
-    (beforeLock, afterLock) <- splitTrunk t
-    newBefore <- applyToRandomNode (Key i :) beforeLock
-    return $ addToTrunk newBefore [Node [Lock i] afterLock]
-{- | Add one corridor between each parent-child link of a tree of annotations.  -}
-padWithCorridors :: Tree [Annotation g] -> Tree [Annotation g]
-padWithCorridors (Node x xs) = Node [Corridor] [Node x (map padWithCorridors xs)]
-padSucWithCorridors :: Tree [Annotation g] -> Tree [Annotation g]
-padSucWithCorridors (Node x xs) = Node x (map padWithCorridors xs)
-
-{- Add one to three corridors between each parent-child link of a tree of annotations.  -}
-randomPadCorridors :: RandomGen g => Tree [Annotation g] -> State g (Tree [Annotation g])
-randomPadCorridors  (Node x xs) = do
-    n <- state $ randomR (1, 3)
-    xs' <- mapM randomPadCorridors xs
-    return $ treeFromTrunk (replicate n [Corridor]) (Node x xs')
-{- | Add a corridor to a random out-link of a room.  -}
-roomThenCorridor :: RandomGen g => Room -> State g (Tree (Either Room Room))
-roomThenCorridor theRoom = fmap (\r -> Node (Left theRoom) [(pure . Right) r]) 
-                                (randomiseOutLinks corridor)
-{- | Create a random room tree structure from a list of annotations.  -}
-anoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
-anoToRoomTree anos = case anos of
-    [SetLabel i randrm] -> do
-        rm <- randrm
-        return . connectRoom $ rm & rmLabel ?~ i
-    [UseLabel i randrm] -> do
-        rm <- randrm
-        return $ connectRoom $ rm & rmTakeFrom ?~ i
-    [ChainAnos ass] -> do
-        rms <- mapM anoToRoomTree ass
-        return $ linkEitherTrees rms
-    [OrAno as] -> do
-        a <- takeOne as
-        anoToRoomTree a
-    [Corridor] -> pure . Right <$> randomiseOutLinks corridor
-    [AirlockAno] -> airlock >>=  roomThenCorridor
-    [FirstWeapon] -> do
-        branchWP <- branchRectWith weaponRoom
-        blockedC <- longBlockedCorridor
-        join $ takeOne $ return (appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom
-    [EndRoom] -> fmap (pure . Right) (telRoomLev 1)
-    [StartRoom] -> startRoom
-    (SpecificRoom rt:_) -> rt
-    (BossAno cr : _) -> do
-        br <- bossRoom cr
-        branchRectWith . pure . fmap Left $ treeFromPost [corridor,corridor] br
-    (TreasureAno crs loot : _) -> branchRectWith . fmap (pure . Left) $ lootRoom crs loot
-    _ -> do
-        w <- state $ randomR (100,400)
-        h <- state $ randomR (200,400)
-        fmap (pure . Right) . randomiseOutLinks $ roomRectAutoLinks w h

src/Dodge/Placements/Door.hs

@@ -28,7 +28,9 @@ putAutoDoor a b = PlacementUsingPos (addZ 0 a)
     $ \az -> PlacementUsingPos (addZ 0 b)
     $ \bz -> putDoubleDoor True (dim yellow) (cond az bz) a b 3
   where
-    cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures
+    --cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures
+    cond az bz = any (crNearPoint 40 (0.5 *.* (stripZ az +.+ stripZ bz))) 
+        . IM.filter isAnimate . _creatures
 
 switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
 switchDoor btpos btrot dra drb col = pContID (PS btpos btrot) (PutButton $ makeSwitch col red id id)

src/Dodge/Room/Start.hs

@@ -19,11 +19,32 @@ import System.Random
 --import qualified Data.IntMap.Strict as IM
 
 rezBox :: Room
-rezBox = shiftRoomBy (V2 (-20) (-10),0) $ roomRect 40 20 1 1 
-    & rmPmnts .~ [ spanColLightI (V3 0 0.7 0.2) 70 (V2 0 10) (V2 40 10) ]
+--rezBox = shiftRoomBy (V2 (-20) (-10),0) $ roomRect 40 20 1 1 
+rezBox = roomRect 40 40 1 1 
+    & rmPmnts .~ [ spanColLightI (V3 0 0.5 0) 95 (V2 0 1) (V2 40 1) ]
+
+rezInvBox :: Room
+rezInvBox = roomRect 40 40 1 1 
+    & rmPmnts .~ [ spanColLightI (V3 0 0.5 0) 95 (V2 0 39) (V2 40 39) ]
 
 startRoom :: RandomGen g => State g (Tree (Either Room Room))
 startRoom = do
+    w <- state $ randomR (100,400)
+    h <- state $ randomR (100,200)
+    let bottomEdgeTest (V2 _ y,_) = y < 1
+    centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest 
+        ((roomRectAutoLinks w h) {_rmPmnts = []})
+    let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
+    centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
+    return $ treeFromTrunk [Left rezBox
+        , Left door
+        ] 
+        (Node (Left centralRoom') (replicate (n-1) dbox ++ [Node (Right door) []]))
+  where
+    dbox = treeFromPost [Left door] (Left rezInvBox)
+
+startRoom' :: RandomGen g => State g (Tree (Either Room Room))
+startRoom' = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)
     let plmnts =