Delete cruft, add Reader monad to some internal ai

src/Dodge/Room.hs

@@ -84,10 +84,8 @@ roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
     f a x b y = putBlockRect a x b y
     g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d
 
-
-
 branchWith :: Room -> [Tree Room] -> Tree (Either Room Room)
-branchWith r ts = Node (Left r) $ [return $ Right door] ++ fmap (fmap Left) ts
+branchWith r ts = Node (Left r) $ return (Right door) : fmap (fmap Left) ts
 
 glassSwitchBack :: RandomGen g => State g Room
 glassSwitchBack = do
@@ -95,16 +93,17 @@ glassSwitchBack = do
     hgt <- state $ randomR (400,600)
     wllen <- state $ randomR (60,wth/2-40)
     let hf = hgt/5
-    let plmnts = [windowLine (wth-60,     hf) (wllen,hf)
-                 ,windowLine (wth-wllen,2*hf) (60,   2*hf)
-                 ,windowLine (wth-60,   3*hf) (wllen,3*hf)
-                 ,windowLine (wth-wllen,4*hf) (60,   4*hf)
-                 ,blockLine (        0, 1*hf) (wllen,1*hf)
-                 ,blockLine (wth-wllen, 2*hf) (  wth,2*hf)
-                 ,blockLine (        0, 3*hf) (wllen,3*hf)
-                 ,blockLine (wth-wllen, 4*hf) (  wth,4*hf)
-                 , sPS (wth/2,hgt/2) 0 $ putLamp
-                 ]
+    let plmnts = 
+            [windowLine (wth-60,     hf) (wllen,hf)
+            ,windowLine (wth-wllen,2*hf) (60,   2*hf)
+            ,windowLine (wth-60,   3*hf) (wllen,3*hf)
+            ,windowLine (wth-wllen,4*hf) (60,   4*hf)
+            ,blockLine (        0, 1*hf) (wllen,1*hf)
+            ,blockLine (wth-wllen, 2*hf) (  wth,2*hf)
+            ,blockLine (        0, 3*hf) (wllen,3*hf)
+            ,blockLine (wth-wllen, 4*hf) (  wth,4*hf)
+            , sPS (wth/2,hgt/2) 0 putLamp
+            ]
     return $ set rmPS plmnts $ roomRect wth hgt 2 6
 
 manyDoors :: Int -> Tree (Either Room Room)
@@ -112,22 +111,22 @@ manyDoors i = treeFromPost (replicate i (Left door)) $ Right door
 
 glassLesson :: RandomGen g => State g (Tree (Either Room Room))
 glassLesson = do
-    corridors <- sequence $ replicate 3 $ fmap Left $ randomiseOutLinks corridor
-    return $ Node (Left $ botRoom) [deadRoom door,uppers, treeFromPost (Left door : corridors) $ Right door]
-        where uppers = Node (Left door) [deadRoom topRoom]
-              botRoom = set rmPS botplmnts 
-                                 $ roomRect 200 200 1 1
-              topRoom = set rmPS topplmnts 
-                                 $ roomRect 200 200 1 1
-              botplmnts = [sPS (0,0) 0 $ PutWall (rectNSWE (200) 0 (90) (110)) 
-                                      $ defaultCrystalWall
-                          ,sPS (50,100) 0 $ PutCrit miniGunCrit
-                          ,sPS (50,50) 0 putLamp
-                          ]
-              topplmnts = [windowLine (100,200) (100,0) 
-                          ,sPS (50,100) 0 $ PutCrit miniGunCrit
-                          ,sPS (50,50) 0 putLamp
-                          ]
+    corridors <- replicateM 3 $ Left <$> randomiseOutLinks corridor
+    return $ Node (Left botRoom) [deadRoom door,uppers, treeFromPost (Left door : corridors) $ Right door]
+  where 
+    uppers = Node (Left door) [deadRoom topRoom]
+    botRoom = set rmPS botplmnts $ roomRect 200 200 1 1
+    topRoom = set rmPS topplmnts $ roomRect 200 200 1 1
+    botplmnts = 
+        [sPS    (0,0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
+        ,sPS (50,100) 0 $ PutCrit miniGunCrit
+        ,sPS  (50,50) 0 putLamp
+        ]
+    topplmnts = 
+        [windowLine (100,200) (100,0) 
+        ,sPS (50,100) 0 $ PutCrit miniGunCrit
+        ,sPS (50,50) 0 putLamp
+        ]
 
 miniRoom1 :: RandomGen g => State g Room
 miniRoom1 = do
@@ -145,7 +144,7 @@ miniRoom1 = do
                      ,windowLine (wth-60,   40+3*hf) (wllen,40+3*hf)
                      ,windowLine (wth-wllen,40+4*hf) (60,40+4*hf)
                      ,sPS (crx,cry) 0 $ PutCrit miniGunCrit
-                     ,sPS (wth-20,hgt/2+40) 0 $ randC
+                     ,sPS (wth-20,hgt/2+40) 0 randC
                      ,sPS (wth/2,hgt/2) 0 putLamp
                      ,blockLine (        0, 40+1*hf) (wllen,40+1*hf)
                      ,blockLine (wth-wllen, 40+2*hf) (  wth,40+2*hf)
@@ -155,9 +154,10 @@ miniRoom1 = do
         return $ set rmPS plmnts $ shiftRoomBy ((0,40),0) $ roomRect wth hgt 2 4
 
 miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
-miniTree2 = miniRoom1 >>= randomiseOutLinks >>= changeLinkTo (\p -> (snd . fst) p < 70) 
-                         >>= return . flip branchWith (replicate 3 $ treeFromPost [door,corridor] 
-                                                                              critInDeadEnd   )
+miniTree2 = miniRoom1 
+    >>= randomiseOutLinks 
+    >>= changeLinkTo (\p -> (snd . fst) p < 70) 
+    <&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
 
 miniRoom3 :: RandomGen g => State g (Tree (Either Room Room))
 miniRoom3 = do
@@ -200,7 +200,7 @@ roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
     [return $ connectRoom door
     ,join $ takeOne [miniTree2,glassLesson]
     ]
-    $ fmap connectRoom $ randomiseOutLinks corridor
+    $ connectRoom <$> randomiseOutLinks corridor
   where 
     f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
     f (Node (Left x) xs) = Node (Left (Left x)) $ map f xs
@@ -245,7 +245,7 @@ allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
 
 randomCorridorFrom :: RandomGen g => [a] -> State g (Tree (Either a a))
 randomCorridorFrom xs = do
-    rooms <- sequence $ replicate 5 $ takeOne xs
+    rooms <- replicateM 5 $ takeOne xs
     return $ treeFromTrunk (map Left $ init rooms) (Node (Right (last rooms)) [])
 {- Probabilites of the type of the first floor weapon.  -}
 randFirstWeapon :: State StdGen PSType
@@ -264,23 +264,25 @@ weaponEmptyRoom :: RandomGen g => State g (Tree (Either Room Room))
 weaponEmptyRoom = do
     w <- state $ randomR (220,300)
     h <- state $ randomR (220,300)
-    let plmnts = [sPS (w/2,h-40) 0 $ RandPS randFirstWeapon
-                 ,sPS (20,20) (pi/2) $ randC1
-                 ,sPS (w-20,20) (pi/2) $ randC1
-                 ,sPS (w/2,h/2) 0 $ putLamp
-                 ]
-    (fmap connectRoom . randomiseOutLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst) 
-                        $ set rmPS plmnts $ roomRect w h 2 2)
+    let plmnts = 
+            [sPS (w/2,h-40)     0 $ RandPS randFirstWeapon
+            ,sPS   (20,20) (pi/2) randC1
+            ,sPS (w-20,20) (pi/2) randC1
+            ,sPS (w/2,h/2)      0 putLamp
+            ]
+    (fmap connectRoom . randomiseOutLinks) =<< 
+        changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst) (set rmPS plmnts $ roomRect w h 2 2)
      
 weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
 weaponUnderCrits = do
     let plmnts = 
-            [sPS (20,0)  0 $ RandPS randFirstWeapon
-            ,sPS (20,0) (0-pi/2) $ randC1
-            ,sPS (20,20) (0-pi/2) $ randC1
+            [sPS (20,0)   0 $ RandPS randFirstWeapon
+            ,sPS (20,0)  (negate $ pi/2) randC1
+            ,sPS (20,20) (negate $ pi/2) randC1
             ]
-    let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN] 
-                                     (connectRoom (set rmPS plmnts $ corridorN))
+    let continuationRoom = treeFromTrunk 
+            [Left corridorN,Left corridorN] 
+            (connectRoom (set rmPS plmnts corridorN))
     rcp' <- roomCenterPillar
     let rcp = over rmPS ( sPS (120,80) 0 putLamp : ) rcp'
     deadEndRoom <- takeOne [roomPillars,rcp]
@@ -295,14 +297,16 @@ weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
 weaponBehindPillar  = do
       crPos <- takeOne $ [(x,y) | x <- [20,220], y <- [20,220]] ++ [(120,160),(120,200)]
       let d p = argV $ (120,80) -.- p
-      let plmnts1 = [sPS (120,160)  0 $ RandPS randFirstWeapon
-                    ,sPS crPos (d crPos) $ randC1
-                    ]
+      let plmnts1 = 
+            [sPS (120,160)  0 $ RandPS randFirstWeapon
+            ,sPS crPos (d crPos) randC1
+            ]
       rcp <- roomCenterPillar
-      return $ treeFromTrunk [Left door
-                         ,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp]
-                         (connectRoom $ set rmPS [sPS (20,60) (0-pi/2) $ randC1]
-                                                  $ corridorN)
+      return $ treeFromTrunk 
+        [Left door
+        ,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp
+        ]
+        (connectRoom $ set rmPS [sPS (20,60) (negate $ pi/2) randC1] corridorN)
 
 weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
 weaponBetweenPillars = do
@@ -313,34 +317,31 @@ weaponBetweenPillars = do
         d p = argV $ (120,120) -.- p
         plmnts = 
             [sPS wpPos 0 $ RandPS randFirstWeapon
-            ,sPS crPos1 (d crPos1) $ randC1
-            ,sPS crPos2 (d crPos2) $ randC1
+            ,sPS crPos1 (d crPos1) randC1
+            ,sPS crPos2 (d crPos2) randC1
             ]
-    (fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
+    (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (over rmPS (++plmnts) roomPillars)
   where 
     f (_,a) = a == 0
 
 weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
 weaponLongCorridor = do
-    root <- takeOne $ [tEast, tWest]
+    root <- takeOne [tEast, tWest]
     connectingRoom <- takeOne 
-        [tEast & rmPS .~ [sPS (-40,60) 0 $ putLamp]
-        ,tWest & rmPS .~ [sPS ( 40,60) 0 $ putLamp]
+        [tEast & rmPS .~ [sPS (-40,60) 0 putLamp]
+        ,tWest & rmPS .~ [sPS ( 40,60) 0 putLamp]
         ]
     i1 <- state $ randomR (2,5)
     i2 <- state $ randomR (2,5)
     let branch1 = treeFromTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
     let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
     return $ Node (Left root) [branch1,branch2]
-        where putCrs = over rmPS (++ [sPS (10,40) (-pi/2) $ randC
-                                 ,sPS (-10,40) (-pi/2) $ randC
-                                 ])
-              putWp = set rmPS [sPS (20,40) 0 $ RandPS randFirstWeapon
-                               ,sPS (20,60) 0 $ putLamp
-                               ]
+      where 
+        putCrs = over rmPS (++ [sPS (10,40) (-pi/2) randC ,sPS (-10,40) (-pi/2) randC ])
+        putWp = set rmPS [sPS (20,40) 0 $ RandPS randFirstWeapon ,sPS (20,60) 0 putLamp ]
 
 critInDeadEnd :: Room
-critInDeadEnd = set rmPS [sPS (0,0) 0 $ randC] deadEndRoom
+critInDeadEnd = set rmPS [sPS (0,0) 0 randC] deadEndRoom
 
 deadEndRoom :: Room
 deadEndRoom = Room
@@ -365,8 +366,8 @@ weaponRoom = join $ takeOne
 
 roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
 roomCCrits = do
-    ps <- sequence $ replicate 20 $ randInCirc 9
-    let plmnts = map (\p -> sPS p 0 $ randC) 
+    ps <- replicateM 20 $ randInCirc 9
+    let plmnts = map (\p -> sPS p 0 randC) 
                        $ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
         lamps = [sPS (50,100) 0 putLamp , sPS (175,100) 0 putLamp]
     return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
@@ -384,38 +385,33 @@ longRoom = do
                     ,rectNSWE (h-35) (h-135) 65 85
                     ]
     let wsDefense = map (\ps -> sPS (0,0) 0 $ PutWall ps defaultCrystalWall)
-                    [rectNSWE (95) (70)  0 25
-                    ,rectNSWE (95) (70) 50 75
+                    [rectNSWE 95 70  0 25
+                    ,rectNSWE 95 70 50 75
                     ]
     brls <- fmap (map (\p -> sPS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) )
-                            $ sequence $ replicate 5 $ randInRect (w-20) 900
+                            $ replicateM 5 $ randInRect (w-20) 900
     let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
-    changeLinkTo cond $ set rmPS (ws ++ brls ++ wsDefense ++
-                                 [sPS ( 12.5,h-25) 0 $ PutCrit longCrit
-                                 ,sPS ( 37.5,h-25) 0 $ PutCrit longCrit
-                                 ,sPS ( 62.5,h-25) 0 $ PutCrit longCrit
-                                 ,sPS ( 25, 20) 0 $ putLamp
-                                 ,sPS ( 25, h-10) 0 $ putLamp
-                                 ]
-                                 )
-                      $ rm
-
+    changeLinkTo cond $ rm & rmPS .~ ws ++ brls ++ wsDefense ++
+        [sPS ( 12.5,h-25) 0 $ PutCrit longCrit
+        ,sPS ( 37.5,h-25) 0 $ PutCrit longCrit
+        ,sPS ( 62.5,h-25) 0 $ PutCrit longCrit
+        ,sPS (   25,  20) 0 putLamp
+        ,sPS (   25,h-10) 0 putLamp
+        ]
 
 shooterRoom :: RandomGen g => State g Room
 shooterRoom = do
     h <- state $ randomR (200,300)
     let cond x = (snd . fst) x < h - 40
-    changeLinkTo cond $ set rmPS ( [blockLine (50,50) (50,h)
-                                   ,sPS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit
-                                   ,sPS ( 75,h-30) 0 $ PutCrit explosiveBarrel
-                                   ,sPS ( 75,h-60) 0 $ PutCrit explosiveBarrel
-                                   ,sPS ( 85,h-10) 0 $ PutCrit explosiveBarrel
-                                   ,sPS ( 85,h-45) 0 $ PutCrit explosiveBarrel
-                                   ,sPS ( 75,h-80) 0 putLamp
-                                   ]
-                                 ) 
-                      $ roomRect 100 h 1 1
-                      
+    changeLinkTo cond $ roomRect 100 h 1 1 & rmPS .~
+        [blockLine (50,50) (50,h)
+        ,sPS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit
+        ,sPS ( 75,h-30) 0 $ PutCrit explosiveBarrel
+        ,sPS ( 75,h-60) 0 $ PutCrit explosiveBarrel
+        ,sPS ( 85,h-10) 0 $ PutCrit explosiveBarrel
+        ,sPS ( 85,h-45) 0 $ PutCrit explosiveBarrel
+        ,sPS ( 75,h-80) 0 putLamp
+        ]
 
 shootersRoom1 :: RandomGen g => State g Room
 shootersRoom1 = do