-- | Two-dimensional lookup tables.
module Geometry.LookupTable.Lookup2 (
    -- * Function cache
      LookupTable2
    , Grid(..)
    , createLookupTable2
    , lookupNearest
    , lookupBilinear
    , forLookupTable2_

    -- * Technical utilities
    , IVec2(..)
    , CIVec2(..)
    , roundCIVec2
    , fromGrid
    , toGrid
    , valueTable
) where



import           Control.DeepSeq
import           Control.Parallel.Strategies
import           Data.Ord.Extended
import           Data.Vector                 (Vector, (!))
import qualified Data.Vector                 as V

import Geometry.Core
import Numerics.Interpolation



-- | Lookup table for a two-dimensional function. Created with 'lookupTable2'.
data LookupTable2 a = LookupTable2 Grid (Vector (Vector a))
    deriving (LookupTable2 a -> LookupTable2 a -> Bool
(LookupTable2 a -> LookupTable2 a -> Bool)
-> (LookupTable2 a -> LookupTable2 a -> Bool)
-> Eq (LookupTable2 a)
forall a. Eq a => LookupTable2 a -> LookupTable2 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => LookupTable2 a -> LookupTable2 a -> Bool
== :: LookupTable2 a -> LookupTable2 a -> Bool
$c/= :: forall a. Eq a => LookupTable2 a -> LookupTable2 a -> Bool
/= :: LookupTable2 a -> LookupTable2 a -> Bool
Eq, Eq (LookupTable2 a)
Eq (LookupTable2 a)
-> (LookupTable2 a -> LookupTable2 a -> Ordering)
-> (LookupTable2 a -> LookupTable2 a -> Bool)
-> (LookupTable2 a -> LookupTable2 a -> Bool)
-> (LookupTable2 a -> LookupTable2 a -> Bool)
-> (LookupTable2 a -> LookupTable2 a -> Bool)
-> (LookupTable2 a -> LookupTable2 a -> LookupTable2 a)
-> (LookupTable2 a -> LookupTable2 a -> LookupTable2 a)
-> Ord (LookupTable2 a)
LookupTable2 a -> LookupTable2 a -> Bool
LookupTable2 a -> LookupTable2 a -> Ordering
LookupTable2 a -> LookupTable2 a -> LookupTable2 a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (LookupTable2 a)
forall a. Ord a => LookupTable2 a -> LookupTable2 a -> Bool
forall a. Ord a => LookupTable2 a -> LookupTable2 a -> Ordering
forall a.
Ord a =>
LookupTable2 a -> LookupTable2 a -> LookupTable2 a
$ccompare :: forall a. Ord a => LookupTable2 a -> LookupTable2 a -> Ordering
compare :: LookupTable2 a -> LookupTable2 a -> Ordering
$c< :: forall a. Ord a => LookupTable2 a -> LookupTable2 a -> Bool
< :: LookupTable2 a -> LookupTable2 a -> Bool
$c<= :: forall a. Ord a => LookupTable2 a -> LookupTable2 a -> Bool
<= :: LookupTable2 a -> LookupTable2 a -> Bool
$c> :: forall a. Ord a => LookupTable2 a -> LookupTable2 a -> Bool
> :: LookupTable2 a -> LookupTable2 a -> Bool
$c>= :: forall a. Ord a => LookupTable2 a -> LookupTable2 a -> Bool
>= :: LookupTable2 a -> LookupTable2 a -> Bool
$cmax :: forall a.
Ord a =>
LookupTable2 a -> LookupTable2 a -> LookupTable2 a
max :: LookupTable2 a -> LookupTable2 a -> LookupTable2 a
$cmin :: forall a.
Ord a =>
LookupTable2 a -> LookupTable2 a -> LookupTable2 a
min :: LookupTable2 a -> LookupTable2 a -> LookupTable2 a
Ord, Int -> LookupTable2 a -> ShowS
[LookupTable2 a] -> ShowS
LookupTable2 a -> String
(Int -> LookupTable2 a -> ShowS)
-> (LookupTable2 a -> String)
-> ([LookupTable2 a] -> ShowS)
-> Show (LookupTable2 a)
forall a. Show a => Int -> LookupTable2 a -> ShowS
forall a. Show a => [LookupTable2 a] -> ShowS
forall a. Show a => LookupTable2 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> LookupTable2 a -> ShowS
showsPrec :: Int -> LookupTable2 a -> ShowS
$cshow :: forall a. Show a => LookupTable2 a -> String
show :: LookupTable2 a -> String
$cshowList :: forall a. Show a => [LookupTable2 a] -> ShowS
showList :: [LookupTable2 a] -> ShowS
Show)

instance NFData a => NFData (LookupTable2 a) where
    rnf :: LookupTable2 a -> ()
rnf (LookupTable2 Grid
grid Vector (Vector a)
vec) = Strategy (Vector (Vector a))
-> Vector (Vector a) -> Vector (Vector a)
forall a. Strategy a -> a -> a
withStrategy (Strategy (Vector a) -> Strategy (Vector (Vector a))
forall (t :: * -> *) a.
Traversable t =>
Strategy a -> Strategy (t a)
parTraversable Strategy (Vector a)
forall a. NFData a => Strategy a
rdeepseq) Vector (Vector a)
vec Vector (Vector a) -> () -> ()
forall a b. a -> b -> b
`seq` Grid -> ()
forall a. NFData a => a -> ()
rnf Grid
grid

-- | Build a 2D lookup table, suitable for caching function calls. Values are
-- initialized lazily, so that only repeated computations are sped up.
--
-- === Example: lookup table for \(f(x,y) = x\cdot y\)
--
-- @
-- grid = 'Grid' ('Vec2' (-10) (-10), 'Vec2' 10 10), (100, 100)
-- f ('Vec2' x y) = x*y
-- table = 'createLookupTable2' grid f
-- @
createLookupTable2 :: Grid -> (Vec2 -> a) -> LookupTable2 a
createLookupTable2 :: forall a. Grid -> (Vec2 -> a) -> LookupTable2 a
createLookupTable2 Grid
grid Vec2 -> a
f = Grid -> Vector (Vector a) -> LookupTable2 a
forall a. Grid -> Vector (Vector a) -> LookupTable2 a
LookupTable2 Grid
grid (Grid -> (Vec2 -> a) -> Vector (Vector a)
forall a. Grid -> (Vec2 -> a) -> Vector (Vector a)
valueTable Grid
grid Vec2 -> a
f)

-- | Nearest neigbour lookup in a two-dimensional lookup table. Lookup outside of
-- the lookup table’s domain is clamped to the table’s edges.
--
-- Compared to 'lookupBilinear' this function works on types that don’t support
-- arithmetic on them, and is faster. The downside is of course that only the
-- values on the grid points are accessible, without any interpolation.
lookupNearest :: LookupTable2 Double -> Vec2 -> Double
lookupNearest :: LookupTable2 Double -> Vec2 -> Double
lookupNearest (LookupTable2 grid :: Grid
grid@(Grid (Vec2, Vec2)
_ (Int
iMax, Int
jMax)) Vector (Vector Double)
vec) Vec2
xy =
    let CIVec2 Double
iCont Double
jCont = Grid -> Vec2 -> CIVec2
toGrid Grid
grid Vec2
xy
        i :: Int
i = (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
clamp (Int
0,Int
iMax) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
iCont)
        j :: Int
j = (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
clamp (Int
0,Int
jMax) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
jCont)
    in Vector (Vector Double)
vecVector (Vector Double) -> Int -> Vector Double
forall a. Vector a -> Int -> a
!Int
iVector Double -> Int -> Double
forall a. Vector a -> Int -> a
!Int
j

-- | Bilinear lookup in a two-dimensional lookup table. Lookup outside of the
-- lookup table’s domain is clamped to the table’s edges, so while it will not make
-- the program crash, the values are not useful.
--
-- This lookup approximates a function in the sense that
--
-- @
-- 'lookupBilinear' ('createLookupTable2' grid f) x ≈ f x
-- @
lookupBilinear :: LookupTable2 Double -> Vec2 -> Double
lookupBilinear :: LookupTable2 Double -> Vec2 -> Double
lookupBilinear (LookupTable2 Grid
grid Vector (Vector Double)
vec) Vec2
xy =
    let CIVec2 Double
iCont Double
jCont = Grid -> Vec2 -> CIVec2
toGrid Grid
grid Vec2
xy
        iFloor :: Int
iFloor = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
iCont
        jFloor :: Int
jFloor = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
jCont
        iCeil :: Int
iCeil = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
iCont
        jCeil :: Int
jCeil = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
jCont

        lut_iFloor :: Vector Double
lut_iFloor = Vector (Vector Double)
vecVector (Vector Double) -> Int -> Vector Double
forall a. Vector a -> Int -> a
!Int
iFloor
        lut_iCeil :: Vector Double
lut_iCeil = Vector (Vector Double)
vecVector (Vector Double) -> Int -> Vector Double
forall a. Vector a -> Int -> a
!Int
iCeil

        iFloorValue :: Double
iFloorValue
            | Int
jFloor Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
jCeil = (Double, Double) -> (Double, Double) -> Double -> Double
forall vec.
VectorSpace vec =>
(Double, Double) -> (vec, vec) -> Double -> vec
lerp (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
jFloor, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
jCeil) (Vector Double
lut_iFloor Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
! Int
jFloor, Vector Double
lut_iFloor Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
! Int
jCeil) Double
jCont
            | Bool
otherwise = Vector Double
lut_iFloorVector Double -> Int -> Double
forall a. Vector a -> Int -> a
!Int
jFloor
        iCeilValue :: Double
iCeilValue
            | Int
jFloor Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
jCeil = (Double, Double) -> (Double, Double) -> Double -> Double
forall vec.
VectorSpace vec =>
(Double, Double) -> (vec, vec) -> Double -> vec
lerp (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
jFloor, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
jCeil) (Vector Double
lut_iCeil Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
! Int
jFloor, Vector Double
lut_iCeil Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
! Int
jCeil) Double
jCont
            | Bool
otherwise = Vector Double
lut_iCeilVector Double -> Int -> Double
forall a. Vector a -> Int -> a
!Int
jFloor

        result :: Double
result
            | Int
iFloor Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
iCeil = (Double, Double) -> (Double, Double) -> Double -> Double
forall vec.
VectorSpace vec =>
(Double, Double) -> (vec, vec) -> Double -> vec
lerp (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iFloor, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iCeil) (Double
iFloorValue, Double
iCeilValue) Double
iCont
            | Bool
otherwise = Double
iFloorValue

    in Double
result

-- | Perform an action for each entry in the lookup table. Can be handy for
-- plotting its contents.
--
-- @
-- grid = 'Grid' ('Vec2' 0 0, 'Vec2' 100, 100) (100, 100)
-- f ('Vec2' x y) = x + 'sin' y
-- table = 'createLookupTable2' grid f
--
-- 'forLookupTable2_' table $ \val pos _ ->
--     'Draw.moveToVec' pos
--     'Draw.showTextAligned' 'Draw.HCenter' 'Draw.VCenter' ('show' val)
-- @
forLookupTable2_ :: Monad f => LookupTable2 a -> (a -> Vec2 -> IVec2 -> f b) -> f ()
forLookupTable2_ :: forall (f :: * -> *) a b.
Monad f =>
LookupTable2 a -> (a -> Vec2 -> IVec2 -> f b) -> f ()
forLookupTable2_ (LookupTable2 Grid
grid Vector (Vector a)
vec) a -> Vec2 -> IVec2 -> f b
f =
    Vector (Vector a) -> (Int -> Vector a -> f ()) -> f ()
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (Int -> a -> m b) -> m ()
V.iforM_ Vector (Vector a)
vec ((Int -> Vector a -> f ()) -> f ())
-> (Int -> Vector a -> f ()) -> f ()
forall a b. (a -> b) -> a -> b
$ \Int
i Vector a
iVec ->
        Vector a -> (Int -> a -> f b) -> f ()
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (Int -> a -> m b) -> m ()
V.iforM_ Vector a
iVec ((Int -> a -> f b) -> f ()) -> (Int -> a -> f b) -> f ()
forall a b. (a -> b) -> a -> b
$ \Int
j a
val ->
            let iVec2 :: IVec2
iVec2 = Int -> Int -> IVec2
IVec2 Int
i Int
j
                vec2 :: Vec2
vec2 = Grid -> IVec2 -> Vec2
fromGrid Grid
grid IVec2
iVec2
            in a -> Vec2 -> IVec2 -> f b
f a
val Vec2
vec2 IVec2
iVec2

-- | Discrete 'Vec2'. Useful as coordinate in a @'Vector' ('Vector' a)@.
data IVec2 = IVec2 !Int !Int
    deriving (IVec2 -> IVec2 -> Bool
(IVec2 -> IVec2 -> Bool) -> (IVec2 -> IVec2 -> Bool) -> Eq IVec2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IVec2 -> IVec2 -> Bool
== :: IVec2 -> IVec2 -> Bool
$c/= :: IVec2 -> IVec2 -> Bool
/= :: IVec2 -> IVec2 -> Bool
Eq, Eq IVec2
Eq IVec2
-> (IVec2 -> IVec2 -> Ordering)
-> (IVec2 -> IVec2 -> Bool)
-> (IVec2 -> IVec2 -> Bool)
-> (IVec2 -> IVec2 -> Bool)
-> (IVec2 -> IVec2 -> Bool)
-> (IVec2 -> IVec2 -> IVec2)
-> (IVec2 -> IVec2 -> IVec2)
-> Ord IVec2
IVec2 -> IVec2 -> Bool
IVec2 -> IVec2 -> Ordering
IVec2 -> IVec2 -> IVec2
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IVec2 -> IVec2 -> Ordering
compare :: IVec2 -> IVec2 -> Ordering
$c< :: IVec2 -> IVec2 -> Bool
< :: IVec2 -> IVec2 -> Bool
$c<= :: IVec2 -> IVec2 -> Bool
<= :: IVec2 -> IVec2 -> Bool
$c> :: IVec2 -> IVec2 -> Bool
> :: IVec2 -> IVec2 -> Bool
$c>= :: IVec2 -> IVec2 -> Bool
>= :: IVec2 -> IVec2 -> Bool
$cmax :: IVec2 -> IVec2 -> IVec2
max :: IVec2 -> IVec2 -> IVec2
$cmin :: IVec2 -> IVec2 -> IVec2
min :: IVec2 -> IVec2 -> IVec2
Ord, Int -> IVec2 -> ShowS
[IVec2] -> ShowS
IVec2 -> String
(Int -> IVec2 -> ShowS)
-> (IVec2 -> String) -> ([IVec2] -> ShowS) -> Show IVec2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IVec2 -> ShowS
showsPrec :: Int -> IVec2 -> ShowS
$cshow :: IVec2 -> String
show :: IVec2 -> String
$cshowList :: [IVec2] -> ShowS
showList :: [IVec2] -> ShowS
Show)

instance NFData IVec2 where rnf :: IVec2 -> ()
rnf IVec2
_ = ()

-- | Continuous version of 'IVec2'. Type-wise the same as 'Vec2', but it shows
-- fractional grid coodrdinates, so we can express the fact that our lookup might
-- be »between i and i+1« and we can interpolate.
data CIVec2 = CIVec2 !Double !Double
    deriving (CIVec2 -> CIVec2 -> Bool
(CIVec2 -> CIVec2 -> Bool)
-> (CIVec2 -> CIVec2 -> Bool) -> Eq CIVec2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CIVec2 -> CIVec2 -> Bool
== :: CIVec2 -> CIVec2 -> Bool
$c/= :: CIVec2 -> CIVec2 -> Bool
/= :: CIVec2 -> CIVec2 -> Bool
Eq, Eq CIVec2
Eq CIVec2
-> (CIVec2 -> CIVec2 -> Ordering)
-> (CIVec2 -> CIVec2 -> Bool)
-> (CIVec2 -> CIVec2 -> Bool)
-> (CIVec2 -> CIVec2 -> Bool)
-> (CIVec2 -> CIVec2 -> Bool)
-> (CIVec2 -> CIVec2 -> CIVec2)
-> (CIVec2 -> CIVec2 -> CIVec2)
-> Ord CIVec2
CIVec2 -> CIVec2 -> Bool
CIVec2 -> CIVec2 -> Ordering
CIVec2 -> CIVec2 -> CIVec2
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CIVec2 -> CIVec2 -> Ordering
compare :: CIVec2 -> CIVec2 -> Ordering
$c< :: CIVec2 -> CIVec2 -> Bool
< :: CIVec2 -> CIVec2 -> Bool
$c<= :: CIVec2 -> CIVec2 -> Bool
<= :: CIVec2 -> CIVec2 -> Bool
$c> :: CIVec2 -> CIVec2 -> Bool
> :: CIVec2 -> CIVec2 -> Bool
$c>= :: CIVec2 -> CIVec2 -> Bool
>= :: CIVec2 -> CIVec2 -> Bool
$cmax :: CIVec2 -> CIVec2 -> CIVec2
max :: CIVec2 -> CIVec2 -> CIVec2
$cmin :: CIVec2 -> CIVec2 -> CIVec2
min :: CIVec2 -> CIVec2 -> CIVec2
Ord, Int -> CIVec2 -> ShowS
[CIVec2] -> ShowS
CIVec2 -> String
(Int -> CIVec2 -> ShowS)
-> (CIVec2 -> String) -> ([CIVec2] -> ShowS) -> Show CIVec2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIVec2 -> ShowS
showsPrec :: Int -> CIVec2 -> ShowS
$cshow :: CIVec2 -> String
show :: CIVec2 -> String
$cshowList :: [CIVec2] -> ShowS
showList :: [CIVec2] -> ShowS
Show)

instance NFData CIVec2 where rnf :: CIVec2 -> ()
rnf CIVec2
_ = ()

-- | Round a »continuous integral« coordinate to a »proper integral« coordinate.
roundCIVec2 :: CIVec2 -> IVec2
roundCIVec2 :: CIVec2 -> IVec2
roundCIVec2 (CIVec2 Double
i Double
j) = Int -> Int -> IVec2
IVec2 (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
i) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
j)

-- | Specification of a discrete grid, used for sampling contour lines.
--
-- Subdivide the unit square with 50 squares (51 steps!) in x direction, and 30 (31
-- steps!) in y direction:
--
-- @
-- 'Grid' ('Vec2' 0 0, 'Vec2' 1 1) (50, 30)
-- @
data Grid = Grid
    { Grid -> (Vec2, Vec2)
_range :: (Vec2, Vec2)  -- ^ Range of continuous coordinates
    , Grid -> (Int, Int)
_maxIndex :: (Int, Int) -- ^ Maximum index of the grid, i.e. coordinates range from @(0,0)@ to @'_maxIndex'@.
    } deriving (Grid -> Grid -> Bool
(Grid -> Grid -> Bool) -> (Grid -> Grid -> Bool) -> Eq Grid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Grid -> Grid -> Bool
== :: Grid -> Grid -> Bool
$c/= :: Grid -> Grid -> Bool
/= :: Grid -> Grid -> Bool
Eq, Eq Grid
Eq Grid
-> (Grid -> Grid -> Ordering)
-> (Grid -> Grid -> Bool)
-> (Grid -> Grid -> Bool)
-> (Grid -> Grid -> Bool)
-> (Grid -> Grid -> Bool)
-> (Grid -> Grid -> Grid)
-> (Grid -> Grid -> Grid)
-> Ord Grid
Grid -> Grid -> Bool
Grid -> Grid -> Ordering
Grid -> Grid -> Grid
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Grid -> Grid -> Ordering
compare :: Grid -> Grid -> Ordering
$c< :: Grid -> Grid -> Bool
< :: Grid -> Grid -> Bool
$c<= :: Grid -> Grid -> Bool
<= :: Grid -> Grid -> Bool
$c> :: Grid -> Grid -> Bool
> :: Grid -> Grid -> Bool
$c>= :: Grid -> Grid -> Bool
>= :: Grid -> Grid -> Bool
$cmax :: Grid -> Grid -> Grid
max :: Grid -> Grid -> Grid
$cmin :: Grid -> Grid -> Grid
min :: Grid -> Grid -> Grid
Ord, Int -> Grid -> ShowS
[Grid] -> ShowS
Grid -> String
(Int -> Grid -> ShowS)
-> (Grid -> String) -> ([Grid] -> ShowS) -> Show Grid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Grid -> ShowS
showsPrec :: Int -> Grid -> ShowS
$cshow :: Grid -> String
show :: Grid -> String
$cshowList :: [Grid] -> ShowS
showList :: [Grid] -> ShowS
Show)

instance NFData Grid where
    rnf :: Grid -> ()
rnf (Grid (Vec2
a,Vec2
b) (Int
c,Int
d)) = Vec2 -> ()
forall a. NFData a => a -> ()
rnf Vec2
a () -> () -> ()
forall a b. a -> b -> b
`seq` Vec2 -> ()
forall a. NFData a => a -> ()
rnf Vec2
b () -> () -> ()
forall a b. a -> b -> b
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
c () -> () -> ()
forall a b. a -> b -> b
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
d

-- | Map a coordinate from the discrete grid to continuous space.
fromGrid
    :: Grid
    -> IVec2 -- ^ Discrete coordinate
    -> Vec2  -- ^ Continuous coordinate
fromGrid :: Grid -> IVec2 -> Vec2
fromGrid (Grid (Vec2 Double
xMin Double
yMin, Vec2 Double
xMax Double
yMax) (Int
iMax, Int
jMax)) (IVec2 Int
i Int
j) =
    let x :: Double
x = (Double, Double) -> (Double, Double) -> Double -> Double
forall vec.
VectorSpace vec =>
(Double, Double) -> (vec, vec) -> Double -> vec
lerp (Double
0, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iMax) (Double
xMin, Double
xMax) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
        y :: Double
y = (Double, Double) -> (Double, Double) -> Double -> Double
forall vec.
VectorSpace vec =>
(Double, Double) -> (vec, vec) -> Double -> vec
lerp (Double
0, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
jMax) (Double
yMin, Double
yMax) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j)
    in Double -> Double -> Vec2
Vec2 Double
x Double
y

toGrid
    :: Grid
    -> Vec2 -- ^ Continuous coordinate
    -> CIVec2
            -- ^ Continuous coordinate, scaled and clamped to grid dimensions.
            --   Suitable to be rounded to an 'IVec' with 'roundCIVec2'.
toGrid :: Grid -> Vec2 -> CIVec2
toGrid (Grid (Vec2 Double
xMin Double
yMin, Vec2 Double
xMax Double
yMax) (Int
iMax, Int
jMax)) (Vec2 Double
x Double
y) =
    let iContinuous :: Double
iContinuous = (Double, Double) -> Double -> Double
forall a. Ord a => (a, a) -> a -> a
clamp (Double
0,Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iMax) ((Double, Double) -> (Double, Double) -> Double -> Double
forall vec.
VectorSpace vec =>
(Double, Double) -> (vec, vec) -> Double -> vec
lerp (Double
xMin, Double
xMax) (Double
0, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iMax) Double
x)
        jContinuous :: Double
jContinuous = (Double, Double) -> Double -> Double
forall a. Ord a => (a, a) -> a -> a
clamp (Double
0,Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
jMax) ((Double, Double) -> (Double, Double) -> Double -> Double
forall vec.
VectorSpace vec =>
(Double, Double) -> (vec, vec) -> Double -> vec
lerp (Double
yMin, Double
yMax) (Double
0, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
jMax) Double
y)
    in Double -> Double -> CIVec2
CIVec2 Double
iContinuous Double
jContinuous

-- | A raw value table, filled (lazily) by a function applied to the underlying
-- 'Grid'.
--
-- We first index by @i@ and then @j@, so that @vec!i!j@ has the intuitive meaning
-- of »go in @i@/@x@ direction and then in @j@/@y@. The drawback is that this makes
-- the table look like downward columns of @y@ values, indexed by @x@. The more
-- common picture for at least me is to have line numbers and then rows in each
-- line.
valueTable :: Grid -> (Vec2 -> a) -> Vector (Vector a)
valueTable :: forall a. Grid -> (Vec2 -> a) -> Vector (Vector a)
valueTable grid :: Grid
grid@Grid{_maxIndex :: Grid -> (Int, Int)
_maxIndex = (Int
is, Int
js)} Vec2 -> a
f =
    Int -> (Int -> Vector a) -> Vector (Vector a)
forall a. Int -> (Int -> a) -> Vector a
V.generate (Int
isInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (\Int
i -> -- »x« direction
        Int -> (Int -> a) -> Vector a
forall a. Int -> (Int -> a) -> Vector a
V.generate (Int
jsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (\Int
j -> -- »y« direction
            Vec2 -> a
f (Grid -> IVec2 -> Vec2
fromGrid Grid
grid (Int -> Int -> IVec2
IVec2 Int
i Int
j))))