{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
module PhotonMap where

import Elem3D
    ( Foton(..),
      Luz(..),
      RGB(..),
      Ray(..),
      Point3D(..),
      movePoint,
      (#<),
      (#),
      pointDir,
      pointToPothon,
      (.*),
      modd,
      normal,
      modRGB,
      scale,
      addPoints,
      escalatePoint, Direction (Direction), distFot )
import Figuras
    ( getShapeID,
      oneCollision,
      Obj(..),
      Shape(Triangle),
      Triangulo(Triangulo) )
import System.Random (StdGen, split)
import Funciones
    ( objAleatorio,
      objEspejo,
      objCristal,
      mediaRGB,
      sumRGB,
      genPoint,
      genPointTotal,
      obtenerPrimeraColision,
      colision, fresnell,
      brdf, sumRGB, ruletaRusa,
      media, desviacionEstandar, fGaus, addNiebla, dirEspejo)
import Debug.Trace (trace)
import qualified Data.DList as DL
import Data.KdTree.Static ( kNearest, KdTree, inRadius, nearest)

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

-- | Función básica, genera una lista de fotones lanzados desde diferentes luces.
createPhoton :: Float -> DL.DList Foton -> Int -> Int -> Set.Set Shape -> [Luz] -> StdGen -> Int -> DL.DList Foton
createPhoton :: Float
-> DList Foton
-> Int
-> Int
-> Set Shape
-> [Luz]
-> StdGen
-> Int
-> DList Foton
createPhoton Float
lzT DList Foton
fotones Int
contador Int
contMx Set Shape
figuras [Luz]
luces StdGen
gen Int
nRebotes
  | Int
contador Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
contMx = DList Foton
fotones -- Devuelve la lista de fotones
  | Int
contador Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
contMx Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float
lzT Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
intLuz) = Float
-> DList Foton
-> Int
-> Int
-> Set Shape
-> [Luz]
-> StdGen
-> Int
-> DList Foton
createPhoton (Float
lzT Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
intLuz) DList Foton
fotones (Int
contadorInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
contMx Set Shape
figuras ([Luz] -> [Luz]
forall a. [a] -> [a]
tail [Luz]
luces) StdGen
gen' Int
nRebotes -- Cambio de luz
  | Bool
otherwise = Float
-> DList Foton
-> Int
-> Int
-> Set Shape
-> [Luz]
-> StdGen
-> Int
-> DList Foton
createPhoton Float
lzT DList Foton
newlisP (Int
contadorInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
contMx Set Shape
figuras [Luz]
luces StdGen
gen' Int
nRebotes -- Se vuelve a llamar con la nueva lista de fotones
  where
    (Ray
ray, Luz Point3D
pointPapa RGB
rgbPadre Float
intLuz) = [Luz] -> Int -> Int -> StdGen -> (Ray, Luz)
selescLightSource [Luz]
luces Int
contador Int
contMx StdGen
gen
    !newlisP :: DList Foton
newlisP = Point3D
-> Float
-> RGB
-> DList Foton
-> Set Shape
-> Int
-> StdGen
-> Obj
-> DList Foton
traceRay Point3D
pointPapa ((Float
4.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
intLuz) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
contMx) RGB
rgbPadre DList Foton
fotones Set Shape
figuras Int
nRebotes StdGen
gen' Obj
nxtObj
    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 Ray
ray) Set Shape
figuras -- Siguiente objeto que choca

    gen' :: StdGen
gen' = (StdGen, StdGen) -> StdGen
forall a b. (a, b) -> b
snd ((StdGen, StdGen) -> StdGen) -> (StdGen, StdGen) -> StdGen
forall a b. (a -> b) -> a -> b
$ StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
gen

-- | Función auxiliar que selecciona la luz de la que se va a lanzar el fotón.
{-# INLINE selescLightSource #-}
selescLightSource :: [Luz] -> Int -> Int -> StdGen -> (Ray, Luz)
selescLightSource :: [Luz] -> Int -> Int -> StdGen -> (Ray, Luz)
selescLightSource [Luz]
luces Int
contador Int
contMx StdGen
gen = (Point3D -> Direction -> Ray
Ray Point3D
pLuz (Direction -> Point3D -> Point3D
movePoint (Point3D -> Direction
pointDir Point3D
pLuz) (StdGen -> Point3D
genPointTotal StdGen
gen) Point3D -> Point3D -> Direction
#< Point3D
pLuz), Luz
luz)
  where
    luz :: Luz
luz@(Luz Point3D
pLuz RGB
_ Float
_) = [Luz] -> Luz
forall a. [a] -> a
head [Luz]
luces

-- | Función auxiliar que calcula y almacena el recorrido de un fotón por la escena.
{-# INLINE traceRay #-}
traceRay :: Point3D -> Float -> RGB -> DL.DList Foton -> Set.Set Shape -> Int -> StdGen -> Obj -> DL.DList Foton
traceRay :: Point3D
-> Float
-> RGB
-> DList Foton
-> Set Shape
-> Int
-> StdGen
-> Obj
-> DList Foton
traceRay Point3D
p Float
pot RGB
rgb DList Foton
fotones Set Shape
figuras Int
n StdGen
gen Obj
obj
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| RGB
rgb RGB -> RGB -> Bool
forall a. Eq a => a -> a -> Bool
== Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0 = DList Foton
fotones
  | Bool
otherwise = DList Foton
result
  where
    result :: DList Foton
result = case Int
caso of
      Int
0 -> DList Foton
photonD -- Difuso
      Int
1 -> DList Foton
photonR --Refracción
      Int
2 -> DList Foton
photonE -- Especular
      Int
_ -> DList Foton
fotones -- Absorción

    pObj :: Point3D
pObj = Obj -> Point3D
colObj Obj
obj
    nObj :: Direction
nObj = Obj -> Direction
normObj Obj
obj

    (Int
caso, Float
por) = (Float, Float, Float) -> StdGen -> (Int, Float)
ruletaRusa (Obj -> (Float, Float, Float)
trObj Obj
obj) StdGen
gen
    photonD :: DList Foton
photonD = Point3D
-> Float
-> RGB
-> DList Foton
-> Set Shape
-> Int
-> StdGen
-> Obj
-> DList Foton
traceRay Point3D
pObj (Float
2Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
forall a. Floating a => a
piFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
pot'Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
porFloat -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Num a => a -> a
abs (Obj -> Direction
w0Obj Obj
nxtObj Direction -> Direction -> Float
.* Direction
nObj)) (Obj -> Set Shape -> RGB
brdf Obj
obj Set Shape
figuras RGB -> Float -> RGB
`modRGB` Float
255) (DList Foton
fotones DList Foton -> Foton -> DList Foton
forall a. DList a -> a -> DList a
`DL.snoc` Foton
foton) Set Shape
figuras (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) StdGen
gen' Obj
nxtObj
    photonE :: DList Foton
photonE = Point3D
-> Float
-> RGB
-> DList Foton
-> Set Shape
-> Int
-> StdGen
-> Obj
-> DList Foton
traceRay Point3D
pObj (Float
pot Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
por) (Obj -> Set Shape -> RGB
brdf Obj
obj Set Shape
figuras RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
* RGB
rgb ) DList Foton
fotones Set Shape
figuras Int
n StdGen
gen' Obj
objEsp
    photonR :: DList Foton
photonR = Point3D
-> Float
-> RGB
-> DList Foton
-> Set Shape
-> Int
-> StdGen
-> Obj
-> DList Foton
traceRay Point3D
pObj (Float
pot Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
por) (Obj -> Set Shape -> RGB
brdf Obj
obj Set Shape
figuras RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
* RGB
rgb ) DList Foton
fotones Set Shape
figuras Int
n StdGen
gen' Obj
objCri

    foton :: Foton
foton = Point3D -> Float -> RGB -> Int -> Foton
Foton Point3D
pObj Float
pot' RGB
rgb (Obj -> Int
idObj Obj
obj)
    pot' :: Float
pot' = Float -> Float
forall a. Num a => a -> a
abs (Obj -> Direction
w0Obj Obj
obj Direction -> Direction -> Float
.* Direction
nObj)Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
pot Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ ((Float
1Float -> Float -> Float
forall a. Num a => a -> a -> a
+(Direction -> Float
modd (Obj -> Point3D
colObj Obj
obj Point3D -> Point3D -> Direction
#< Point3D
p)Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
10.0))Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2)
    
    nxtObj :: Obj
nxtObj = Set Shape -> Obj -> StdGen -> Obj
objAleatorio Set Shape
figuras' Obj
obj StdGen
gen -- Siguiente objeto que choca con dirección random
    objEsp :: Obj
objEsp = Set Shape -> Direction -> Direction -> Point3D -> Obj
objEspejo Set Shape
figuras' (Obj -> Direction
w0Obj Obj
obj) Direction
nObj Point3D
pObj -- Siguiente objeto que choca con dirección espejo
    (Obj
objCri, Float
_) = Set Shape
-> Direction
-> Direction
-> Float
-> Float
-> Point3D
-> (Obj, Float)
objCristal Set Shape
figuras (Obj -> Direction
w0Obj Obj
obj) Direction
nObj Float
1 (Obj -> Float
reflObj Obj
obj) Point3D
pObj -- Siguiente objeto que choca con dirección refracción

    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 -- Quita el objeto que choca de la lista de figuras para que al buscar la primera vez no choque consigo mismo

    gen' :: StdGen
gen' = (StdGen, StdGen) -> StdGen
forall a b. (a, b) -> b
snd ((StdGen, StdGen) -> StdGen) -> (StdGen, StdGen) -> StdGen
forall a b. (a -> b) -> a -> b
$ StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
gen

-- | Función auxiliar que estima la densidad de fotones en un punto.
{-# INLINE estDensPhoton #-}
estDensPhoton :: [Foton] -> Obj -> Set.Set Shape -> Float -> RGB
estDensPhoton :: [Foton] -> Obj -> Set Shape -> Float -> RGB
estDensPhoton [Foton]
photons Obj
obj Set Shape
figuras Float
radio = RGB
newRGB
  where
   -- newRGB = sumRGB $ map (\photon -> fusion obj (fGaus photons obj photon) photon) photons
    --newRGB = sumRGB $ map (\photon -> fusion obj (1/(radio * radio * pi)) photon) photons
    newRGB :: RGB
newRGB = [RGB] -> RGB
sumRGB ([RGB] -> RGB) -> [RGB] -> RGB
forall a b. (a -> b) -> a -> b
$ (Foton -> RGB) -> [Foton] -> [RGB]
forall a b. (a -> b) -> [a] -> [b]
map (\Foton
photon -> Obj -> Float -> Foton -> RGB
fusion Obj
obj (Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Point3D -> Foton -> Float
distFot (Obj -> Point3D
colObj Obj
obj) Foton
photon)) Foton
photon) [Foton]
photons
    fusion :: Obj -> Float -> Foton -> RGB
    fusion :: Obj -> Float -> Foton -> RGB
fusion Obj
obj Float
kernel Foton
fot = RGB
newRGB RGB -> Float -> RGB
`modRGB` Float
kernel
      where
        newRGB :: RGB
newRGB = RGB -> Float -> RGB
modRGB (RGB -> RGB
scale (RGB -> RGB) -> RGB -> RGB
forall a b. (a -> b) -> a -> b
$ Foton -> RGB
rgbFot Foton
fot) (Foton -> Float
iFot Foton
fot) RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
* Obj -> Set Shape -> RGB
brdf Obj
obj Set Shape
figuras
        
-- photonMap :: KdTree Float Foton -> Int -> Set.Set Shape-> Obj -> RGB
-- photonMap kdt nPhoton figuras obj@(Obj rgb w0 p norm (kd,0,0) kr' id) = newRGB * RGB 255 255 255
--   where
--     !newRGB = kdToRGB kdt (round $ fromIntegral nPhoton * kd) figuras obj
--     figuras' = filter (\shape -> id /= getShapeID shape) figuras
--     objEsp = objEspejo figuras' w0 norm p
--     (objCri,_) = objCristal figuras' w0 norm 1 kr' p

-- photonMap kdt nPhoton figuras obj@(Obj rgb w0 p norm (kd,kr,ke) kr' id) = newRGB
--   where
--     !newRGB = kdToRGB kdt (round $ fromIntegral nPhoton * kd) figuras obj + (rgb * scale colorEsp) + rgb * scale colorCri
--     figuras' = filter (\shape -> id /= getShapeID shape) figuras
--     objEsp = objEspejo figuras' w0 norm p
--     (objCri,_) = objCristal figuras' w0 norm 1 kr' p
--     colorCri = if round (fromIntegral nPhoton * kr) == 0 then RGB 0 0 0 else photonMap kdt (round $ fromIntegral nPhoton * kr) figuras objCri --Fixear :D
--     colorEsp = if round (fromIntegral nPhoton * ke) == 0 then RGB 0 0 0 else photonMap kdt (round $ fromIntegral nPhoton * ke) figuras objEsp


-- kdToRGB :: KdTree Float Foton -> Int -> Set.Set Shape-> Obj -> RGB
-- kdToRGB kdt 0 figuras obj@(Obj rgb w0 p norm (kd,kr,ke) kr' id) = RGB 0 0 0
-- kdToRGB kdt nPhoton figuras obj@(Obj rgb w0 p norm (kd,kr,ke) kr' id) = newRGB
--   where
--     photons = kNearest kdt nPhoton (pointToPothon p)
--     photons' = filter (\(Foton point int dir rgbF idF) -> id == idF) photons
--     -- Coger solo fotones del mismo objeto
--     !newRGB = estDensPhoton photons' obj figuras

-- | Función principal que calcula el color de un punto a partir de un kdt de fotones.
photonMap :: KdTree Float Foton -> [Luz] -> Float -> Set.Set Shape -> Obj -> RGB
photonMap :: KdTree Float Foton -> [Luz] -> Float -> Set Shape -> Obj -> RGB
photonMap KdTree Float Foton
kdt [Luz]
luces Float
radio Set Shape
figuras Obj
obj
  | Obj -> Float
mindObj Obj
obj Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 = Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0
  | Bool
otherwise = {- addNiebla (head luces) obj 0.9 figuras $ -} RGB
difuso RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
+ RGB
espejo RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
+ RGB
cristal
  where
    fr :: Float
fr = Obj -> Float -> Float
fresnell Obj
obj Float
1
    difuso :: RGB
difuso = if Float
kd Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 then Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0 else KdTree Float Foton -> Float -> Set Shape -> Obj -> RGB
kdToRGB KdTree Float Foton
kdt Float
radio Set Shape
figuras Obj
obj
    espejo :: RGB
espejo = if Float
ke Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 then Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0 else Obj -> RGB
rgbObj Obj
obj RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
* RGB -> RGB
scale RGB
colorEsp --  `modRGB` ke
    cristal :: RGB
cristal = if Float
kr Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 then Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0 else Obj -> RGB
rgbObj Obj
obj RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
* RGB -> RGB
scale RGB
colorCri RGB -> Float -> RGB
`modRGB` Float
kr

    (Float
kd,Float
kr,Float
ke) = Obj -> (Float, Float, Float)
trObj Obj
obj
    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
    objEsp :: Obj
objEsp = Set Shape -> Direction -> Direction -> Point3D -> Obj
objEspejo Set Shape
figuras' (Obj -> Direction
w0Obj Obj
obj) (Obj -> Direction
normObj Obj
obj) (Obj -> Point3D
colObj Obj
obj)
    (Obj
objCri,Float
_) = Set Shape
-> Direction
-> Direction
-> Float
-> Float
-> Point3D
-> (Obj, Float)
objCristal Set Shape
figuras' (Obj -> Direction
w0Obj Obj
obj) (Obj -> Direction
normObj Obj
obj) Float
1 (Obj -> Float
reflObj Obj
obj) (Obj -> Point3D
colObj Obj
obj)

    colorCri :: RGB
colorCri = KdTree Float Foton -> [Luz] -> Float -> Set Shape -> Obj -> RGB
photonMap KdTree Float Foton
kdt [Luz]
luces Float
radio Set Shape
figuras Obj
objCri
    colorEsp :: RGB
colorEsp = KdTree Float Foton -> [Luz] -> Float -> Set Shape -> Obj -> RGB
photonMap KdTree Float Foton
kdt [Luz]
luces Float
radio Set Shape
figuras Obj
objEsp

-- | Función auxiliar que calcula el color de un punto a partir de un kdt de fotones.
{-# INLINE kdToRGB #-}
kdToRGB :: KdTree Float Foton -> Float -> Set.Set Shape-> Obj -> RGB
kdToRGB :: KdTree Float Foton -> Float -> Set Shape -> Obj -> RGB
kdToRGB KdTree Float Foton
kdt Float
0 Set Shape
figuras Obj
obj = Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0
kdToRGB KdTree Float Foton
kdt Float
radio Set Shape
figuras Obj
obj = RGB
newRGB
  where
    photons :: [Foton]
photons = KdTree Float Foton -> Float -> Foton -> [Foton]
forall a p. Real a => KdTree a p -> a -> p -> [p]
inRadius KdTree Float Foton
kdt Float
radio (Point3D -> Foton
pointToPothon (Obj -> Point3D
colObj Obj
obj))
    -- photons = kNearest kdt (round radio) (pointToPothon (colObj obj)) -- Si quisieramos coger los k-fotones más cercanos
    photons' :: [Foton]
photons' = (Foton -> Bool) -> [Foton] -> [Foton]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Foton
fot -> Obj -> Int
idObj Obj
obj Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Foton -> Int
idFot Foton
fot) [Foton]
photons -- Coger solo fotones del mismo objeto
    
    !newRGB :: RGB
newRGB = if [Foton] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Foton]
photons' then Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0 else [Foton] -> Obj -> Set Shape -> Float -> RGB
estDensPhoton [Foton]
photons' Obj
obj Set Shape
figuras Float
radio --Si no hay fotones el color es 0, sino ecuación de estiamcion de densidad