{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Funciones where

import Codec.Picture
import Elem3D
    ( RGB(..),
      Luz(..),
      Base(..),
      Ray(..),
      Direction(..),
      Point3D(..),
      (#<),
      aproxPoint,
      (.*),
      escalateDir, escalateDir',
      modd,
      normal,
      modRGB,
      divRGB,
      scale,
      generateBase,
      cambioBase, addPoints, pointDir, Foton, distFot, (#), escalatePoint,
      distPoint, movePoint, angleBetween )
import Figuras
    ( oneCollision,
      Camara(..),
      Obj(..),
      Rectangulo(Rectangulo),
      Shape(Null,Triangle),
       getShapeID, getUV )
import Tone_map(gammaFunc')

--import Math.Erf (erf)
import System.IO.Unsafe (unsafePerformIO)
import Data.Ord (comparing)
import Debug.Trace (trace)
import Data.List (transpose)
import System.Random (randomR, StdGen, randomRs,split, mkStdGen)

import Data.Binary (Word8)
import Data.Number.Erf
import Data.Foldable (toList)
import qualified Data.DList as DL
import qualified Data.Set as Set

--------------------------
--  FunciónES LIBRERIA  --
--------------------------
-- | Función auxiliar, divide una lista en n sublistas.
{-# INLINE chunksOf #-}
chunksOf :: Int -> [e] -> [[e]]
chunksOf :: forall e. Int -> [e] -> [[e]]
chunksOf Int
i [e]
ls = ([e] -> [e]) -> [[e]] -> [[e]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [e] -> [e]
forall a. Int -> [a] -> [a]
take Int
i) ((([e] -> [[e]] -> [[e]]) -> [[e]] -> [[e]]) -> [[e]]
forall a. ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build ([e] -> ([e] -> [[e]] -> [[e]]) -> [[e]] -> [[e]]
forall e a. [e] -> ([e] -> a -> a) -> a -> a
splitter [e]
ls))
  where
    splitter :: [e] -> ([e] -> a -> a) -> a -> a
    splitter :: forall e a. [e] -> ([e] -> a -> a) -> a -> a
splitter [] [e] -> a -> a
_ a
n = a
n
    splitter [e]
l [e] -> a -> a
c a
n = [e]
l [e] -> a -> a
`c` [e] -> ([e] -> a -> a) -> a -> a
forall e a. [e] -> ([e] -> a -> a) -> a -> a
splitter (Int -> [e] -> [e]
forall a. Int -> [a] -> [a]
drop Int
i [e]
l) [e] -> a -> a
c a
n

    build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
    build :: forall a. ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build (a -> [a] -> [a]) -> [a] -> [a]
g = (a -> [a] -> [a]) -> [a] -> [a]
g (:) []


--------------------------
-- FunciónES DE OBJETOS --
--------------------------

-- | Función auxiliar, que devuelve un objeto aleatorio tirado desde otro objeto.
{-# INLINE objAleatorio #-}
objAleatorio :: Set.Set Shape -> Obj -> StdGen -> Obj
objAleatorio :: Set Shape -> Obj -> StdGen -> Obj
objAleatorio Set Shape
figuras Obj
obj StdGen
gen = Obj
nxtObj
  where
    !nxtObj :: Obj
nxtObj = Set Obj -> Obj
obtenerPrimeraColision (Set Obj -> Obj) -> Set Obj -> Obj
forall a b. (a -> b) -> a -> b
$ (Shape -> Obj) -> Set Shape -> Set Obj
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\Shape
figura -> Shape -> Ray -> Obj
oneCollision Shape
figura (Point3D -> Direction -> Ray
Ray (Obj -> Point3D
colObj Obj
obj) (Direction -> Ray) -> Direction -> Ray
forall a b. (a -> b) -> a -> b
$ Direction -> Direction
normal (Point3D
puntoAl Point3D -> Point3D -> Direction
#< Obj -> Point3D
colObj Obj
obj))) Set Shape
figuras
    !puntoAl :: Point3D
puntoAl = Point3D -> Base -> Point3D -> Point3D
cambioBase (Obj -> Point3D
colObj Obj
obj) (Direction -> Direction -> Direction -> Base
generateBase Direction
dirAl (Obj -> Direction
normObj Obj
obj) (Direction -> Direction
normal (Direction
dirAl Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
* Obj -> Direction
normObj Obj
obj))) (Point3D -> Point3D) -> Point3D -> Point3D
forall a b. (a -> b) -> a -> b
$ StdGen -> Point3D
genPoint StdGen
gen
    !dirAl :: Direction
dirAl = Direction -> Direction
normal (Direction -> Direction) -> Direction -> Direction
forall a b. (a -> b) -> a -> b
$ Obj -> Direction
normObj Obj
obj Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
* Float -> Float -> Float -> Direction
Direction Float
2 Float
1 (-Float
2)

-- | Función auxiliar, que devuelve el siguiente objeto después de chocar con un objeto con propiedades de espejo.
{-# INLINE objEspejo #-}
objEspejo :: Set.Set Shape -> Direction -> Direction -> Point3D -> Obj
objEspejo :: Set Shape -> Direction -> Direction -> Point3D -> Obj
objEspejo Set Shape
figuras Direction
w0 Direction
norm Point3D
p = Set Obj -> Obj
obtenerPrimeraColision (Set Obj -> Obj) -> Set Obj -> Obj
forall a b. (a -> b) -> a -> b
$ (Shape -> Obj) -> Set Shape -> Set Obj
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\Shape
figura -> Shape -> Ray -> Obj
oneCollision Shape
figura (Point3D -> Direction -> Ray
Ray Point3D
p Direction
newDir)) Set Shape
figuras
  where
    newDir :: Direction
newDir = Direction -> Direction -> Direction
dirEspejo Direction
w0 Direction
norm

-- | Función auxiliar, que devuelve el siguiente objeto después de chocar con un objeto con propiedades de cristal.
{-# INLINE objCristal #-}
objCristal :: Set.Set Shape -> Direction -> Direction -> Float -> Float -> Point3D -> (Obj, Float)
objCristal :: Set Shape
-> Direction
-> Direction
-> Float
-> Float
-> Point3D
-> (Obj, Float)
objCristal Set Shape
figuras Direction
w0 Direction
norm Float
n1 Float
n2 Point3D
p = {- trace (show newDir ++ " " ++ show nxtObj) $ -} (Obj
nxtObj, Float
n2)
  where
    nxtObj :: Obj
nxtObj = Set Obj -> Obj
obtenerPrimeraColision (Set Obj -> Obj) -> Set Obj -> Obj
forall a b. (a -> b) -> a -> b
$ (Shape -> Obj) -> Set Shape -> Set Obj
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\Shape
figura -> Shape -> Ray -> Obj
oneCollision Shape
figura (Point3D -> Direction -> Ray
Ray Point3D
pFix Direction
newDir)) Set Shape
figuras
    pFix :: Point3D
pFix = Direction -> Point3D -> Point3D
movePoint Direction
newDir Point3D
p
    newDir :: Direction
newDir = Direction -> Direction
normal (Direction -> Direction) -> Direction -> Direction
forall a b. (a -> b) -> a -> b
$ Direction -> Direction -> Float -> Float -> Direction
calcularDirCristal Direction
w0 Direction
norm Float
n1 Float
n2

--------------------------
-- FunciónES DE COLORES --
--------------------------

-- | Función auxiliar, que realiza la media de una una matriz a una lista.
{-# INLINE mediaLRGB #-}
mediaLRGB :: [[RGB]] -> [RGB]
mediaLRGB :: [[RGB]] -> [RGB]
mediaLRGB = ([RGB] -> RGB) -> [[RGB]] -> [RGB]
forall a b. (a -> b) -> [a] -> [b]
map [RGB] -> RGB
mediaRGB ([[RGB]] -> [RGB]) -> ([[RGB]] -> [[RGB]]) -> [[RGB]] -> [RGB]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[RGB]] -> [[RGB]]
forall a. [[a]] -> [[a]]
transpose

{-# INLINE mediaRGB #-}
-- | Función auxiliar, que realiza la media RGB de una lista de RGBs dados.
mediaRGB :: [RGB] -> RGB
mediaRGB :: [RGB] -> RGB
mediaRGB [RGB]
xs = RGB -> Float -> RGB
divRGB ([RGB] -> RGB
sumRGB [RGB]
xs) (Float -> RGB) -> Float -> RGB
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([RGB] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RGB]
xs)

{-# INLINE sumRGB #-}
-- | Función auxiliar, que realiza el sumatorio RGB de una lista de RGBs dados.
sumRGB :: [RGB] -> RGB
sumRGB :: [RGB] -> RGB
sumRGB [] = Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0
sumRGB [RGB]
xs = (RGB -> RGB -> RGB) -> RGB -> [RGB] -> RGB
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
(+) ([RGB] -> RGB
forall a. [a] -> a
head [RGB]
xs) ([RGB] -> [RGB]
forall a. [a] -> [a]
tail [RGB]
xs)


{-# INLINE formula #-}
-- | Función básica, calcula la formula de render.
formula :: RGB -> Float -> Point3D -> Point3D -> Direction -> RGB -> RGB
formula :: RGB -> Float -> Point3D -> Point3D -> Direction -> RGB -> RGB
formula RGB
rgbLuz Float
intLuz Point3D
pointLuz Point3D
p Direction
vNormal RGB
rgbObj
  | (Direction
vNormal Direction -> Direction -> Float
.* Direction -> Direction
normal (Point3D
pointLuz Point3D -> Point3D -> Direction
#< Point3D
p)) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 = Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0
  | Point3D
p Point3D -> Point3D -> Bool
forall a. Eq a => a -> a -> Bool
== Point3D
pointLuz = RGB -> Float -> RGB
modRGB RGB
rgbLuz (Float
intLuz Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ ((Float
1Float -> Float -> Float
forall a. Num a => a -> a -> a
+(Direction -> Float
modd (Point3D
pointLuz Point3D -> Point3D -> Direction
#< Point3D
p)Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
30))Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2)) RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
* RGB
rgbObj
  | Bool
otherwise = RGB -> Float -> RGB
modRGB RGB
rgbLuz (Float
intLuz Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ ((Float
1Float -> Float -> Float
forall a. Num a => a -> a -> a
+(Direction -> Float
modd (Point3D
pointLuz Point3D -> Point3D -> Direction
#< Point3D
p)Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
30))Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2)) RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
* RGB
rgbObj RGB -> Float -> RGB
`modRGB` (Direction
vNormal Direction -> Direction -> Float
.* Direction -> Direction
normal (Point3D
pointLuz Point3D -> Point3D -> Direction
#< Point3D
p))

--------------------------
-- FunciónES DE CAMARA  --
--------------------------
{-# INLINE tuplasAleatorias #-}
-- | Función auxiliar, aplica un valor aleatorio € [0,salto], sobre la lista de tuplas float.
tuplasAleatorias :: [(Float, Float)] -> Float -> StdGen -> [(Float, Float)]
tuplasAleatorias :: [(Float, Float)] -> Float -> StdGen -> [(Float, Float)]
tuplasAleatorias [(Float, Float)]
inputTuplas Float
salto StdGen
gen =
  [(Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
r1, Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
r2) | ((Float
x, Float
y), Float
r1, Float
r2) <- [(Float, Float)]
-> [Float] -> [Float] -> [((Float, Float), Float, Float)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [(Float, Float)]
inputTuplas (Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take Int
halfLen [Float]
randomNumbers) (Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
drop Int
halfLen [Float]
randomNumbers)]
  where
    randomNumbers :: [Float]
randomNumbers = Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take ([(Float, Float)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Float, Float)]
inputTuplas Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) ([Float] -> [Float]) -> [Float] -> [Float]
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> StdGen -> [Float]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Float
0.0, Float
salto) StdGen
gen :: [Float]
    halfLen :: Int
halfLen = [Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
randomNumbers Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

{-# INLINE generarTuplas #-}
-- | Función auxiliar, dadas dos listas genera todas las permutaciones de estas generando todas las combinaciones de 2 a 2. 
generarTuplas :: [Float] -> [Float] -> [(Float, Float)]
generarTuplas :: [Float] -> [Float] -> [(Float, Float)]
generarTuplas ![Float]
xs ![Float]
ys =[(Float
x, Float
y) | Float
y <- [Float]
ys, Float
x <- [Float]
xs]

{-# INLINE generateRaysForPixels #-}
-- | Función básica, daados los datos de entrada, la camara y el tamaño de la imagen, lanza los rayos pertinentes desde la cámara.
generateRaysForPixels :: Int -> Int -> Int -> Int -> Camara -> Float -> Float -> Int -> StdGen -> [Ray]
generateRaysForPixels :: Int
-> Int
-> Int
-> Int
-> Camara
-> Float
-> Float
-> Int
-> StdGen
-> [Ray]
generateRaysForPixels Int
maxN Int
etapasX Int
n Int
etapaX (Camara Point3D
p (Base {Direction
d2 :: Base -> Direction
d1 :: Base -> Direction
d0 :: Base -> Direction
d2 :: Direction
d1 :: Direction
d0 :: Direction
..})) Float
width Float
height Int
j StdGen
gen =
  ((Float, Float) -> Ray) -> [(Float, Float)] -> [Ray]
forall a b. (a -> b) -> [a] -> [b]
map (\(Float
x, Float
y) -> Point3D -> Direction -> Ray
Ray Point3D
p (Float -> Float -> Float -> Direction
forall {p}. Float -> Float -> p -> Direction
generateDirection Float
x Float
y (Direction -> Float
zD Direction
d2))) [(Float, Float)]
tuplasRandom
  where
    px :: Float
px = Direction -> Float
xD Direction
d0
    py :: Float
py = Direction -> Float
yD Direction
d1
    piY :: Float
piY = Float
py Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
height
    piX :: Float
piX = Float
px Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
width
    px' :: Float
px' = Float
px Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0
    py' :: Float
py' = Float
py Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2.0
    yValues :: [Float]
yValues = [Float
py', (Float
py' Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
piY) .. (-Float
py' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
piY)]
    yStep :: Int
yStep = [Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
yValues Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
maxN
    startIdxy :: Int
startIdxy = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
yStep
    endIdxy :: Int
endIdxy = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
yStep
    selectedYValues :: [Float]
selectedYValues = Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take (Int
endIdxy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startIdxy) (Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
drop Int
startIdxy [Float]
yValues)
    generateDirection :: Float -> Float -> p -> Direction
generateDirection !Float
width !Float
height !p
focal = Direction -> Direction
normal (Direction -> Direction) -> Direction -> Direction
forall a b. (a -> b) -> a -> b
$ Point3D -> Direction
pointDir (Point3D -> Direction) -> Point3D -> Direction
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Point3D
Point3D (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Point3D -> Float
xP Point3D
p ) (Float
height Float -> Float -> Float
forall a. Num a => a -> a -> a
- Point3D -> Float
yP Point3D
p) (Direction -> Float
zD Direction
d2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Point3D -> Float
zP Point3D
p) 
    xValues :: [Float]
xValues = [(-Float
px'), (-Float
px' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
piX) .. (Float
px' Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
piX)]
    xStep :: Int
xStep = [Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
xValues Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
etapasX
    startIdxx :: Int
startIdxx = Int
etapaX Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
xStep
    endIdxx :: Int
endIdxx = (Int
etapaX Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
xStep
    selectedxValues :: [Float]
selectedxValues = Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take (Int
endIdxx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startIdxx) (Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
drop Int
startIdxx [Float]
xValues)
    !tuplas :: [(Float, Float)]
tuplas = [Float] -> [Float] -> [(Float, Float)]
generarTuplas ((Float -> [Float]) -> [Float] -> [Float]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Float -> [Float]
forall a. Int -> a -> [a]
replicate Int
j) [Float]
selectedxValues) [Float]
selectedYValues
    !tuplasRandom :: [(Float, Float)]
tuplasRandom = [(Float, Float)] -> Float -> StdGen -> [(Float, Float)]
tuplasAleatorias [(Float, Float)]
tuplas Float
piY StdGen
gen
--------------------------
--FunciónES DE PUNTOS.AL--
--------------------------

{-# INLINE polarToCartesian #-}
-- | Función auxiliar, convierte de coordenadas polares a coordenadas cartesianas.
polarToCartesian :: Float -> Float -> Float -> Point3D
polarToCartesian :: Float -> Float -> Float -> Point3D
polarToCartesian !Float
inclinacion !Float
azimut !Float
cosRand = Float -> Float -> Float -> Point3D
Point3D (Float -> Float
forall a. Floating a => a -> a
sin Float
inclinacion Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
cos Float
azimut) Float
cosRand (Float -> Float
forall a. Floating a => a -> a
sin Float
inclinacion Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
sin Float
azimut)

{-# INLINE genPointTotal #-}
-- | Función auxiliar, genera un punto aleatorio sobre la superficie de una esfera.
genPointTotal :: StdGen -> Point3D
genPointTotal :: StdGen -> Point3D
genPointTotal StdGen
gen = Float -> Float -> Float -> Point3D
polarToCartesian (Float -> Float
forall a. Floating a => a -> a
acos Float
randIncl) (Float
2.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
randAz) Float
randIncl
  where
    !(Float
randIncl, StdGen
gen') = (Float, Float) -> StdGen -> (Float, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (-Float
1.0, Float
1.0) StdGen
gen :: (Float, StdGen)
    !(Float
randAz, StdGen
_) = (Float, Float) -> StdGen -> (Float, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Float
0.0, Float
1.0) StdGen
gen' :: (Float, StdGen)

{-# INLINE genPoint #-}
-- | Función auxiliar, genera un punto aleatorio sobre la superficie de una semiesfera.    
genPoint :: StdGen -> Point3D
genPoint :: StdGen -> Point3D
genPoint StdGen
gen = Float -> Float -> Float -> Point3D
polarToCartesian (Float -> Float
forall a. Floating a => a -> a
acos Float
randIncl') (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
randAz) Float
randIncl' 
  where
    !(Float
randIncl, StdGen
gen') = (Float, Float) -> StdGen -> (Float, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Float
0.0, Float
1.0) StdGen
gen :: (Float, StdGen)
    !(Float
randAz, StdGen
_) = (Float, Float) -> StdGen -> (Float, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Float
0.0, Float
1.0) StdGen
gen' :: (Float, StdGen)
    --randIncl' = sqrt(1 - randIncl) -- Luz Area
    randIncl' :: Float
randIncl' = Float
randIncl -- Luz Puntual


--------------------------
--FunciónES DE COLISION --
--------------------------

--Devuelve la primera colision de cada lista de colisiones
{-# INLINE obtenerPrimeraColision #-}
-- | Función básica, dada una lista de colisiones devuelve la primera(por cercanía).
obtenerPrimeraColision :: Set.Set Obj -> Obj
obtenerPrimeraColision :: Set Obj -> Obj
obtenerPrimeraColision Set Obj
xs =
  case Set Obj -> Maybe Obj
forall a. Set a -> Maybe a
Set.lookupMin (Set Obj -> Maybe Obj) -> Set Obj -> Maybe Obj
forall a b. (a -> b) -> a -> b
$ (Obj -> Bool) -> Set Obj -> Set Obj
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\Obj
obj -> Obj -> Float
mindObj Obj
obj Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0) Set Obj
xs of
    Maybe Obj
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) (Float -> Float -> Float -> Direction
Direction Float
0 Float
0 Float
0) (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
Null)
    Just Obj
obj -> Obj
obj

-- dada la lista de listas de colisiones, devuelve la lista de la primera colisión de cada rayo
{-# INLINE listRay #-}
-- | Función auxiliar, dada una lista de colisiones devuelve la primera(por cercanía)(probablemente sobra esta función :c).
listRay :: Set.Set Obj -> Obj
listRay :: Set Obj -> Obj
listRay = Set Obj -> Obj
obtenerPrimeraColision

{-# INLINE colision #-}
-- | Función básica, dados dos puntos y una figura, devuelve si existe o no una colisión directa entre ellos.
colision :: Point3D -> Point3D -> Set.Set Shape -> Bool
colision :: Point3D -> Point3D -> Set Shape -> Bool
colision !Point3D
p0 !Point3D
luz !Set Shape
figuras = Point3D -> Point3D -> Bool
aproxPoint Point3D
p0 Point3D
bonk -- Si es el mismo punto, no choca con nada
  where
    bonk :: Point3D
bonk = Obj -> Point3D
colObj (Obj -> Point3D) -> Obj -> Point3D
forall a b. (a -> b) -> a -> b
$ Set Obj -> Obj
obtenerPrimeraColision (Set Obj -> Obj) -> Set Obj -> Obj
forall a b. (a -> b) -> a -> b
$ (Shape -> Obj) -> Set Shape -> Set Obj
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\Shape
figura -> Shape -> Ray -> Obj
oneCollision Shape
figura (Point3D -> Direction -> Ray
Ray Point3D
luz (Direction -> Direction
normal (Direction -> Direction) -> Direction -> Direction
forall a b. (a -> b) -> a -> b
$ Point3D
p0 Point3D -> Point3D -> Direction
#< Point3D
luz))) Set Shape
figuras --Saca el punto de la primera colision de la luz con las figuras

--------------------------
--FunciónES DE DIRECCIONES
--------------------------

{-# INLINE dirEspejo #-}
-- | Función básica, dada una dirección y la direción normal de un objeto, devuelve la dirección espejo.
dirEspejo :: Direction -> Direction -> Direction
dirEspejo :: Direction -> Direction -> Direction
dirEspejo !Direction
d !Direction
norm = Direction -> Direction
normal (Direction -> Direction) -> Direction -> Direction
forall a b. (a -> b) -> a -> b
$  Direction
d Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
- Float -> Direction -> Direction
escalateDir (Float
2.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Direction
d Direction -> Direction -> Float
.* Direction
norm)) Direction
norm

{-# INLINE calcularDirCristal #-}
-- | Función básica,  dada una dirección y la direción normal de un objeto y los coeficientes de refracción, devuelve la dirección refractada.
calcularDirCristal :: Direction -> Direction -> Float -> Float -> Direction
calcularDirCristal :: Direction -> Direction -> Float -> Float -> Direction
calcularDirCristal !Direction
d !Direction
norm Float
n1 Float
n2 = if Float
sinT2 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
1 then Direction
d else Direction
d'
 where
    n :: Float
n = Float
n1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
n2
    cosI :: Float
cosI = -(Direction
d Direction -> Direction -> Float
.* Direction
norm)
    !sinT2 :: Float
sinT2 = (Float
n Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
n) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
cosI Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cosI))
    d' :: Direction
d' = Direction -> Direction
normal (Direction -> Direction) -> Direction -> Direction
forall a b. (a -> b) -> a -> b
$ Float -> Direction -> Direction
escalateDir Float
n Direction
d Direction -> Direction -> Direction
forall a. Num a => a -> a -> a
+ Float -> Direction -> Direction
escalateDir (Float
n Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cosI Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
forall a. Floating a => a -> a
sqrt (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
sinT2)) Direction
norm

--------------------------
-- FunciónES AUXILIARES --
--------------------------
-- | Función básica, depende de las caracterisicas del material, devuelve como se comporta el objeto y su probabilidad.
{-# INLINE ruletaRusa #-}
ruletaRusa :: (Float, Float, Float) -> StdGen -> (Int, Float)
ruletaRusa :: (Float, Float, Float) -> StdGen -> (Int, Float)
ruletaRusa (Float
a,Float
b,Float
c) StdGen
gen = (Int
i, Float
p')
  where
    absorption :: Float
absorption = if Float
aFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
bFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
c Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
1 then Float
0.1 else Float
1Float -> Float -> Float
forall a. Num a => a -> a -> a
-(Float
aFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
bFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
c)
    d :: Float
d = Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
absorption
    a' :: Float
a' = Float
aFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
d
    b' :: Float
b' = (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
b)Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
d
    c' :: Float
c' = (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
c)Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
d
    (Float
p, StdGen
_) = (Float, Float) -> StdGen -> (Float, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Float
0.0, Float
1.0) StdGen
gen :: (Float, StdGen)
    i :: Int
i | Float
p Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
a' = Int
0
      | Float
p Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
b' = Int
1
      | Float
p Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
c' = Int
2
      | Bool
otherwise = Int
3
    p' :: Float
p'
      | Float
p Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
a' = Float
aFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
d
      | Float
p Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
b' = Float
bFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
d
      | Float
p Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
c' = Float
cFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
d
      | Bool
otherwise = Float
absorption

-- 
{-# INLINE brdf #-}
-- | Función básica, dicta de que color se comporta un objeto.
brdf :: Obj -> Set.Set Shape-> RGB
brdf :: Obj -> Set Shape -> RGB
brdf obj :: Obj
obj@(Obj {Float
Int
(Float, Float, Float)
RGB
Direction
Point3D
Shape
shObj :: Obj -> Shape
idObj :: Obj -> Int
reflObj :: Obj -> Float
trObj :: Obj -> (Float, Float, Float)
w0Obj :: Obj -> Direction
rgbObj :: Obj -> RGB
shObj :: Shape
idObj :: Int
reflObj :: Float
trObj :: (Float, Float, Float)
normObj :: Direction
colObj :: Point3D
w0Obj :: Direction
rgbObj :: RGB
mindObj :: Float
mindObj :: Obj -> Float
normObj :: Obj -> Direction
colObj :: Obj -> Point3D
..}) Set Shape
figuras
  -- | idObj == 7 =  rgbTxt "../meshes/gold.png"
  | Int
idObj Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = String -> RGB
rgbTxt String
"../meshes/algo.png"
  -- | idObj == 6 = rgbTxt "../meshes/wood.png"
  | Float
kd Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = Float -> Float -> Float -> RGB
RGB Float
1 Float
1 Float
1 -- Que a los cristales o espejos sin difusa no le afecte un color que le hayas puesto
  | Bool
otherwise = RGB -> RGB
scale RGB
rgbObj
  where
      (Float
kd, Float
ke, Float
kr) = (Float, Float, Float)
trObj
      rgbTxt :: String -> RGB
rgbTxt String
path = String -> Obj -> RGB
getRGBTexture String
path Obj
obj

-- | Función auxiliar, devuelve el color de un objeto en una textura.
{-# INLINE getRGBTexture #-}
getRGBTexture :: String -> Obj -> RGB
getRGBTexture :: String -> Obj -> RGB
getRGBTexture String
path (Obj {Float
Int
(Float, Float, Float)
RGB
Direction
Point3D
Shape
shObj :: Shape
idObj :: Int
reflObj :: Float
trObj :: (Float, Float, Float)
normObj :: Direction
colObj :: Point3D
w0Obj :: Direction
rgbObj :: RGB
mindObj :: Float
shObj :: Obj -> Shape
idObj :: Obj -> Int
reflObj :: Obj -> Float
trObj :: Obj -> (Float, Float, Float)
w0Obj :: Obj -> Direction
rgbObj :: Obj -> RGB
mindObj :: Obj -> Float
normObj :: Obj -> Direction
colObj :: Obj -> Point3D
..}) = RGB
newRGB
  where
      textureImage :: Image PixelRGB8
textureImage = String -> Image PixelRGB8
loadTexture String
path
      (Float
texWidth, Float
texHeight)
        = (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> Int
forall a. Image a -> Int
imageWidth Image PixelRGB8
textureImage,
          Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> Int
forall a. Image a -> Int
imageHeight Image PixelRGB8
textureImage)
      newRGB :: RGB
newRGB = PixelRGB8 -> RGB
pixtoRGB (PixelRGB8 -> RGB) -> PixelRGB8 -> RGB
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> Int -> Int -> PixelRGB8
forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image PixelRGB8
textureImage (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
texWidth Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1)) (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$  Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
texHeight Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1))
      (Float
u,Float
v) = Shape -> Point3D -> (Float, Float)
getUV Shape
shObj Point3D
colObj

-- | Función auxiliar, carga una textura  de un fichero.
loadTexture :: FilePath -> Image PixelRGB8
loadTexture :: String -> Image PixelRGB8
loadTexture String
filePath =
    IO (Image PixelRGB8) -> Image PixelRGB8
forall a. IO a -> a
unsafePerformIO (IO (Image PixelRGB8) -> Image PixelRGB8)
-> IO (Image PixelRGB8) -> Image PixelRGB8
forall a b. (a -> b) -> a -> b
$ do
        Either String DynamicImage
eitherImage <- String -> IO (Either String DynamicImage)
readImage String
filePath
        case Either String DynamicImage
eitherImage of
            Right (ImageRGB8 Image PixelRGB8
img) -> Image PixelRGB8 -> IO (Image PixelRGB8)
forall (m :: * -> *) a. Monad m => a -> m a
return Image PixelRGB8
img
            Left String
err -> String -> IO (Image PixelRGB8)
forall a. HasCallStack => String -> a
error (String -> IO (Image PixelRGB8)) -> String -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ String
"Error loading image: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
            Either String DynamicImage
_ -> String -> IO (Image PixelRGB8)
forall a. HasCallStack => String -> a
error String
"Usa png ;)"

-- | Función auxiliar, convierte el tipo PixelRGB8 a RGB.
{-# INLINE pixtoRGB #-}
pixtoRGB :: PixelRGB8 -> RGB
pixtoRGB :: PixelRGB8 -> RGB
pixtoRGB (PixelRGB8 Word8
r Word8
g Word8
b) = Float -> Float -> Float -> RGB
RGB (Word8 -> Float
toFloat Word8
r) (Word8 -> Float
toFloat Word8
g) (Word8 -> Float
toFloat Word8
b)
  where
    toFloat :: Word8 -> Float
    toFloat :: Word8 -> Float
toFloat Word8
x = Word8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255.0

-- | Función auxiliar, suma los valores de las luces.
{-# INLINE sumFlLuz #-}
sumFlLuz :: [Luz] -> Float
sumFlLuz :: [Luz] -> Float
sumFlLuz [] = Float
0
sumFlLuz ((Luz Point3D
_ RGB
_ Float
int):[Luz]
luz) = Float
int Float -> Float -> Float
forall a. Num a => a -> a -> a
+ [Luz] -> Float
sumFlLuz [Luz]
luz

--------------------------
--FunciónES ESTADISTICAS--
--------------------------


-- | Calcular la media de una lista de valores.
{-# INLINE media #-}
media :: [Float] -> Float
media :: [Float] -> Float
media [Float]
xs = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Float]
xs Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
xs)

-- | Calcular la varianza de una lista de valores.
{-# INLINE varianza #-}
varianza :: [Float] -> Float
varianza :: [Float] -> Float
varianza [Float]
xs = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Float -> Float) -> [Float] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\Float
x -> (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
m) Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
2) [Float]
xs) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
xs)
  where m :: Float
m = [Float] -> Float
media [Float]
xs

-- | Calcular la desviación estándar de una lista de valores.
{-# INLINE desviacionEstandar #-}
desviacionEstandar :: [Float] -> Float
desviacionEstandar :: [Float] -> Float
desviacionEstandar [Float]
xs = Float -> Float
forall a. Floating a => a -> a
sqrt ([Float] -> Float
varianza [Float]
xs)

-- | Calcula mediante una Función Gaussiana el peso de un fotón.
{-# INLINE fGaus #-}
fGaus :: [Foton] -> Obj -> Foton -> Float
fGaus :: [Foton] -> Obj -> Foton -> Float
fGaus [Foton]
photons Obj
obj Foton
fot = if Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
result then Float
0 else Float
result
  where
    !list :: [Float]
list = (Foton -> Float) -> [Foton] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Point3D -> Foton -> Float
distFot (Obj -> Point3D
colObj Obj
obj)) [Foton]
photons
    a :: Float
a = Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
sqrt (Float
2Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
forall a. Floating a => a
pi))
    b :: Float
b = [Float] -> Float
media [Float]
list
    c :: Float
c = [Float] -> Float
desviacionEstandar [Float]
list
    x :: Float
x = Point3D -> Foton -> Float
distFot (Obj -> Point3D
colObj Obj
obj) Foton
fot
    result :: Float
result = Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
exp (-(((Float
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
b)Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
2Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
cFloat -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2)))


--------------------------
--       EXTRAS         --
--------------------------
-- | Función auxiliar, devuelve el color después de que un rayo pase a traves de niebla homogenea.
{-# INLINE addNiebla #-}
addNiebla :: Luz -> Obj -> Float -> Set.Set Shape ->  RGB -> RGB
addNiebla :: Luz -> Obj -> Float -> Set Shape -> RGB -> RGB
addNiebla (Luz {Float
RGB
Point3D
luzPot :: Luz -> Float
luzRGB :: Luz -> RGB
luzP :: Luz -> Point3D
luzPot :: Float
luzRGB :: RGB
luzP :: Point3D
..}) Obj
obj Float
x Set Shape
figuras RGB
rgb = if (Obj -> Float
mindObj Obj
obj) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 {- || choca closest figuras luzP -} then Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0 else RGB
newRGB RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
+ (RGB
rgb RGB -> Float -> RGB
`modRGB` Float
reducObj)
  where
    rgb' :: RGB
rgb' = [RGB] -> RGB
forall a. [a] -> a
head ([RGB] -> RGB) -> [RGB] -> RGB
forall a b. (a -> b) -> a -> b
$ Float -> Float -> [RGB] -> [RGB]
gammaFunc' Float
1 Float
2.4 [RGB
rgb]
    newRGB :: RGB
newRGB = Float -> Float -> Float -> RGB
RGB Float
fact Float
fact Float
fact RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
* (RGB -> RGB
scale RGB
luzRGB)
    reducLuz :: Float
reducLuz = if Point3D -> Float
zP Point3D
closest Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 then Float -> Float
forall a. Floating a => a -> a
exp (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Point3D -> Float
zP Point3D
closest Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
30) else Float
1
    reducObj :: Float
reducObj = if Point3D -> Float
zP (Obj -> Point3D
colObj Obj
obj) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 then Float -> Float
forall a. Floating a => a -> a
exp ((Float
1Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
x) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Point3D -> Float
zP (Obj -> Point3D
colObj Obj
obj) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
30) else Float
1 -- Como le afecta la niebla de lejos a los objetos

    camP :: Point3D
camP = Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
35 -- Comienzo de la camara
    cam :: Ray
cam = Point3D -> Direction -> Ray
Ray Point3D
camP Direction
dir
    dir :: Direction
dir = Direction -> Direction
normal (Direction -> Direction) -> Direction -> Direction
forall a b. (a -> b) -> a -> b
$ (Obj -> Point3D
colObj Obj
obj) Point3D -> Point3D -> Direction
#< Point3D
camP
    closest :: Point3D
closest = Point3D -> Ray -> Point3D
distanceToRay Point3D
luzP Ray
cam
    fact :: Float
fact = (Float
1Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
x) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
reducLuz Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Point3D -> Point3D -> Float
distPoint Point3D
luzP Point3D
closest Float -> Float -> Float
forall a. Floating a => a -> a -> a
** (-Float
1.75)) -- Como afecta la luz a los objetos

    choca :: Point3D -> Set.Set Shape -> Point3D -> Bool
    choca :: Point3D -> Set Shape -> Point3D -> Bool
choca Point3D
p Set Shape
figuras Point3D
pLuz = ((Obj -> Float
mindObj Obj
bonk) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
distLuz) Bool -> Bool -> Bool
&& (Point3D -> Point3D -> Float
distPoint Point3D
pLuz (Obj -> Point3D
colObj Obj
bonk) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Point3D -> Point3D -> Float
distPoint Point3D
pLuz Point3D
p)
      where
        bonk :: Obj
bonk = Set Obj -> Obj
obtenerPrimeraColision (Set Obj -> Obj) -> Set Obj -> Obj
forall a b. (a -> b) -> a -> b
$ (Shape -> Obj) -> Set Shape -> Set Obj
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\Shape
figura -> Shape -> Ray -> Obj
oneCollision Shape
figura (Point3D -> Direction -> Ray
Ray Point3D
pLuz (Direction -> Direction
normal (Direction -> Direction) -> Direction -> Direction
forall a b. (a -> b) -> a -> b
$ Point3D
pLuz Point3D -> Point3D -> Direction
#< Point3D
p))) Set Shape
figuras --Saca el punto de la primera colision de la luz con las figuras
        distLuz :: Float
distLuz = Point3D -> Point3D -> Float
distPoint Point3D
pLuz Point3D
p

-- | Función auxiliar, devuelve el punto en un rayo más cerca de un punto dado.
{-# INLINE distanceToRay #-}
distanceToRay :: Point3D -> Ray -> Point3D -- Punto más cercano al rayo
distanceToRay :: Point3D -> Ray -> Point3D
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
closestPoint

-- | Función auxiliar, brdf de Phong.
{-# INLINE fPhong #-}
fPhong :: Point3D -> Obj -> Float -> Set.Set Shape -> Float
fPhong :: Point3D -> Obj -> Float -> Set Shape -> Float
fPhong Point3D
pLuz Obj
obj Float
alpha Set Shape
figuras  = if Bool
col then (Float
alphaFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
2Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
2) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Num a => a -> a
abs (Direction -> Direction -> Direction
dirEspejo (Obj -> Point3D
colObj Obj
obj Point3D -> Point3D -> Direction
#<Point3D
pLuz) (Obj -> Direction
normObj Obj
obj) Direction -> Direction -> Float
.* Obj -> Direction
w0Obj Obj
obj)Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
alpha else Float
0
  where
    col :: Bool
col = Point3D -> Point3D -> Set Shape -> Bool
colision (Obj -> Point3D
colObj Obj
obj) Point3D
pLuz Set Shape
figuras'
    figuras' :: Set Shape
figuras' = (Shape -> Bool) -> Set Shape -> Set Shape
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\Shape
shape -> Obj -> Int
idObj Obj
obj Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Shape -> Int
getShapeID Shape
shape) Set Shape
figuras

-- iris :: Obj -> RGB
-- iris (Obj {..}) = newRGB
--   where
--     newRGB = RGB (1 * rFactor') (1 * gFactor') (1 * bFactor')
--     angle = abs $ normObj .* w0Obj
--     thickness = 0.3
--     rFactor' = rFactor
--     bFactor' = bFactor
--     gFactor' = gFactor
--     -- Factores de ajuste para cada canal
--     rFactor = abs $ interferenceFactor * cos (2 * pi * thickness * refractiveIndex)
--     gFactor = abs $ interferenceFactor * cos (2 * pi * thickness * refractiveIndex)
--     bFactor = abs $ interferenceFactor * cos (2 * pi * thickness * refractiveIndex)

--     -- Ajusta estos parámetros según tu necesidad
--     interferenceFactor = 0.2
--     refractiveIndex = reflObj

-- | Función auxiliar, devuelve el porcentaje de especular de como se comporta un objeto después de aplicarle las ecuaciones de fresnell.
fresnell :: Obj -> Float -> Float
fresnell :: Obj -> Float -> Float
fresnell (Obj {Float
Int
(Float, Float, Float)
RGB
Direction
Point3D
Shape
shObj :: Shape
idObj :: Int
reflObj :: Float
trObj :: (Float, Float, Float)
normObj :: Direction
colObj :: Point3D
w0Obj :: Direction
rgbObj :: RGB
mindObj :: Float
shObj :: Obj -> Shape
idObj :: Obj -> Int
reflObj :: Obj -> Float
trObj :: Obj -> (Float, Float, Float)
w0Obj :: Obj -> Direction
rgbObj :: Obj -> RGB
mindObj :: Obj -> Float
normObj :: Obj -> Direction
colObj :: Obj -> Point3D
..}) Float
iR = Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
paraleloFloat -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
perpendicularFloat -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2)
  where
    paralelo :: Float
paralelo = (Float
reflObjFloat -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cosI Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
iR Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cosT) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
reflObjFloat -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cosI Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
iR Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cosT)
    perpendicular :: Float
perpendicular = (Float
iRFloat -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cosI Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
reflObj Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cosT) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
iRFloat -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cosI Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
reflObj Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cosT)
    cosI :: Float
cosI = Direction
w0Obj Direction -> Direction -> Float
.* Direction
normObj
    cosT :: Float
cosT = Direction
normObj Direction -> Direction -> Float
.* Direction -> Direction -> Float -> Float -> Direction
calcularDirCristal Direction
w0Obj Direction
normObj Float
reflObj Float
iR

-- microfacet :: Direction -> Direction -> Float -> Float
-- microfacet wH norm alpha = exp (- (sqrt (1 - cos**2) / cos) / alpha**2) / (pi * alpha**2 * cos**4 )
--   where cos = min (wH .* norm) 1

-- shadowing :: Direction -> Direction -> Float -> Float
-- shadowing wI norm alpha = 2 / (1 + erf s + 1/(s*sqrt pi) + exp (-(s**2)))
--   where
--     s = abs $ 1 / (alpha * tan)
--     tan = sqrt (1 - cos**2) / cos
--     cos = min (wI .* norm) 1

-- | Función auxiliar, genera múltiples cámaras en un radio dado.
{-# INLINE mulCam #-}
mulCam :: Camara -> Int -> Float -> [Camara]
mulCam :: Camara -> Int -> Float -> [Camara]
mulCam cam :: Camara
cam@(Camara Point3D
p Base
b) Int
n Float
radio = Camara
cam Camara -> [Camara] -> [Camara]
forall a. a -> [a] -> [a]
: (Point3D -> Camara) -> [Point3D] -> [Camara]
forall a b. (a -> b) -> [a] -> [b]
map (Point3D -> Base -> Camara
`Camara` Base
b) (Int -> [Point3D] -> [Point3D]
forall a. Int -> [a] -> [a]
take Int
n [Point3D]
transformedPoints)
  where
    circlePoints :: [(Float, Float)]
circlePoints = [(Float, Float)]
pointsInUnitCircle  -- Tomamos todos los puntos dentro de un círculo unitario
    
    -- Función para escalar y desplazar puntos según el círculo deseado
    transformPoint :: (Float, Float) -> Point3D
transformPoint (Float
x, Float
y) = Float -> Float -> Float -> Point3D
Point3D (Float
radio Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x) (Float
radio Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y) (Float
35)

    -- Lista de puntos dentro de un círculo unitario
    pointsInUnitCircle :: [(Float, Float)]
pointsInUnitCircle = [(Float -> Float
forall a. Floating a => a -> a
cos Float
theta, Float -> Float
forall a. Floating a => a -> a
sin Float
theta) | Float
theta <- [Float
0, (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n .. Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi]]

    -- Aplicar la transformación a cada punto
    transformedPoints :: [Point3D]
transformedPoints = ((Float, Float) -> Point3D) -> [(Float, Float)] -> [Point3D]
forall a b. (a -> b) -> [a] -> [b]
map (Float, Float) -> Point3D
transformPoint [(Float, Float)]
circlePoints