Commit before static wall overhaul

src/Dodge/Base.hs

@@ -15,7 +15,7 @@ import Dodge.Base.Zone
 import Dodge.Base.Window
 import Dodge.Base.Collide
 import Geometry
-import Picture
+--import Picture
 import qualified IntMapHelp as IM
 
 import Control.Lens
@@ -287,6 +287,17 @@ collideCircWalls' p1 p2 rad ws
 -- unfortunately, doesn't allow for collisions when the circle spawns on the
 -- wall
 
+-- | Looks for first collision of a point with a list of lines.
+-- If found, gives point and normal of wall.
+collidePointLines :: Point2 -> Point2 -> [Wall'] -> Maybe (Point2,Point2)
+collidePointLines p1 p2 ws 
+    = listToMaybe 
+    . sortOn f
+    $ mapMaybe (( \(x,y) -> intersectSegSeg' p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
+        . _wlLine') ws
+  where 
+    f (a,_) = magV (p1 -.- a)
+
 -- | Looks for first collision of a point with walls.
 -- If found, gives point and normal of wall.
 collidePointWallsNorm :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
@@ -298,32 +309,6 @@ collidePointWallsNorm p1 p2 ws
         . _wlLine) ws
   where 
     f (a,_) = magV (p1 -.- a)
-{- | Looks for first collision of a point with walls.
-If found, gives point and colour of wall.
--}
-collidePointWallsCol :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Color)
-collidePointWallsCol p1 p2 ws 
-    = listToMaybe 
-    . sortOn f 
-    . IM.elems 
-    $ IM.mapMaybe ( (\(m, c) -> m <&> (, c))
-        . (\w -> (uncurry (intersectSegSeg' p1 p2) (_wlLine w), _wlColor w))) ws
-  where 
-    f (a,_) = magV (p1 -.- a)
-{- | Looks for first collision of a point with walls.
-If found, gives point, and normal and colour of wall.
--}
-collidePointWallsNormCol :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2,Color)
-collidePointWallsNormCol p1 p2 ws 
-    = listToMaybe 
-    . sortOn f 
-    . IM.elems 
-    $ IM.mapMaybe m ws
-  where 
-    f (a,_,_) = magV $ p1 -.- a
-    m w = 
-        let (x,y) = _wlLine w
-        in intersectSegSeg' p1 p2 x y <&> (, vNormal (x -.- y), _wlColor w)
 -- | Returns the first creature, if any, that a point intersects with.
 collidePointCreatures :: Point2 -> Point2 -> World -> Maybe Int
 collidePointCreatures p1 p2 w 

src/Dodge/Creature/Action/UseItem.hs

@@ -3,7 +3,7 @@ module Dodge.Creature.Action.UseItem
 import Dodge.Data
 import Dodge.Inventory
 
-import qualified Data.IntMap as IM
+import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Data.Maybe
 

src/Dodge/Creature/Boid.hs

@@ -8,7 +8,7 @@ import Geometry
 
 import Control.Monad.Reader
 import Control.Lens
-import qualified Data.IntMap as IM
+import qualified Data.IntMap.Strict as IM
 
 interpWith :: Float -> Point2 -> Point2 -> Point2
 interpWith x a b = x *.* a +.+ (1 - x) *.* b

src/Dodge/Creature/ImpulseRat.hs

@@ -6,7 +6,7 @@ import Dodge.Data
 --import Dodge.Creature.State.Data
 import Geometry
 
---import qualified Data.IntMap as IM
+--import qualified Data.IntMap.Strict as IM
 import Control.Lens
 --import Control.Monad.Reader
 

src/Dodge/Data.hs

@@ -42,7 +42,7 @@ import Data.Int (Int16)
 import qualified Data.Set as S
 import qualified Data.IntSet as IS
 import qualified Data.IntMap.Strict as IM
-import qualified Data.Map as M
+import qualified Data.Map.Strict as M
 import SDL (Scancode, MouseButton)
 data World = World 
     { _keys                 :: !(S.Set Scancode)
@@ -59,7 +59,8 @@ data World = World
     , _cloudsZone           :: IM.IntMap (IM.IntMap (IM.IntMap Cloud))
     , _projectiles          :: IM.IntMap Projectile
     , _particles            :: ![Particle]
-    , _staticWalls          :: [Wall]
+    , _staticWalls          :: IM.IntMap (IM.IntMap [Wall'])
+    , _seenStaticWalls      :: IM.IntMap (IM.IntMap [Wall'])
     , _walls                :: !(IM.IntMap Wall)
     , _wallsZone            :: IM.IntMap (IM.IntMap (IM.IntMap Wall))
     , _forceFields          :: IM.IntMap ForceField
@@ -446,6 +447,12 @@ data Projectile
         , _pjTimer :: Int
         }
 data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
+
+data Wall' = Wall'
+    { _wlLine' :: (Point2,Point2)
+    , _wlColor' :: Color
+    }
+
 data Wall 
     = Wall 
         { _wlLine :: (Point2,Point2) 

src/Dodge/Default/World.hs

@@ -32,7 +32,8 @@ defaultWorld = World
     , _itemPositions = IM.empty
     , _projectiles = IM.empty
     , _particles = []
-    , _staticWalls = []
+    , _staticWalls = IM.empty
+    , _seenStaticWalls = IM.empty
     , _walls = IM.empty
     , _wallsZone = IM.empty
     , _forceFields = IM.empty

src/Dodge/Event/Test.hs

@@ -8,7 +8,7 @@ import Dodge.Data
 --import Picture
 --import Geometry
 --
---import qualified Data.IntMap as IM
+--import qualified Data.IntMap.Strict as IM
 --import Control.Lens
 testEvent :: World -> World
 testEvent w = w

src/Dodge/Initialisation.hs

@@ -16,9 +16,6 @@ import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map as M
 
-initializeWorld :: World -> World
-initializeWorld w = w
-
 firstWorld :: IO World
 firstWorld = do
 --    i <- randomRIO (0,5000)

src/Dodge/Layout.hs

@@ -28,7 +28,8 @@ import Data.Graph.Inductive.Graph (labNodes)
 import qualified Data.Map as M
 
 generateLevelFromRoomList :: State StdGen [Room] -> World -> World
-generateLevelFromRoomList gr w = updateWallZoning 
+generateLevelFromRoomList gr w = initializeStaticWalls
+    . updateWallZoning 
     . placeSpots plmnts
 --    . addRoomPolyDecorations rs
 --    . addRoomLinkDecorations rs
@@ -58,6 +59,18 @@ generateFromTree t w = updateWallZoning $ placeSpots plmnts
     insertPoint  pp@(_,(x,y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
     pinc = M.fromList $ pairsToIncidence pairGraph
 
+initializeStaticWalls :: World -> World
+initializeStaticWalls w = w & staticWalls %~ (\wls' -> foldr wallToWall wls' wls)
+  where
+    wls = [wl | wl@Wall{} <- (IM.elems $ _walls w)]
+
+wallToWall :: Wall -> IM.IntMap (IM.IntMap [Wall']) -> IM.IntMap (IM.IntMap [Wall'])
+wallToWall wl wls = foldr f wls is
+  where
+    is = uncurry zoneOfLine (_wlLine wl)
+    wl' = Wall' {_wlLine' = _wlLine wl, _wlColor' = _wlColor wl}
+    f (x,y) = insertInZoneWith x y (++) [wl']
+
 updateWallZoning :: World -> World
 updateWallZoning w = set wallsZone (IM.foldr wallInZone IM.empty (_walls w)) w
   where

src/Dodge/LevelGen/InnerWalls.hs

@@ -5,7 +5,7 @@ module Dodge.LevelGen.InnerWalls
 --import Geometry
 
 --import Control.Lens
---import qualified Data.IntMap as IM
+--import qualified Data.IntMap.Strict as IM
 ------------------------------------------------------------------------------------
 -- idea: create inner walls to draw and to cast shadows
 --createInnerWalls :: IM.IntMap Wall -> IM.IntMap Wall

src/Dodge/LevelGen/Pathing.hs

@@ -7,7 +7,7 @@ import Geometry
 import Control.Lens
 import Data.Maybe
 import Data.List
-import qualified Data.IntMap as IM
+import qualified Data.IntMap.Strict as IM
 import Data.Graph.Inductive hiding ((&))
 --import Data.Graph.Inductive.NodeMap
 

src/Dodge/Render.hs

@@ -54,19 +54,22 @@ doDrawing pdata w = do
         viewFroms = _cameraViewFrom w
         pic = worldPictures w
     -- bind as much data into vbos as feasible at this point
-    -- bind wall points and colors to vbo
+    -- poke wall points and colors
     nWalls <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wallPointsCol)
-    bindShaderBuffers [_wallTextureShader pdata] [nWalls]
-    -- store foreground silhouette geometry into buffer
+    -- poke silhouette vertex data
     nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) 
                 (concatMap polyToRender (foregroundPics w))
-    bindShaderBuffers [_lightingLineShadowShader pdata] [nSils]
-    -- store foreground geometry and floor into buffer
+    -- poke foreground geometry and floor
     let addC (xx,yy) = (xx,yy,0)
     nsurfVs <- F.foldM (pokeShader (_lightingSurfaceShader pdata)) 
         $ (Render3 $ polyToTris $ map addC $ screenPolygon w)
         : concatMap polyToGeoRender (foregroundPics w)
-    bindShaderBuffers [_lightingSurfaceShader pdata] [nsurfVs]
+    -- bind wall points, silhouette data, surface geometry
+    uncurry bindShaderBuffers $ unzip
+        [ ( _wallTextureShader pdata, nWalls)
+        , (_lightingLineShadowShader pdata, nSils)
+        , (_lightingSurfaceShader pdata, nsurfVs)
+        ]
     -- set the coordinate uniform ready for drawing elements using world coordinates
     bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
     bindFramebuffer Framebuffer $= fst (_fboBase pdata)

src/Dodge/Render/HUD.hs

@@ -8,7 +8,7 @@ import Picture
 import Geometry
 
 import Data.Maybe
-import qualified Data.IntMap as IM
+import qualified Data.IntMap.Strict as IM
 import qualified Data.Set as S
 import Control.Lens
 import SDL (MouseButton (..))

src/Music.hs

@@ -1,7 +1,7 @@
 module Music
   where
 import qualified SDL.Mixer as Mix
-import qualified Data.IntMap as IM
+import qualified Data.IntMap.Strict as IM
 
 data MusicData = MusicData
     { _loadedMusic   :: IM.IntMap Mix.Music

src/Shader/Poke.hs

@@ -32,4 +32,5 @@ pokeVertex ptr stride n fs = do
     return $ n + 1
 
 pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO ()
+{-# INLINE pokeArrayOff #-}
 pokeArrayOff ptr i = zipWithM_ (pokeElemOff ptr) [i..]

src/Sound.hs

@@ -22,7 +22,7 @@ import Sound.Data
 
 import qualified SDL.Mixer as Mix
 import Data.Maybe
-import qualified Data.IntMap as IM
+import qualified Data.IntMap.Strict as IM
 import qualified Data.Map as M
 import Control.Monad
 import Control.Monad.Trans

src/Sound/Data.hs

@@ -2,8 +2,8 @@
 module Sound.Data
     where
 import qualified SDL.Mixer as Mix
-import qualified Data.IntMap as IM
-import qualified Data.Map as M
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Map.Strict as M
 import Control.Lens
 --import Geometry
 import Data.Word (Word8)