Refactor level/room generation modules

src/Dodge/LevelGen.hs

@@ -14,8 +14,6 @@ module Dodge.LevelGen
 
 import Dodge.Data
 import Dodge.Base
-import Dodge.SoundLogic
-import Dodge.Prototypes
 
 import Dodge.LevelGen.Block
 import Dodge.LevelGen.Pathing
@@ -29,7 +27,6 @@ import Picture
 
 import System.Random
 
-
 import Control.Monad.State
 import Data.List
 import Data.Function
@@ -40,16 +37,7 @@ import qualified Data.IntMap.Strict as IM
 import qualified Data.Set as S
 import qualified Data.Map as M
 
-import Data.Graph.Inductive hiding ((&))
-import Data.Graph.Inductive.NodeMap
-import Data.Tree
-
-treeTrunk :: [a] -> Tree a -> Tree a
-treeTrunk [] t     = t
-treeTrunk (x:xs) t = Node x [treeTrunk xs t]
-
-applyToRoot :: (a -> a) -> Tree a -> Tree a
-applyToRoot f (Node x xs) = Node (f x) xs
+-- deals with placement of objects within the world
 
 placeSpots :: [PlacementSpot] -> World -> World
 placeSpots pss w = foldr placeSpot w basicPlacements
@@ -101,7 +89,8 @@ placeSpot ps w = case ps of
 
     PS {_psPos = p, _psRot = rot, _psType = PutWindow { _pwPoly = ps, _pwColor = c }}
         -> rmCrossPaths $ over walls (addWindow (q:qs) c) w
-                where (q:qs) = translateS p $ rotateS rot ps
+--                where (q:qs) = translateS p $ rotateS rot ps
+                where (q:qs) = map (shiftPointBy (p,rot)) ps
                       rmCrossPaths w = foldr (uncurry removePathsCrossing) w $ zip (q:qs) (qs++[q])
 
     _   -> w
@@ -130,11 +119,6 @@ instance Shiftable PlacementSpot where
     translateS p' (PS p r x) = PS (p +.+ p') r x
     rotateS    r' (PS p r x) = PS (rotateV r' p) (r + r') x
 
-
-          
-
-
-
 putWindowBlock :: Point2 -> Point2 -> World -> World
 putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
     where d = dist a b
@@ -201,8 +185,6 @@ putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
                         }
                 f = IM.insert k0 l . IM.insert k1 t . IM.insert k2 r . IM.insert k3 b
             in  over walls f w
-                                    
-
 
 shiftPointBy (pos,rot) p = pos +.+ rotateV rot p
 
@@ -228,29 +210,6 @@ placeFlIt fi p rot w = over floorItems addFI w
 placePressPlate pp p rot w = over pressPlates addPP w
     where addPP pps = IM.insert (newKey pps) (pp {_ppPos = p,_ppRot = rot}) pps
 
--- Left elements get new children, Right elements inherit the children from the
--- mapped over node
-expandTreeBy :: (a -> Tree (Either b b)) -> Tree a -> Tree b
-expandTreeBy f (Node x []) = fmap removeEither (f x)
-    where removeEither (Left y)  = y
-          removeEither (Right y) = y
-expandTreeBy f (Node x xs) = appendAndRemove $ f x
-    where appendAndRemove (Node (Left y)  ys) = Node y (map appendAndRemove ys)
-          appendAndRemove (Node (Right y) _ ) = Node y (map (expandTreeBy f) xs)
-
-expandTreeRand :: RandomGen g => 
-        (a -> State g (Tree (Either b b))) -> Tree a -> State g (Tree b)
-expandTreeRand f (Node x []) = fmap (fmap removeEither) (f x)
-    where removeEither (Left y)  = y
-          removeEither (Right y) = y
-expandTreeRand f (Node x xs) = do
-    root <- f x
-    branches <- sequence $ map (expandTreeRand f) xs
-    return (appendAndRemove branches root)
-        where appendAndRemove :: [Tree a] -> Tree (Either a a) -> Tree a
-              appendAndRemove bran (Node (Left y) ys) = Node y (map (appendAndRemove bran) ys)
-              appendAndRemove bran (Node (Right y) _) = Node y bran
-
 placeCr :: Creature -> Point2 -> Float -> World -> World
 placeCr crF p rot w = over creatures addCr w
     where addCr crs = IM.insert (newKey crs)