Improve level generation speed
This commit is contained in:
+64
-95
@@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
module Geometry.Zone
|
||||
( ddaExt
|
||||
)
|
||||
@@ -19,62 +19,63 @@ import qualified Data.IntSet as IS
|
||||
-- g (r,x) y = (f r x y,y)
|
||||
--foldl2' _ s _ = s
|
||||
|
||||
sortArguments
|
||||
:: Ord a
|
||||
=> (a -> a -> b)
|
||||
-> a -> a -> b
|
||||
sortArguments f x y
|
||||
| x < y = f x y
|
||||
| otherwise = f y x
|
||||
sortArgumentsReverse
|
||||
:: Ord a
|
||||
=> (a -> a -> [b])
|
||||
-> a -> a -> [b]
|
||||
sortArgumentsReverse f x y
|
||||
| x < y = f x y
|
||||
| otherwise = reverse $ f y x
|
||||
--sortArguments
|
||||
-- :: Ord a
|
||||
-- => (a -> a -> b)
|
||||
-- -> a -> a -> b
|
||||
--sortArguments f x y
|
||||
-- | x < y = f x y
|
||||
-- | otherwise = f y x
|
||||
--sortArgumentsReverse
|
||||
-- :: Ord a
|
||||
-- => (a -> a -> [b])
|
||||
-- -> a -> a -> [b]
|
||||
--sortArgumentsReverse f x y
|
||||
-- | x < y = f x y
|
||||
-- | otherwise = reverse $ f y x
|
||||
--
|
||||
--intervalBounds
|
||||
-- :: Float -- ^ interval threshold
|
||||
-- -> Float -- ^ First endpoint
|
||||
-- -> Float -- ^ Second endpoint
|
||||
-- -> [Float]
|
||||
--intervalBounds = sortArgumentsReverse . f
|
||||
-- where
|
||||
-- f r a b
|
||||
-- | x > b = [a]
|
||||
-- | otherwise = (a : [x,x+r..b])
|
||||
-- where
|
||||
-- x = floorTo r a + r
|
||||
|
||||
intervalBounds
|
||||
:: Float -- ^ interval threshold
|
||||
-> Float -- ^ First endpoint
|
||||
-> Float -- ^ Second endpoint
|
||||
-> [Float]
|
||||
intervalBounds = sortArgumentsReverse . f
|
||||
where
|
||||
f r a b
|
||||
| x > b = [a]
|
||||
| otherwise = (a : [x,x+r..b])
|
||||
where
|
||||
x = floorTo r a + r
|
||||
--floorTo :: Float -> Float -> Float
|
||||
--floorTo r x = r * (fromIntegral ((floor $ x / r) :: Int))
|
||||
|
||||
floorTo :: Float -> Float -> Float
|
||||
floorTo r x = r * (fromIntegral ((floor $ x / r) :: Int))
|
||||
|
||||
ceilingTo :: Float -> Float -> Float
|
||||
ceilingTo r x = r * (fromIntegral ((ceiling $ x / r) :: Int))
|
||||
--ceilingTo :: Float -> Float -> Float
|
||||
--ceilingTo r x = r * (fromIntegral ((ceiling $ x / r) :: Int))
|
||||
|
||||
divTo :: Float -> Float -> Int
|
||||
{-# INLINE divTo #-}
|
||||
divTo s = floor . (/s)
|
||||
|
||||
flipV :: Point2 -> Point2
|
||||
{-# INLINE flipV #-}
|
||||
flipV (V2 a b) = V2 b a
|
||||
--flipV :: Point2 -> Point2
|
||||
--{-# INLINE flipV #-}
|
||||
--flipV (V2 a b) = V2 b a
|
||||
|
||||
applyInverted
|
||||
:: (Point2 -> Point2 -> [Point2])
|
||||
-> Point2 -> Point2 -> [Point2]
|
||||
applyInverted f sp@(V2 sx sy) ep@(V2 ex ey)
|
||||
| abs (sx-ex) > abs (sy-ey) = f sp ep
|
||||
| otherwise = map flipV $ f (flipV sp) (flipV ep)
|
||||
--applyInverted
|
||||
-- :: (Point2 -> Point2 -> [Point2])
|
||||
-- -> Point2 -> Point2 -> [Point2]
|
||||
--applyInverted f sp@(V2 sx sy) ep@(V2 ex ey)
|
||||
-- | abs (sx-ex) > abs (sy-ey) = f sp ep
|
||||
-- | otherwise = map flipV $ f (flipV sp) (flipV ep)
|
||||
|
||||
sizeZoneOfPoint' :: Float -> Point2 -> V2 Int
|
||||
{-# INLINE sizeZoneOfPoint' #-}
|
||||
sizeZoneOfPoint' s = fmap (divTo s)
|
||||
|
||||
increasingInterval :: Int -> Int -> [Int]
|
||||
increasingInterval x y
|
||||
| y > x = [x .. y]
|
||||
| otherwise = [y .. x]
|
||||
--increasingInterval :: Int -> Int -> [Int]
|
||||
--increasingInterval x y
|
||||
-- | y > x = [x .. y]
|
||||
-- | otherwise = [y .. x]
|
||||
|
||||
-- | Determines which horizontal and vertical lines on a grid are crossed by a
|
||||
-- line. For each adds the x-y index of the square to the right or above the
|
||||
@@ -91,41 +92,14 @@ ddaExt s sp@(V2 sx sy) ep@(V2 ex ey)
|
||||
in insertXY im (x,y)
|
||||
x1 = divTo s sx
|
||||
x2 = divTo s ex
|
||||
x1y = fx' sp ep $ s * (fromIntegral x1)
|
||||
x2y = fx' sp ep $ s * (fromIntegral x2)
|
||||
x1y = fx' sp ep $ s * fromIntegral x1
|
||||
x2y = fx' sp ep $ s * fromIntegral x2
|
||||
ydx = s * ydx' sp ep
|
||||
addys m = add2s m ypairs
|
||||
y1 = divTo s sy
|
||||
y2 = divTo s ey
|
||||
y1x = fy' sp ep $ s * (fromIntegral y1)
|
||||
y2x = fy' sp ep $ s * (fromIntegral y2)
|
||||
xdy = s * xdy' sp ep
|
||||
ypairs
|
||||
| y1 <= y2 = zip (map (divTo s) [y1x,y1x+xdy..])
|
||||
[y1 .. y2]
|
||||
| otherwise = zip (map (divTo s) [y2x,y2x+xdy..])
|
||||
[y2-1 .. y1-1]
|
||||
-- | Determines which horizontal and vertical lines on a grid are crossed by a
|
||||
-- line. For each adds the x-y index of the square to the right or above the
|
||||
-- crossed grid line. Also adds the index of the square containing the start
|
||||
-- point.
|
||||
ddaExtExt :: Float -> V2 Float -> V2 Float -> IM.IntMap IS.IntSet
|
||||
ddaExtExt s sp@(V2 sx sy) ep@(V2 ex ey)
|
||||
| x1 <= x2 = addys . IM.fromDistinctAscList $ zip [x1 .. x2]
|
||||
$ map (IS.singleton . divTo s) [x1y,x1y+ydx..]
|
||||
| otherwise = addys . IM.fromDistinctAscList $ zip [x2-1 .. x1-1]
|
||||
$ map (IS.singleton . divTo s) [x2y,x2y+ydx..]
|
||||
where
|
||||
x1 = divTo s sx
|
||||
x2 = divTo s ex
|
||||
x1y = fx' sp ep $ s * (fromIntegral x1)
|
||||
x2y = fx' sp ep $ s * (fromIntegral x2)
|
||||
ydx = s * ydx' sp ep
|
||||
addys m = add2s m ypairs
|
||||
y1 = divTo s sy
|
||||
y2 = divTo s ey
|
||||
y1x = fy' sp ep $ s * (fromIntegral y1)
|
||||
y2x = fy' sp ep $ s * (fromIntegral y2)
|
||||
y1x = fy' sp ep $ s * fromIntegral y1
|
||||
y2x = fy' sp ep $ s * fromIntegral y2
|
||||
xdy = s * xdy' sp ep
|
||||
ypairs
|
||||
| y1 <= y2 = zip (map (divTo s) [y1x,y1x+xdy..])
|
||||
@@ -138,44 +112,39 @@ ydx' :: Point2 -> Point2 -> Float
|
||||
ydx' (V2 sx sy) (V2 ex ey)
|
||||
| sx == ex = 0
|
||||
| otherwise = (ey - sy) / (ex - sx)
|
||||
xInt' :: Float -> Point2 -> Point2 -> Float
|
||||
xInt' s (V2 sx _) (V2 ex _)
|
||||
| ex > sx = ceilingTo s sx
|
||||
| otherwise = floorTo s sx
|
||||
fx' :: Point2 -> Point2 -> Float -> Float
|
||||
{-# INLINE fx' #-}
|
||||
fx' sp@(V2 sx sy) ep@(V2 _ ey) x
|
||||
| sy == ey = sy
|
||||
| otherwise = sy + ydx' sp ep * (x - sx)
|
||||
|
||||
xdy' :: Point2 -> Point2 -> Float
|
||||
{-# INLINE xdy' #-}
|
||||
xdy' (V2 sx sy) (V2 ex ey)
|
||||
| sy == ey = 0
|
||||
| otherwise = (ex - sx) / (ey - sy)
|
||||
yInt' :: Float -> Point2 -> Point2 -> Float
|
||||
yInt' s (V2 _ sy) (V2 _ ey)
|
||||
| ey > sy = ceilingTo s sy
|
||||
| otherwise = floorTo s sy
|
||||
fy' :: Point2 -> Point2 -> Float -> Float
|
||||
{-# INLINE fy' #-}
|
||||
fy' sp@(V2 sx sy) ep@(V2 ex _) y
|
||||
| sx == ex = sx
|
||||
| otherwise = sx + xdy' sp ep * (y - sy)
|
||||
|
||||
add2s :: IM.IntMap IS.IntSet -> [(Int,Int)] -> IM.IntMap IS.IntSet
|
||||
{-# INLINE add2s #-}
|
||||
add2s imis = foldl'
|
||||
add2s = foldl'
|
||||
(\m (k,x) -> IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m)
|
||||
imis
|
||||
|
||||
insertXY :: IM.IntMap IS.IntSet -> (Int,Int) -> IM.IntMap IS.IntSet
|
||||
{-# INLINE insertXY #-}
|
||||
insertXY m (k,x) = IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m
|
||||
|
||||
addV2s :: IM.IntMap IS.IntSet -> [V2 Int] -> IM.IntMap IS.IntSet
|
||||
{-# INLINE addV2s #-}
|
||||
addV2s imis = foldl'
|
||||
(\m (V2 k x) -> IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m)
|
||||
imis
|
||||
--addV2s :: IM.IntMap IS.IntSet -> [V2 Int] -> IM.IntMap IS.IntSet
|
||||
--{-# INLINE addV2s #-}
|
||||
--addV2s imis = foldl'
|
||||
-- (\m (V2 k x) -> IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m)
|
||||
-- imis
|
||||
|
||||
pairsToIntMapSet :: [V2 Int] -> IM.IntMap IS.IntSet
|
||||
pairsToIntMapSet = foldl'
|
||||
(\m (V2 k x) -> IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m)
|
||||
IM.empty
|
||||
--pairsToIntMapSet :: [V2 Int] -> IM.IntMap IS.IntSet
|
||||
--pairsToIntMapSet = foldl'
|
||||
-- (\m (V2 k x) -> IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m)
|
||||
-- IM.empty
|
||||
|
||||
Reference in New Issue
Block a user