{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}

module Figuras where
import Elem3D
    ( RGB(..),
      Base,
      Ray(..),
      Direction(..),
      Point3D(..),
      movePoint,
      (#<),
      (#),
      (.*),
      escalateDir, modd,
      normal, escalatePoint, pointDir, dirPoint, distPoint, addPoints )
import Debug.Trace (trace)
import Data.Maybe (mapMaybe)
import Data.List (minimumBy)
import Data.Ord (comparing)

import qualified Data.DList as DL
import qualified Data.Set as Set

-- | Tipo de dato básico, se usa para representar las coordenadas U V de texturas.
data Point2D = Point2D {Point2D -> Float
uP :: Float, Point2D -> Float
vP :: Float} deriving Int -> Point2D -> ShowS
[Point2D] -> ShowS
Point2D -> String
(Int -> Point2D -> ShowS)
-> (Point2D -> String) -> ([Point2D] -> ShowS) -> Show Point2D
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point2D] -> ShowS
$cshowList :: [Point2D] -> ShowS
show :: Point2D -> String
$cshow :: Point2D -> String
showsPrec :: Int -> Point2D -> ShowS
$cshowsPrec :: Int -> Point2D -> ShowS
Show

-- |Tipo compuesto, este representa la base de la camara y su posición tridimensional sobre dicha base.
data Camara = Camara Point3D Base
-- |Tipo compuesto, representa una esfera, tiene un punto central, la longitud del radio, el color, las propiedades del material y su indice de reflexión.
data Esfera = Esfera {Esfera -> Point3D
centEs :: Point3D, Esfera -> Float
radEs :: Float, Esfera -> RGB
rgbEs ::  RGB, Esfera -> (Float, Float, Float)
trEs :: (Float, Float, Float), Esfera -> Float
reflEs :: Float, Esfera -> Int
idEs :: Int} deriving Int -> Esfera -> ShowS
[Esfera] -> ShowS
Esfera -> String
(Int -> Esfera -> ShowS)
-> (Esfera -> String) -> ([Esfera] -> ShowS) -> Show Esfera
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Esfera] -> ShowS
$cshowList :: [Esfera] -> ShowS
show :: Esfera -> String
$cshow :: Esfera -> String
showsPrec :: Int -> Esfera -> ShowS
$cshowsPrec :: Int -> Esfera -> ShowS
Show
-- |Tipo compuesto, representa un plano, tiene un punto central, la dirección normal al plano, el color, las propiedades del material y su indice de reflexión.
data Plano = Plano {Plano -> Point3D
centPl :: Point3D, Plano -> Direction
normPl :: Direction, Plano -> RGB
rgbPl :: RGB, Plano -> (Float, Float, Float)
trPl :: (Float, Float, Float), Plano -> Float
reflPl :: Float, Plano -> Int
idPl :: Int} deriving Int -> Plano -> ShowS
[Plano] -> ShowS
Plano -> String
(Int -> Plano -> ShowS)
-> (Plano -> String) -> ([Plano] -> ShowS) -> Show Plano
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Plano] -> ShowS
$cshowList :: [Plano] -> ShowS
show :: Plano -> String
$cshow :: Plano -> String
showsPrec :: Int -> Plano -> ShowS
$cshowsPrec :: Int -> Plano -> ShowS
Show
-- |Tipo compuesto, representa un triángulo, tiene sus 3 vertices, el color, las propiedades del material y su indice de reflexión.
data Triangulo = Triangulo {Triangulo -> Point3D
p0Tr :: Point3D, Triangulo -> Point3D
p1Tr :: Point3D, Triangulo -> Point3D
p2Tr :: Point3D,Triangulo -> Point2D
uv0Tr :: Point2D, Triangulo -> Point2D
uv1Tr :: Point2D, Triangulo -> Point2D
uv2Tr :: Point2D, Triangulo -> RGB
rgbTr :: RGB, Triangulo -> (Float, Float, Float)
trTr :: (Float, Float, Float), Triangulo -> Float
reflTr :: Float, Triangulo -> Int
idTr :: Int} deriving Int -> Triangulo -> ShowS
[Triangulo] -> ShowS
Triangulo -> String
(Int -> Triangulo -> ShowS)
-> (Triangulo -> String)
-> ([Triangulo] -> ShowS)
-> Show Triangulo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Triangulo] -> ShowS
$cshowList :: [Triangulo] -> ShowS
show :: Triangulo -> String
$cshow :: Triangulo -> String
showsPrec :: Int -> Triangulo -> ShowS
$cshowsPrec :: Int -> Triangulo -> ShowS
Show
-- |Tipo compuesto, representa un cilindro, tiene un punto central, la longitud del radio, el color, las propiedades del material y su indice de reflexión.
data Cilindro = Cilindro Point3D Direction Float RGB (Float, Float, Float) Float Int deriving Int -> Cilindro -> ShowS
[Cilindro] -> ShowS
Cilindro -> String
(Int -> Cilindro -> ShowS)
-> (Cilindro -> String) -> ([Cilindro] -> ShowS) -> Show Cilindro
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cilindro] -> ShowS
$cshowList :: [Cilindro] -> ShowS
show :: Cilindro -> String
$cshow :: Cilindro -> String
showsPrec :: Int -> Cilindro -> ShowS
$cshowsPrec :: Int -> Cilindro -> ShowS
Show
-- |Tipo compuesto, representa un cono, tiene un punto central, la longitud del radio, el color, las propiedades del material y su indice de reflexión.
data Cono = Cono {Cono -> Point3D
centCo :: Point3D, Cono -> Float
altCo :: Float, Cono -> Float
radCo :: Float, Cono -> RGB
rgbCo :: RGB, Cono -> (Float, Float, Float)
trCo :: (Float, Float, Float), Cono -> Float
reflCo :: Float, Cono -> Int
idCo :: Int} deriving Int -> Cono -> ShowS
[Cono] -> ShowS
Cono -> String
(Int -> Cono -> ShowS)
-> (Cono -> String) -> ([Cono] -> ShowS) -> Show Cono
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cono] -> ShowS
$cshowList :: [Cono] -> ShowS
show :: Cono -> String
$cshow :: Cono -> String
showsPrec :: Int -> Cono -> ShowS
$cshowsPrec :: Int -> Cono -> ShowS
Show
-- |Tipo compuesto, representa un rectángulo, tiene un punto central, las direcciones normal y tangente, longitud y anchura, el color, las propiedades del material y su indice de reflexión.
data Rectangulo = Rectangulo {Rectangulo -> Point3D
centRe :: Point3D, Rectangulo -> Direction
normRe :: Direction, Rectangulo -> Direction
tngRe :: Direction, Rectangulo -> Float
altRe :: Float, Rectangulo -> Float
ancRe :: Float, Rectangulo -> RGB
rgbRe :: RGB, Rectangulo -> (Float, Float, Float)
trRe :: (Float, Float, Float), Rectangulo -> Float
reflRe:: Float, Rectangulo -> Int
idRe:: Int} deriving Int -> Rectangulo -> ShowS
[Rectangulo] -> ShowS
Rectangulo -> String
(Int -> Rectangulo -> ShowS)
-> (Rectangulo -> String)
-> ([Rectangulo] -> ShowS)
-> Show Rectangulo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rectangulo] -> ShowS
$cshowList :: [Rectangulo] -> ShowS
show :: Rectangulo -> String
$cshow :: Rectangulo -> String
showsPrec :: Int -> Rectangulo -> ShowS
$cshowsPrec :: Int -> Rectangulo -> ShowS
Show


-- |Tipo compuesto, representa una hitbox 3D de forma rectangular, tiene dos puntos que representan los vertices de cada extremo.
data AABB = AABB {AABB -> Point3D
p0AB :: Point3D, AABB -> Point3D
p1AB ::  Point3D} deriving Int -> AABB -> ShowS
[AABB] -> ShowS
AABB -> String
(Int -> AABB -> ShowS)
-> (AABB -> String) -> ([AABB] -> ShowS) -> Show AABB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AABB] -> ShowS
$cshowList :: [AABB] -> ShowS
show :: AABB -> String
$cshow :: AABB -> String
showsPrec :: Int -> AABB -> ShowS
$cshowsPrec :: Int -> AABB -> ShowS
Show

-- |Tipo compuesto, representa una BVH, es un tipo especial dado que es recursivo, contiene un AABB que actua como Hitbox, subinstancias de si mismo y una lista de triángulos.
data BVH = BVH {BVH -> AABB
aabb::AABB, BVH -> [BVH]
bvhs :: [BVH], BVH -> [Triangulo]
triangulos :: [Triangulo], BVH -> Int
idBvh :: Int} deriving Int -> BVH -> ShowS
[BVH] -> ShowS
BVH -> String
(Int -> BVH -> ShowS)
-> (BVH -> String) -> ([BVH] -> ShowS) -> Show BVH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BVH] -> ShowS
$cshowList :: [BVH] -> ShowS
show :: BVH -> String
$cshow :: BVH -> String
showsPrec :: Int -> BVH -> ShowS
$cshowsPrec :: Int -> BVH -> ShowS
Show

-- |Tipo auxiliar, representa la posición de un triángulo, solo tiene sus 3 vértices.
data TrianglePos = TrianglePos { TrianglePos -> Int
v1 :: Int, TrianglePos -> Int
v2 :: Int, TrianglePos -> Int
v3 :: Int } deriving Int -> TrianglePos -> ShowS
[TrianglePos] -> ShowS
TrianglePos -> String
(Int -> TrianglePos -> ShowS)
-> (TrianglePos -> String)
-> ([TrianglePos] -> ShowS)
-> Show TrianglePos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrianglePos] -> ShowS
$cshowList :: [TrianglePos] -> ShowS
show :: TrianglePos -> String
$cshow :: TrianglePos -> String
showsPrec :: Int -> TrianglePos -> ShowS
$cshowsPrec :: Int -> TrianglePos -> ShowS
Show


-- |Tipo especial, sería lo equivalente a una clase virtual, esta nos permite interactuar de forma transparente con su contenido sin necesidad de saber la clase concreta que contiene.
data Shape = Sphere Esfera | Plane Plano | Triangle Triangulo | Cylinder Cilindro | Rectangle Rectangulo | Acelerator BVH | Cone Cono | Null deriving Int -> Shape -> ShowS
[Shape] -> ShowS
Shape -> String
(Int -> Shape -> ShowS)
-> (Shape -> String) -> ([Shape] -> ShowS) -> Show Shape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shape] -> ShowS
$cshowList :: [Shape] -> ShowS
show :: Shape -> String
$cshow :: Shape -> String
showsPrec :: Int -> Shape -> ShowS
$cshowsPrec :: Int -> Shape -> ShowS
Show


-- |Tipo compuesto, contiene todas las propiedades obtenidas al colisionar un rayo con un objeto, la distancia del impacto, el color, la dirección incidente, el punto de colisión, la dirección normal de ese punto para el objeto y las propiedades internas del mismo(coeficientes).
data Obj = Obj {Obj -> Float
mindObj :: Float, Obj -> RGB
rgbObj :: RGB, Obj -> Direction
w0Obj :: Direction, Obj -> Point3D
colObj :: Point3D, Obj -> Direction
normObj :: Direction, Obj -> (Float, Float, Float)
trObj ::(Float, Float, Float), Obj -> Float
reflObj :: Float, Obj -> Int
idObj:: Int,Obj -> Shape
shObj :: Shape} deriving Int -> Obj -> ShowS
[Obj] -> ShowS
Obj -> String
(Int -> Obj -> ShowS)
-> (Obj -> String) -> ([Obj] -> ShowS) -> Show Obj
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Obj] -> ShowS
$cshowList :: [Obj] -> ShowS
show :: Obj -> String
$cshow :: Obj -> String
showsPrec :: Int -> Obj -> ShowS
$cshowsPrec :: Int -> Obj -> ShowS
Show

instance Eq Shape where
    Shape
a == :: Shape -> Shape -> Bool
== Shape
b = Bool
False
instance Ord Shape where
    compare :: Shape -> Shape -> Ordering
compare = (Shape -> Int) -> Shape -> Shape -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Shape -> Int
getShapeID

instance Eq Obj where
    Obj
obj == :: Obj -> Obj -> Bool
== Obj
obj1 = Obj -> Float
mindObj Obj
obj Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Obj -> Float
mindObj Obj
obj1
instance Ord Obj where
    compare :: Obj -> Obj -> Ordering
compare Obj
obj Obj
obj1 = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Obj -> Float
mindObj Obj
obj) (Obj -> Float
mindObj Obj
obj1)

-- |Función auxiliar, para dada una SHAPE y un punto3d de la misma, devolver en coordenadas UV la posición de dicho punto.(Se emplea para las texturas)
{-# INLINE getUV #-}
getUV :: Shape -> Point3D -> (Float, Float)
--getUV (Plane (Plano {..})) p = (1,1)
getUV :: Shape -> Point3D -> (Float, Float)
getUV (Sphere (Esfera {Float
Int
(Float, Float, Float)
RGB
Point3D
idEs :: Int
reflEs :: Float
trEs :: (Float, Float, Float)
rgbEs :: RGB
radEs :: Float
centEs :: Point3D
idEs :: Esfera -> Int
reflEs :: Esfera -> Float
trEs :: Esfera -> (Float, Float, Float)
rgbEs :: Esfera -> RGB
radEs :: Esfera -> Float
centEs :: Esfera -> Point3D
..})) Point3D
p = (Float
u,Float
v)
    where
        (Point3D Float
x Float
y Float
z) = Point3D
p
        (Point3D Float
cx Float
cy Float
cz) = Point3D
centEs
        u :: Float
u = Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float -> Float -> Float
forall a. RealFloat a => a -> a -> a
atan2 (Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
cz) (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
cx) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi)
        v :: Float
v = Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
forall a. Floating a => a -> a
asin ((Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
cy) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
radEs) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
forall a. Floating a => a
pi

getUV (Triangle (Triangulo {Float
Int
(Float, Float, Float)
RGB
Point3D
Point2D
idTr :: Int
reflTr :: Float
trTr :: (Float, Float, Float)
rgbTr :: RGB
uv2Tr :: Point2D
uv1Tr :: Point2D
uv0Tr :: Point2D
p2Tr :: Point3D
p1Tr :: Point3D
p0Tr :: Point3D
idTr :: Triangulo -> Int
reflTr :: Triangulo -> Float
trTr :: Triangulo -> (Float, Float, Float)
rgbTr :: Triangulo -> RGB
uv2Tr :: Triangulo -> Point2D
uv1Tr :: Triangulo -> Point2D
uv0Tr :: Triangulo -> Point2D
p2Tr :: Triangulo -> Point3D
p1Tr :: Triangulo -> Point3D
p0Tr :: Triangulo -> Point3D
..})) Point3D
p = (Float
u,Float
v)
    where
        v0 :: Direction
v0 =  Point3D
p2Tr Point3D -> Point3D -> Direction
#< Point3D
p0Tr
        v1 :: Direction
v1 =  Point3D
p1Tr Point3D -> Point3D -> Direction
#< Point3D
p0Tr
        v2 :: Direction
v2 =  Point3D
p Point3D -> Point3D -> Direction
#< Point3D
p0Tr
        n :: Direction
n = Direction
v1 Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
* Direction
v0
        cross1 :: Direction
cross1 = Direction
v2 Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
* Direction
v1
        cross2 :: Direction
cross2 = Direction
v0 Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
* Direction
v2
        aTri :: Float
aTri = Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Direction -> Float
modd Direction
n
        alpha :: Float
alpha = Direction -> Float
modd Direction
cross1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
aTri)
        beta :: Float
beta = Direction -> Float
modd Direction
cross2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
aTri)
        gamma :: Float
gamma = Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
alpha Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
beta
        u :: Float
u = (Float
alpha Float -> Float -> Float
forall a. Num a => a -> a -> a
* Point2D -> Float
uP Point2D
uv0Tr Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
beta Float -> Float -> Float
forall a. Num a => a -> a -> a
* Point2D -> Float
uP Point2D
uv1Tr Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
gamma Float -> Float -> Float
forall a. Num a => a -> a -> a
* Point2D -> Float
uP Point2D
uv2Tr) 
        v :: Float
v = (Float
alpha Float -> Float -> Float
forall a. Num a => a -> a -> a
* Point2D -> Float
vP Point2D
uv0Tr Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
beta Float -> Float -> Float
forall a. Num a => a -> a -> a
* Point2D -> Float
vP Point2D
uv1Tr Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
gamma Float -> Float -> Float
forall a. Num a => a -> a -> a
* Point2D -> Float
vP Point2D
uv2Tr) 

        
        
getUV (Cylinder (Cilindro Point3D
p1 Direction
p2 Float
p3 RGB
_ (Float, Float, Float)
_ Float
_ Int
_)) Point3D
p = (Float
1,Float
1)
getUV (Rectangle(Rectangulo {Float
Int
(Float, Float, Float)
RGB
Direction
Point3D
idRe :: Int
reflRe :: Float
trRe :: (Float, Float, Float)
rgbRe :: RGB
ancRe :: Float
altRe :: Float
tngRe :: Direction
normRe :: Direction
centRe :: Point3D
idRe :: Rectangulo -> Int
reflRe :: Rectangulo -> Float
trRe :: Rectangulo -> (Float, Float, Float)
rgbRe :: Rectangulo -> RGB
ancRe :: Rectangulo -> Float
altRe :: Rectangulo -> Float
tngRe :: Rectangulo -> Direction
normRe :: Rectangulo -> Direction
centRe :: Rectangulo -> Point3D
..})) Point3D
p = (Float
u,Float
v)
    where
      halfHeight :: Float
halfHeight = Float
altRe Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
      halfWidth :: Float
halfWidth = Float
ancRe Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
      Direction Float
x Float
y Float
z = Direction
normRe 
      right :: Direction
right = Direction
tngRe
      up :: Direction
up = Direction -> Direction
normal (Direction -> Direction) -> Direction -> Direction
forall a b. (a -> b) -> a -> b
$ Direction
normRe Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
* Direction -> Direction
normal Direction
right
      bottomLeft :: Point3D
bottomLeft = Float -> Float -> Point3D
calculateVertex (-Float
halfWidth) (-Float
halfHeight)
      bottomRight :: Point3D
bottomRight = Float -> Float -> Point3D
calculateVertex Float
halfWidth (-Float
halfHeight)
      topLeft :: Point3D
topLeft = Float -> Float -> Point3D
calculateVertex (-Float
halfWidth) Float
halfHeight

      calculateVertex :: Float -> Float -> Point3D
calculateVertex Float
w Float
h = Point3D
centRe Point3D -> Point3D -> Point3D
`addPoints` Direction -> Point3D
dirPoint (Float -> Direction -> Direction
escalateDir Float
w Direction
right Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
+ Float -> Direction -> Direction
escalateDir Float
h Direction
up)

      !u :: Float
u = Point3D -> Ray -> Float
distanceToRay Point3D
p (Point3D -> Direction -> Ray
Ray Point3D
bottomLeft (Point3D
bottomLeft Point3D -> Point3D -> Direction
#< Point3D
topLeft)) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
altRe
      !v :: Float
v = Point3D -> Ray -> Float
distanceToRay Point3D
p (Point3D -> Direction -> Ray
Ray Point3D
bottomLeft (Point3D
bottomLeft Point3D -> Point3D -> Direction
#< Point3D
bottomRight)) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
ancRe

      distanceToRay :: Point3D -> Ray -> Float -- Punto más cercano al rayo
      distanceToRay :: Point3D -> Ray -> Float
distanceToRay Point3D
point Ray
ray =
        let
            (Point3D Float
ox Float
oy Float
oz) = Ray -> Point3D
oR Ray
ray
            (Direction Float
dx Float
dy Float
dz) = Ray -> Direction
dR Ray
ray
            px :: Float
px = Float
ox Float -> Float -> Float
forall a. Num a => a -> a -> a
- Point3D -> Float
xP Point3D
point
            py :: Float
py = Float
oy Float -> Float -> Float
forall a. Num a => a -> a -> a
- Point3D -> Float
yP Point3D
point
            pz :: Float
pz = Float
oz Float -> Float -> Float
forall a. Num a => a -> a -> a
- Point3D -> Float
zP Point3D
point
            a :: Float
a = Float
dx Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dx Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dy Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dz Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dz
            b :: Float
b = Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dx Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
pz Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dz
            t :: Float
t = -(Float
b Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
a)
            closestPoint :: Point3D
closestPoint = Float -> Float -> Float -> Point3D
Point3D (Float
ox Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dx) (Float
oy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dy) (Float
oz Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dz)
            in Point3D -> Point3D -> Float
distPoint Point3D
point Point3D
closestPoint

        -- (Direction x y z) = normal normRe
        -- pAbI = Point3D (xP centRe - (ancRe/2 * abs(1 - x))) (yP centRe - (altRe/2 * abs(1 - y))) (zP centRe + (ancRe/2 * abs(1 - z)))
        -- pArI = Point3D (xP centRe - (ancRe/2 * abs(1 - x))) (yP centRe - (altRe/2 * abs(1 - y))) (zP centRe - (ancRe/2 * abs(1 - z)))
        -- pAbD = Point3D (xP centRe - (ancRe/2 * abs(1 - x))) (yP centRe - (altRe/2 * abs(1 - y))) (zP centRe - (ancRe/2 * abs(1 - z)))
    
getUV (Acelerator (BVH {Int
[BVH]
[Triangulo]
AABB
idBvh :: Int
triangulos :: [Triangulo]
bvhs :: [BVH]
aabb :: AABB
idBvh :: BVH -> Int
triangulos :: BVH -> [Triangulo]
bvhs :: BVH -> [BVH]
aabb :: BVH -> AABB
..})) Point3D
p = (Float
1,Float
1)


-- |Función auxiliar, dada una lista de triángulos, calcula su hitbox y la devuelve.
{-# INLINE calculateBoundingBox #-}
calculateBoundingBox :: [Triangulo] -> AABB
calculateBoundingBox :: [Triangulo] -> AABB
calculateBoundingBox [Triangulo]
triangles =
    let xs :: [Float]
xs = [Float
x | Triangulo
tri <- [Triangulo]
triangles, Float
x <- [Point3D -> Float
xP (Triangulo -> Point3D
p0Tr Triangulo
tri), Point3D -> Float
xP (Triangulo -> Point3D
p1Tr Triangulo
tri), Point3D -> Float
xP (Triangulo -> Point3D
p2Tr Triangulo
tri)]]
        ys :: [Float]
ys = [Float
y | Triangulo
tri <- [Triangulo]
triangles, Float
y <- [Point3D -> Float
yP (Triangulo -> Point3D
p0Tr Triangulo
tri), Point3D -> Float
yP (Triangulo -> Point3D
p1Tr Triangulo
tri), Point3D -> Float
yP (Triangulo -> Point3D
p2Tr Triangulo
tri)]]
        zs :: [Float]
zs = [Float
z | Triangulo
tri <- [Triangulo]
triangles, Float
z <- [Point3D -> Float
zP (Triangulo -> Point3D
p0Tr Triangulo
tri), Point3D -> Float
zP (Triangulo -> Point3D
p1Tr Triangulo
tri), Point3D -> Float
zP (Triangulo -> Point3D
p2Tr Triangulo
tri)]]
        minPoint :: Point3D
minPoint = Float -> Float -> Float -> Point3D
Point3D ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
xs) ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
ys) ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
zs)
        maxPoint :: Point3D
maxPoint = Float -> Float -> Float -> Point3D
Point3D ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
xs) ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
ys) ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
zs)
    in Point3D -> Point3D -> AABB
AABB Point3D
minPoint Point3D
maxPoint

-- |Función auxiliar, dado un entero y una lista de triángulos, genera una lista de listas de triángulos, cada sublista tiene tantos triángulos como indique el entero.
{-# INLINE splitTriangles #-}
splitTriangles :: Int -> [Triangulo] -> [[Triangulo]]
splitTriangles :: Int -> [Triangulo] -> [[Triangulo]]
splitTriangles Int
maxSize [] = []
splitTriangles Int
maxSize [Triangulo]
triangles =
    let ([Triangulo]
first, [Triangulo]
rest) = Int -> [Triangulo] -> ([Triangulo], [Triangulo])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
maxSize [Triangulo]
triangles
    in [Triangulo]
first [Triangulo] -> [[Triangulo]] -> [[Triangulo]]
forall a. a -> [a] -> [a]
: Int -> [Triangulo] -> [[Triangulo]]
splitTriangles Int
maxSize [Triangulo]
rest

-- |Función básica, dada una lista de triángulos genera un BVH a partir de esta.
{-# INLINE buildBVH #-}
buildBVH :: Int -> [Triangulo] -> BVH
buildBVH :: Int -> [Triangulo] -> BVH
buildBVH Int
idNum [Triangulo]
triangles =
    let bbox :: AABB
bbox = [Triangulo] -> AABB
calculateBoundingBox [Triangulo]
triangles
        maxSize :: Int
maxSize = Int
64
    in if [Triangulo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Triangulo]
triangles Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxSize
        then AABB -> [BVH] -> [Triangulo] -> Int -> BVH
BVH AABB
bbox [] [Triangulo]
triangles Int
idNum
        else
            let sublists :: [[Triangulo]]
sublists = Int -> [Triangulo] -> [[Triangulo]]
splitTriangles ([Triangulo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Triangulo]
triangles Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
maxSize) [Triangulo]
triangles
                subBVHs :: [BVH]
subBVHs = (Int -> [Triangulo] -> BVH) -> [Int] -> [[Triangulo]] -> [BVH]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
idx [Triangulo]
sublist -> Int -> [Triangulo] -> BVH
buildBVH Int
idx [Triangulo]
sublist) [Int
idNum..] [[Triangulo]]
sublists
            in AABB -> [BVH] -> [Triangulo] -> Int -> BVH
BVH AABB
bbox ([BVH]
subBVHs) [] Int
idNum

-- |Función auxiliar, dado un rayo y una Hitbox comprueba si estos colisionan o no, devuelve un booleano para indicarlo.
{-# INLINE rayIntersectsAABB #-}
rayIntersectsAABB :: Ray -> AABB -> Bool
rayIntersectsAABB :: Ray -> AABB -> Bool
rayIntersectsAABB (Ray {oR :: Ray -> Point3D
oR = Point3D Float
x Float
y Float
z ,dR :: Ray -> Direction
dR = Direction Float
dx Float
dy Float
dz}) (AABB {p0AB :: AABB -> Point3D
p0AB = Point3D Float
minx Float
miny Float
minz, p1AB :: AABB -> Point3D
p1AB = Point3D Float
maxx Float
maxy Float
maxz}) =
    let tx1 :: Float
tx1 = (Float
minx Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
dx
        tx2 :: Float
tx2 = (Float
maxx Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
dx
        ty1 :: Float
ty1 = (Float
miny Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
dy
        ty2 :: Float
ty2 = (Float
maxy Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
dy
        tz1 :: Float
tz1 = (Float
minz Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
z) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
dz
        tz2 :: Float
tz2 = (Float
maxz Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
z) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
dz
        tmin :: Float
tmin = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
tx1 Float
tx2, Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
ty1 Float
ty2, Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
tz1 Float
tz2]
        tmax :: Float
tmax = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
tx1 Float
tx2, Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
ty1 Float
ty2, Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
tz1 Float
tz2]
    in Float
tmax Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
tmin Bool -> Bool -> Bool
&& Float
tmax Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0

-- |Función auxiliar, dado un rayo y una lista de triángulos, intersecta este con todos y devuelve la intersección más cercana.
{-# INLINE closestIntersection #-}
closestIntersection :: Ray -> [Triangulo] -> (Float, Triangulo)
closestIntersection :: Ray -> [Triangulo] -> (Float, Triangulo)
closestIntersection Ray
_ [] = (-Float
1, Point3D
-> Point3D
-> Point3D
-> Point2D
-> Point2D
-> Point2D
-> RGB
-> (Float, Float, Float)
-> Float
-> Int
-> Triangulo
Triangulo (Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) (Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) (Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) (Float -> Float -> Point2D
Point2D Float
0 Float
0) (Float -> Float -> Point2D
Point2D Float
0 Float
0) (Float -> Float -> Point2D
Point2D Float
0 Float
0) (Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0) (Float
0, Float
0, Float
0) Float
0 Int
0) -- Default value
closestIntersection (Ray {Direction
Point3D
dR :: Direction
oR :: Point3D
dR :: Ray -> Direction
oR :: Ray -> Point3D
..}) [Triangulo]
triangles =
    (Triangulo -> (Float, Triangulo) -> (Float, Triangulo))
-> (Float, Triangulo) -> [Triangulo] -> (Float, Triangulo)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Triangulo -> (Float, Triangulo) -> (Float, Triangulo)
findClosestIntersection (-Float
1, [Triangulo] -> Triangulo
forall a. [a] -> a
head [Triangulo]
triangles) [Triangulo]
triangles
    where
        findClosestIntersection :: Triangulo -> (Float, Triangulo) -> (Float, Triangulo)
        findClosestIntersection :: Triangulo -> (Float, Triangulo) -> (Float, Triangulo)
findClosestIntersection Triangulo
triangle (Float
minDist, Triangulo
closestTri) =
            let intersection :: Maybe (Float, Point3D)
intersection = Point3D
-> Direction
-> Point3D
-> Point3D
-> Point3D
-> Maybe (Float, Point3D)
ray1TriangleIntersection Point3D
oR Direction
dR (Triangulo -> Point3D
p0Tr Triangulo
triangle) (Triangulo -> Point3D
p1Tr Triangulo
triangle) (Triangulo -> Point3D
p2Tr Triangulo
triangle)
            in case Maybe (Float, Point3D)
intersection of
                Just (Float
t, Point3D
_) ->
                    if Float
minDist Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 Bool -> Bool -> Bool
|| (Float
t Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
&& Float
t Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
minDist)
                        then (Float
t, Triangulo
triangle)
                        else (Float
minDist, Triangulo
closestTri)
                Maybe (Float, Point3D)
Nothing -> (Float
minDist, Triangulo
closestTri)


-- |Función auxiliar, dada una figura individual, añade esta a una lista de figuras.
addFig :: Shape -> [Shape] -> [Shape]
addFig :: Shape -> [Shape] -> [Shape]
addFig (Plane (Plano {Float
Int
(Float, Float, Float)
RGB
Direction
Point3D
idPl :: Int
reflPl :: Float
trPl :: (Float, Float, Float)
rgbPl :: RGB
normPl :: Direction
centPl :: Point3D
idPl :: Plano -> Int
reflPl :: Plano -> Float
trPl :: Plano -> (Float, Float, Float)
rgbPl :: Plano -> RGB
normPl :: Plano -> Direction
centPl :: Plano -> Point3D
..})) [Shape]
shapes = Plano -> Shape
Plane (Point3D
-> Direction
-> RGB
-> (Float, Float, Float)
-> Float
-> Int
-> Plano
Plano Point3D
centPl Direction
normPl RGB
rgbPl (Float, Float, Float)
trPl Float
reflPl ([Shape] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Shape]
shapes))Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
:[Shape]
shapes
addFig (Sphere (Esfera {Float
Int
(Float, Float, Float)
RGB
Point3D
idEs :: Int
reflEs :: Float
trEs :: (Float, Float, Float)
rgbEs :: RGB
radEs :: Float
centEs :: Point3D
idEs :: Esfera -> Int
reflEs :: Esfera -> Float
trEs :: Esfera -> (Float, Float, Float)
rgbEs :: Esfera -> RGB
radEs :: Esfera -> Float
centEs :: Esfera -> Point3D
..})) [Shape]
shapes = Esfera -> Shape
Sphere (Point3D
-> Float -> RGB -> (Float, Float, Float) -> Float -> Int -> Esfera
Esfera Point3D
centEs Float
radEs RGB
rgbEs (Float, Float, Float)
trEs Float
reflEs ([Shape] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Shape]
shapes))Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
:[Shape]
shapes
addFig (Triangle (Triangulo {Float
Int
(Float, Float, Float)
RGB
Point3D
Point2D
idTr :: Int
reflTr :: Float
trTr :: (Float, Float, Float)
rgbTr :: RGB
uv2Tr :: Point2D
uv1Tr :: Point2D
uv0Tr :: Point2D
p2Tr :: Point3D
p1Tr :: Point3D
p0Tr :: Point3D
idTr :: Triangulo -> Int
reflTr :: Triangulo -> Float
trTr :: Triangulo -> (Float, Float, Float)
rgbTr :: Triangulo -> RGB
uv2Tr :: Triangulo -> Point2D
uv1Tr :: Triangulo -> Point2D
uv0Tr :: Triangulo -> Point2D
p2Tr :: Triangulo -> Point3D
p1Tr :: Triangulo -> Point3D
p0Tr :: Triangulo -> Point3D
..})) [Shape]
shapes = Triangulo -> Shape
Triangle (Point3D
-> Point3D
-> Point3D
-> Point2D
-> Point2D
-> Point2D
-> RGB
-> (Float, Float, Float)
-> Float
-> Int
-> Triangulo
Triangulo Point3D
p0Tr Point3D
p1Tr Point3D
p2Tr Point2D
uv0Tr Point2D
uv1Tr Point2D
uv2Tr RGB
rgbTr (Float, Float, Float)
trTr Float
reflTr ([Shape] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Shape]
shapes))Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
:[Shape]
shapes
addFig (Cylinder (Cilindro Point3D
p1 Direction
p2 Float
p3 RGB
color (Float, Float, Float)
reflec Float
kr Int
_)) [Shape]
shapes = Cilindro -> Shape
Cylinder (Point3D
-> Direction
-> Float
-> RGB
-> (Float, Float, Float)
-> Float
-> Int
-> Cilindro
Cilindro Point3D
p1 Direction
p2 Float
p3 RGB
color (Float, Float, Float)
reflec Float
kr ([Shape] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Shape]
shapes))Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
:[Shape]
shapes
addFig (Rectangle(Rectangulo {Float
Int
(Float, Float, Float)
RGB
Direction
Point3D
idRe :: Int
reflRe :: Float
trRe :: (Float, Float, Float)
rgbRe :: RGB
ancRe :: Float
altRe :: Float
tngRe :: Direction
normRe :: Direction
centRe :: Point3D
idRe :: Rectangulo -> Int
reflRe :: Rectangulo -> Float
trRe :: Rectangulo -> (Float, Float, Float)
rgbRe :: Rectangulo -> RGB
ancRe :: Rectangulo -> Float
altRe :: Rectangulo -> Float
tngRe :: Rectangulo -> Direction
normRe :: Rectangulo -> Direction
centRe :: Rectangulo -> Point3D
..})) [Shape]
shapes = Rectangulo -> Shape
Rectangle (Point3D
-> Direction
-> Direction
-> Float
-> Float
-> RGB
-> (Float, Float, Float)
-> Float
-> Int
-> Rectangulo
Rectangulo Point3D
centRe Direction
normRe Direction
tngRe Float
altRe Float
ancRe RGB
rgbRe (Float, Float, Float)
trRe Float
reflRe ([Shape] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Shape]
shapes))Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
:[Shape]
shapes
addFig (Acelerator (BVH {Int
[BVH]
[Triangulo]
AABB
idBvh :: Int
triangulos :: [Triangulo]
bvhs :: [BVH]
aabb :: AABB
idBvh :: BVH -> Int
triangulos :: BVH -> [Triangulo]
bvhs :: BVH -> [BVH]
aabb :: BVH -> AABB
..})) [Shape]
shapes = BVH -> Shape
Acelerator (AABB -> [BVH] -> [Triangulo] -> Int -> BVH
BVH AABB
aabb [BVH]
bvhs [Triangulo]
triangulos ([Shape] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Shape]
shapes))Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
:[Shape]
shapes
addFig (Cone (Cono {Float
Int
(Float, Float, Float)
RGB
Point3D
idCo :: Int
reflCo :: Float
trCo :: (Float, Float, Float)
rgbCo :: RGB
radCo :: Float
altCo :: Float
centCo :: Point3D
idCo :: Cono -> Int
reflCo :: Cono -> Float
trCo :: Cono -> (Float, Float, Float)
rgbCo :: Cono -> RGB
radCo :: Cono -> Float
altCo :: Cono -> Float
centCo :: Cono -> Point3D
..})) [Shape]
shapes = Cono -> Shape
Cone (Point3D
-> Float
-> Float
-> RGB
-> (Float, Float, Float)
-> Float
-> Int
-> Cono
Cono Point3D
centCo Float
altCo Float
radCo RGB
rgbCo (Float, Float, Float)
trCo Float
reflCo ([Shape] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Shape]
shapes))Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
:[Shape]
shapes

-- |Función básica, junta 2 listas de figuras.
addFigMult :: [Shape] -> [Shape] -> [Shape]
addFigMult :: [Shape] -> [Shape] -> [Shape]
addFigMult [Shape]
xs [Shape]
shapes = ([Shape] -> Shape -> [Shape]) -> [Shape] -> [Shape] -> [Shape]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Shape -> [Shape] -> [Shape]) -> [Shape] -> Shape -> [Shape]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Shape -> [Shape] -> [Shape]
addFig) [Shape]
shapes [Shape]
xs

-- |Función básica, convierte las figuras en luces de área.
encenderShapes :: [Shape] -> [Shape]
encenderShapes :: [Shape] -> [Shape]
encenderShapes = (Shape -> Shape) -> [Shape] -> [Shape]
forall a b. (a -> b) -> [a] -> [b]
map Shape -> Shape
encenderShape

-- |Función auxiliar, convierte una figura a luz de área.
encenderShape :: Shape -> Shape
encenderShape :: Shape -> Shape
encenderShape (Plane (Plano {Float
Int
(Float, Float, Float)
RGB
Direction
Point3D
idPl :: Int
reflPl :: Float
trPl :: (Float, Float, Float)
rgbPl :: RGB
normPl :: Direction
centPl :: Point3D
idPl :: Plano -> Int
reflPl :: Plano -> Float
trPl :: Plano -> (Float, Float, Float)
rgbPl :: Plano -> RGB
normPl :: Plano -> Direction
centPl :: Plano -> Point3D
..})) = Plano -> Shape
Plane (Point3D
-> Direction
-> RGB
-> (Float, Float, Float)
-> Float
-> Int
-> Plano
Plano Point3D
centPl Direction
normPl RGB
rgbPl (Float, Float, Float)
trPl Float
reflPl (-Int
idPl))
encenderShape (Sphere (Esfera {Float
Int
(Float, Float, Float)
RGB
Point3D
idEs :: Int
reflEs :: Float
trEs :: (Float, Float, Float)
rgbEs :: RGB
radEs :: Float
centEs :: Point3D
idEs :: Esfera -> Int
reflEs :: Esfera -> Float
trEs :: Esfera -> (Float, Float, Float)
rgbEs :: Esfera -> RGB
radEs :: Esfera -> Float
centEs :: Esfera -> Point3D
..})) = Esfera -> Shape
Sphere (Point3D
-> Float -> RGB -> (Float, Float, Float) -> Float -> Int -> Esfera
Esfera Point3D
centEs Float
radEs RGB
rgbEs (Float, Float, Float)
trEs Float
reflEs (-Int
idEs))
encenderShape (Triangle (Triangulo {Float
Int
(Float, Float, Float)
RGB
Point3D
Point2D
idTr :: Int
reflTr :: Float
trTr :: (Float, Float, Float)
rgbTr :: RGB
uv2Tr :: Point2D
uv1Tr :: Point2D
uv0Tr :: Point2D
p2Tr :: Point3D
p1Tr :: Point3D
p0Tr :: Point3D
idTr :: Triangulo -> Int
reflTr :: Triangulo -> Float
trTr :: Triangulo -> (Float, Float, Float)
rgbTr :: Triangulo -> RGB
uv2Tr :: Triangulo -> Point2D
uv1Tr :: Triangulo -> Point2D
uv0Tr :: Triangulo -> Point2D
p2Tr :: Triangulo -> Point3D
p1Tr :: Triangulo -> Point3D
p0Tr :: Triangulo -> Point3D
..})) = Triangulo -> Shape
Triangle (Point3D
-> Point3D
-> Point3D
-> Point2D
-> Point2D
-> Point2D
-> RGB
-> (Float, Float, Float)
-> Float
-> Int
-> Triangulo
Triangulo Point3D
p0Tr Point3D
p1Tr Point3D
p2Tr Point2D
uv0Tr Point2D
uv1Tr Point2D
uv2Tr RGB
rgbTr (Float, Float, Float)
trTr Float
reflTr (-Int
idTr))

{-# INLINE parametricShapeCollision #-}
-- |Función básica, dada una figuro y una lista de rayos, devuelve la lista de colisiones de cada uno de los rayos con la figura.
parametricShapeCollision :: Set.Set Shape -> [Ray] -> [Set.Set Obj]
parametricShapeCollision :: Set Shape -> [Ray] -> [Set Obj]
parametricShapeCollision Set Shape
shapes [Ray]
rays = (Ray -> Set Obj) -> [Ray] -> [Set Obj]
forall a b. (a -> b) -> [a] -> [b]
map (Set Shape -> Ray -> Set Obj
collision Set Shape
shapes) [Ray]
rays
  where
    collision :: Set Shape -> Ray -> Set Obj
collision Set Shape
shapes Ray
ray = (Shape -> Obj) -> Set Shape -> Set Obj
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Shape -> Ray -> Obj
`oneCollision` Ray
ray) Set Shape
shapes

{-# INLINE oneCollision #-}
oneCollision :: Shape -> Ray -> Obj
-- |Función auxiliar, dada una figura y un rayo traza la colisión.
oneCollision :: Shape -> Ray -> Obj
oneCollision es :: Shape
es@(Sphere (Esfera {Float
Int
(Float, Float, Float)
RGB
Point3D
idEs :: Int
reflEs :: Float
trEs :: (Float, Float, Float)
rgbEs :: RGB
radEs :: Float
centEs :: Point3D
idEs :: Esfera -> Int
reflEs :: Esfera -> Float
trEs :: Esfera -> (Float, Float, Float)
rgbEs :: Esfera -> RGB
radEs :: Esfera -> Float
centEs :: Esfera -> Point3D
..})) (Ray {Direction
Point3D
dR :: Direction
oR :: Point3D
dR :: Ray -> Direction
oR :: Ray -> Point3D
..}) =
    let f :: Direction
f = Point3D
oR Point3D -> Point3D -> Direction
#< Point3D
centEs
        a :: Float
a = Direction
dR Direction -> Direction -> Float
.* Direction
dR
        b :: Float
b = Float
2.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Direction
f Direction -> Direction -> Float
.* Direction
dR)
        c :: Float
c = Direction
f Direction -> Direction -> Float
.* Direction
f Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
radEs Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
radEs
        raiz :: Float
raiz = Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
4.0Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
aFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
c
    in
        (if Float
raiz Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then (let t0 :: Float
t0 = (-Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float -> Float
forall a. Floating a => a -> a
sqrt Float
raiz) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
2.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
a)
                               t1 :: Float
t1 = (-Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
forall a. Floating a => a -> a
sqrt Float
raiz) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
2.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
a)
                               mind :: Float
mind = Float -> Float -> Float
findMinPositive Float
t0 Float
t1
                               collisionPoint :: Point3D
collisionPoint = Direction -> Point3D -> Point3D
movePoint (Float -> Direction -> Direction
escalateDir Float
mind Direction
dR) Point3D
oR
                               vectorNormal :: Direction
vectorNormal = Direction -> Direction
normal (Direction -> Direction) -> Direction -> Direction
forall a b. (a -> b) -> a -> b
$ Point3D
collisionPoint Point3D -> Point3D -> Direction
#< Point3D
centEs
                           in if Float
t0 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
|| Float
t1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0
                               then (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj Float
mind RGB
rgbEs Direction
dR Point3D
collisionPoint Direction
vectorNormal (Float, Float, Float)
trEs Float
reflEs Int
idEs Shape
es)
                               else (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj (-Float
1) (Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0) Direction
dR (Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) (Float -> Float -> Float -> Direction
Direction Float
0 Float
0 Float
0) (Float, Float, Float)
trEs Float
reflEs Int
0 Shape
es)) else (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj (-Float
1) (Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0) Direction
dR (Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) (Float -> Float -> Float -> Direction
Direction Float
0 Float
0 Float
0) (Float, Float, Float)
trEs Float
reflEs Int
0 Shape
es))

oneCollision pl :: Shape
pl@(Plane (Plano {Float
Int
(Float, Float, Float)
RGB
Direction
Point3D
idPl :: Int
reflPl :: Float
trPl :: (Float, Float, Float)
rgbPl :: RGB
normPl :: Direction
centPl :: Point3D
idPl :: Plano -> Int
reflPl :: Plano -> Float
trPl :: Plano -> (Float, Float, Float)
rgbPl :: Plano -> RGB
normPl :: Plano -> Direction
centPl :: Plano -> Point3D
..})) (Ray {Direction
Point3D
dR :: Direction
oR :: Point3D
dR :: Ray -> Direction
oR :: Ray -> Point3D
..}) = (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj Float
mind RGB
rgbPl Direction
dR Point3D
collisionPoint Direction
vectorNormal (Float, Float, Float)
trPl Float
reflPl Int
idPl Shape
pl)
  where
    mind :: Float
mind = ((Point3D
centPl Point3D -> Point3D -> Direction
#< Point3D
oR) Direction -> Direction -> Float
.* Direction
vectorNormal) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Direction
dR Direction -> Direction -> Float
.* Direction
vectorNormal)
    collisionPoint :: Point3D
collisionPoint = Direction -> Point3D -> Point3D
movePoint (Float -> Direction -> Direction
escalateDir Float
mind Direction
dR) Point3D
oR
    vectorNormal :: Direction
vectorNormal = if (Direction
dRDirection -> Direction -> Float
.*Direction
normPl) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then Direction -> Direction
normal (Float -> Direction -> Direction
escalateDir (-Float
1) Direction
normPl) else Direction -> Direction
normal Direction
normPl


oneCollision cl :: Shape
cl@(Cylinder(Cilindro Point3D
p0 Direction
n Float
r RGB
color (Float, Float, Float)
reflec Float
kr Int
id)) (Ray {Direction
Point3D
dR :: Direction
oR :: Point3D
dR :: Ray -> Direction
oR :: Ray -> Point3D
..}) = (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj Float
mind RGB
color Direction
dR Point3D
collisionPoint Direction
vectorNormal (Float, Float, Float)
reflec Float
kr Int
id Shape
cl)
  where
    mind :: Float
mind = Float -> Float -> Float
findMinPositive Float
t1 Float
t2
    t1 :: Float
t1 = ((Point3D
p0 Point3D -> Point3D -> Direction
#< Point3D
oR) Direction -> Direction -> Float
.* Direction
vectorNormal Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float -> Float
forall a. Floating a => a -> a
sqrt Float
discriminant) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Direction
dR Direction -> Direction -> Float
.* Direction
vectorNormal)
    t2 :: Float
t2 = ((Point3D
p0 Point3D -> Point3D -> Direction
#< Point3D
oR) Direction -> Direction -> Float
.* Direction
vectorNormal Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
forall a. Floating a => a -> a
sqrt Float
discriminant) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Direction
dR Direction -> Direction -> Float
.* Direction
vectorNormal)
    discriminant :: Float
discriminant = ((Point3D
oR Point3D -> Point3D -> Direction
#< Point3D
p0) Direction -> Direction -> Float
.* (Point3D
oR Point3D -> Point3D -> Direction
#< Point3D
p0)) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r
    collisionPoint :: Point3D
collisionPoint = Direction -> Point3D -> Point3D
movePoint (Float -> Direction -> Direction
escalateDir Float
mind Direction
dR) Point3D
oR
    vectorNormal :: Direction
vectorNormal = if (Direction
dRDirection -> Direction -> Float
.*Direction
n)Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>Float
0 then Direction -> Direction
normal (Float -> Direction -> Direction
escalateDir (-Float
1) Direction
n) else Direction -> Direction
normal Direction
n


oneCollision acl :: Shape
acl@(Acelerator (BVH {Int
[BVH]
[Triangulo]
AABB
idBvh :: Int
triangulos :: [Triangulo]
bvhs :: [BVH]
aabb :: AABB
idBvh :: BVH -> Int
triangulos :: BVH -> [Triangulo]
bvhs :: BVH -> [BVH]
aabb :: BVH -> AABB
..})) Ray
ray =
    if Ray -> AABB -> Bool
rayIntersectsAABB Ray
ray AABB
aabb
        then
            if [BVH] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BVH]
bvhs
                then
                    Shape -> Ray -> Obj
oneCollision (Triangulo -> Shape
Triangle (Triangulo -> Shape) -> Triangulo -> Shape
forall a b. (a -> b) -> a -> b
$ (Float, Triangulo) -> Triangulo
forall a b. (a, b) -> b
snd(Ray -> [Triangulo] -> (Float, Triangulo)
closestIntersection Ray
ray [Triangulo]
triangulos)) Ray
ray
                else
                    let childCollisions :: [Obj]
childCollisions = (Obj -> Bool) -> [Obj] -> [Obj]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Obj
obj -> Obj -> Float
mindObj Obj
obj Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= -Float
1) ([Obj] -> [Obj]) -> [Obj] -> [Obj]
forall a b. (a -> b) -> a -> b
$ (BVH -> Obj) -> [BVH] -> [Obj]
forall a b. (a -> b) -> [a] -> [b]
map (\BVH
ch -> Shape -> Ray -> Obj
oneCollision (BVH -> Shape
Acelerator BVH
ch) Ray
ray ) [BVH]
bvhs

                    in case [Obj]
childCollisions of
                        [] -> (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj (-Float
1) (Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0) (Ray -> Direction
dR Ray
ray) (Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) (Float -> Float -> Float -> Direction
Direction Float
0 Float
0 Float
0) (Float
0,Float
0,Float
0) Float
0 Int
0 Shape
acl)
                        [Obj]
_ -> let mindObj :: Obj
mindObj = [Obj] -> Obj
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Obj]
childCollisions
                             in Obj
mindObj
        else (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj (-Float
1) (Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0) (Ray -> Direction
dR Ray
ray) (Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) (Float -> Float -> Float -> Direction
Direction Float
0 Float
0 Float
0) (Float
0,Float
0,Float
0) Float
0 Int
0 Shape
acl)


oneCollision  rct :: Shape
rct@(Rectangle (Rectangulo {Float
Int
(Float, Float, Float)
RGB
Direction
Point3D
idRe :: Int
reflRe :: Float
trRe :: (Float, Float, Float)
rgbRe :: RGB
ancRe :: Float
altRe :: Float
tngRe :: Direction
normRe :: Direction
centRe :: Point3D
idRe :: Rectangulo -> Int
reflRe :: Rectangulo -> Float
trRe :: Rectangulo -> (Float, Float, Float)
rgbRe :: Rectangulo -> RGB
ancRe :: Rectangulo -> Float
altRe :: Rectangulo -> Float
tngRe :: Rectangulo -> Direction
normRe :: Rectangulo -> Direction
centRe :: Rectangulo -> Point3D
..})) (Ray {Direction
Point3D
dR :: Direction
oR :: Point3D
dR :: Ray -> Direction
oR :: Ray -> Point3D
..})
  | Float
denom Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0 Bool -> Bool -> Bool
&& Float
t Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
&& Bool
withinBounds = (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj Float
t RGB
rgbRe Direction
dR (Direction -> Point3D
dirPoint Direction
collisionPoint) Direction
normRe' (Float, Float, Float)
trRe Float
reflRe Int
idRe Shape
rct)
  | Bool
otherwise = (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj (-Float
1) (Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0) Direction
dR (Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) (Float -> Float -> Float -> Direction
Direction Float
0 Float
0 Float
0) (Float, Float, Float)
trRe Float
reflRe Int
0 Shape
rct )
  where
    offset :: Direction
offset = Direction
collisionPoint Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
- Point3D -> Direction
pointDir Point3D
centRe
    localX :: Float
localX = Direction
offset Direction -> Direction -> Float
.* Direction
right
    localY :: Float
localY = Direction
offset Direction -> Direction -> Float
.* Direction
up
    halfWidth :: Float
halfWidth = Float
ancRe Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
    halfHeight :: Float
halfHeight = Float
altRe Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
    collisionPoint :: Direction
collisionPoint = Point3D -> Direction
pointDir Point3D
oR Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
+ Float -> Direction -> Direction
escalateDir Float
t Direction
dR
    t :: Float
t = (Point3D
centRe Point3D -> Point3D -> Direction
#< Point3D
oR) Direction -> Direction -> Float
.* Direction
normRe Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
denom
    withinBounds :: Bool
withinBounds = -Float
halfWidth Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
localX Bool -> Bool -> Bool
&& Float
localX Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
halfWidth Bool -> Bool -> Bool
&& -Float
halfHeight Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
localY Bool -> Bool -> Bool
&& Float
localY Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
halfHeight
    denom :: Float
denom = Direction
dR Direction -> Direction -> Float
.* Direction
normRe
    right :: Direction
right = Direction -> Direction
normal Direction
tngRe
    up :: Direction
up = Direction
normRe Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
* Direction
right
    normRe' :: Direction
normRe' = if Direction
dR Direction -> Direction -> Float
.* Direction
normRe Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then Direction -> Direction
normal (Float -> Direction -> Direction
escalateDir (-Float
1) Direction
normRe) else Direction -> Direction
normal Direction
normRe

oneCollision cn :: Shape
cn@(Cone (Cono{Float
Int
(Float, Float, Float)
RGB
Point3D
idCo :: Int
reflCo :: Float
trCo :: (Float, Float, Float)
rgbCo :: RGB
radCo :: Float
altCo :: Float
centCo :: Point3D
idCo :: Cono -> Int
reflCo :: Cono -> Float
trCo :: Cono -> (Float, Float, Float)
rgbCo :: Cono -> RGB
radCo :: Cono -> Float
altCo :: Cono -> Float
centCo :: Cono -> Point3D
..})) (Ray{Direction
Point3D
dR :: Direction
oR :: Point3D
dR :: Ray -> Direction
oR :: Ray -> Point3D
..})
  | Float
denom Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0  Bool -> Bool -> Bool
|| Float
t Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 = (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj (-Float
1) (Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0) Direction
dR (Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) (Float -> Float -> Float -> Direction
Direction Float
0 Float
0 Float
0) (Float
0,Float
0,Float
0) Float
0 Int
0 Shape
cn)
  | Bool
otherwise = String -> Obj -> Obj
forall a. String -> a -> a
trace (Float -> String
forall a. Show a => a -> String
show Float
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Point3D -> String
forall a. Show a => a -> String
show Point3D
collisionPoint) (Obj -> Obj) -> Obj -> Obj
forall a b. (a -> b) -> a -> b
$ (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj Float
t RGB
rgbCo Direction
dR Point3D
collisionPoint Direction
normCo (Float, Float, Float)
trCo Float
reflCo Int
idCo Shape
cn)
    where
        t :: Float
t = Float -> Float -> Float
findMinPositive Float
t1 Float
t2
        collisionPoint :: Point3D
collisionPoint = Direction -> Point3D -> Point3D
movePoint (Float -> Direction -> Direction
escalateDir Float
t Direction
dR) Point3D
oR
        normCo :: Direction
normCo = Direction -> Direction
normal (Direction -> Direction) -> Direction -> Direction
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Direction
Direction (Point3D -> Float
xP Point3D
centCo) (Float
radCo Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
tan) (Point3D -> Float
zP Point3D
centCo)
        denom :: Float
denom = (Float
bFloat -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
4 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
c)
        t1 :: Float
t1 = (-Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float -> Float
forall a. Floating a => a -> a
sqrt (Float
denom)) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
a)
        t2 :: Float
t2 = (-Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
forall a. Floating a => a -> a
sqrt (Float
denom)) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
a)

        tan :: Float
tan = (Float
radCo Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
altCo)Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2
        a :: Float
a = ((Direction -> Float
xD Direction
dR)Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ ((Direction -> Float
zD Direction
dR)Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (((Float
tanFloat -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Direction -> Float
yD Direction
dR))Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2)

        b :: Float
b = (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* ((Point3D -> Float
xP Point3D
centCo) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Point3D -> Float
xP Point3D
oR)) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Direction -> Float
xD Direction
dR)) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* ((Point3D -> Float
zP Point3D
centCo) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Point3D -> Float
zP Point3D
oR)) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Direction -> Float
zD Direction
dR)) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
tanFloat -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
altCo Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Point3D -> Float
yP Point3D
oR) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Point3D -> Float
yP Point3D
centCo)) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Direction -> Float
yD Direction
dR))
        c :: Float
c = (((Point3D -> Float
xP Point3D
centCo) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Point3D -> Float
xP Point3D
oR))Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (((Point3D -> Float
zP Point3D
centCo) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Point3D -> Float
zP Point3D
oR))Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
tanFloat -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
altCo Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Point3D -> Float
yP Point3D
oR) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Point3D -> Float
yP Point3D
centCo))Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2

oneCollision tr :: Shape
tr@(Triangle (Triangulo {Float
Int
(Float, Float, Float)
RGB
Point3D
Point2D
idTr :: Int
reflTr :: Float
trTr :: (Float, Float, Float)
rgbTr :: RGB
uv2Tr :: Point2D
uv1Tr :: Point2D
uv0Tr :: Point2D
p2Tr :: Point3D
p1Tr :: Point3D
p0Tr :: Point3D
idTr :: Triangulo -> Int
reflTr :: Triangulo -> Float
trTr :: Triangulo -> (Float, Float, Float)
rgbTr :: Triangulo -> RGB
uv2Tr :: Triangulo -> Point2D
uv1Tr :: Triangulo -> Point2D
uv0Tr :: Triangulo -> Point2D
p2Tr :: Triangulo -> Point3D
p1Tr :: Triangulo -> Point3D
p0Tr :: Triangulo -> Point3D
..})) (Ray {Direction
Point3D
dR :: Direction
oR :: Point3D
dR :: Ray -> Direction
oR :: Ray -> Point3D
..}) =
    case Point3D
-> Direction
-> Point3D
-> Point3D
-> Point3D
-> Maybe (Float, Point3D)
ray1TriangleIntersection Point3D
oR Direction
dR Point3D
p0Tr Point3D
p1Tr Point3D
p2Tr of
        Just (Float
t, Point3D
intersectionPoint) ->
            let normalVec :: Direction
normalVec = (Point3D
p1Tr Point3D -> Point3D -> Direction
#< Point3D
p0Tr) Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
* (Point3D
p2Tr Point3D -> Point3D -> Direction
#< Point3D
p0Tr)
                normalVec' :: Direction
normalVec' = if (Direction
dRDirection -> Direction -> Float
.*Direction
normalVec) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then Direction -> Direction
normal (Float -> Direction -> Direction
escalateDir (-Float
1) Direction
normalVec) else Direction -> Direction
normal Direction
normalVec
            in (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj Float
t RGB
rgbTr Direction
dR Point3D
intersectionPoint Direction
normalVec' (Float, Float, Float)
trTr Float
reflTr Int
idTr Shape
tr)
        Maybe (Float, Point3D)
Nothing -> (Float
-> RGB
-> Direction
-> Point3D
-> Direction
-> (Float, Float, Float)
-> Float
-> Int
-> Shape
-> Obj
Obj (-Float
1) (Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0) Direction
dR (Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) (Float -> Float -> Float -> Direction
Direction Float
0 Float
0 Float
0) (Float
0,Float
0,Float
0) Float
0 Int
0 Shape
tr)


-- |Función auxiliar, devuelve el id interno de las figuras.
{-# INLINE getShapeID #-}
getShapeID :: Shape -> Int
getShapeID :: Shape -> Int
getShapeID (Sphere (Esfera{Float
Int
(Float, Float, Float)
RGB
Point3D
idEs :: Int
reflEs :: Float
trEs :: (Float, Float, Float)
rgbEs :: RGB
radEs :: Float
centEs :: Point3D
idEs :: Esfera -> Int
reflEs :: Esfera -> Float
trEs :: Esfera -> (Float, Float, Float)
rgbEs :: Esfera -> RGB
radEs :: Esfera -> Float
centEs :: Esfera -> Point3D
..})) = Int
idEs
getShapeID (Plane (Plano {Float
Int
(Float, Float, Float)
RGB
Direction
Point3D
idPl :: Int
reflPl :: Float
trPl :: (Float, Float, Float)
rgbPl :: RGB
normPl :: Direction
centPl :: Point3D
idPl :: Plano -> Int
reflPl :: Plano -> Float
trPl :: Plano -> (Float, Float, Float)
rgbPl :: Plano -> RGB
normPl :: Plano -> Direction
centPl :: Plano -> Point3D
..})) = Int
idPl
getShapeID (Triangle (Triangulo {Float
Int
(Float, Float, Float)
RGB
Point3D
Point2D
idTr :: Int
reflTr :: Float
trTr :: (Float, Float, Float)
rgbTr :: RGB
uv2Tr :: Point2D
uv1Tr :: Point2D
uv0Tr :: Point2D
p2Tr :: Point3D
p1Tr :: Point3D
p0Tr :: Point3D
idTr :: Triangulo -> Int
reflTr :: Triangulo -> Float
trTr :: Triangulo -> (Float, Float, Float)
rgbTr :: Triangulo -> RGB
uv2Tr :: Triangulo -> Point2D
uv1Tr :: Triangulo -> Point2D
uv0Tr :: Triangulo -> Point2D
p2Tr :: Triangulo -> Point3D
p1Tr :: Triangulo -> Point3D
p0Tr :: Triangulo -> Point3D
..})) = Int
idTr
getShapeID (Cylinder (Cilindro Point3D
_ Direction
_ Float
_ RGB
_ (Float, Float, Float)
_ Float
_ Int
id)) = Int
id
getShapeID (Rectangle(Rectangulo{Float
Int
(Float, Float, Float)
RGB
Direction
Point3D
idRe :: Int
reflRe :: Float
trRe :: (Float, Float, Float)
rgbRe :: RGB
ancRe :: Float
altRe :: Float
tngRe :: Direction
normRe :: Direction
centRe :: Point3D
idRe :: Rectangulo -> Int
reflRe :: Rectangulo -> Float
trRe :: Rectangulo -> (Float, Float, Float)
rgbRe :: Rectangulo -> RGB
ancRe :: Rectangulo -> Float
altRe :: Rectangulo -> Float
tngRe :: Rectangulo -> Direction
normRe :: Rectangulo -> Direction
centRe :: Rectangulo -> Point3D
..})) = Int
idRe
getShapeID (Acelerator(BVH{Int
[BVH]
[Triangulo]
AABB
idBvh :: Int
triangulos :: [Triangulo]
bvhs :: [BVH]
aabb :: AABB
idBvh :: BVH -> Int
triangulos :: BVH -> [Triangulo]
bvhs :: BVH -> [BVH]
aabb :: BVH -> AABB
..})) = Int
idBvh
getShapeID (Cone (Cono{Float
Int
(Float, Float, Float)
RGB
Point3D
idCo :: Int
reflCo :: Float
trCo :: (Float, Float, Float)
rgbCo :: RGB
radCo :: Float
altCo :: Float
centCo :: Point3D
idCo :: Cono -> Int
reflCo :: Cono -> Float
trCo :: Cono -> (Float, Float, Float)
rgbCo :: Cono -> RGB
radCo :: Cono -> Float
altCo :: Cono -> Float
centCo :: Cono -> Point3D
..})) = Int
idCo
-- getShapeID (Donut (Rosquilla _ _ _ _ _ _ _ id)) = id

-- |Función auxiliar, dado un rayo(descompuesto) y un triángulo(descompuesto) cálcula la intersección.
{-# INLINE ray1TriangleIntersection #-}
ray1TriangleIntersection :: Point3D -> Direction -> Point3D -> Point3D -> Point3D -> Maybe (Float, Point3D)
ray1TriangleIntersection :: Point3D
-> Direction
-> Point3D
-> Point3D
-> Point3D
-> Maybe (Float, Point3D)
ray1TriangleIntersection Point3D
orig Direction
dir Point3D
v1 Point3D
v2 Point3D
v3 = do
    let e1 :: Direction
e1 = Point3D
v2 Point3D -> Point3D -> Direction
#< Point3D
v1
        e2 :: Direction
e2 = Point3D
v3 Point3D -> Point3D -> Direction
#< Point3D
v1
        h :: Direction
h = Direction
dir Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
* Direction
e2
        a :: Float
a = Direction
e1 Direction -> Direction -> Float
.* Direction
h
    if Float -> Float
forall a. Num a => a -> a
abs Float
a Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
1e-5
        then Maybe (Float, Point3D)
forall a. Maybe a
Nothing
        else do
            let f :: Float
f = Float
1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
a
                s :: Direction
s = Point3D
orig Point3D -> Point3D -> Direction
#< Point3D
v1
                u :: Float
u = Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Direction
s Direction -> Direction -> Float
.* Direction
h)
            if Float
u Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.0 Bool -> Bool -> Bool
|| Float
u Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
1.0
                then Maybe (Float, Point3D)
forall a. Maybe a
Nothing
                else do
                    let q :: Direction
q = Direction
s Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
* Direction
e1
                        v :: Float
v = Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Direction
dir Direction -> Direction -> Float
.* Direction
q)
                    if Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.0 Bool -> Bool -> Bool
|| Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
1.0
                        then Maybe (Float, Point3D)
forall a. Maybe a
Nothing
                        else do
                            let t :: Float
t = Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Direction
e2 Direction -> Direction -> Float
.* Direction
q)
                            if Float
t Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
1e-5
                                then (Float, Point3D) -> Maybe (Float, Point3D)
forall a. a -> Maybe a
Just (Float
t, Direction -> Point3D -> Point3D
movePoint (Float -> Direction -> Direction
escalateDir Float
t Direction
dir) Point3D
orig)
                                else Maybe (Float, Point3D)
forall a. Maybe a
Nothing


-- |Función auxiliar, convierte de triangle a triangulo.
{-# INLINE triangleToTriangulo #-}
triangleToTriangulo :: RGB -> (Float,Float,Float) -> Float -> Int -> ([Point3D], TrianglePos,[Point2D], TrianglePos) -> Triangulo
triangleToTriangulo :: RGB
-> (Float, Float, Float)
-> Float
-> Int
-> ([Point3D], TrianglePos, [Point2D], TrianglePos)
-> Triangulo
triangleToTriangulo RGB
rgb (Float
kd,Float
ke,Float
kr) Float
reflec Int
id ([Point3D]
vertices, TrianglePos Int
v1 Int
v2 Int
v3, [Point2D]
texturas, TrianglePos Int
t1 Int
t2 Int
t3) =
    (Point3D
-> Point3D
-> Point3D
-> Point2D
-> Point2D
-> Point2D
-> RGB
-> (Float, Float, Float)
-> Float
-> Int
-> Triangulo
Triangulo
        ([Point3D]
vertices [Point3D] -> Int -> Point3D
forall a. [a] -> Int -> a
!! (Int
v1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ([Point3D]
vertices [Point3D] -> Int -> Point3D
forall a. [a] -> Int -> a
!! (Int
v2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ([Point3D]
vertices [Point3D] -> Int -> Point3D
forall a. [a] -> Int -> a
!! (Int
v3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ([Point2D]
texturas [Point2D] -> Int -> Point2D
forall a. [a] -> Int -> a
!! (Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ([Point2D]
texturas [Point2D] -> Int -> Point2D
forall a. [a] -> Int -> a
!! (Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ([Point2D]
texturas [Point2D] -> Int -> Point2D
forall a. [a] -> Int -> a
!! (Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
        RGB
rgb (Float
kd,Float
ke,Float
kr) Float
reflec Int
id
    )
    -- where
        -- v1' = vertices !! (v1 - 1)
        -- v2' = vertices !! (v2 - 1)
        -- v3' = vertices !! (v3 - 1)
        -- vNormal = normal $ (v2' #< v1') * (v3' #< v1')

-- |Función básica, convierte los tríangulos y vértices cargados al formato deseado(color,propiedades).
{-# INLINE convertToCustomFormat #-}
convertToCustomFormat :: RGB -> (Float,Float,Float) -> Float -> Int -> ([Point3D], [TrianglePos], [Point2D], [TrianglePos]) -> [Triangulo]
convertToCustomFormat :: RGB
-> (Float, Float, Float)
-> Float
-> Int
-> ([Point3D], [TrianglePos], [Point2D], [TrianglePos])
-> [Triangulo]
convertToCustomFormat RGB
rgb (Float
kd,Float
ke,Float
kr) Float
reflec Int
id ([Point3D]
vertices, [TrianglePos]
triangles, [Point2D]
texturas, [TrianglePos]
texttring) = ((TrianglePos, TrianglePos) -> Triangulo)
-> [(TrianglePos, TrianglePos)] -> [Triangulo]
forall a b. (a -> b) -> [a] -> [b]
map (RGB
-> (Float, Float, Float)
-> Float
-> Int
-> ([Point3D], TrianglePos, [Point2D], TrianglePos)
-> Triangulo
triangleToTriangulo RGB
rgb (Float
kd,Float
ke,Float
kr) Float
reflec Int
id (([Point3D], TrianglePos, [Point2D], TrianglePos) -> Triangulo)
-> ((TrianglePos, TrianglePos)
    -> ([Point3D], TrianglePos, [Point2D], TrianglePos))
-> (TrianglePos, TrianglePos)
-> Triangulo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TrianglePos, TrianglePos)
-> ([Point3D], TrianglePos, [Point2D], TrianglePos)
resolveVertices) ([(TrianglePos, TrianglePos)] -> [Triangulo])
-> [(TrianglePos, TrianglePos)] -> [Triangulo]
forall a b. (a -> b) -> a -> b
$ [TrianglePos] -> [TrianglePos] -> [(TrianglePos, TrianglePos)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TrianglePos]
triangles [TrianglePos]
texttring
  where
    resolveVertices :: (TrianglePos, TrianglePos)
-> ([Point3D], TrianglePos, [Point2D], TrianglePos)
resolveVertices ((TrianglePos Int
v1 Int
v2 Int
v3),(TrianglePos Int
t1 Int
t2 Int
t3)) = ([Point3D]
vertices, Int -> Int -> Int -> TrianglePos
TrianglePos Int
v1 Int
v2 Int
v3, [Point2D]
texturas, Int -> Int -> Int -> TrianglePos
TrianglePos Int
t1 Int
t2 Int
t3)

-- |Función auxiliar, dada una línea del .obj parsea el triángulo que esta contiene.
{-# INLINE parseTriangle #-}
parseTriangle :: String -> Maybe [TrianglePos]
parseTriangle :: String -> Maybe [TrianglePos]
parseTriangle String
line = case String -> [String]
words String
line of
    [String
"f", String
v1Str, String
v1Tex, String
v2Str,String
v2Tex, String
v3Str,String
v3Tex] -> [TrianglePos] -> Maybe [TrianglePos]
forall a. a -> Maybe a
Just ([TrianglePos] -> Maybe [TrianglePos])
-> [TrianglePos] -> Maybe [TrianglePos]
forall a b. (a -> b) -> a -> b
$ [Int -> Int -> Int -> TrianglePos
TrianglePos (String -> Int
forall a. Read a => String -> a
read String
v1Str) (String -> Int
forall a. Read a => String -> a
read String
v2Str) (String -> Int
forall a. Read a => String -> a
read String
v3Str), Int -> Int -> Int -> TrianglePos
TrianglePos (String -> Int
forall a. Read a => String -> a
read String
v1Tex) (String -> Int
forall a. Read a => String -> a
read String
v2Tex) (String -> Int
forall a. Read a => String -> a
read String
v3Tex)]
    -- ["f", v1Str, v2Str, v3Str] -> Just $ [(TrianglePos (read v1Str) (read v2Str) (read v3Str)),(TrianglePos 0 0 0)]
    [String]
_ -> Maybe [TrianglePos]
forall a. Maybe a
Nothing


-- |Función auxiliar, parsea una línea del .obj a punto 3D.
{-# INLINE parsePoint3D #-}
parsePoint3D :: String -> Maybe Point3D
parsePoint3D :: String -> Maybe Point3D
parsePoint3D String
line = case String -> [String]
words String
line of
    [String
"v", String
xStr, String
yStr, String
zStr] -> Point3D -> Maybe Point3D
forall a. a -> Maybe a
Just (Point3D -> Maybe Point3D) -> Point3D -> Maybe Point3D
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Point3D
Point3D (String -> Float
forall a. Read a => String -> a
read String
xStr) (String -> Float
forall a. Read a => String -> a
read String
yStr) (String -> Float
forall a. Read a => String -> a
read String
zStr)
    [String]
_ -> Maybe Point3D
forall a. Maybe a
Nothing

-- |Función auxiliar, parsea una línea del .obj a punto 3D.
{-# INLINE parsePoint2D #-}
parsePoint2D :: String -> Maybe Point2D
parsePoint2D :: String -> Maybe Point2D
parsePoint2D String
line = case String -> [String]
words String
line of
    [String
"vt", String
uStr, String
vStr] -> Point2D -> Maybe Point2D
forall a. a -> Maybe a
Just (Point2D -> Maybe Point2D) -> Point2D -> Maybe Point2D
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Point2D
Point2D (String -> Float
forall a. Read a => String -> a
read String
uStr) (String -> Float
forall a. Read a => String -> a
read String
vStr)
    [String]
_ -> Maybe Point2D
forall a. Maybe a
Nothing

-- |Función básica, extrae los vértices y triángulos de un fichero .obj.
{-# INLINE loadObjFile #-}
loadObjFile :: FilePath -> IO ([Point2D],[Point3D], [[TrianglePos]])
loadObjFile :: String -> IO ([Point2D], [Point3D], [[TrianglePos]])
loadObjFile String
filePath = do
    String
contents <- String -> IO String
readFile String
filePath
    let  lines' :: [String]
lines' = String -> [String]
lines String
contents
         validTexturePoints :: [Point2D]
validTexturePoints = (String -> Maybe Point2D) -> [String] -> [Point2D]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Point2D
parsePoint2D [String]
lines'
         validVertices :: [Point3D]
validVertices = (String -> Maybe Point3D) -> [String] -> [Point3D]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Point3D
parsePoint3D [String]
lines'
         validTriangles :: [[TrianglePos]]
validTriangles = (String -> Maybe [TrianglePos]) -> [String] -> [[TrianglePos]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe [TrianglePos]
parseTriangle [String]
lines'
    ([Point2D], [Point3D], [[TrianglePos]])
-> IO ([Point2D], [Point3D], [[TrianglePos]])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Point2D]
validTexturePoints, [Point3D]
validVertices, [[TrianglePos]]
validTriangles)

-- |Función auxiliar, convierte de punto3D a punto3D (convierte contenido a floats).
{-# INLINE vertexToPoint3D #-}
vertexToPoint3D :: Point3D -> Point3D
vertexToPoint3D :: Point3D -> Point3D
vertexToPoint3D (Point3D Float
x Float
y Float
z) = Float -> Float -> Float -> Point3D
Point3D (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y) (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z)

-- |Función auxiliar, devuelve el mínimo(este debe ser positivo).
{-# INLINE findMinPositive #-}
findMinPositive :: Float -> Float -> Float
findMinPositive :: Float -> Float -> Float
findMinPositive Float
x Float
y
    | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
&& Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x Float
y
    | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0          = Float
x
    | Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0          = Float
y
    | Bool
otherwise      = -Float
1