diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index c38abc786..ef851d758 100644 --- a/src/Dodge/Base.hs +++ b/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 diff --git a/src/Dodge/Creature/Action/UseItem.hs b/src/Dodge/Creature/Action/UseItem.hs index a9bc84119..54f165610 100644 --- a/src/Dodge/Creature/Action/UseItem.hs +++ b/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 diff --git a/src/Dodge/Creature/Boid.hs b/src/Dodge/Creature/Boid.hs index a8834d068..5c33abbde 100644 --- a/src/Dodge/Creature/Boid.hs +++ b/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 diff --git a/src/Dodge/Creature/ImpulseRat.hs b/src/Dodge/Creature/ImpulseRat.hs index ac9d69bc2..66d6474ae 100644 --- a/src/Dodge/Creature/ImpulseRat.hs +++ 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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index eb309ff83..4cfe19121 100644 --- a/src/Dodge/Data.hs +++ b/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) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index d67662e86..ecedc4f95 100644 --- a/src/Dodge/Default/World.hs +++ b/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 diff --git a/src/Dodge/Event/Test.hs b/src/Dodge/Event/Test.hs index 51657f522..0d99baa22 100644 --- a/src/Dodge/Event/Test.hs +++ b/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 diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 5eda7aea4..52daf49c2 100644 --- a/src/Dodge/Initialisation.hs +++ b/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) diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 637e8c0b6..232b12d2c 100644 --- a/src/Dodge/Layout.hs +++ b/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 diff --git a/src/Dodge/LevelGen/InnerWalls.hs b/src/Dodge/LevelGen/InnerWalls.hs index 1b5ab1ee6..da0d75725 100644 --- a/src/Dodge/LevelGen/InnerWalls.hs +++ b/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 diff --git a/src/Dodge/LevelGen/Pathing.hs b/src/Dodge/LevelGen/Pathing.hs index 581b90852..0ea7a65e8 100644 --- a/src/Dodge/LevelGen/Pathing.hs +++ b/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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index cb0e89dad..6b062769b 100644 --- a/src/Dodge/Render.hs +++ b/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) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index be794319f..75ec02cf3 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 (..)) diff --git a/src/Music.hs b/src/Music.hs index 55c3610d9..349a995ef 100644 --- a/src/Music.hs +++ b/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 diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 19c3b4f6a..4194b3019 100644 --- a/src/Shader/Poke.hs +++ b/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..] diff --git a/src/Sound.hs b/src/Sound.hs index 768bc46b8..79747a8a7 100644 --- a/src/Sound.hs +++ b/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 diff --git a/src/Sound/Data.hs b/src/Sound/Data.hs index b8e2987df..fa9ebb7f5 100644 --- a/src/Sound/Data.hs +++ b/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)