Delete cruft, add Reader monad to some internal ai

src/Dodge/LevelGen.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleInstances #-}
 -- | deals with placement of objects within the world
 -- after they have had their coordinates set by the layout
@@ -8,9 +7,7 @@ module Dodge.LevelGen
     , pairsToGraph
     , makeButton
     , makeSwitch
-    )
-    where
-
+    ) where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Room.Data
@@ -29,22 +26,24 @@ import System.Random
 import Control.Monad.State
 import Control.Applicative
 import Control.Lens
-import Data.List
+import Data.List.Extra
 import Data.Function
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Set as S
 import qualified Data.Map as M
 
-
 placeSpots :: [Placement] -> World -> World
-placeSpots pss w = foldr placeSpot w' $ map _placementSpot singlePlacements
+placeSpots pss w = foldr (placeSpot . _placementSpot) w' singlePlacements
   where
     (singlePlacements, groupedPlacements) = partition isSPS pss
-    isSPS (SinglePlacement {}) = True
+    isSPS SinglePlacement{} = True
     isSPS _ = False
-    gplmnts = groupBy ((==) `on` _groupPlacementID) $ sortOn _groupPlacementID groupedPlacements
-    w' = foldr updateGroup w gplmnts
+    gplmnts :: [[Placement]]
+    gplmnts = groupOn _groupPlacementID $ sortOn _groupPlacementID groupedPlacements
+    w' = foldr putGroup w gplmnts
+    putGroup :: [Placement] -> World -> World
+    putGroup gps w = (_groupUpdate $ head gps) w gps
 
 {- | OK, this is perhaps slightly impenetrable.
  - The idea is that for a list of collected group placements, we first update
@@ -53,20 +52,20 @@ placeSpots pss w = foldr placeSpot w' $ map _placementSpot singlePlacements
  - After this, for each placement we apply the group placement function to
  - the psType using a zipWith, and taking all the pstypes as a paramenter,
  - then successively update the world using a foldr. -}
-updateGroup :: [Placement] -> World -> World
-updateGroup ps w =
-    let (w', psTypes) = mapAccumR updateSpot w $ map _placementSpot ps
-        fs = zipWith (\gp pst -> _groupPlacementFunc gp psTypes pst) ps psTypes
-    in foldr ($) w' fs
-    
-updateSpot :: World -> PlacementSpot -> (World, PSType)
-updateSpot w ps = case _psType ps of
-    PutButton bt -> undefined
-    PutCrit cr -> placeUpdateCr cr p rot w
-  where
-    p = _psPos ps
-    rot = _psRot ps
-
+--updateGroup :: [Placement] -> World -> World
+--updateGroup ps w =
+--    let (w', psTypes) = mapAccumR updateSpot w $ map _placementSpot ps
+--        fs = zipWith (\gp pst -> _groupPlacementFunc gp psTypes pst) ps psTypes
+--    in foldr ($) w' fs
+--{- | -}
+--updateSpot :: World -> PlacementSpot -> (World, PSType)
+--updateSpot w ps = case _psType ps of
+--    PutButton bt -> undefined
+--    PutCrit cr -> placeUpdateCr cr p rot w
+--  where
+--    p = _psPos ps
+--    rot = _psRot ps
+{- | -}    
 placeSpot :: PlacementSpot -> World -> World
 placeSpot ps w = case _psType ps of
     PutButton bt -> placeBt bt p rot w
@@ -134,7 +133,7 @@ addPane wl (p0,p1) wls = IM.insert (newKey wls) (wl
     })
     wls
 
-placeBt bt p rot w = over buttons addBT w
+placeBt bt p rot = over buttons addBT
   where 
     addBT bts = IM.insert (newKey bts) (bt {_btPos = p, _btRot = rot, _btID = newKey bts}) bts
 {- Creates a floor item at a given point.
@@ -155,7 +154,7 @@ placeFlIt itm p rot = floorItems %~
             }
         ) fis
 
-placePressPlate pp p rot w = over pressPlates addPP w
+placePressPlate pp p rot = over pressPlates addPP
   where 
     addPP pps = IM.insert (newKey pps) (pp {_ppPos = p,_ppRot = rot}) pps
 
@@ -166,20 +165,21 @@ placeUpdateCr scr p rot w = (w & creatures %~ IM.insert cid cr, PutCrit cr)
     cr = scr {_crPos = p,_crOldPos = p,_crDir = rot,_crID = cid} 
 
 placeCr :: Creature -> Point2 -> Float -> World -> World
-placeCr crF p rot w = over creatures addCr w
+placeCr crF p rot = over creatures addCr
   where 
-    addCr crs = IM.insert (newKey crs) 
+    addCr crs = IM.insert 
+        (newKey crs) 
         (crF {_crPos = p,_crOldPos = p,_crDir = rot,_crID = newKey crs}) 
         crs
 
 placeLS :: LightSource -> Picture -> Point2 -> Float -> World -> World
-placeLS ls dec p rot w = over lightSources addLS 
-                            $ over decorations addDec w
-    where addLS lss = IM.insert (newKey lss) 
-                                (ls {_lsPos = p,_lsDir = rot,_lsID = newKey lss}) 
-                                lss
-          addDec decs = IM.insert (newKey decs) 
-                                  (uncurry translate p $ rotate (0 - rot) dec)
-                                  decs
-
-
+placeLS ls dec p rot w = over lightSources addLS $ over decorations addDec w
+  where 
+    addLS lss = IM.insert 
+        (newKey lss) 
+        (ls {_lsPos = p,_lsDir = rot,_lsID = newKey lss}) 
+        lss
+    addDec decs = IM.insert 
+        (newKey decs) 
+        (uncurry translate p $ rotate (negate rot) dec)
+        decs