diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 945487632..b2587f9b6 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -15,7 +15,6 @@ module Dodge.Base , module Dodge.Base.CardinalPoint , module Dodge.Base.Wall ) where -import Dodge.Data import Dodge.Base.WinScale import Dodge.Base.Wall import Dodge.Base.Arithmetic @@ -37,11 +36,6 @@ import Control.Lens --import qualified Data.IntSet as IS --import qualified Data.Set as S - -allWalls :: World -> IM.IntMap Wall -allWalls = IM.unions . concatMap IM.elems . IM.elems . _znObjects . _wallsZone - - {- | Expands a line out to a given thickness. -} lineGeom :: Float -> Point2 -> Point2 -> [Point2] lineGeom t x y diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index be61f8504..aab3b607a 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -30,7 +30,7 @@ unshadowBlock :: Int -> World -> World unshadowBlock wlid w = case w ^? walls . ix wlid of Just wl -> w & walls . ix wlid . wlDraw .~ True - & wallsZone . znObjects . ix x . ix y . ix wlid . wlDraw .~ True + & wlZoning . znObjects . ix x . ix y . ix wlid . wlDraw .~ True where V2 x y = wlZoneOfPoint $ uncurry midPoint (_wlLine wl) Nothing -> w diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 25342ea7f..79a177664 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -14,6 +14,7 @@ module Dodge.Data , module Dodge.Data.LoadAction , module Dodge.Data.ForegroundShape , module Dodge.Data.Wall + , module Dodge.Data.Zoning , module Dodge.Data.Bounds , module Dodge.Combine.Data , module Dodge.Distortion.Data @@ -33,6 +34,7 @@ module Dodge.Data , module Dodge.Data.Room ) where import Dodge.Data.Room +import Dodge.Data.Zoning import Dodge.Data.ForegroundShape import Dodge.Data.LoadAction import Dodge.Data.Material @@ -104,13 +106,13 @@ data World = World , _boundBox :: [Point2] , _boundDist :: (Float,Float,Float,Float) -- NSEW, S and W negative , _creatures :: IM.IntMap Creature - , _creaturesZone :: Zoning (IM.IntMap Creature) + , _crZoning :: Zoning IM.IntMap Creature , _creatureGroups :: IM.IntMap CrGroupParams , _itemPositions :: IM.IntMap ItemPos , _clouds :: [Cloud] - , _cloudsZone :: Zoning [Cloud] + , _clZoning :: Zoning [] Cloud , _gusts :: IM.IntMap Gust - , _gustsZone :: Zoning (IM.IntMap Gust) + , _gsZoning :: Zoning IM.IntMap Gust , _props :: IM.IntMap Prop , _instantParticles :: [Particle] , _particles :: [Particle] @@ -125,7 +127,7 @@ data World = World , _blocks :: IM.IntMap Block , _coordinates :: IM.IntMap Point2 , _triggers :: IM.IntMap (World -> Bool) - , _wallsZone :: Zoning (IM.IntMap Wall) + , _wlZoning :: Zoning IM.IntMap Wall , _floorItems :: IM.IntMap FloorItem , _floorTiles :: [(Point3,Point3)] , _randGen :: StdGen @@ -145,7 +147,7 @@ data World = World , _clickMousePos :: Point2 , _pathGraph :: Gr Point2 Float , _pathGraphP :: S.Set (Point2,Point2) - , _pathPoints :: Zoning [(Int,Point2)] + , _phZoning :: Zoning [] (Int,Point2) , _hud :: HUD , _lightSources :: IM.IntMap LightSource , _tempLightSources :: [TempLightSource] @@ -1327,9 +1329,6 @@ data Goal | SentinelAt Point2 Float deriving (Show) -newtype Zoning a = Zoning - { _znObjects :: IM.IntMap (IM.IntMap a) - } data DamageEffect = PushDamage { _dePush :: Float @@ -1515,7 +1514,6 @@ makeLenses ''Block makeLenses ''Terminal makeLenses ''Machine makeLenses ''MachineType -makeLenses ''Zoning makeLenses ''ItemDimension makeLenses ''Vocalization makeLenses ''Universe diff --git a/src/Dodge/Data/Zoning.hs b/src/Dodge/Data/Zoning.hs new file mode 100644 index 000000000..7fb3dfbfe --- /dev/null +++ b/src/Dodge/Data/Zoning.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.Zoning where +import Geometry.Data +import Control.Lens +import qualified Data.IntMap.Strict as IM +import StreamingHelp + +data Zoning t a = Zoning + { _znObjects :: IM.IntMap (IM.IntMap (t a)) + , _znSize :: Float + , _znFunc :: Float -> a -> StreamOf Int2 + } + +makeLenses ''Zoning diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 019ab9538..afc0495c6 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -1,6 +1,9 @@ module Dodge.Default.World where import Dodge.Data +import Dodge.Zone.Size +import Dodge.Zone.Object import Dodge.Base +import Geometry.Vector3D --import Dodge.Config.KeyConfig --import Dodge.Menu --import Picture @@ -28,14 +31,14 @@ defaultWorld = World , _defaultZoom = 1 , _cameraViewFrom = V2 0 0 , _viewDistance = 1000 - , _modifications = IM.empty - , _creatures = IM.empty - , _creaturesZone = Zoning IM.empty - , _creatureGroups = IM.empty + , _modifications = IM.empty + , _creatures = IM.empty + , _crZoning = Zoning IM.empty crZoneSize zoneOfCreature + , _creatureGroups = IM.empty , _clouds = [] - , _cloudsZone = Zoning IM.empty + , _clZoning = Zoning IM.empty clZoneSize (zonePos (stripZ . _clPos)) , _gusts = IM.empty - , _gustsZone = Zoning IM.empty + , _gsZoning = Zoning IM.empty clZoneSize (zonePos _guPos) , _itemPositions = IM.empty , _props = IM.empty , _instantParticles = [] @@ -50,7 +53,7 @@ defaultWorld = World , _doors = IM.empty , _coordinates = IM.empty , _triggers = IM.empty - , _wallsZone = Zoning IM.empty + , _wlZoning = Zoning IM.empty wlZoneSize zoneOfWall , _floorItems = IM.empty , _floorTiles = [] , _randGen = mkStdGen 2 @@ -70,8 +73,8 @@ defaultWorld = World -- , _menuLayers = [] , _clickMousePos = V2 0 0 , _pathGraph = Data.Graph.Inductive.Graph.empty - , _pathGraphP = mempty - , _pathPoints = Zoning IM.empty + , _pathGraphP = mempty + , _phZoning = Zoning mempty wlZoneSize (zonePos snd) , _hud = HUD { _hudElement = DisplayInventory NoSubInventory , _carteCenter = V2 0 0 diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index d9214746f..235f1d797 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -140,7 +140,7 @@ setupWorldBounds w = w & worldBounds %~ --polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges initWallZoning :: World -> World -initWallZoning w = foldl' (flip insertWallInZones) (w & wallsZone . znObjects .~ IM.empty) (_walls w) +initWallZoning w = foldl' (flip insertWallInZones) (w & wlZoning . znObjects .~ IM.empty) (_walls w) --makePath :: Tree Room -> [(Point2,Point2)] --makePath = concatMap _rmPath . flatten diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index 9d30e664d..a2e626176 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -28,7 +28,7 @@ makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w) sp na nb (_pathGraph w) where --nodesNear p = concat $ lookLookups (zoneNearPointIP p) (_pathPoints w) - nodesNear p = runIdentity . S.toList_ $ nearPoint wlZoneSize _pathPoints p w + nodesNear p = runIdentity . S.toList_ $ nearPoint _phZoning p w walkableNodeNear p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear p --walkableNodeNear :: Point2 -> World -> Maybe Point2 @@ -93,7 +93,8 @@ removePathsCrossing :: Point2 -> Point2 -> World -> World removePathsCrossing a b w = w & pathGraph .~ newGraph & pathGraphP .~ pg' - & pathPoints .~ foldl' insertpoint (Zoning mempty) (labNodes newGraph) + & phZoning %~ \zn -> foldl' (flip $ insertInZoning (:)) (zn & znObjects .~ mempty) + (labNodes newGraph) where pg' = Set.filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w insertpoint zn (i,p) = insertInZoneWith (wlZoneOfPoint p) (++) [(i,p)] zn diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs index 40a6123f7..671fcd3a1 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -24,7 +24,7 @@ addBlock -> World -> World addBlock (p:ps) wl bl w = w - & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes + & wlZoning . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes & walls %~ IM.union panes & blocks %~ IM.insert blid bl {_blID = blid,_blWallIDs = IS.fromList is, _blShadows=[] diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index c75ce2bd5..777998398 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -108,7 +108,7 @@ drawInspectWall :: World -> Wall -> Picture drawInspectWall _ wl = setLayer DebugLayer $ color rose (thickLine 3 [a,b]) <> foldMap (drawZone wlZoneSize) - (runIdentity $ S.toList_ $ zoneOfWall wl) + (runIdentity $ S.toList_ $ zoneOfWall wlZoneSize wl) -- this won't work if wlZoneSize is not consistent where (a,b) = _wlLine wl -- $ line [a,b] diff --git a/src/Dodge/Render/Walls.hs b/src/Dodge/Render/Walls.hs index e677dfe79..1d13ca423 100644 --- a/src/Dodge/Render/Walls.hs +++ b/src/Dodge/Render/Walls.hs @@ -26,7 +26,7 @@ wallsToDraw w <*> L.prefilter wlSeeThroughDraw (L.premap f L.list) <*> L.premap getWallSPic L.mconcat ) (S.concat $ S.mapMaybe g $ zoneOfSight wlZoneSize w) - g (V2 i j) = w ^? wallsZone . znObjects . ix i . ix j + g (V2 i j) = w ^? wlZoning . znObjects . ix i . ix j wlOpaqueDraw :: Wall -> Bool wlOpaqueDraw wl = wlIsOpaque wl && _wlDraw wl diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index fdde9cc1a..77f3216bb 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -97,11 +97,12 @@ functionalUpdate cfig w = checkEndGame $ updateCloseObjects w zoneClouds :: World -> World -zoneClouds w = w & set cloudsZone (foldl' (flip cloudInZone) (Zoning mempty) (_clouds w)) - where - cloudInZone cl = insertInZoneWith p (++) [cl] - where - p = clZoneOfPoint $ stripZ $ _clPos cl +zoneClouds w = w & clZoning %~ \zn -> + foldl' (flip $ insertInZoning (:)) (zn & znObjects .~ mempty) (_clouds w) +-- where +-- cloudInZone cl = insertInZoneWith p (++) [cl] +-- where +-- p = clZoneOfPoint $ stripZ $ _clPos cl updateWorldSelect :: World -> World updateWorldSelect w = case w ^? mouseButtons . ix ButtonLeft of @@ -148,17 +149,19 @@ doRewind w = case _maybeWorld w of Nothing' -> w & timeFlow .~ NormalTimeFlow zoneCreatures :: World -> World -zoneCreatures w = w - & creaturesZone . znObjects .~ - IM.foldl' zoneCreature IM.empty (_creatures w) --- runIdentity (S.fold_ zoneCreature IM.empty id (S.each $ _creatures w)) - -zoneCreature :: IM.IntMap (IM.IntMap (IM.IntMap Creature)) - -> Creature - -> IM.IntMap (IM.IntMap (IM.IntMap Creature)) -zoneCreature m cr = runIdentity $ S.fold_ doinsert m id (zoneOfCreature cr) - where - doinsert m' (V2 x y) = insertIMInZone x y (_crID cr) cr m' +zoneCreatures w = w & crZoning %~ \zn -> + foldl' (flip $ insertInZoning (\cr -> IM.insert (_crID cr) cr)) + (zn & znObjects .~ mempty) (_creatures w) +-- . znObjects .~ +-- IM.foldl' zoneCreature IM.empty (_creatures w) +---- runIdentity (S.fold_ zoneCreature IM.empty id (S.each $ _creatures w)) +-- +--zoneCreature :: IM.IntMap (IM.IntMap (IM.IntMap Creature)) +-- -> Creature +-- -> IM.IntMap (IM.IntMap (IM.IntMap Creature)) +--zoneCreature m cr = runIdentity $ S.fold_ doinsert m id (zoneOfCreature cr) +-- where +-- doinsert m' (V2 x y) = insertIMInZone x y (_crID cr) cr m' -- IM.foldl' (flip creatureInZone) IM.empty (_creatures w) -- where diff --git a/src/Dodge/Wall/Zone.hs b/src/Dodge/Wall/Zone.hs index ce570e173..a499613da 100644 --- a/src/Dodge/Wall/Zone.hs +++ b/src/Dodge/Wall/Zone.hs @@ -5,20 +5,19 @@ import Geometry import Dodge.Zone import Dodge.Base +import qualified Data.IntMap.Strict as IM import Control.Lens --import Data.Foldable --import Streaming import qualified Streaming.Prelude as S insertWallInZones :: Wall -> World -> World -insertWallInZones wl = wallsZone . znObjects - %~ (runIdentity . (\wlzns -> S.fold_ doinsert wlzns id (zoneOfWall wl))) - where - doinsert wlzns (V2 x y) = insertIMInZone x y (_wlID wl) wl wlzns +insertWallInZones wl = wlZoning %~ insertInZoning (IM.insert (_wlID wl)) wl +--insertWallInZones wl = wlZoning . znObjects +-- %~ (runIdentity . (\wlzns -> S.fold_ doinsert wlzns id (zoneOfWall wl))) +-- where +-- doinsert wlzns (V2 x y) = insertIMInZone x y (_wlID wl) wl wlzns deleteWallFromZones :: Wall -> World -> World -deleteWallFromZones wl = wallsZone . znObjects - %~ (runIdentity . (\wlzns -> S.fold_ dodelete wlzns id (zoneOfWall wl))) - where - dodelete wlzns (V2 x y) = deleteIMInZone x y (_wlID wl) wlzns +deleteWallFromZones wl = wlZoning %~ insertInZoning (const $ IM.delete (_wlID wl)) wl -- %~ flip (foldl' (flip $ \(a,b) -> deleteIMInZone a b (_wlID wl))) (zoneOfWall wl) diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs index aa1130ab3..aa7ade821 100644 --- a/src/Dodge/Zone.hs +++ b/src/Dodge/Zone.hs @@ -1,9 +1,5 @@ module Dodge.Zone - ( insertInZoneWith - , zoneOfSeg - , zoneOfCreature - , zoneOfWall - , zoneOfSight + ( zoneOfSight , zoneAroundPoint , nearPoint , wlsNearPoint @@ -19,8 +15,12 @@ module Dodge.Zone , crZoneOfPoint , wlZoneOfPoint , module Dodge.Zone.Size + , module Dodge.Zone.Object + , module Dodge.Zone.Update ) where +import Dodge.Zone.Object +import Dodge.Zone.Update import Dodge.Zone.Size import Dodge.Data --import Dodge.Base.Window @@ -33,33 +33,12 @@ import Data.Maybe import qualified Data.IntMap.Strict as IM import Control.Lens -extractFromZone :: Zoning a -> Int2 -> Maybe a +extractFromZone :: Zoning t a -> Int2 -> Maybe (t a) extractFromZone zn (V2 x y) = zn ^? znObjects . ix x . ix y -streamFromZone :: Foldable t => Zoning (t a) -> StreamOf Int2 -> StreamOf a +streamFromZone :: Foldable t => Zoning t a -> StreamOf Int2 -> StreamOf a streamFromZone zn = S.concat . S.mapMaybe (extractFromZone zn) -insertInZoneWith - :: Int2 - -> (a -> a -> a) -- ^ Combining function - -> a -- ^ Value to insert - -> Zoning a - -> Zoning a -insertInZoneWith (V2 x y) fun obj = over znObjects $ IM.insertWith f x $ IM.singleton y obj - where - f _ = IM.insertWith fun y obj - -zoneOfSeg :: Float -> Point2 -> Point2 -> StreamOf Int2 -zoneOfSeg = ddaStream - -zoneInsideCirc :: Float -> Point2 -> Float -> StreamOf Int2 -zoneInsideCirc x p r = ddaSqStream x (p +.+ V2 r r) (p -.- V2 r r) - -zoneOfWall :: Wall -> Stream (Of (V2 Int)) Identity () -zoneOfWall = uncurry (zoneOfSeg wlZoneSize) . _wlLine - -zoneOfCreature :: Creature -> StreamOf Int2 -zoneOfCreature cr = zoneInsideCirc crZoneSize (_crPos cr) (_crRad cr) zoneNearPointIP :: Point2 -> [(Int,Int)] zoneNearPointIP p = [(a,b) | a <- [x-1..x+1] , b <- [y-1..y+1] ] @@ -98,36 +77,42 @@ lookLookups xs z = mapMaybe (flip (uncurry lookLookup) z) xs nearPoint :: (Foldable t,Monoid (t a)) - => Float -> (World -> Zoning (t a)) -> Point2 -> World -> StreamOf a + => (World -> Zoning t a) -> Point2 -> World -> StreamOf a {-# INLINE nearPoint #-} -nearPoint s f p w = S.each . fromMaybe mempty $ extractFromZone (f w) (zoneOfPoint s p) +nearPoint f p w = S.each . fromMaybe mempty $ extractFromZone zn (zoneOfPoint (_znSize zn) p) + where + zn = f w clsNearPoint :: Point2 -> World -> StreamOf Cloud -clsNearPoint = nearPoint clZoneSize _cloudsZone +clsNearPoint = nearPoint _clZoning wlsNearPoint :: Point2 -> World -> StreamOf Wall -wlsNearPoint = nearPoint wlZoneSize _wallsZone +wlsNearPoint = nearPoint _wlZoning crsNearPoint :: Point2 -> World -> StreamOf Creature -crsNearPoint = nearPoint crZoneSize _creaturesZone +crsNearPoint = nearPoint _crZoning -nearSeg :: Foldable t => Float -> (World -> Zoning (t a)) -> Point2 -> Point2 -> World -> StreamOf a -nearSeg s f p r w = streamFromZone (f w) $ zoneOfSeg s p r +nearSeg :: Foldable t => (World -> Zoning t a) -> Point2 -> Point2 -> World -> StreamOf a +nearSeg f p r w = streamFromZone zn $ zoneOfSeg (_znSize zn) p r + where + zn = (f w) wlsNearSeg :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity () -wlsNearSeg = nearSeg wlZoneSize _wallsZone +wlsNearSeg = nearSeg _wlZoning crsNearSeg :: Point2 -> Point2 -> World -> StreamOf Creature -crsNearSeg = nearSeg crZoneSize _creaturesZone +crsNearSeg = nearSeg _crZoning -insideCirc :: Foldable t => Float -> (World -> Zoning (t a)) -> Point2 -> Float -> World -> StreamOf a -insideCirc s f p r w = streamFromZone (f w) $ zoneInsideCirc s p r +insideCirc :: Foldable t => (World -> Zoning t a) -> Point2 -> Float -> World -> StreamOf a +insideCirc f p r w = streamFromZone zn $ zoneInsideCirc (_znSize zn) p r + where + zn = f w wlsInsideCirc :: Point2 -> Float -> World -> Stream (Of Wall) Identity () -wlsInsideCirc = insideCirc wlZoneSize _wallsZone +wlsInsideCirc = insideCirc _wlZoning crsInsideCirc :: Point2 -> Float -> World -> StreamOf Creature -crsInsideCirc = insideCirc crZoneSize _creaturesZone +crsInsideCirc = insideCirc _crZoning wlZoneOfPoint :: Point2 -> Int2 wlZoneOfPoint = zoneOfPoint wlZoneSize diff --git a/src/Dodge/Zone/Object.hs b/src/Dodge/Zone/Object.hs new file mode 100644 index 000000000..e73a56b90 --- /dev/null +++ b/src/Dodge/Zone/Object.hs @@ -0,0 +1,16 @@ +module Dodge.Zone.Object where +import Dodge.Data +import Geometry.Zone +import Geometry.Data +import Geometry.Vector3D +import StreamingHelp +import qualified Streaming.Prelude as S + +zoneOfCreature :: Float -> Creature -> StreamOf Int2 +zoneOfCreature x cr = zoneInsideCirc x (_crPos cr) (_crRad cr) + +zoneOfWall :: Float -> Wall -> StreamOf Int2 +zoneOfWall x = uncurry (zoneOfSeg x) . _wlLine + +zonePos :: (a -> Point2) -> Float -> a -> StreamOf Int2 +zonePos f x = S.yield . zoneOfPoint x . f diff --git a/src/Dodge/Zone/Update.hs b/src/Dodge/Zone/Update.hs new file mode 100644 index 000000000..d0de30ea6 --- /dev/null +++ b/src/Dodge/Zone/Update.hs @@ -0,0 +1,32 @@ +module Dodge.Zone.Update where +import Dodge.Data.Zoning +import StreamingHelp +import qualified Streaming.Prelude as S +import qualified Data.IntMap.Strict as IM +import Geometry +import LensHelp + +insertInZoning :: Monoid (t a) => (a -> t a -> t a) -> a -> Zoning t a -> Zoning t a +insertInZoning f obj zn = runIdentity (S.fold_ doinsert zn id (_znFunc zn (_znSize zn) obj)) + where + doinsert znobs vxy = insertInZoneWith vxy (\_ -> f obj) (f obj mempty) znobs + +--alterInZone :: (a -> Maybe (t a) -> Maybe (t a)) -> a -> Zoning + +updateInZoning' :: Applicative t => (t a -> t a -> t a) -> a -> Zoning t a -> Zoning t a +updateInZoning' f obj zn = runIdentity (S.fold_ doinsert zn id (_znFunc zn (_znSize zn) obj)) + where + doinsert znobs vxy = insertInZoneWith vxy f (pure obj) znobs + +imInsert :: (a -> Int) -> a -> IM.IntMap a -> IM.IntMap a +imInsert getID x = IM.insert (getID x) x + +insertInZoneWith + :: Int2 + -> (t a -> t a -> t a) -- ^ Combining function + -> t a -- ^ Value to insert + -> Zoning t a + -> Zoning t a +insertInZoneWith (V2 x y) fun obj = over znObjects $ IM.insertWith f x $ IM.singleton y obj + where + f _ = IM.insertWith fun y obj diff --git a/src/Geometry/Zone.hs b/src/Geometry/Zone.hs index 32d06978b..1c4a24705 100644 --- a/src/Geometry/Zone.hs +++ b/src/Geometry/Zone.hs @@ -11,10 +11,13 @@ module Geometry.Zone , yIntercepts , divTo , zoneOfPoint + , zoneOfSeg + , zoneInsideCirc ) where import Geometry.Data +import Geometry.Vector -import Streaming +import StreamingHelp import qualified Streaming.Prelude as S import Data.Foldable import qualified Data.IntMap.Strict as IM @@ -157,6 +160,12 @@ makeInterval x y | x < y = [x-1..y+1] | otherwise = [y-1..x+1] +zoneInsideCirc :: Float -> Point2 -> Float -> StreamOf Int2 +zoneInsideCirc x p r = ddaSqStream x (p +.+ V2 r r) (p -.- V2 r r) + +zoneOfSeg :: Float -> Point2 -> Point2 -> StreamOf Int2 +zoneOfSeg = ddaStream + ddaStream :: Float -> Point2 -> Point2 -> Stream (Of (V2 Int)) Identity () ddaStream s sp ep = S.map (zoneOfPoint s) $ S.yield sp