Add new files

src/Dodge/Base/Collide.hs

@@ -12,21 +12,6 @@ import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
--- | A version of 'minimum' where the comparison is done on some extracted value.
---   Returns Nothing if the list is empty. Only calls the function once per element.
---
--- > safeMinimumOn id [] == Nothing
--- > safeMinimumOn length ["test","extra","a"] == Just "a"
-safeMinimumOn' :: (Ord b) => (a -> b) -> [a] -> Maybe a
-safeMinimumOn' _ [] = Nothing
-safeMinimumOn' f (x:xs) = g x (f x) xs
-    where
-        g v _  [] = Just v
-        g v mv (y:ys) | my < mv = g y my ys
-                      | otherwise = g v mv ys
-            where my = f y
-
-
 hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
 hasLOS p1 p2 w = not $ pointHitsWalls p1 p2 $ wallsAlongLine p1 p2 w

src/Dodge/Creature/Boid.hs

@@ -5,6 +5,7 @@ import Dodge.Base
 import Dodge.Creature.State.Data
 import Dodge.Creature.ImpulseRat
 import Geometry
+import Geometry.ConvexPoly
 
 import Control.Monad.Reader
 import Control.Lens

src/Dodge/Layout/Tree/Shift.hs

@@ -4,11 +4,14 @@ links connect and that none of them clip.
 Returns a list; after this step the structure is determined by the actual positions of rooms.
  -}
 module Dodge.Layout.Tree.Shift
-    where
+    ( shiftRoomTreeSearchAll
+    , shiftExpandTree
+    ) where
 import Dodge.Room.Data
 import Dodge.Room.Link
 import Dodge.Layout.Tree.Polymorphic
 import Geometry
+import Geometry.ConvexPoly
 --import Geometry.Data
 
 import Data.Tree
@@ -16,25 +19,7 @@ import Data.Sequence hiding (zipWith)
 import Data.List (delete)
 import Data.Maybe (listToMaybe)
 import Control.Lens hiding (Empty, (<|) , (|>))
-
-{- |
-Helper: Depth first search of trees of rooms, maybe produces a list rooms that are not clipping.
- -}
-shiftRoomTreeSearch 
-    :: [[Point2]]       -- ^ Clipping bounds
-    -> Seq (Tree Room)  -- ^ Rooms to be added
-    -> Maybe [Room]
-shiftRoomTreeSearch _  Empty = Just []
-shiftRoomTreeSearch bs (Node r ts :<| ts')
-    | roomIsClipping = Nothing
-    | otherwise = fmap (r :) . shiftRoomTreeSearch newBounds $ ts' >< chldren
-  where
-    roomIsClipping = or (polysIntersect <$> _rmBound r <*> bs)
-    newBounds = _rmBound r ++ bs
-    chldren = fromList $ zipWith (applyToRoot . shiftRoomToLink) (_rmLinks r) ts
-{- |
-All: Depth first search of trees of rooms, produces a list of lists of rooms that are not clipping.
- -}
+{- | All: Depth first search of trees of rooms, produces a list of lists of rooms that are not clipping.  -}
 shiftRoomTreeSearchAll 
     :: [[Point2]]       -- ^ Clipping bounds
     -> Seq (Tree Room)  -- ^ Rooms to be added
@@ -46,6 +31,7 @@ shiftRoomTreeSearchAll bs (Node r ts :<| ts')
         [] -> (r :) <$> shiftRoomTreeSearchAll newBounds ts'
         (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (rm l) ss <| (ts' |> f l s))) ls
   where
+    convexBounds = map pointsToPoly $ _rmBound r
     ls = init $ _rmLinks r
     newBounds = _rmBound r ++ bs
     roomIsClipping = or (polysOverlap <$> _rmBound r <*> bs)

src/Dodge/LevelGen/SwarmPlacement.hs

@@ -5,7 +5,8 @@ module Dodge.LevelGen.SwarmPlacement
 import Dodge.Data
 import Dodge.LevelGen.Data
 import Dodge.Creature.State.Data
-import Geometry
+--import Geometry
+import Geometry.ConvexPoly
 import qualified IntMapHelp as IM
 
 import Data.List

src/Dodge/Render.hs

@@ -7,17 +7,13 @@ module Dodge.Render
 import Dodge.Data
 import Dodge.Config.Data
 import Dodge.Base.Window
---import Dodge.Render.HUD
---import Dodge.Render.MenuScreen
 import Dodge.Render.Picture
---import Dodge.Render.PerspectiveMatrix
 import Geometry
---import Geometry.Data
---import Picture
 import Render
 import Data.Preload.Render
 import Shader
 import Shader.Poke
+import Shader.Bind
 import Shader.Data
 import MatrixHelper
 --import Polyhedra.Data
@@ -50,6 +46,7 @@ doDrawing pdata w = do
         (wallPointsCol,windowPoints) = wallsAndWindows w
         lightPoints     = lightsForGloom w
         viewFroms = _cameraViewFrom w
+        shadV = _pictureShaders pdata
     -- bind as much data into vbos as feasible at this point
     -- poke wall points and colors
     nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
@@ -60,7 +57,6 @@ doDrawing pdata w = do
     nsurfVs <- pokePoint3s (shadVBOptr $ _lightingSurfaceShader pdata)
         $ polyToTris (map addC $ screenPolygon w)
         ++ concatMap polyToGeoRender (foregroundPics w)
-
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip
         [ ( _wallTextureShader pdata, nWalls)
@@ -77,7 +73,6 @@ doDrawing pdata w = do
         then renderTextureWalls pdata nWalls
         else renderBlankWalls pdata nWalls
 
-    let shadV = _pictureShaders pdata
     renderFoldable shadV $ polysToPic $ foregroundPics w
 
     layerCounts <- UMV.replicate (6*6) 0

src/Dodge/SoundLogic.hs

@@ -23,7 +23,6 @@ module Dodge.SoundLogic (
 import Dodge.Data
 import Sound.Data (SoundStatus (..))
 import Geometry.Vector
-import Geometry (dist)
 
 import Control.Lens
 import qualified Data.Map as M