Move toward implementing chasms

src/Dodge/Data/CWorld.hs

@@ -27,6 +27,7 @@ data CWorld = CWorld
     , _cwTiles :: [Tile]
     , _pathGraph :: Gr Point2 PathEdge
     , _numberFloorVerxs :: Int
+    , _chasms :: [[Point2]]
     }
 
 data CWGen = CWGen

src/Dodge/Data/GenWorld.hs

@@ -55,6 +55,7 @@ data PSType
     | PutNothing
     | PutUsingGenParams (World -> (World, PSType))
     | PutID {_putID :: Int}
+    | PutChasm {_putChasmPoly :: [Point2]}
 
 -- maybe there is a monadic implementation of this?
 -- add room effect for any placement spot?

src/Dodge/Default/World.hs

@@ -91,6 +91,7 @@ defaultCWorld =
         , _pathGraph = Data.Graph.Inductive.Graph.empty
         , _cwTiles = mempty
         , _numberFloorVerxs = 0
+        , _chasms = mempty
         }
 
 defaultLWorld :: LWorld

src/Dodge/Placement/PlaceSpot.hs

@@ -7,7 +7,7 @@ module Dodge.Placement.PlaceSpot (
 ) where
 
 import Color
-import Control.Lens
+import LensHelp
 import Control.Monad.State
 import Data.Bifunctor
 import Data.Foldable
@@ -140,6 +140,7 @@ placeSpotID' ps pt w = case pt of
     PutUsingGenParams f ->
         let (w', pt') = f w
          in placeSpotID' ps pt' w'
+    PutChasm ps' -> (0, w & cWorld . chasms .:~ map doShift ps')
   where
     p@(V2 px py) = _psPos ps
     p' = V3 px py 0

src/Dodge/Render/ShapePicture.hs

@@ -31,12 +31,16 @@ worldSPic cfig u =
         <> foldup floorItemSPic (filtOn _flItPos (_unNIntMap . _floorItems))
         <> foldup btSPic (filtOn _btPos _buttons)
         <> foldup (mcSPic (u ^. uvWorld . cWorld . lWorld)) (filtOn _mcPos _machines)
+        <> foldMap' drawChasm (u ^. uvWorld . cWorld . chasms)
   where
     w = _uvWorld u
     foldup = foldMap'
     filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
     pointIsClose = cullPoint cfig w
 
+drawChasm :: [Point2] -> SPic
+drawChasm = noShape . color green . setDepth 2 . polygon
+
 drawPulseBall :: PulseBall -> SPic
 drawPulseBall pb =
     translateSPz 20 

src/Dodge/Room/Pillar.hs

@@ -120,8 +120,10 @@ roomPillars pillarsize w h wn hn = do
     addGirderLights $
         rm
             & cleatSide
-            & rmPmnts .~ plmnts
+            & rmPmnts .~ (testchasm : plmnts)
             & rmName .~ "rectPillars"
   where
     pilw = ((w - 40 * (fromIntegral wn + 1)) / fromIntegral wn) - pillarsize
     pilh = ((h - 40 * (fromIntegral hn + 1)) / fromIntegral hn) - pillarsize
+    testchasm = Placement 0 (PS 0 0) (PutChasm (map (+V2 100 100) (square 50))) Nothing
+        (\_ _ -> Nothing)