Cleanup

src/Dodge/Data/PathGraph.hs

@@ -50,6 +50,7 @@ data EdgeObstacle
     | DoorObstacle
     | AutoDoorObstacle
     | WallObstacle
+    | ChasmObstacle
     deriving (Eq, Ord, Show, Bounded, Enum, Read) --Generic, Flat)
 
 --instance (ToJSON a, ToJSON b) => ToJSON (Gr a b) where

src/Dodge/Debug/Picture.hs

@@ -270,10 +270,11 @@ drawPathEdge pe =
 
 obstacleColor :: EdgeObstacle -> Color
 obstacleColor eo = case eo of
-    WallObstacle -> cyan
-    DoorObstacle -> red
+    WallObstacle -> red
+    DoorObstacle -> orange
     AutoDoorObstacle -> yellow
     BlockObstacle -> blue
+    ChasmObstacle -> cyan
 
 drawFarWallDetect :: World -> Picture
 drawFarWallDetect w =

src/Dodge/Default/Block.hs.orig

@@ -1,29 +0,0 @@
-module Dodge.Default.Block where
-
-import Dodge.Block.Debris
-import Dodge.Data.Block
-import LensHelp
-
-defaultBlock :: Block
-defaultBlock =
-    Block
-        { _blID = 0
-        , _blWallIDs = mempty
-        , _blHP = 1000
-        , _blShadows = []
-        , _blFootprint = []
-        , _blPos = 0
-        , _blDir = 0
-        , _blDraw = const mempty
-        , _blDeath = makeBlockDebris
-        , _blObstructs =
-            []
-                <<<<<<< HEAD
-                =======
-        , _blPaths =
-            []
-                >>>>>>> efficientRuntime
-        }
-
-defaultDirtBlock :: Block
-defaultDirtBlock = defaultBlock & blHP .~ 50

src/Dodge/Path.hs

@@ -145,7 +145,8 @@ addEdges nodemap gr = foldl' f (mempty, gr)
         theedgedata = PathEdgeNodes (g a) (g b) (PathEdge a b (dist a b) mempty)
     g a = nodemap M.! a
 
-obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> (World, Set PathEdgeNodes)
+obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World 
+    -> (World, Set PathEdgeNodes)
 obstructPathsCrossing obstacletype sp' ep w =
     ( w & cWorld . pathGraph %~ updateedges
     , es

src/Dodge/Placement/PlaceSpot/Block.hs.orig

@@ -1,123 +0,0 @@
-{- | Creation, update and destruction of destructible walls.  -}
-module Dodge.Placement.PlaceSpot.Block 
-    ( plBlock
-    , plLineBlock
-    )
-    where
-import Dodge.Data.World
-import Dodge.Path
-import Dodge.Block.Debris
-import Dodge.Base
-import Geometry
-import qualified IntMapHelp as IM
-import Control.Lens
-import qualified Data.IntSet as IS
-
-plBlock 
-    :: [Point2]     -- ^ Block polygon
-    -> Block
-    -> Wall         -- ^ Base Pane
-    -> World 
-    -> (Int,World)
-plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
-plBlock (p:ps) bl wl w = (,) blid $ w
-<<<<<<< HEAD
-    & flip (foldr insertWall) wls
-=======
->>>>>>> efficientRuntime
-    & blocks . at blid ?~ bl 
-        { _blID = blid
-        , _blWallIDs = IS.fromList is
-        , _blShadows = []
-        , _blFootprint = p:ps
-        }
-<<<<<<< HEAD
-=======
-    & insertWalls blid wls
->>>>>>> efficientRuntime
-  where 
-    blid = IM.newKey $ _blocks w
-    lns = zip (p:ps) (ps ++ [p])
-    i = IM.newKey $ _walls w
-    is = [i.. i + length lns-1]
-    wls = zipWith 
-        (\j ln -> wl & wlLine .~ ln & wlID .~ j & wlStructure .~ BlockPart blid) 
-        is 
-        lns 
-        
-{- | Splits a line into many four cornered blocks. -}
-plLineBlock 
-    :: Wall     -- ^ Base pane
-    -> Float
-    -> Point2   -- ^ Start point (symmetric)
-    -> Point2   -- ^ End point (symmetric)
-    -> World 
-    -> (Int, World)
-plLineBlock basePane blwidth a b gw = ( 0 
-<<<<<<< HEAD
-    , foldr insertWall (insertBlocks gw) listWalls
-=======
---    , foldr insertWall (insertBlocks gw) listWalls
-    , insertBlocks gw
->>>>>>> efficientRuntime
-    )
-  where 
-    depth = blwidth
-    psOnLine = divideLineOddNumPoints blwidth a b
-    halfBlockWidth = dist a b / fromIntegral (length psOnLine - 1)
-    blockCenPs = snd $ evenOddSplit psOnLine
-    numBlocks = length blockCenPs
-    is = [0.. numBlocks - 1]
-    cornerPoints = rectWH halfBlockWidth depth -- goes clockwise around the block
-    cornersAt p = fmap ( (p +.+) . rotateV (argV (b -.- a)) ) cornerPoints
-    linesAt p = loopPairs $ cornersAt p
-    wlid = IM.newKey $ _walls gw
-    blid = IM.newKey $ _blocks gw
-    insertBlock (i,p) = 
-        insertWalls (i + blid) (makeWallAt p i)
-        . (over blocks $ IM.insert (i+blid) Block 
-        { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
-        , _blHP = 1000, _blShadows = shadowsAt i
-        , _blDir = 0    -- THIS IS NOT SENSIBLE. TODO rethink block positioning
-        , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
-        , _blObstructs = []
-<<<<<<< HEAD
-=======
-        , _blPaths = []
->>>>>>> efficientRuntime
-        , _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris}
-        )
-    insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs
-    ksAtI i = map ( + (wlid + i*4) ) [0,1,2,3]
-    visibilityAt i 
-        | i == 0             = [False,True,True ,True]
-        | i == numBlocks - 1 = [True ,True,False,True]
-        | otherwise          = [False,True,False,True]
-    shadowsAt i
-        | i == 0             = ksAtI 1
-        | i == numBlocks - 1 = ksAtI $ numBlocks - 2
-        | otherwise          = ksAtI (i-1) ++ ksAtI (i+1)
-    makeWallAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
-    makePane i visStatus k ps = basePane
-        {_wlID = k
-        ,_wlStructure = BlockPart $ i + blid
-        ,_wlLine = ps
-        ,_wlUnshadowed = visStatus
-        }
-    listWalls = concat $ zipWith makeWallAt blockCenPs is
-
-<<<<<<< HEAD
-insertWall :: Wall -> World -> World
-insertWall wl = (walls . at (_wlID wl) ?~ wl)
-    . uncurry (addObstacleCrossing' BlockObstacle) (_wlLine wl)
-=======
--- | Must be done after inserting the block
-insertWalls :: Int -> [Wall] -> World -> World
-insertWalls blid wls w = w' & blocks . ix blid . blPaths .~ concat paths
-  where
-    (w',paths) = mapAccumR (flip insertWall) w wls
-
-insertWall :: Wall -> World -> (World,[(Int,Int,PathEdge)])
-insertWall wl = uncurry obstructPathsCrossing (_wlLine wl)
-    . (walls . at (_wlID wl) ?~ wl)
->>>>>>> efficientRuntime