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)

src/Preload/Render.hs

@@ -38,10 +38,6 @@ preloadRender = do
     glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW
     glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO
 
-    --    orthonormalUBO <- mglCreate glCreateBuffers
-    --    withArray idMat $ \ptr ->
-    --        glNamedBufferStorage orthonormalUBO 64 ptr 0
-
     lightsubo <- mglCreate glCreateBuffers
     glNamedBufferData lightsubo 640 nullPtr GL_STREAM_DRAW
     glBindBufferBase GL_UNIFORM_BUFFER 1 lightsubo
@@ -113,7 +109,7 @@ preloadRender = do
     -- blank wallShader
     putStrLn "Setup floor VBO, shader"
     let floorverxstrd = 8
-    floorvbo <- setupVBOStatic floorverxstrd
+    floorvbo <- setupVBOStatic (floatSize * floorverxstrd)
     floorshader <- makeShaderUsingVBO "floor/arrayPos" [vert, frag] (toFloatVAs [4, 4]) pmTriangles floorvbo
     initTexture2DArraySquare 40 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/diffuseArray.png"
     initTexture2DArraySquare 41 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/normalArray.png"

src/Shader/Compile.hs

@@ -120,10 +120,10 @@ setupVBOStatic vertexsize = do
     -- Allocate space
     glNamedBufferData
         vboname
-        (fromIntegral $ floatSize * numDrawableVertices * vertexsize)
+        (fromIntegral $ numDrawableVertices * vertexsize)
         nullPtr
         GL_STATIC_DRAW
-    return VBO{_vboName = vboname, _vboPtr = thePtr, _vboVertexBytes = floatSize * vertexsize}
+    return VBO{_vboName = vboname, _vboPtr = thePtr, _vboVertexBytes = vertexsize}
 
 makeByteStringShaderUsingVAO ::
     -- | (Arbitrary) name of the shader