-- |
-- Module: M.Collision.Internal.Face
-- Description: Point sampling on cuboid faces for collision detection
-- Copyright: (c) axionbuster, 2025
-- License: BSD-3-Clause
--
-- Provides utilities for sampling points on cuboid faces, used in collision detection.
-- The module focuses on efficient face point generation for AABB collision testing.
module M.Collision.Internal.Face
  ( facepoints,
    dbgcountfacepoints,
    dbgdesmos,
  )
where

import Control.Lens hiding (index)
import Data.Functor.Rep
import Data.Ix (range)
import Data.List (intercalate)
import Linear.V3
import Text.Printf

-- | retrieve the points on the faces of a cuboid
-- normal to a certain direction (sig: {-1, 0, 1}) from said cuboid
facepoints ::
  -- | cuboid dimensions
  V3 Int ->
  -- | direction (signum vector)
  V3 Int ->
  -- | points on the faces from the cuboid's (0, 0, 0) corner
  [V3 Int]
facepoints :: V3 Int -> V3 Int -> [V3 Int]
facepoints V3 Int
coid V3 Int
sig =
  let ! :: 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
      -- enumerate points on the faces of the cuboid
      -- p, q, r: dimensions
      -- ps: list of points to sample
      -- h: permutation of a V3
      rule :: E V3
-> E V3 -> E V3 -> [(Int, Int)] -> (V3 Int -> V3 Int) -> [V3 Int]
rule E V3
p E V3
q E V3
r [(Int, Int)]
ps V3 Int -> V3 Int
h
        | V3 Int
sig V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = []
        | Bool
otherwise =
            [ let a :: Int
a = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
i (V3 Int
coid V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
r)
                  b :: Int
b = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
j (V3 Int
coid V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
q)
                  c :: Int
c = if V3 Int
sig V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
0 else V3 Int
coid V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
p
               in V3 Int -> V3 Int
h do Int -> Int -> Int -> V3 Int
forall a. a -> a -> a -> V3 a
V3 Int
a Int
b Int
c
            | (Int
i, Int
j) <- [(Int, Int)]
ps
            ]
      -- compute ranges for the points to sample
      st :: E V3 -> (Int, Int)
st E V3
i
        | V3 Int
sig V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (Int
1, Int
0)
        | V3 Int
sig V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (Int
0, Int
1)
        | Bool
otherwise = (Int
0, Int
0)
      p0 :: [(Int, Int)]
p0 =
        let (Int
sj, Int
ej) = E V3 -> (Int, Int)
st E V3
forall (t :: * -> *). R2 t => E t
ey
            (Int
si, Int
ei) = E V3 -> (Int, Int)
st E V3
forall (t :: * -> *). R3 t => E t
ez
         in ((Int, Int), (Int, Int)) -> [(Int, Int)]
forall a. Ix a => (a, a) -> [a]
range ((Int
si, Int
sj), (V3 Int
coid V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
forall (t :: * -> *). R3 t => E t
ez Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ei, V3 Int
coid V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
forall (t :: * -> *). R2 t => E t
ey Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ej))
      p1 :: [(Int, Int)]
p1 =
        let (Int
sj, Int
ej) = E V3 -> (Int, Int)
st E V3
forall (t :: * -> *). R3 t => E t
ez
         in ((Int, Int), (Int, Int)) -> [(Int, Int)]
forall a. Ix a => (a, a) -> [a]
range ((Int
sj, Int
0), (V3 Int
coid V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
forall (t :: * -> *). R3 t => E t
ez Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ej, V3 Int
coid V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
forall (t :: * -> *). R1 t => E t
ex))
      p2 :: [(Int, Int)]
p2 = ((Int, Int), (Int, Int)) -> [(Int, Int)]
forall a. Ix a => (a, a) -> [a]
range ((Int
0, Int
0), (V3 Int
coid V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
forall (t :: * -> *). R2 t => E t
ey, V3 Int
coid V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
forall (t :: * -> *). R1 t => E t
ex))
      -- mirror or rotate the coordinate system
      h0 :: V3 a -> V3 a
h0 (V3 a
a a
b a
c) = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
c a
b a
a
      h1 :: V3 a -> V3 a
h1 (V3 a
a a
b a
c) = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
b a
c a
a
      h2 :: V3 a -> V3 a
h2 (V3 a
a a
b a
c) = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
b a
a a
c
   in -- compute points for faces perpendicular to the respective axes
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat @[]
        [ E V3
-> E V3 -> E V3 -> [(Int, Int)] -> (V3 Int -> V3 Int) -> [V3 Int]
rule E V3
forall (t :: * -> *). R1 t => E t
ex E V3
forall (t :: * -> *). R2 t => E t
ey E V3
forall (t :: * -> *). R3 t => E t
ez [(Int, Int)]
p0 V3 Int -> V3 Int
forall {a}. V3 a -> V3 a
h0,
          E V3
-> E V3 -> E V3 -> [(Int, Int)] -> (V3 Int -> V3 Int) -> [V3 Int]
rule E V3
forall (t :: * -> *). R2 t => E t
ey E V3
forall (t :: * -> *). R1 t => E t
ex E V3
forall (t :: * -> *). R3 t => E t
ez [(Int, Int)]
p1 V3 Int -> V3 Int
forall {a}. V3 a -> V3 a
h1,
          E V3
-> E V3 -> E V3 -> [(Int, Int)] -> (V3 Int -> V3 Int) -> [V3 Int]
rule E V3
forall (t :: * -> *). R3 t => E t
ez E V3
forall (t :: * -> *). R1 t => E t
ex E V3
forall (t :: * -> *). R2 t => E t
ey [(Int, Int)]
p2 V3 Int -> V3 Int
forall {a}. V3 a -> V3 a
h2
        ]

-- | print a list of vectors in a format that can be copy-pasted into Desmos
dbgdesmos :: (Show a) => [V3 a] -> String
dbgdesmos :: forall a. Show a => [V3 a] -> String
dbgdesmos [V3 a]
vs = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (V3 a -> String
forall {t} {a}. (PrintfType t, Show a) => V3 a -> t
f (V3 a -> String) -> [V3 a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [V3 a]
vs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
  where
    f :: V3 a -> t
f (V3 a
x a
y a
z) = String -> String -> String -> String -> t
forall r. PrintfType r => String -> r
printf String
"(%s,%s,%s)" (a -> String
forall a. Show a => a -> String
show a
x) (a -> String
forall a. Show a => a -> String
show a
y) (a -> String
forall a. Show a => a -> String
show a
z)

-- | predict the number of points sampled by 'facepoints'
dbgcountfacepoints ::
  -- | cuboid dimensions
  V3 Int ->
  -- | direction (signum vector)
  V3 Int ->
  -- | number of points sampled by 'facepoints'
  Int
dbgcountfacepoints :: V3 Int -> V3 Int -> Int
dbgcountfacepoints ((V3 Int -> V3 Int -> V3 Int
forall a. Num a => a -> a -> a
+ Int -> V3 Int
forall a. a -> V3 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1) -> V3 Int
coid) V3 Int
sig =
  let ! :: 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
      Bool
c ? :: Bool -> p -> p
? p
a = if Bool
c then p
a else p
0
      V3 Int
cx Int
cy Int
cz = V3 Int
coid
   in (V3 Int
sig V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
forall (t :: * -> *). R1 t => E t
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) Bool -> Int -> Int
forall {p}. Num p => Bool -> p -> p
? (Int
cy Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cz)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (V3 Int
sig V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
forall (t :: * -> *). R2 t => E t
ey Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) Bool -> Int -> Int
forall {p}. Num p => Bool -> p -> p
? (Int
cz Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cx)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (V3 Int
sig V3 Int -> Rep V3 -> Int
forall a. V3 a -> Rep V3 -> a
! Rep V3
E V3
forall (t :: * -> *). R3 t => E t
ez Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) Bool -> Int -> Int
forall {p}. Num p => Bool -> p -> p
? (Int
cx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cy)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if
          | Int -> V3 Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Int
0 V3 Int
sig -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cz
          | Int -> V2 Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Int
0 (V2 Int -> Bool) -> V2 Int -> Bool
forall a b. (a -> b) -> a -> b
$ V3 Int
sig V3 Int -> Getting (V2 Int) (V3 Int) (V2 Int) -> V2 Int
forall s a. s -> Getting a s a -> a
^. Getting (V2 Int) (V3 Int) (V2 Int)
forall a. Lens' (V3 a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy -> -Int
cz
          | Int -> V2 Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Int
0 (V2 Int -> Bool) -> V2 Int -> Bool
forall a b. (a -> b) -> a -> b
$ V3 Int
sig V3 Int -> Getting (V2 Int) (V3 Int) (V2 Int) -> V2 Int
forall s a. s -> Getting a s a -> a
^. Getting (V2 Int) (V3 Int) (V2 Int)
Lens' (V3 Int) (V2 Int)
forall (t :: * -> *) a. R3 t => Lens' (t a) (V2 a)
_yz -> -Int
cx
          | Int -> V2 Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Int
0 (V2 Int -> Bool) -> V2 Int -> Bool
forall a b. (a -> b) -> a -> b
$ V3 Int
sig V3 Int -> Getting (V2 Int) (V3 Int) (V2 Int) -> V2 Int
forall s a. s -> Getting a s a -> a
^. Getting (V2 Int) (V3 Int) (V2 Int)
Lens' (V3 Int) (V2 Int)
forall (t :: * -> *) a. R3 t => Lens' (t a) (V2 a)
_zx -> -Int
cy
          | Bool
otherwise -> Int
0