{-# LANGUAGE MonoLocalBinds #-}

-- |
-- Module: M.Collision.Pure
-- Description: Pure collision detection primitives and algorithms
-- Copyright: (c) axionbuster, 2025
-- License: BSD-3-Clause
--
-- Core collision detection primitives and algorithms in pure form.
-- Provides AABB collision testing, shape interfaces, and hit detection utilities.
module M.Collision.Pure
  ( Shape (..),
    SomeShape1 (..),
    Hit (..),
    Hit' (..),
    Box (.., Box'),
    ManyBoxes (..),
    ManyBoxes_,
    _dimensions,
    _center,
    _lcorner,
    _hcorner,
    hitin01,
    infhit,
    boxfromcorners,
    castshape1,
    boxzero,
    hicorner,
    hicorner',
    locorner,
    locorner',
    shicorner,
    slocorner,
  )
where

import Control.Lens hiding (index)
import Control.Monad.Zip
import Data.Data
import Data.Foldable
import Data.Functor.Rep
import Data.Hashable
import Data.Ord
import Data.Semigroup
import GHC.Generics (Generic)
import Linear

-- | a collision resolution data type
--
-- no hit is represented by a hit at infinity (other fields are unspecified)
data Hit a = Hit
  { -- | proportion of move completed in [0, 1]
    forall a. Hit a -> a
hittime :: !a,
    -- | the point of collision
    --
    -- if you're using 'Box', this is the center of the box
    forall a. Hit a -> V3 a
hitwhere :: !(V3 a),
    -- | normal vector of the surface hit
    --
    -- a signum vector, so each component is either -1, 0, or 1
    forall a. Hit a -> V3 a
hitnorm :: !(V3 a)
  }
  deriving (Int -> Hit a -> ShowS
[Hit a] -> ShowS
Hit a -> String
(Int -> Hit a -> ShowS)
-> (Hit a -> String) -> ([Hit a] -> ShowS) -> Show (Hit a)
forall a. Show a => Int -> Hit a -> ShowS
forall a. Show a => [Hit a] -> ShowS
forall a. Show a => Hit a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Hit a -> ShowS
showsPrec :: Int -> Hit a -> ShowS
$cshow :: forall a. Show a => Hit a -> String
show :: Hit a -> String
$cshowList :: forall a. Show a => [Hit a] -> ShowS
showList :: [Hit a] -> ShowS
Show, Hit a -> Hit a -> Bool
(Hit a -> Hit a -> Bool) -> (Hit a -> Hit a -> Bool) -> Eq (Hit a)
forall a. Eq a => Hit a -> Hit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Hit a -> Hit a -> Bool
== :: Hit a -> Hit a -> Bool
$c/= :: forall a. Eq a => Hit a -> Hit a -> Bool
/= :: Hit a -> Hit a -> Bool
Eq, (forall x. Hit a -> Rep (Hit a) x)
-> (forall x. Rep (Hit a) x -> Hit a) -> Generic (Hit a)
forall x. Rep (Hit a) x -> Hit a
forall x. Hit a -> Rep (Hit a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Hit a) x -> Hit a
forall a x. Hit a -> Rep (Hit a) x
$cfrom :: forall a x. Hit a -> Rep (Hit a) x
from :: forall x. Hit a -> Rep (Hit a) x
$cto :: forall a x. Rep (Hit a) x -> Hit a
to :: forall x. Rep (Hit a) x -> Hit a
Generic, Typeable, Eq (Hit a)
Eq (Hit a) =>
(Int -> Hit a -> Int) -> (Hit a -> Int) -> Hashable (Hit a)
Int -> Hit a -> Int
Hit a -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Hashable a => Eq (Hit a)
forall a. Hashable a => Int -> Hit a -> Int
forall a. Hashable a => Hit a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Hit a -> Int
hashWithSalt :: Int -> Hit a -> Int
$chash :: forall a. Hashable a => Hit a -> Int
hash :: Hit a -> Int
Hashable, (forall a b. (a -> b) -> Hit a -> Hit b)
-> (forall a b. a -> Hit b -> Hit a) -> Functor Hit
forall a b. a -> Hit b -> Hit a
forall a b. (a -> b) -> Hit a -> Hit b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Hit a -> Hit b
fmap :: forall a b. (a -> b) -> Hit a -> Hit b
$c<$ :: forall a b. a -> Hit b -> Hit a
<$ :: forall a b. a -> Hit b -> Hit a
Functor, Typeable (Hit a)
Typeable (Hit a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Hit a -> c (Hit a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Hit a))
-> (Hit a -> Constr)
-> (Hit a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Hit a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Hit a)))
-> ((forall b. Data b => b -> b) -> Hit a -> Hit a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hit a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hit a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Hit a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Hit a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Hit a -> m (Hit a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Hit a -> m (Hit a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Hit a -> m (Hit a))
-> Data (Hit a)
Hit a -> Constr
Hit a -> DataType
(forall b. Data b => b -> b) -> Hit a -> Hit a
forall a. Data a => Typeable (Hit a)
forall a. Data a => Hit a -> Constr
forall a. Data a => Hit a -> DataType
forall a. Data a => (forall b. Data b => b -> b) -> Hit a -> Hit a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Hit a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Hit a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hit a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hit a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Hit a -> m (Hit a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Hit a -> m (Hit a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Hit a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hit a -> c (Hit a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Hit a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Hit a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Hit a -> u
forall u. (forall d. Data d => d -> u) -> Hit a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hit a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hit a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Hit a -> m (Hit a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hit a -> m (Hit a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Hit a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hit a -> c (Hit a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Hit a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Hit a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hit a -> c (Hit a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hit a -> c (Hit a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Hit a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Hit a)
$ctoConstr :: forall a. Data a => Hit a -> Constr
toConstr :: Hit a -> Constr
$cdataTypeOf :: forall a. Data a => Hit a -> DataType
dataTypeOf :: Hit a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Hit a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Hit a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Hit a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Hit a))
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Hit a -> Hit a
gmapT :: (forall b. Data b => b -> b) -> Hit a -> Hit a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hit a -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hit a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hit a -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hit a -> r
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Hit a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Hit a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Hit a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Hit a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Hit a -> m (Hit a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Hit a -> m (Hit a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Hit a -> m (Hit a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hit a -> m (Hit a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Hit a -> m (Hit a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hit a -> m (Hit a)
Data)

posinf :: (Fractional a) => a
posinf :: forall a. Fractional a => a
posinf = a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0
{-# INLINE posinf #-}

-- | check if the hit time is in [0, 1]
hitin01 :: (Num a, Ord a) => Hit a -> Bool
hitin01 :: forall a. (Num a, Ord a) => Hit a -> Bool
hitin01 Hit {a
hittime :: forall a. Hit a -> a
hittime :: a
hittime} = a
hittime a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
hittime a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1
{-# INLINE hitin01 #-}

-- | a hit at infinity
infhit :: (Fractional a) => Hit a
infhit :: forall a. Fractional a => Hit a
infhit = a -> V3 a -> V3 a -> Hit a
forall a. a -> V3 a -> V3 a -> Hit a
Hit a
forall a. Fractional a => a
posinf V3 a
forall a. Num a => V3 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero V3 a
forall a. Num a => V3 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
{-# INLINE infhit #-}

-- | internal newtype used with 'Data.Semigroup.Min' to find the closest hit
newtype Hit' a = Hit' {forall a. Hit' a -> Hit a
unHit' :: Hit a}
  deriving newtype (Int -> Hit' a -> ShowS
[Hit' a] -> ShowS
Hit' a -> String
(Int -> Hit' a -> ShowS)
-> (Hit' a -> String) -> ([Hit' a] -> ShowS) -> Show (Hit' a)
forall a. Show a => Int -> Hit' a -> ShowS
forall a. Show a => [Hit' a] -> ShowS
forall a. Show a => Hit' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Hit' a -> ShowS
showsPrec :: Int -> Hit' a -> ShowS
$cshow :: forall a. Show a => Hit' a -> String
show :: Hit' a -> String
$cshowList :: forall a. Show a => [Hit' a] -> ShowS
showList :: [Hit' a] -> ShowS
Show, Hit' a -> Hit' a -> Bool
(Hit' a -> Hit' a -> Bool)
-> (Hit' a -> Hit' a -> Bool) -> Eq (Hit' a)
forall a. Eq a => Hit' a -> Hit' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Hit' a -> Hit' a -> Bool
== :: Hit' a -> Hit' a -> Bool
$c/= :: forall a. Eq a => Hit' a -> Hit' a -> Bool
/= :: Hit' a -> Hit' a -> Bool
Eq, Eq (Hit' a)
Eq (Hit' a) =>
(Int -> Hit' a -> Int) -> (Hit' a -> Int) -> Hashable (Hit' a)
Int -> Hit' a -> Int
Hit' a -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Hashable a => Eq (Hit' a)
forall a. Hashable a => Int -> Hit' a -> Int
forall a. Hashable a => Hit' a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Hit' a -> Int
hashWithSalt :: Int -> Hit' a -> Int
$chash :: forall a. Hashable a => Hit' a -> Int
hash :: Hit' a -> Int
Hashable)

instance (Ord a) => Ord (Hit' a) where
  compare :: Hit' a -> Hit' a -> Ordering
compare = (Hit' a -> a) -> Hit' a -> Hit' a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Hit a -> a
forall a. Hit a -> a
hittime (Hit a -> a) -> (Hit' a -> Hit a) -> Hit' a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hit' a -> Hit a
forall a. Hit' a -> Hit a
unHit')
  {-# INLINE compare #-}

instance (Fractional a, Num a) => Bounded (Hit' a) where
  minBound :: Hit' a
minBound = Hit a -> Hit' a
forall a. Hit a -> Hit' a
Hit' (Hit a -> Hit' a) -> Hit a -> Hit' a
forall a b. (a -> b) -> a -> b
$ a -> V3 a -> V3 a -> Hit a
forall a. a -> V3 a -> V3 a -> Hit a
Hit a
0 V3 a
forall a. Num a => V3 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero V3 a
forall a. Num a => V3 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero -- no negative time
  maxBound :: Hit' a
maxBound = Hit a -> Hit' a
forall a. Hit a -> Hit' a
Hit' (Hit a -> Hit' a) -> Hit a -> Hit' a
forall a b. (a -> b) -> a -> b
$ a -> V3 a -> V3 a -> Hit a
forall a. a -> V3 a -> V3 a -> Hit a
Hit a
forall a. Fractional a => a
posinf V3 a
forall a. Num a => V3 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero V3 a
forall a. Num a => V3 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero -- hit at infinity
  {-# INLINE minBound #-}
  {-# INLINE maxBound #-}

-- | existential 'Shape' type but where numeric type is erased
--
-- see also: 'castshape1'
data SomeShape1 a
  = forall s.
    ( Typeable (s a),
      Show (s a),
      Shape s
    ) =>
    SomeShape1 (s a)
  deriving (Typeable)

instance Show (SomeShape1 a) where
  show :: SomeShape1 a -> String
show (SomeShape1 s a
s) = s a -> String
forall a. Show a => a -> String
show s a
s

instance Shape SomeShape1 where
  crossing :: forall a. RealFloat a => V3 a -> V3 a -> SomeShape1 a -> Hit a
crossing V3 a
v V3 a
d (SomeShape1 s a
s) = V3 a -> V3 a -> s a -> Hit a
forall a. RealFloat a => V3 a -> V3 a -> s a -> Hit a
forall (s :: * -> *) a.
(Shape s, RealFloat a) =>
V3 a -> V3 a -> s a -> Hit a
crossing V3 a
v V3 a
d s a
s
  intersecting :: forall a.
(Fractional a, Ord a) =>
SomeShape1 a -> SomeShape1 a -> Bool
intersecting (SomeShape1 s a
s1) (SomeShape1 s a
s2)
    | Just s a
s3 <- s a -> Maybe (s a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast s a
s2 = s a -> s a -> Bool
forall a. (Fractional a, Ord a) => s a -> s a -> Bool
forall (s :: * -> *) a.
(Shape s, Fractional a, Ord a) =>
s a -> s a -> Bool
intersecting s a
s1 s a
s3
    | Bool
otherwise = ManyBoxes [] a -> ManyBoxes [] a -> Bool
forall a.
(Fractional a, Ord a) =>
ManyBoxes [] a -> ManyBoxes [] a -> Bool
forall (s :: * -> *) a.
(Shape s, Fractional a, Ord a) =>
s a -> s a -> Bool
intersecting (s a -> ManyBoxes [] a
forall a. s a -> ManyBoxes [] a
forall (s :: * -> *) a. Shape s => s a -> ManyBoxes [] a
tomanyboxes s a
s1) (s a -> ManyBoxes [] a
forall a. s a -> ManyBoxes [] a
forall (s :: * -> *) a. Shape s => s a -> ManyBoxes [] a
tomanyboxes s a
s2)
  hitting :: forall a.
RealFloat a =>
V3 a -> SomeShape1 a -> SomeShape1 a -> Hit a
hitting V3 a
v (SomeShape1 s a
s1) (SomeShape1 s a
s2)
    | Just s a
s3 <- s a -> Maybe (s a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast s a
s2 = V3 a -> s a -> s a -> Hit a
forall a. RealFloat a => V3 a -> s a -> s a -> Hit a
forall (s :: * -> *) a.
(Shape s, RealFloat a) =>
V3 a -> s a -> s a -> Hit a
hitting V3 a
v s a
s1 s a
s3
    | Bool
otherwise = V3 a -> ManyBoxes [] a -> ManyBoxes [] a -> Hit a
forall a.
RealFloat a =>
V3 a -> ManyBoxes [] a -> ManyBoxes [] a -> Hit a
forall (s :: * -> *) a.
(Shape s, RealFloat a) =>
V3 a -> s a -> s a -> Hit a
hitting V3 a
v (s a -> ManyBoxes [] a
forall a. s a -> ManyBoxes [] a
forall (s :: * -> *) a. Shape s => s a -> ManyBoxes [] a
tomanyboxes s a
s1) (s a -> ManyBoxes [] a
forall a. s a -> ManyBoxes [] a
forall (s :: * -> *) a. Shape s => s a -> ManyBoxes [] a
tomanyboxes s a
s2)
  translate :: forall a. Num a => V3 a -> SomeShape1 a -> SomeShape1 a
translate V3 a
v (SomeShape1 s a
s) = s a -> SomeShape1 a
forall a (s :: * -> *).
(Typeable (s a), Show (s a), Shape s) =>
s a -> SomeShape1 a
SomeShape1 (V3 a -> s a -> s a
forall a. Num a => V3 a -> s a -> s a
forall (s :: * -> *) a. (Shape s, Num a) => V3 a -> s a -> s a
translate V3 a
v s a
s)
  corners :: forall a. (Fractional a, Ord a) => SomeShape1 a -> V2 (V3 a)
corners (SomeShape1 s a
s) = s a -> V2 (V3 a)
forall a. (Fractional a, Ord a) => s a -> V2 (V3 a)
forall (s :: * -> *) a.
(Shape s, Fractional a, Ord a) =>
s a -> V2 (V3 a)
corners s a
s
  tomanyboxes :: forall a. SomeShape1 a -> ManyBoxes [] a
tomanyboxes (SomeShape1 s a
s) = s a -> ManyBoxes [] a
forall a. s a -> ManyBoxes [] a
forall (s :: * -> *) a. Shape s => s a -> ManyBoxes [] a
tomanyboxes s a
s

-- | cast a 'SomeShape1' to a specific type
castshape1 :: (Typeable b) => SomeShape1 a -> Maybe b
castshape1 :: forall b a. Typeable b => SomeShape1 a -> Maybe b
castshape1 (SomeShape1 s a
s) = s a -> Maybe b
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast s a
s

-- | an AABB type class used for collision detection and resolution
class Shape s where
  -- | check if two shapes intersect
  intersecting :: (Fractional a, Ord a) => s a -> s a -> Bool

  -- | check if a ray will hit the shape and return the hit data
  crossing :: (RealFloat a) => V3 a -> V3 a -> s a -> Hit a

  -- | check if the first shape will collide into the second shape
  -- if it moves with the given displacement
  hitting :: (RealFloat a) => V3 a -> s a -> s a -> Hit a

  -- | translate the shape by the given displacement
  translate :: (Num a) => V3 a -> s a -> s a

  -- | the locations of the lower and higher corners of the shape
  -- respectively
  corners :: (Fractional a, Ord a) => s a -> V2 (V3 a)

  -- | convert a 'Shape' to a 'ManyBoxes' of 'Box'es with a list container,
  -- which is a canonical form for 'ManyBoxes'
  tomanyboxes :: s a -> ManyBoxes [] a

  -- | the center of the shape
  scenter :: (Fractional a, Ord a) => s a -> V3 a
  scenter s a
s = (V2 (V3 a) -> V3 a
forall a. Num a => V2 a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (V2 (V3 a) -> V3 a) -> (s a -> V2 (V3 a)) -> s a -> V3 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s a -> V2 (V3 a)
forall a. (Fractional a, Ord a) => s a -> V2 (V3 a)
forall (s :: * -> *) a.
(Shape s, Fractional a, Ord a) =>
s a -> V2 (V3 a)
corners (s a -> V3 a) -> s a -> V3 a
forall a b. (a -> b) -> a -> b
$ s a
s) V3 a -> (a -> a) -> V3 a
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2) -- not robust to large numbers
  {-# INLINE scenter #-}

  -- | the dimensions of the shape
  sdimensions :: (Fractional a, Ord a) => s a -> V3 a
  sdimensions s a
s = let V2 V3 a
l V3 a
h = s a -> V2 (V3 a)
forall a. (Fractional a, Ord a) => s a -> V2 (V3 a)
forall (s :: * -> *) a.
(Shape s, Fractional a, Ord a) =>
s a -> V2 (V3 a)
corners s a
s in V3 a
h V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
- V3 a
l
  {-# INLINE sdimensions #-}

v2fst :: V2 a -> a
v2fst :: forall a. V2 a -> a
v2fst (V2 a
a a
_) = a
a

v2snd :: V2 a -> a
v2snd :: forall a. V2 a -> a
v2snd (V2 a
_ a
b) = a
b

-- | the upper corner of a shape
shicorner :: (Shape s, Fractional a, Ord a) => s a -> V3 a
shicorner :: forall (s :: * -> *) a.
(Shape s, Fractional a, Ord a) =>
s a -> V3 a
shicorner = V2 (V3 a) -> V3 a
forall a. V2 a -> a
v2snd (V2 (V3 a) -> V3 a) -> (s a -> V2 (V3 a)) -> s a -> V3 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s a -> V2 (V3 a)
forall a. (Fractional a, Ord a) => s a -> V2 (V3 a)
forall (s :: * -> *) a.
(Shape s, Fractional a, Ord a) =>
s a -> V2 (V3 a)
corners
{-# INLINE shicorner #-}

-- | the lower corner of a shape
slocorner :: (Shape s, Fractional a, Ord a) => s a -> V3 a
slocorner :: forall (s :: * -> *) a.
(Shape s, Fractional a, Ord a) =>
s a -> V3 a
slocorner = V2 (V3 a) -> V3 a
forall a. V2 a -> a
v2fst (V2 (V3 a) -> V3 a) -> (s a -> V2 (V3 a)) -> s a -> V3 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s a -> V2 (V3 a)
forall a. (Fractional a, Ord a) => s a -> V2 (V3 a)
forall (s :: * -> *) a.
(Shape s, Fractional a, Ord a) =>
s a -> V2 (V3 a)
corners
{-# INLINE slocorner #-}

-- | a box in 3D space, located either relatively or absolutely
data Box a = Box
  { -- | the dimensions of the box
    forall a. Box a -> V3 a
dimensions :: !(V3 a),
    -- | the center of the box
    forall a. Box a -> V3 a
center :: !(V3 a)
  }
  deriving stock (Int -> Box a -> ShowS
[Box a] -> ShowS
Box a -> String
(Int -> Box a -> ShowS)
-> (Box a -> String) -> ([Box a] -> ShowS) -> Show (Box a)
forall a. Show a => Int -> Box a -> ShowS
forall a. Show a => [Box a] -> ShowS
forall a. Show a => Box a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Box a -> ShowS
showsPrec :: Int -> Box a -> ShowS
$cshow :: forall a. Show a => Box a -> String
show :: Box a -> String
$cshowList :: forall a. Show a => [Box a] -> ShowS
showList :: [Box a] -> ShowS
Show, Box a -> Box a -> Bool
(Box a -> Box a -> Bool) -> (Box a -> Box a -> Bool) -> Eq (Box a)
forall a. Eq a => Box a -> Box a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Box a -> Box a -> Bool
== :: Box a -> Box a -> Bool
$c/= :: forall a. Eq a => Box a -> Box a -> Bool
/= :: Box a -> Box a -> Bool
Eq, (forall x. Box a -> Rep (Box a) x)
-> (forall x. Rep (Box a) x -> Box a) -> Generic (Box a)
forall x. Rep (Box a) x -> Box a
forall x. Box a -> Rep (Box a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Box a) x -> Box a
forall a x. Box a -> Rep (Box a) x
$cfrom :: forall a x. Box a -> Rep (Box a) x
from :: forall x. Box a -> Rep (Box a) x
$cto :: forall a x. Rep (Box a) x -> Box a
to :: forall x. Rep (Box a) x -> Box a
Generic, Typeable, (forall a b. (a -> b) -> Box a -> Box b)
-> (forall a b. a -> Box b -> Box a) -> Functor Box
forall a b. a -> Box b -> Box a
forall a b. (a -> b) -> Box a -> Box b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Box a -> Box b
fmap :: forall a b. (a -> b) -> Box a -> Box b
$c<$ :: forall a b. a -> Box b -> Box a
<$ :: forall a b. a -> Box b -> Box a
Functor, Typeable (Box a)
Typeable (Box a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Box a -> c (Box a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Box a))
-> (Box a -> Constr)
-> (Box a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Box a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Box a)))
-> ((forall b. Data b => b -> b) -> Box a -> Box a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Box a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Box a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Box a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Box a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Box a -> m (Box a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Box a -> m (Box a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Box a -> m (Box a))
-> Data (Box a)
Box a -> Constr
Box a -> DataType
(forall b. Data b => b -> b) -> Box a -> Box a
forall a. Data a => Typeable (Box a)
forall a. Data a => Box a -> Constr
forall a. Data a => Box a -> DataType
forall a. Data a => (forall b. Data b => b -> b) -> Box a -> Box a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Box a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Box a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Box a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Box a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Box a -> m (Box a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Box a -> m (Box a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Box a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Box a -> c (Box a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Box a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Box a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Box a -> u
forall u. (forall d. Data d => d -> u) -> Box a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Box a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Box a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Box a -> m (Box a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Box a -> m (Box a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Box a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Box a -> c (Box a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Box a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Box a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Box a -> c (Box a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Box a -> c (Box a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Box a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Box a)
$ctoConstr :: forall a. Data a => Box a -> Constr
toConstr :: Box a -> Constr
$cdataTypeOf :: forall a. Data a => Box a -> DataType
dataTypeOf :: Box a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Box a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Box a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Box a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Box a))
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Box a -> Box a
gmapT :: (forall b. Data b => b -> b) -> Box a -> Box a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Box a -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Box a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Box a -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Box a -> r
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Box a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Box a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Box a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Box a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Box a -> m (Box a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Box a -> m (Box a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Box a -> m (Box a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Box a -> m (Box a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Box a -> m (Box a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Box a -> m (Box a)
Data)
  deriving anyclass (Eq (Box a)
Eq (Box a) =>
(Int -> Box a -> Int) -> (Box a -> Int) -> Hashable (Box a)
Int -> Box a -> Int
Box a -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Hashable a => Eq (Box a)
forall a. Hashable a => Int -> Box a -> Int
forall a. Hashable a => Box a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Box a -> Int
hashWithSalt :: Int -> Box a -> Int
$chash :: forall a. Hashable a => Box a -> Int
hash :: Box a -> Int
Hashable)

instance Applicative Box where
  pure :: forall a. a -> Box a
pure a
x = V3 a -> V3 a -> Box a
forall a. V3 a -> V3 a -> Box a
Box (a -> V3 a
forall a. a -> V3 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x) (a -> V3 a
forall a. a -> V3 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  {-# INLINE pure #-}
  Box V3 (a -> b)
d1 V3 (a -> b)
c1 <*> :: forall a b. Box (a -> b) -> Box a -> Box b
<*> Box V3 a
d2 V3 a
c2 = V3 b -> V3 b -> Box b
forall a. V3 a -> V3 a -> Box a
Box (V3 (a -> b)
d1 V3 (a -> b) -> V3 a -> V3 b
forall a b. V3 (a -> b) -> V3 a -> V3 b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> V3 a
d2) (V3 (a -> b)
c1 V3 (a -> b) -> V3 a -> V3 b
forall a b. V3 (a -> b) -> V3 a -> V3 b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> V3 a
c2)
  {-# INLINE (<*>) #-}

-- used to define the Box' pattern
-- the expression is kind of nonsense, but it just needs to
-- work in a formal way so we can use the pattern
chgbox_ :: (Fractional a) => Box a -> Box a
chgbox_ :: forall a. Fractional a => Box a -> Box a
chgbox_ Box a
b = V3 a -> V3 a -> Box a
forall a. V3 a -> V3 a -> Box a
Box (Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
locorner Box a
b) (Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
hicorner Box a
b)

-- | bidrectional pattern for 'Box' but with corner locations (low to high)
--
-- you can use the 'locorner'' and 'hicorner'' patterns to extract the corners,
-- respectively
pattern Box' :: (Fractional a) => V3 a -> V3 a -> Box a
pattern $mBox' :: forall {r} {a}.
Fractional a =>
Box a -> (V3 a -> V3 a -> r) -> ((# #) -> r) -> r
$bBox' :: forall a. Fractional a => V3 a -> V3 a -> Box a
Box' {forall a. Fractional a => Box a -> V3 a
locorner', forall a. Fractional a => Box a -> V3 a
hicorner'} <- (chgbox_ -> Box locorner' hicorner')
  where
    Box' V3 a
l V3 a
h = V3 a -> V3 a -> Box a
forall a. V3 a -> V3 a -> Box a
Box (V3 a
h V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
- V3 a
l) ((V3 a
h V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
+ V3 a
l) V3 a -> a -> V3 a
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ a
2)

{-# COMPLETE Box' #-}

-- | a box from the low and high corners
boxfromcorners ::
  (Fractional a) =>
  -- | low corner
  V3 a ->
  -- | high corner
  V3 a ->
  -- | the box
  Box a
boxfromcorners :: forall a. Fractional a => V3 a -> V3 a -> Box a
boxfromcorners V3 a
l V3 a
h = V3 a -> V3 a -> Box a
forall a. V3 a -> V3 a -> Box a
Box (V3 a
h V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
- V3 a
l) ((V3 a
h V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
+ V3 a
l) V3 a -> a -> V3 a
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ a
2)

-- | a newtype over a 'Foldable' 'Functor' container of 'Box'es
--
-- the low and high corners are those of the smallest bounding box
newtype ManyBoxes f a = ManyBoxes (f (Box a))
  deriving stock ((forall x. ManyBoxes f a -> Rep (ManyBoxes f a) x)
-> (forall x. Rep (ManyBoxes f a) x -> ManyBoxes f a)
-> Generic (ManyBoxes f a)
forall x. Rep (ManyBoxes f a) x -> ManyBoxes f a
forall x. ManyBoxes f a -> Rep (ManyBoxes f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) a x. Rep (ManyBoxes f a) x -> ManyBoxes f a
forall (f :: * -> *) a x. ManyBoxes f a -> Rep (ManyBoxes f a) x
$cfrom :: forall (f :: * -> *) a x. ManyBoxes f a -> Rep (ManyBoxes f a) x
from :: forall x. ManyBoxes f a -> Rep (ManyBoxes f a) x
$cto :: forall (f :: * -> *) a x. Rep (ManyBoxes f a) x -> ManyBoxes f a
to :: forall x. Rep (ManyBoxes f a) x -> ManyBoxes f a
Generic, Typeable)

-- | a type alias for a list of 'Box'es
-- (canonical form for 'ManyBoxes')
type ManyBoxes_ a = ManyBoxes [] a

deriving stock instance
  (Typeable f, Typeable a, Data (f (Box a))) =>
  Data (ManyBoxes f a)

instance (Eq (f (Box a))) => Eq (ManyBoxes f a) where
  ManyBoxes f (Box a)
a == :: ManyBoxes f a -> ManyBoxes f a -> Bool
== ManyBoxes f (Box a)
b = f (Box a)
a f (Box a) -> f (Box a) -> Bool
forall a. Eq a => a -> a -> Bool
== f (Box a)
b
  {-# INLINE (==) #-}

instance (Ord (f (Box a))) => Ord (ManyBoxes f a) where
  compare :: ManyBoxes f a -> ManyBoxes f a -> Ordering
compare (ManyBoxes f (Box a)
a) (ManyBoxes f (Box a)
b) = f (Box a) -> f (Box a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare f (Box a)
a f (Box a)
b
  {-# INLINE compare #-}

instance (Functor f) => Functor (ManyBoxes f) where
  fmap :: forall a b. (a -> b) -> ManyBoxes f a -> ManyBoxes f b
fmap a -> b
f (ManyBoxes f (Box a)
boxes) = f (Box b) -> ManyBoxes f b
forall (f :: * -> *) a. f (Box a) -> ManyBoxes f a
ManyBoxes (f (Box b) -> ManyBoxes f b) -> f (Box b) -> ManyBoxes f b
forall a b. (a -> b) -> a -> b
$ (Box a -> Box b) -> f (Box a) -> f (Box b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Box a -> Box b
g f (Box a)
boxes
    where
      g :: Box a -> Box b
g (Box V3 a
d V3 a
c) = V3 b -> V3 b -> Box b
forall a. V3 a -> V3 a -> Box a
Box (a -> b
f (a -> b) -> V3 a -> V3 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V3 a
d) (a -> b
f (a -> b) -> V3 a -> V3 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V3 a
c)
  {-# INLINE fmap #-}

instance (Hashable (f (Box a))) => Hashable (ManyBoxes f a) where
  hashWithSalt :: Int -> ManyBoxes f a -> Int
hashWithSalt Int
s (ManyBoxes f (Box a)
boxes) = Int -> f (Box a) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s f (Box a)
boxes
  {-# INLINE hashWithSalt #-}

-- | Lens for the dimensions of the box
_dimensions :: Lens' (Box a) (V3 a)
_dimensions :: forall a (f :: * -> *).
Functor f =>
(V3 a -> f (V3 a)) -> Box a -> f (Box a)
_dimensions = (Box a -> V3 a)
-> (Box a -> V3 a -> Box a) -> Lens (Box a) (Box a) (V3 a) (V3 a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Box a -> V3 a
forall a. Box a -> V3 a
dimensions \Box a
b V3 a
d -> Box a
b {dimensions = d}
{-# INLINE _dimensions #-}

-- | Lens for the center of the box
_center :: Lens' (Box a) (V3 a)
_center :: forall a (f :: * -> *).
Functor f =>
(V3 a -> f (V3 a)) -> Box a -> f (Box a)
_center = (Box a -> V3 a)
-> (Box a -> V3 a -> Box a) -> Lens (Box a) (Box a) (V3 a) (V3 a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Box a -> V3 a
forall a. Box a -> V3 a
center \Box a
b V3 a
c -> Box a
b {center = c}
{-# INLINE _center #-}

-- | Lens for the lower corner of the box
_lcorner :: (Fractional a) => Lens' (Box a) (V3 a)
_lcorner :: forall a. Fractional a => Lens' (Box a) (V3 a)
_lcorner = (Box a -> V3 a)
-> (Box a -> V3 a -> Box a) -> Lens (Box a) (Box a) (V3 a) (V3 a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
locorner \Box a
b V3 a
l -> Box a
b {center = l + dimensions b ^/ 2}
{-# INLINE _lcorner #-}

-- | Lens for the higher corner of the box
_hcorner :: (Fractional a) => Lens' (Box a) (V3 a)
_hcorner :: forall a. Fractional a => Lens' (Box a) (V3 a)
_hcorner = (Box a -> V3 a)
-> (Box a -> V3 a -> Box a) -> Lens (Box a) (Box a) (V3 a) (V3 a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
hicorner \Box a
b V3 a
h -> Box a
b {center = h - dimensions b ^/ 2}
{-# INLINE _hcorner #-}

instance Shape Box where
  crossing :: forall a. RealFloat a => V3 a -> V3 a -> Box a -> Hit a
crossing V3 a
origin V3 a
displacement Box a
shape =
    let v2sort :: V2 a -> V2 a
v2sort (V2 a
x a
y)
          | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
x a
y
          | Bool
otherwise = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
y a
x
        ! :: V3 a -> Rep V3 -> a
(!) = V3 a -> Rep V3 -> a
forall a. V3 a -> Rep V3 -> a
forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index
        times :: V3 (V2 a)
times = (Rep V3 -> V2 a) -> V3 (V2 a)
forall a. (Rep V3 -> a) -> V3 a
forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate \Rep V3
i ->
          let l :: V3 a
l = Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
locorner Box a
shape
              h :: V3 a
h = Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
hicorner Box a
shape
              x :: a
x = (V3 a
l V3 a -> Rep V3 -> a
forall a. V3 a -> Rep V3 -> a
! Rep V3
i a -> a -> a
forall a. Num a => a -> a -> a
- V3 a
origin V3 a -> Rep V3 -> a
forall a. V3 a -> Rep V3 -> a
! Rep V3
i) a -> a -> a
forall a. Fractional a => a -> a -> a
/ V3 a
displacement V3 a -> Rep V3 -> a
forall a. V3 a -> Rep V3 -> a
! Rep V3
i
              y :: a
y = (V3 a
h V3 a -> Rep V3 -> a
forall a. V3 a -> Rep V3 -> a
! Rep V3
i a -> a -> a
forall a. Num a => a -> a -> a
- V3 a
origin V3 a -> Rep V3 -> a
forall a. V3 a -> Rep V3 -> a
! Rep V3
i) a -> a -> a
forall a. Fractional a => a -> a -> a
/ V3 a
displacement V3 a -> Rep V3 -> a
forall a. V3 a -> Rep V3 -> a
! Rep V3
i
           in V2 a -> V2 a
forall {a}. Ord a => V2 a -> V2 a
v2sort (V2 a -> V2 a) -> V2 a -> V2 a
forall a b. (a -> b) -> a -> b
$ a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
x a
y
        nonans :: V4 a -> Bool
nonans = Bool -> Bool
not (Bool -> Bool) -> (V4 a -> Bool) -> V4 a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> V4 a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
forall a. RealFloat a => a -> Bool
isNaN
        -- sequenceA = transpose; sequenceA :: V3 (V2 a) -> V2 (V3 a)
        -- vector upgrades a V3 to V4 but sets fourth component to 0
        -- point does the same but sets fourth component to 1
        V2 (V3 a -> V4 a
forall a. Num a => V3 a -> V4 a
vector -> V4 a
tenter) (V3 a -> V4 a
forall a. Num a => V3 a -> V4 a
point -> V4 a
tleave) = V3 (V2 a) -> V2 (V3 a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => V3 (f a) -> f (V3 a)
sequenceA V3 (V2 a)
times
        t :: a
t = V4 a -> a
forall a. Ord a => V4 a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum V4 a
tenter
     in if V4 a -> Bool
nonans V4 a
tenter Bool -> Bool -> Bool
&& V4 a -> Bool
nonans V4 a
tleave Bool -> Bool -> Bool
&& a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< V4 a -> a
forall a. Ord a => V4 a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum V4 a
tleave
          then
            Hit
              { hittime :: a
hittime = a
t,
                hitwhere :: V3 a
hitwhere = V3 a
origin V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
+ a
t a -> V3 a -> V3 a
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V3 a
displacement,
                hitnorm :: V3 a
hitnorm =
                  let p1m1 :: Bool -> a
p1m1 Bool
True = a
1
                      p1m1 Bool
_ = -a
1
                   in (Rep V3 -> a) -> V3 a
forall a. (Rep V3 -> a) -> V3 a
forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate \Rep V3
i ->
                        if a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (V4 a
tenter V4 a -> Getting (V3 a) (V4 a) (V3 a) -> V3 a
forall s a. s -> Getting a s a -> a
^. Getting (V3 a) (V4 a) (V3 a)
forall a. Lens' (V4 a) (V3 a)
forall (t :: * -> *) a. R3 t => Lens' (t a) (V3 a)
_xyz) V3 a -> Rep V3 -> a
forall a. V3 a -> Rep V3 -> a
! Rep V3
i
                          then Bool -> a
forall {a}. Num a => Bool -> a
p1m1 (Bool -> a) -> Bool -> a
forall a b. (a -> b) -> a -> b
$ V3 a
displacement V3 a -> Rep V3 -> a
forall a. V3 a -> Rep V3 -> a
! Rep V3
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0
                          else a
0
              }
          else Hit a
forall a. Fractional a => Hit a
infhit

  -- moving = displacement from t = 0 to t = 1
  -- 'this' is the box that is moving
  -- into 'that' box
  hitting :: forall a. RealFloat a => V3 a -> Box a -> Box a -> Hit a
hitting V3 a
moving Box a
this Box a
that =
    let l :: V3 a
l = Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
locorner Box a
that
        h :: V3 a
h = Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
hicorner Box a
that
        d :: V3 a
d = Box a -> V3 a
forall a. Box a -> V3 a
dimensions Box a
this
        -- reduce box-box collision to ray-box collision
        --  1. shrink 'this' box into a point
        --  2. expand 'that' box by the same amount in each direction
        (V3 a
l', V3 a
h') = (V3 a
l V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
- V3 a
d V3 a -> a -> V3 a
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ a
2, V3 a
h V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
+ V3 a
d V3 a -> a -> V3 a
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ a
2)
     in V3 a -> V3 a -> Box a -> Hit a
forall a. RealFloat a => V3 a -> V3 a -> Box a -> Hit a
forall (s :: * -> *) a.
(Shape s, RealFloat a) =>
V3 a -> V3 a -> s a -> Hit a
crossing
          do Box a -> V3 a
forall a. Box a -> V3 a
center Box a
this
          do V3 a
moving
          do V3 a -> V3 a -> Box a
forall a. Fractional a => V3 a -> V3 a -> Box a
boxfromcorners V3 a
l' V3 a
h'
  intersecting :: forall a. (Fractional a, Ord a) => Box a -> Box a -> Bool
intersecting Box a
this Box a
that =
    let lotest :: Bool
lotest = V3 Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (V3 Bool -> Bool) -> V3 Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> V3 a -> V3 a -> V3 Bool
forall a b c. (a -> b -> c) -> V3 a -> V3 b -> V3 c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) (Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
locorner Box a
this) (Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
hicorner Box a
that)
        hitest :: Bool
hitest = V3 Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (V3 Bool -> Bool) -> V3 Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> V3 a -> V3 a -> V3 Bool
forall a b c. (a -> b -> c) -> V3 a -> V3 b -> V3 c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) (Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
hicorner Box a
this) (Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
locorner Box a
that)
     in Bool
lotest Bool -> Bool -> Bool
&& Bool
hitest
  translate :: forall a. Num a => V3 a -> Box a -> Box a
translate V3 a
displacement Box a
box = Box a
box {center = displacement + center box}
  corners :: forall a. (Fractional a, Ord a) => Box a -> V2 (V3 a)
corners Box a
box = V3 a -> V3 a -> V2 (V3 a)
forall a. a -> a -> V2 a
V2 (Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
locorner Box a
box) (Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
hicorner Box a
box)
  tomanyboxes :: forall a. Box a -> ManyBoxes [] a
tomanyboxes = [Box a] -> ManyBoxes [] a
forall (f :: * -> *) a. f (Box a) -> ManyBoxes f a
ManyBoxes ([Box a] -> ManyBoxes [] a)
-> (Box a -> [Box a]) -> Box a -> ManyBoxes [] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box a -> [Box a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  scenter :: forall a. (Fractional a, Ord a) => Box a -> V3 a
scenter = Box a -> V3 a
forall a. Box a -> V3 a
center
  sdimensions :: forall a. (Fractional a, Ord a) => Box a -> V3 a
sdimensions = Box a -> V3 a
forall a. Box a -> V3 a
dimensions

-- | a box with zero dimensions and center
boxzero :: (Num a) => Box a
boxzero :: forall a. Num a => Box a
boxzero = V3 a -> V3 a -> Box a
forall a. V3 a -> V3 a -> Box a
Box V3 a
forall a. Num a => V3 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero V3 a
forall a. Num a => V3 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero

-- | the location of the lower corner of the box
locorner :: (Fractional a) => Box a -> V3 a
locorner :: forall a. Fractional a => Box a -> V3 a
locorner (Box V3 a
d V3 a
c) = V3 a
c V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
- V3 a
d V3 a -> a -> V3 a
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ a
2

-- | the location of the higher corner of the box
hicorner :: (Fractional a) => Box a -> V3 a
hicorner :: forall a. Fractional a => Box a -> V3 a
hicorner (Box V3 a
d V3 a
c) = V3 a
c V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
+ V3 a
d V3 a -> a -> V3 a
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ a
2

instance (Show (f (Box a))) => Show (ManyBoxes f a) where
  show :: ManyBoxes f a -> String
show (ManyBoxes f (Box a)
boxes) = f (Box a) -> String
forall a. Show a => a -> String
show f (Box a)
boxes

-- | this one implements 'Bounded' as well
newtype Arg' a b = Arg' (Arg a b)
  deriving newtype (Arg' a b -> Arg' a b -> Bool
(Arg' a b -> Arg' a b -> Bool)
-> (Arg' a b -> Arg' a b -> Bool) -> Eq (Arg' a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. Eq a => Arg' a b -> Arg' a b -> Bool
$c== :: forall a b. Eq a => Arg' a b -> Arg' a b -> Bool
== :: Arg' a b -> Arg' a b -> Bool
$c/= :: forall a b. Eq a => Arg' a b -> Arg' a b -> Bool
/= :: Arg' a b -> Arg' a b -> Bool
Eq, Eq (Arg' a b)
Eq (Arg' a b) =>
(Arg' a b -> Arg' a b -> Ordering)
-> (Arg' a b -> Arg' a b -> Bool)
-> (Arg' a b -> Arg' a b -> Bool)
-> (Arg' a b -> Arg' a b -> Bool)
-> (Arg' a b -> Arg' a b -> Bool)
-> (Arg' a b -> Arg' a b -> Arg' a b)
-> (Arg' a b -> Arg' a b -> Arg' a b)
-> Ord (Arg' a b)
Arg' a b -> Arg' a b -> Bool
Arg' a b -> Arg' a b -> Ordering
Arg' a b -> Arg' a b -> Arg' a b
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 b. Ord a => Eq (Arg' a b)
forall a b. Ord a => Arg' a b -> Arg' a b -> Bool
forall a b. Ord a => Arg' a b -> Arg' a b -> Ordering
forall a b. Ord a => Arg' a b -> Arg' a b -> Arg' a b
$ccompare :: forall a b. Ord a => Arg' a b -> Arg' a b -> Ordering
compare :: Arg' a b -> Arg' a b -> Ordering
$c< :: forall a b. Ord a => Arg' a b -> Arg' a b -> Bool
< :: Arg' a b -> Arg' a b -> Bool
$c<= :: forall a b. Ord a => Arg' a b -> Arg' a b -> Bool
<= :: Arg' a b -> Arg' a b -> Bool
$c> :: forall a b. Ord a => Arg' a b -> Arg' a b -> Bool
> :: Arg' a b -> Arg' a b -> Bool
$c>= :: forall a b. Ord a => Arg' a b -> Arg' a b -> Bool
>= :: Arg' a b -> Arg' a b -> Bool
$cmax :: forall a b. Ord a => Arg' a b -> Arg' a b -> Arg' a b
max :: Arg' a b -> Arg' a b -> Arg' a b
$cmin :: forall a b. Ord a => Arg' a b -> Arg' a b -> Arg' a b
min :: Arg' a b -> Arg' a b -> Arg' a b
Ord, (forall x. Arg' a b -> Rep (Arg' a b) x)
-> (forall x. Rep (Arg' a b) x -> Arg' a b) -> Generic (Arg' a b)
forall x. Rep (Arg' a b) x -> Arg' a b
forall x. Arg' a b -> Rep (Arg' a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (Arg' a b) x -> Arg' a b
forall a b x. Arg' a b -> Rep (Arg' a b) x
$cfrom :: forall a b x. Arg' a b -> Rep (Arg' a b) x
from :: forall x. Arg' a b -> Rep (Arg' a b) x
$cto :: forall a b x. Rep (Arg' a b) x -> Arg' a b
to :: forall x. Rep (Arg' a b) x -> Arg' a b
Generic, Typeable, Eq (Arg' a b)
Eq (Arg' a b) =>
(Int -> Arg' a b -> Int)
-> (Arg' a b -> Int) -> Hashable (Arg' a b)
Int -> Arg' a b -> Int
Arg' a b -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a b. Hashable a => Eq (Arg' a b)
forall a b. Hashable a => Int -> Arg' a b -> Int
forall a b. Hashable a => Arg' a b -> Int
$chashWithSalt :: forall a b. Hashable a => Int -> Arg' a b -> Int
hashWithSalt :: Int -> Arg' a b -> Int
$chash :: forall a b. Hashable a => Arg' a b -> Int
hash :: Arg' a b -> Int
Hashable, (forall a b. (a -> b) -> Arg' a a -> Arg' a b)
-> (forall a b. a -> Arg' a b -> Arg' a a) -> Functor (Arg' a)
forall a b. a -> Arg' a b -> Arg' a a
forall a b. (a -> b) -> Arg' a a -> Arg' a b
forall a a b. a -> Arg' a b -> Arg' a a
forall a a b. (a -> b) -> Arg' a a -> Arg' a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> Arg' a a -> Arg' a b
fmap :: forall a b. (a -> b) -> Arg' a a -> Arg' a b
$c<$ :: forall a a b. a -> Arg' a b -> Arg' a a
<$ :: forall a b. a -> Arg' a b -> Arg' a a
Functor)

instance (Fractional a, Bounded b) => Bounded (Arg' a b) where
  minBound :: Arg' a b
minBound = Arg a b -> Arg' a b
forall a b. Arg a b -> Arg' a b
Arg' (a -> b -> Arg a b
forall a b. a -> b -> Arg a b
Arg a
0 b
forall a. Bounded a => a
minBound)
  maxBound :: Arg' a b
maxBound = Arg a b -> Arg' a b
forall a b. Arg a b -> Arg' a b
Arg' (a -> b -> Arg a b
forall a b. a -> b -> Arg a b
Arg a
forall a. Fractional a => a
posinf b
forall a. Bounded a => a
maxBound)
  {-# INLINE minBound #-}
  {-# INLINE maxBound #-}

unarg :: Arg' a b -> b
unarg :: forall a b. Arg' a b -> b
unarg (Arg' (Arg a
_ b
b)) = b
b
{-# INLINE unarg #-}

-- if a ~ 'Box _', the find the box with the smallest hit time
arghitminboxf ::
  (Foldable f, Ord b, Fractional b) =>
  (a -> Hit b) -> f a -> Hit b
arghitminboxf :: forall (f :: * -> *) b a.
(Foldable f, Ord b, Fractional b) =>
(a -> Hit b) -> f a -> Hit b
arghitminboxf a -> Hit b
f =
  let g :: a -> Min (Arg' b (Hit' b))
g (a -> Hit b
f -> Hit b
h) = Arg' b (Hit' b) -> Min (Arg' b (Hit' b))
forall a. a -> Min a
Min (Arg' b (Hit' b) -> Min (Arg' b (Hit' b)))
-> Arg' b (Hit' b) -> Min (Arg' b (Hit' b))
forall a b. (a -> b) -> a -> b
$ Arg b (Hit' b) -> Arg' b (Hit' b)
forall a b. Arg a b -> Arg' a b
Arg' (Arg b (Hit' b) -> Arg' b (Hit' b))
-> Arg b (Hit' b) -> Arg' b (Hit' b)
forall a b. (a -> b) -> a -> b
$ b -> Hit' b -> Arg b (Hit' b)
forall a b. a -> b -> Arg a b
Arg (Hit b -> b
forall a. Hit a -> a
hittime Hit b
h) (Hit b -> Hit' b
forall a. Hit a -> Hit' a
Hit' Hit b
h)
   in Hit' b -> Hit b
forall a. Hit' a -> Hit a
unHit' (Hit' b -> Hit b) -> (f a -> Hit' b) -> f a -> Hit b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg' b (Hit' b) -> Hit' b
forall a b. Arg' a b -> b
unarg (Arg' b (Hit' b) -> Hit' b)
-> (f a -> Arg' b (Hit' b)) -> f a -> Hit' b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Min (Arg' b (Hit' b)) -> Arg' b (Hit' b)
forall a. Min a -> a
getMin (Min (Arg' b (Hit' b)) -> Arg' b (Hit' b))
-> (f a -> Min (Arg' b (Hit' b))) -> f a -> Arg' b (Hit' b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Min (Arg' b (Hit' b))) -> f a -> Min (Arg' b (Hit' b))
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' a -> Min (Arg' b (Hit' b))
g
{-# INLINE arghitminboxf #-}

instance (Functor f, Foldable f) => Shape (ManyBoxes f) where
  crossing :: forall a. RealFloat a => V3 a -> V3 a -> ManyBoxes f a -> Hit a
crossing V3 a
origin V3 a
displacement (ManyBoxes f (Box a)
boxes) =
    (Box a -> Hit a) -> f (Box a) -> Hit a
forall (f :: * -> *) b a.
(Foldable f, Ord b, Fractional b) =>
(a -> Hit b) -> f a -> Hit b
arghitminboxf (V3 a -> V3 a -> Box a -> Hit a
forall a. RealFloat a => V3 a -> V3 a -> Box a -> Hit a
forall (s :: * -> *) a.
(Shape s, RealFloat a) =>
V3 a -> V3 a -> s a -> Hit a
crossing V3 a
origin V3 a
displacement) f (Box a)
boxes

  -- find the first hitting collision
  hitting :: forall a.
RealFloat a =>
V3 a -> ManyBoxes f a -> ManyBoxes f a -> Hit a
hitting V3 a
moving (ManyBoxes f (Box a)
these) (ManyBoxes f (Box a)
those) =
    let firsthit :: f (Box a) -> Box a -> Hit a
firsthit f (Box a)
boxes Box a
box = (Box a -> Hit a) -> f (Box a) -> Hit a
forall (f :: * -> *) b a.
(Foldable f, Ord b, Fractional b) =>
(a -> Hit b) -> f a -> Hit b
arghitminboxf (V3 a -> Box a -> Box a -> Hit a
forall a. RealFloat a => V3 a -> Box a -> Box a -> Hit a
forall (s :: * -> *) a.
(Shape s, RealFloat a) =>
V3 a -> s a -> s a -> Hit a
hitting V3 a
moving Box a
box) f (Box a)
boxes
     in (Box a -> Hit a) -> f (Box a) -> Hit a
forall (f :: * -> *) b a.
(Foldable f, Ord b, Fractional b) =>
(a -> Hit b) -> f a -> Hit b
arghitminboxf (f (Box a) -> Box a -> Hit a
firsthit f (Box a)
those) f (Box a)
these

  -- check if any of the boxes intersect
  intersecting :: forall a.
(Fractional a, Ord a) =>
ManyBoxes f a -> ManyBoxes f a -> Bool
intersecting (ManyBoxes f (Box a)
these) (ManyBoxes f (Box a)
those) =
    (Box a -> Bool -> Bool) -> Bool -> f (Box a) -> Bool
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      ( \Box a
this Bool
r ->
          (Box a -> Bool -> Bool) -> Bool -> f (Box a) -> Bool
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            do \Box a
that Bool
s -> Box a -> Box a -> Bool
forall a. (Fractional a, Ord a) => Box a -> Box a -> Bool
forall (s :: * -> *) a.
(Shape s, Fractional a, Ord a) =>
s a -> s a -> Bool
intersecting Box a
this Box a
that Bool -> Bool -> Bool
|| Bool
s
            do Bool
False
            do f (Box a)
those
            Bool -> Bool -> Bool
|| Bool
r
      )
      do Bool
False
      do f (Box a)
these

  -- translate all the boxes
  translate :: forall a. Num a => V3 a -> ManyBoxes f a -> ManyBoxes f a
translate V3 a
displacement (ManyBoxes f (Box a)
boxes) =
    f (Box a) -> ManyBoxes f a
forall (f :: * -> *) a. f (Box a) -> ManyBoxes f a
ManyBoxes (f (Box a) -> ManyBoxes f a) -> f (Box a) -> ManyBoxes f a
forall a b. (a -> b) -> a -> b
$
      V3 a -> Box a -> Box a
forall a. Num a => V3 a -> Box a -> Box a
forall (s :: * -> *) a. (Shape s, Num a) => V3 a -> s a -> s a
translate V3 a
displacement (Box a -> Box a) -> f (Box a) -> f (Box a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Box a)
boxes

  -- find the corners of the smallest bounding box
  corners :: forall a. (Fractional a, Ord a) => ManyBoxes f a -> V2 (V3 a)
corners (ManyBoxes f (Box a)
boxes) =
    let low :: V3 a
low = (V3 a -> Box a -> V3 a) -> V3 a -> f (Box a) -> V3 a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Box a -> V3 a -> V3 a) -> V3 a -> Box a -> V3 a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Box a -> V3 a -> V3 a) -> V3 a -> Box a -> V3 a)
-> (Box a -> V3 a -> V3 a) -> V3 a -> Box a -> V3 a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> V3 a -> V3 a -> V3 a
forall a b c. (a -> b -> c) -> V3 a -> V3 b -> V3 c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Ord a => a -> a -> a
min (V3 a -> V3 a -> V3 a) -> (Box a -> V3 a) -> Box a -> V3 a -> V3 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
locorner) (a -> V3 a
forall a. a -> V3 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Fractional a => a
posinf) f (Box a)
boxes
        high :: V3 a
high = (V3 a -> Box a -> V3 a) -> V3 a -> f (Box a) -> V3 a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Box a -> V3 a -> V3 a) -> V3 a -> Box a -> V3 a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Box a -> V3 a -> V3 a) -> V3 a -> Box a -> V3 a)
-> (Box a -> V3 a -> V3 a) -> V3 a -> Box a -> V3 a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> V3 a -> V3 a -> V3 a
forall a b c. (a -> b -> c) -> V3 a -> V3 b -> V3 c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Ord a => a -> a -> a
max (V3 a -> V3 a -> V3 a) -> (Box a -> V3 a) -> Box a -> V3 a -> V3 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box a -> V3 a
forall a. Fractional a => Box a -> V3 a
hicorner) (a -> V3 a
forall a. a -> V3 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-a
forall a. Fractional a => a
posinf)) f (Box a)
boxes
     in V3 a -> V3 a -> V2 (V3 a)
forall a. a -> a -> V2 a
V2 V3 a
low V3 a
high

  tomanyboxes :: forall a. ManyBoxes f a -> ManyBoxes [] a
tomanyboxes (ManyBoxes f (Box a)
boxes) = [Box a] -> ManyBoxes [] a
forall (f :: * -> *) a. f (Box a) -> ManyBoxes f a
ManyBoxes ([Box a] -> ManyBoxes [] a) -> [Box a] -> ManyBoxes [] a
forall a b. (a -> b) -> a -> b
$ f (Box a) -> [Box a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Box a)
boxes