{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE InstanceSigs #-}

module Elem3D where
import Data.Binary ( Binary(get, put) )
import Debug.Trace (trace)
import qualified Data.Binary.Put
import qualified Data.Binary as Data.Binary.Get.Internal

-- |Tipo básico empleado por todo el código, este representa un punto en un espacio tridimensional, en su interior contiene un punto en el eje X otro en el Y e otro en el Z.
data Point3D = Point3D {Point3D -> Float
xP :: Float, Point3D -> Float
yP :: Float, Point3D -> Float
zP :: Float} deriving (Point3D -> Point3D -> Bool
(Point3D -> Point3D -> Bool)
-> (Point3D -> Point3D -> Bool) -> Eq Point3D
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point3D -> Point3D -> Bool
$c/= :: Point3D -> Point3D -> Bool
== :: Point3D -> Point3D -> Bool
$c== :: Point3D -> Point3D -> Bool
Eq)
-- |Tipo básico, representa una dirección, de la misma forma que el punto contiene 3 valores en su interior, uno para cada eje.
data Direction = Direction {Direction -> Float
xD :: Float, Direction -> Float
yD :: Float, Direction -> Float
zD :: Float} deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq)
-- |Tipo compuesto, representa un tayo, este se forma de su punto de origen y la dirección en la que este se desplaza.
data Ray = Ray {Ray -> Point3D
oR :: Point3D, Ray -> Direction
dR :: Direction}
-- |Tipo compuesto, representa la base de un espacio, se conforma por 3 direcciones.
data Base = Base {Base -> Direction
d0 :: Direction, Base -> Direction
d1 :: Direction, Base -> Direction
d2 :: Direction} deriving (Int -> Base -> ShowS
[Base] -> ShowS
Base -> String
(Int -> Base -> ShowS)
-> (Base -> String) -> ([Base] -> ShowS) -> Show Base
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Base] -> ShowS
$cshowList :: [Base] -> ShowS
show :: Base -> String
$cshow :: Base -> String
showsPrec :: Int -> Base -> ShowS
$cshowsPrec :: Int -> Base -> ShowS
Show)
-- |Tipo básico, representa la tripleta de color RGB, la conforman por tres valores float(uno para cada canal de color) que pertenecen al rango [0,1]
data RGB = RGB {RGB -> Float
red :: Float, RGB -> Float
green :: Float, RGB -> Float
blue :: Float} deriving (RGB -> RGB -> Bool
(RGB -> RGB -> Bool) -> (RGB -> RGB -> Bool) -> Eq RGB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RGB -> RGB -> Bool
$c/= :: RGB -> RGB -> Bool
== :: RGB -> RGB -> Bool
$c== :: RGB -> RGB -> Bool
Eq)
-- |Tipo compuesto, representa una fuente de luz, esta se encuentra en un punto del espacio por lo que tiene un punto3D, emite una cierta tonalidad de luz por lo que tiene un RGB y emite una cierta intensidad de luz por lo que tiene el Float.
data Luz = Luz {Luz -> Point3D
luzP :: Point3D, Luz -> RGB
luzRGB :: RGB, Luz -> Float
luzPot :: Float}
-- |Tipo compuesto, representa una partícula de fotón, esta tiene un punto3D, una intensidad(float), una tonalidad(RGB), por último tiene un id(Entero) para identificarlo.
data Foton = Foton {Foton -> Point3D
pFot :: Point3D, Foton -> Float
iFot :: Float, Foton -> RGB
rgbFot :: RGB, Foton -> Int
idFot :: Int}

instance Binary Point3D where
  put :: Point3D -> Data.Binary.Put.Put
  put :: Point3D -> Put
put (Point3D {Float
zP :: Float
yP :: Float
xP :: Float
zP :: Point3D -> Float
yP :: Point3D -> Float
xP :: Point3D -> Float
..}) = Float -> Put
forall t. Binary t => t -> Put
put Float
xP Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> Put
forall t. Binary t => t -> Put
put Float
yP Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> Put
forall t. Binary t => t -> Put
put Float
zP
  get :: Data.Binary.Get.Internal.Get Point3D
  get :: Get Point3D
get = do
    Float
x <- Get Float
forall t. Binary t => Get t
get
    Float
y <- Get Float
forall t. Binary t => Get t
get
    Float -> Float -> Float -> Point3D
Point3D Float
x Float
y (Float -> Point3D) -> Get Float -> Get Point3D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
forall t. Binary t => Get t
get

instance Binary Direction where
  put :: Direction -> Data.Binary.Get.Internal.Put
  put :: Direction -> Put
put (Direction {Float
zD :: Float
yD :: Float
xD :: Float
zD :: Direction -> Float
yD :: Direction -> Float
xD :: Direction -> Float
..}) = Float -> Put
forall t. Binary t => t -> Put
put Float
xD Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> Put
forall t. Binary t => t -> Put
put Float
yD Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> Put
forall t. Binary t => t -> Put
put Float
zD
  get :: Data.Binary.Get.Internal.Get Direction
  get :: Get Direction
get = do
    Float
x <- Get Float
forall t. Binary t => Get t
get
    Float
y <- Get Float
forall t. Binary t => Get t
get
    Float -> Float -> Float -> Direction
Direction Float
x Float
y (Float -> Direction) -> Get Float -> Get Direction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
forall t. Binary t => Get t
get

instance Binary RGB where
  put :: RGB -> Data.Binary.Get.Internal.Put
  put :: RGB -> Put
put (RGB {Float
blue :: Float
green :: Float
red :: Float
blue :: RGB -> Float
green :: RGB -> Float
red :: RGB -> Float
..}) = Float -> Put
forall t. Binary t => t -> Put
put Float
red Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> Put
forall t. Binary t => t -> Put
put Float
green Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> Put
forall t. Binary t => t -> Put
put Float
blue
  get :: Data.Binary.Get.Internal.Get RGB
  get :: Get RGB
get = do
    Float
r <- Get Float
forall t. Binary t => Get t
get
    Float
g <- Get Float
forall t. Binary t => Get t
get
    Float -> Float -> Float -> RGB
RGB Float
r Float
g (Float -> RGB) -> Get Float -> Get RGB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
forall t. Binary t => Get t
get

instance Binary Foton where
  put :: Foton -> Data.Binary.Get.Internal.Put
  put :: Foton -> Put
put (Foton {Float
Int
RGB
Point3D
idFot :: Int
rgbFot :: RGB
iFot :: Float
pFot :: Point3D
idFot :: Foton -> Int
rgbFot :: Foton -> RGB
iFot :: Foton -> Float
pFot :: Foton -> Point3D
..}) = Point3D -> Put
forall t. Binary t => t -> Put
put Point3D
pFot Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> Put
forall t. Binary t => t -> Put
put Float
iFot  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RGB -> Put
forall t. Binary t => t -> Put
put RGB
rgbFot Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
idFot
  get :: Data.Binary.Get.Internal.Get Foton
  get :: Get Foton
get = do
    Point3D
p <- Get Point3D
forall t. Binary t => Get t
get
    Float
f <- Get Float
forall t. Binary t => Get t
get
    RGB
c <- Get RGB
forall t. Binary t => Get t
get
    Point3D -> Float -> RGB -> Int -> Foton
Foton Point3D
p Float
f RGB
c (Int -> Foton) -> Get Int -> Get Foton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall t. Binary t => Get t
get

instance Show Point3D where
    show :: Point3D -> String
    show :: Point3D -> String
show (Point3D{Float
zP :: Float
yP :: Float
xP :: Float
zP :: Point3D -> Float
yP :: Point3D -> Float
xP :: Point3D -> Float
..}) = String
"Point3D " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
xP String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
yP String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
zP

instance Show Direction where
    show :: Direction -> String
    show :: Direction -> String
show (Direction {Float
zD :: Float
yD :: Float
xD :: Float
zD :: Direction -> Float
yD :: Direction -> Float
xD :: Direction -> Float
..}) = String
"Direction " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
xD String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
yD String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
zD

instance Show Ray where
    show :: Ray -> String
    show :: Ray -> String
show (Ray {Direction
Point3D
dR :: Direction
oR :: Point3D
dR :: Ray -> Direction
oR :: Ray -> Point3D
..}) = String
"Rayo hasta "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Direction -> String
forall a. Show a => a -> String
show Direction
dR

instance Show RGB where
    show :: RGB -> String
    show :: RGB -> String
show (RGB {Float
blue :: Float
green :: Float
red :: Float
blue :: RGB -> Float
green :: RGB -> Float
red :: RGB -> Float
..}) = String
"R "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
red String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" G "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
green String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" B "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
blue

instance Show Foton where
    show :: Foton -> String
    show :: Foton -> String
show (Foton {Float
Int
RGB
Point3D
idFot :: Int
rgbFot :: RGB
iFot :: Float
pFot :: Point3D
idFot :: Foton -> Int
rgbFot :: Foton -> RGB
iFot :: Foton -> Float
pFot :: Foton -> Point3D
..}) = String
"Foton " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show (Point3D -> Float
xP Point3D
pFot) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show (Point3D -> Float
yP Point3D
pFot) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show (Point3D -> Float
zP Point3D
pFot) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
iFot String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RGB -> String
forall a. Show a => a -> String
show RGB
rgbFot


{-# INLINE roundTo #-}
-- |Función auxiliar, redondea los valores de las posiciones de un punto hasta n dígitos.
roundTo :: Int -> Point3D -> Point3D
roundTo :: Int -> Point3D -> Point3D
roundTo Int
n (Point3D Float
a Float
b Float
c) = Float -> Float -> Float -> Point3D
Point3D Float
a' Float
b' Float
c'
    where
        !a' :: Float
a' = Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$ Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
10Float -> Int -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
10.0Float -> Int -> Float
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Int
n) :: Float
        !b' :: Float
b' = Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$ Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
10Float -> Int -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
10.0Float -> Int -> Float
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Int
n) :: Float
        !c' :: Float
c' = Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$ Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
10Float -> Int -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
10.0Float -> Int -> Float
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Int
n) :: Float

-- ************************************************
-- Angulos y transformaciones
{-# INLINE radToDeg #-}
-- |Función auxiliar, convierte de radianes a grados.
radToDeg :: Float -> Float
radToDeg :: Float -> Float
radToDeg Float
radians = Float
radians Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
180.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
forall a. Floating a => a
pi)

{-# INLINE degToRad #-}
-- |Función auxiliar, convierte de grados a radianes.
degToRad :: Float -> Float
degToRad :: Float -> Float
degToRad Float
degree = Float
degree 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
/ Float
180.0)

{-# INLINE angleBetween #-}
-- |Función auxiliar, calcula el ángulo que forman 2 direcciones dadas.
angleBetween :: Direction -> Direction -> Float
angleBetween :: Direction -> Direction -> Float
angleBetween Direction
d1 Direction
d2 = Float -> Float
forall a. Floating a => a -> a
acos (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Direction
d1 Direction -> Direction -> Float
.* Direction
d2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Direction -> Float
modd Direction
d1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Direction -> Float
modd Direction
d2)

-- ************************************************

-----------------------------------------------------------------------------------------------------------------------------------------------
--Puntos

-- |Función auxiliar, rota un punto en uno de los ejes X Y Z, emplea radianes como unidad de rotación.
rotatePoint :: Char -> Float -> Point3D -> Point3D
rotatePoint :: Char -> Float -> Point3D -> Point3D
rotatePoint Char
axis Float
radiant  (Point3D Float
x Float
y Float
z)
 | Float
radiant Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = Float -> Float -> Float -> Point3D
Point3D Float
x Float
y Float
z
 | Char
axis Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'X' = Float -> Float -> Float -> Point3D
Point3D Float
x (Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z) (-Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z)
 | Char
axis Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Y' = Float -> Float -> Float -> Point3D
Point3D (-Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x) Float
y (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z)
 | Char
axis Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Z' = Float -> Float -> Float -> Point3D
Point3D (Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y) (-Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y) Float
z
 | Bool
otherwise = Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0
    where
        !c :: Float
c = Float -> Float
forall a. Floating a => a -> a
cos Float
radiant
        !s :: Float
s = Float -> Float
forall a. Floating a => a -> a
sin Float
radiant

-- |Función básica, rota un punto en uno de los ejes X Y Z, emplea grados como unidad de rotación.
rotatePointt :: Char -> Float -> Point3D -> Point3D
rotatePointt :: Char -> Float -> Point3D -> Point3D
rotatePointt Char
axis Float
radiant  (Point3D Float
x Float
y Float
z)
 | Float
radiant Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = Float -> Float -> Float -> Point3D
Point3D Float
x Float
y Float
z
 | Char
axis Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'X' = Float -> Float -> Float -> Point3D
Point3D Float
x (Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z) (-Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z)
 | Char
axis Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Y' = Float -> Float -> Float -> Point3D
Point3D (-Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x) Float
y (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z)
 | Char
axis Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Z' = Float -> Float -> Float -> Point3D
Point3D (Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y) (-Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y) Float
z
 | Bool
otherwise = Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0
    where
        !c :: Float
c = Float -> Float
forall a. Floating a => a -> a
cos (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
degToRad Float
radiant
        !s :: Float
s = Float -> Float
forall a. Floating a => a -> a
sin (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
degToRad Float
radiant

-- |Función de rotación inversa, deshace la rotación de un punto en uno de los ejes X Y Z, emplea radianes como unidad de rotación.
rotatePoint' :: Char -> Float -> Point3D -> Point3D
rotatePoint' :: Char -> Float -> Point3D -> Point3D
rotatePoint' Char
axis Float
radiant  (Point3D Float
x Float
y Float
z)
 | Float
radiant Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = Float -> Float -> Float -> Point3D
Point3D Float
x Float
y Float
z
 | Char
axis Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'X' = Float -> Float -> Float -> Point3D
Point3D Float
x (Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z) (-Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z)
 | Char
axis Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Y' = Float -> Float -> Float -> Point3D
Point3D (-Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x) Float
y (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
z)
 | Char
axis Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Z' = Float -> Float -> Float -> Point3D
Point3D (Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y) (-Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y) Float
z
 | Bool
otherwise = Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0
    where
        radiant' :: Float
radiant' = Float
2Float -> 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
radiant
        c :: Float
c = Float -> Float
forall a. Floating a => a -> a
cos Float
radiant
        s :: Float
s = Float -> Float
forall a. Floating a => a -> a
sin Float
radiant

{-# INLINE movePoint #-}
-- |Función básica, aplica una dirección a un punto para desplazarlo en el espacio.
movePoint :: Direction -> Point3D -> Point3D
movePoint :: Direction -> Point3D -> Point3D
movePoint (Direction {Float
zD :: Float
yD :: Float
xD :: Float
zD :: Direction -> Float
yD :: Direction -> Float
xD :: Direction -> Float
..}) (Point3D {Float
zP :: Float
yP :: Float
xP :: Float
zP :: Point3D -> Float
yP :: Point3D -> Float
xP :: Point3D -> Float
..}) = Float -> Float -> Float -> Point3D
Point3D (Float
xD Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
xP) (Float
yD Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
yP) (Float
zD Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
zP)

{-# INLINE movePoint' #-}
-- |Función auxiliar, esta revierte el desplazamiento de una dirección a un punto para desplazarlo en el espacio.
movePoint' :: Direction -> Point3D -> Point3D
movePoint' :: Direction -> Point3D -> Point3D
movePoint' (Direction {Float
zD :: Float
yD :: Float
xD :: Float
zD :: Direction -> Float
yD :: Direction -> Float
xD :: Direction -> Float
..}) (Point3D {Float
zP :: Float
yP :: Float
xP :: Float
zP :: Point3D -> Float
yP :: Point3D -> Float
xP :: Point3D -> Float
..}) = Float -> Float -> Float -> Point3D
Point3D (Float
xD Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
xP) (Float
yD Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
yP) (Float
zD Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
zP)

{-# INLINE distPoint #-}
-- |Función básica, cálcula la distancia real entre dos puntos en el espacio.
distPoint :: Point3D -> Point3D -> Float
distPoint :: Point3D -> Point3D -> Float
distPoint Point3D
p Point3D
p' = Float -> Float
forall a. Floating a => a -> a
sqrt (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ (Point3D -> Float
xP Point3D
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
xP Point3D
p)Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Point3D -> Float
yP Point3D
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
yP Point3D
p)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
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
zP Point3D
p)Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2

-- -- Resta de puntos -> Dirección del primero al segundo
{-# INLINE (#) #-}
----------------------------------------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------------------------------------
-- QUE ES ESTO
-- |Función básica, cálcula la dirección del primer punto al segundo.
(#) :: Point3D -> Point3D -> Point3D
Point3D
p' # :: Point3D -> Point3D -> Point3D
# Point3D
p= Float -> Float -> Float -> Point3D
Point3D (Point3D -> Float
xP Point3D
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
xP Point3D
p) (Point3D -> Float
yP Point3D
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
yP Point3D
p) (Point3D -> Float
zP Point3D
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
zP Point3D
p)

{-# INLINE addPoints #-}
-- |Función auxiliar, suma de puntos.
addPoints :: Point3D -> Point3D -> Point3D
addPoints :: Point3D -> Point3D -> Point3D
addPoints Point3D
p Point3D
p'= Float -> Float -> Float -> Point3D
Point3D (Point3D -> Float
xP Point3D
p' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Point3D -> Float
xP Point3D
p) (Point3D -> Float
yP Point3D
p' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Point3D -> Float
yP Point3D
p) (Point3D -> Float
zP Point3D
p' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Point3D -> Float
zP Point3D
p)


-- -- Direccion entre puntos -> Dirección del primero al segundo
{-# INLINE (#<) #-}
-- |Función básica, cálcula la dirección del primer punto al segundo.
(#<) :: Point3D -> Point3D -> Direction
Point3D
p' #< :: Point3D -> Point3D -> Direction
#< Point3D
p= Float -> Float -> Float -> Direction
Direction (Point3D -> Float
xP Point3D
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
xP Point3D
p) (Point3D -> Float
yP Point3D
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
yP Point3D
p) (Point3D -> Float
zP Point3D
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
zP Point3D
p)

{-# INLINE aproxPoint #-}
-- |Función básica, dados dos puntos en el espacio comprueba si estos son aproximadamente(0.1 de error de posición por eje) el mismo punto.
aproxPoint :: Point3D -> Point3D -> Bool
aproxPoint :: Point3D -> Point3D -> Bool
aproxPoint Point3D
p Point3D
p' = Bool
a Bool -> Bool -> Bool
&& Bool
b Bool -> Bool -> Bool
&& Bool
c
    where
        !a :: Bool
a = Float -> Float
forall a. Num a => a -> a
abs (Point3D -> Float
xP Point3D
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
xP Point3D
p) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.1
        !b :: Bool
b = Float -> Float
forall a. Num a => a -> a
abs (Point3D -> Float
yP Point3D
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
yP Point3D
p) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.1
        !c :: Bool
c = Float -> Float
forall a. Num a => a -> a
abs (Point3D -> Float
zP Point3D
p'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Point3D -> Float
zP Point3D
p) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.1

-- -- -- Escalado de puntos
{-# INLINE escalatePoint' #-}
-- |Función auxiliar, revierte el proceso de escalar un punto.
escalatePoint' :: Float -> Point3D -> Point3D
escalatePoint' :: Float -> Point3D -> Point3D
escalatePoint' Float
s (Point3D {Float
zP :: Float
yP :: Float
xP :: Float
zP :: Point3D -> Float
yP :: Point3D -> Float
xP :: Point3D -> Float
..}) = Float -> Float -> Float -> Point3D
Point3D (Float
xPFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
s) (Float
yPFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
s) (Float
zPFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
s)

-- -- -- Escalado de puntos
{-# INLINE escalatePoint #-}
-- |Función básica, reescala las dimensiones de un punto en el espacio.
escalatePoint :: Point3D -> Float -> Point3D
escalatePoint :: Point3D -> Float -> Point3D
escalatePoint (Point3D {Float
zP :: Float
yP :: Float
xP :: Float
zP :: Point3D -> Float
yP :: Point3D -> Float
xP :: Point3D -> Float
..}) Float
s = Float -> Float -> Float -> Point3D
Point3D (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
xP) (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
yP) (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
zP)
{-# INLINE escalatePointt #-}
-- |Función básica, reescala las dimensiones de un punto en el espacio.
escalatePointt :: Float -> Point3D -> Point3D
escalatePointt :: Float -> Point3D -> Point3D
escalatePointt Float
s (Point3D {Float
zP :: Float
yP :: Float
xP :: Float
zP :: Point3D -> Float
yP :: Point3D -> Float
xP :: Point3D -> Float
..}) = Float -> Float -> Float -> Point3D
Point3D (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
xP) (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
yP) (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
zP)

{-# INLINE pointDir#-}
-- |Función básica, dado un punto traza una dirección desde el origen(0,0,0) hasta dicho punto.
pointDir :: Point3D -> Direction
pointDir :: Point3D -> Direction
pointDir (Point3D {Float
zP :: Float
yP :: Float
xP :: Float
zP :: Point3D -> Float
yP :: Point3D -> Float
xP :: Point3D -> Float
..}) = Float -> Float -> Float -> Direction
Direction Float
xP Float
yP Float
zP

{-# INLINE dirPoint#-}
-- |Función básica, dado una dirección, la traza desde el origen(0,0,0) y devuelve el punto donde acaba.
dirPoint :: Direction -> Point3D
dirPoint :: Direction -> Point3D
dirPoint (Direction {Float
zD :: Float
yD :: Float
xD :: Float
zD :: Direction -> Float
yD :: Direction -> Float
xD :: Direction -> Float
..}) = Float -> Float -> Float -> Point3D
Point3D Float
xD Float
yD Float
zD

{-# INLINE pointToPothon#-}
-- |Función auxiliar, dado un punto en el espacio, crea un foton "vacío" en este punto.
pointToPothon :: Point3D -> Foton
pointToPothon :: Point3D -> Foton
pointToPothon Point3D
p = Point3D -> Float -> RGB -> Int -> Foton
Foton Point3D
p Float
0 (Float -> Float -> Float -> RGB
RGB Float
0 Float
0 Float
0) Int
0

{-# INLINE distFot #-}
-- |Función básica, dados un punto y un fotón calcula la distancia real entre ambos.
distFot :: Point3D -> Foton -> Float
distFot :: Point3D -> Foton -> Float
distFot Point3D
p Foton
fot = Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Point3D
p Point3D -> Point3D -> Float
`distPoint` Foton -> Point3D
pFot Foton
fot

------------------------------------------------------------------------------------------------------------------
--Direcciones

instance Num Direction where
-- Suma de direcciones
 {-# INLINE (+) #-}
 (+) :: Direction -> Direction -> Direction
 Direction
d + :: Direction -> Direction -> Direction
+ Direction
d' = Float -> Float -> Float -> Direction
Direction (Direction -> Float
xD Direction
d Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Direction -> Float
xD Direction
d') (Direction -> Float
yD Direction
dFloat -> Float -> Float
forall a. Num a => a -> a -> a
+ Direction -> Float
yD Direction
d') (Direction -> Float
zD Direction
d Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Direction -> Float
zD Direction
d')
-- Resta de Direcciones
 {-# INLINE (-) #-}
 (-) :: Direction -> Direction -> Direction
 Direction
d - :: Direction -> Direction -> Direction
- Direction
d' = Float -> Float -> Float -> Direction
Direction (Direction -> Float
xD Direction
d Float -> Float -> Float
forall a. Num a => a -> a -> a
- Direction -> Float
xD Direction
d') (Direction -> Float
yD Direction
d Float -> Float -> Float
forall a. Num a => a -> a -> a
- Direction -> Float
yD Direction
d') (Direction -> Float
zD Direction
d Float -> Float -> Float
forall a. Num a => a -> a -> a
- Direction -> Float
zD Direction
d')

 -- Producto vectorial
 {-# INLINE (*) #-}
 (*) :: Direction -> Direction -> Direction
 Direction
dir0 * :: Direction -> Direction -> Direction
* Direction
dir1 = Float -> Float -> Float -> Direction
Direction Float
x Float
y Float
z
     where
        x :: Float
x = Direction -> Float
yD Direction
dir0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Direction -> Float
zD Direction
dir1Float -> Float -> Float
forall a. Num a => a -> a -> a
- Direction -> Float
zD Direction
dir0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Direction -> Float
yD Direction
dir1
        y :: Float
y = Direction -> Float
zD Direction
dir0Float -> Float -> Float
forall a. Num a => a -> a -> a
* Direction -> Float
xD Direction
dir1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Direction -> Float
xD Direction
dir0Float -> Float -> Float
forall a. Num a => a -> a -> a
* Direction -> Float
zD Direction
dir1
        z :: Float
z = Direction -> Float
xD Direction
dir0Float -> Float -> Float
forall a. Num a => a -> a -> a
* Direction -> Float
yD Direction
dir1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Direction -> Float
yD Direction
dir0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Direction -> Float
xD Direction
dir1

-- -- -- Producto escalar
{-# INLINE (.*) #-}
-- |Función básica, calcula el producto escalar de dos direcciones.
(.*) :: Direction -> Direction -> Float
Direction
dir0 .* :: Direction -> Direction -> Float
.* Direction
dir1  = Direction -> Float
xD Direction
dir0Float -> Float -> Float
forall a. Num a => a -> a -> a
*Direction -> Float
xD Direction
dir1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Direction -> Float
yD Direction
dir0Float -> Float -> Float
forall a. Num a => a -> a -> a
*Direction -> Float
yD Direction
dir1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Direction -> Float
zD Direction
dir0Float -> Float -> Float
forall a. Num a => a -> a -> a
*Direction -> Float
zD Direction
dir1

-- -- -- Escalado de dirección
{-# INLINE escalateDir #-}
-- |Función básica, reescala una dirección.
escalateDir :: Float -> Direction -> Direction
escalateDir :: Float -> Direction -> Direction
escalateDir Float
s (Direction {Float
zD :: Float
yD :: Float
xD :: Float
zD :: Direction -> Float
yD :: Direction -> Float
xD :: Direction -> Float
..}) = Float -> Float -> Float -> Direction
Direction (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
xD) (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
yD) (Float
sFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
zD)

-- -- -- Escalado de dirección
{-# INLINE escalateDir' #-}
-- |Función auxiliar, deshace el reescalado de una dirección.
escalateDir' :: Float -> Direction -> Direction
escalateDir' :: Float -> Direction -> Direction
escalateDir' Float
s (Direction {Float
zD :: Float
yD :: Float
xD :: Float
zD :: Direction -> Float
yD :: Direction -> Float
xD :: Direction -> Float
..}) = Float -> Float -> Float -> Direction
Direction (Float
xDFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
s) (Float
yDFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
s) (Float
zDFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
s)

-- -- Modulo
{-# INLINE modd #-}
-- |Función auxiliar, dada una dirección calcula su módulo.
modd :: Direction -> Float
modd :: Direction -> Float
modd (Direction {Float
zD :: Float
yD :: Float
xD :: Float
zD :: Direction -> Float
yD :: Direction -> Float
xD :: Direction -> Float
..}) = Float -> Float
forall a. Floating a => a -> a
sqrt (Float
xDFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
xD Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
yDFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
yD Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
zDFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
zD)

-- Normalización
{-# INLINE normal #-}
-- |Función auxiliar, dada una dirección la normaliza.
normal :: Direction -> Direction
normal :: Direction -> Direction
normal (Direction {Float
zD :: Float
yD :: Float
xD :: Float
zD :: Direction -> Float
yD :: Direction -> Float
xD :: Direction -> Float
..}) = let !invLen :: Float
invLen = Float
1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float -> Float
forall a. Floating a => a -> a
sqrt (Float
xDFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
xD Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
yDFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
yD Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
zDFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
zD) in Float -> Float -> Float -> Direction
Direction (Float
xDFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
invLen) (Float
yDFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
invLen) (Float
zDFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
invLen)

-----------------------------------------------------------------------------------------------------------------------------------------------
--RGB

{-# INLINE elevateRGBPoint #-}
-- |Función auxiliar, calcula el valor de un RGB elevado a 1/x.
elevateRGBPoint :: Float -> RGB -> RGB
elevateRGBPoint :: Float -> RGB -> RGB
elevateRGBPoint Float
x (RGB {Float
blue :: Float
green :: Float
red :: Float
blue :: RGB -> Float
green :: RGB -> Float
red :: RGB -> Float
..}) =
    Float -> Float -> Float -> RGB
RGB (Float
red Float -> Float -> Float
forall a. Floating a => a -> a -> a
** (Float
1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x))
        (Float
green Float -> Float -> Float
forall a. Floating a => a -> a -> a
** (Float
1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x))
        (Float
blue Float -> Float -> Float
forall a. Floating a => a -> a -> a
** (Float
1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x))

instance Num RGB where

 {-# INLINE (+) #-}
 (+) :: RGB -> RGB -> RGB
 RGB
rgb + :: RGB -> RGB -> RGB
+ RGB
rgb' = Float -> Float -> Float -> RGB
RGB (RGB -> Float
red RGB
rgb Float -> Float -> Float
forall a. Num a => a -> a -> a
+ RGB -> Float
red RGB
rgb') (RGB -> Float
green RGB
rgb Float -> Float -> Float
forall a. Num a => a -> a -> a
+ RGB -> Float
green RGB
rgb') (RGB -> Float
blue RGB
rgb Float -> Float -> Float
forall a. Num a => a -> a -> a
+ RGB -> Float
blue RGB
rgb') 

 {-# INLINE (-) #-}
 (-) :: RGB -> RGB -> RGB
 RGB
rgb - :: RGB -> RGB -> RGB
- RGB
rgb' = Float -> Float -> Float -> RGB
RGB (RGB -> Float
red RGB
rgb Float -> Float -> Float
forall a. Num a => a -> a -> a
- RGB -> Float
red RGB
rgb') (RGB -> Float
green RGB
rgb Float -> Float -> Float
forall a. Num a => a -> a -> a
- RGB -> Float
green RGB
rgb') (RGB -> Float
blue RGB
rgb Float -> Float -> Float
forall a. Num a => a -> a -> a
- RGB -> Float
blue RGB
rgb') 

 {-# INLINE (*) #-}
 (*) :: RGB -> RGB -> RGB
 RGB
rgb * :: RGB -> RGB -> RGB
* RGB
rgb' = Float -> Float -> Float -> RGB
RGB (RGB -> Float
red RGB
rgb Float -> Float -> Float
forall a. Num a => a -> a -> a
* RGB -> Float
red RGB
rgb') (RGB -> Float
green RGB
rgb Float -> Float -> Float
forall a. Num a => a -> a -> a
* RGB -> Float
green RGB
rgb') (RGB -> Float
blue RGB
rgb Float -> Float -> Float
forall a. Num a => a -> a -> a
* RGB -> Float
blue RGB
rgb') 

{-# INLINE (./) #-}
-- |Función auxiliar, dados dos RGB, calcula su división.
(./) :: RGB -> RGB -> RGB
RGB
rgb ./ :: RGB -> RGB -> RGB
./ RGB
rgb' = Float -> Float -> Float -> RGB
RGB (RGB -> Float
red RGB
rgb Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ RGB -> Float
red RGB
rgb') (RGB -> Float
green RGB
rgb Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ RGB -> Float
green RGB
rgb') (RGB -> Float
blue RGB
rgb Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ RGB -> Float
blue RGB
rgb') 

{-# INLINE modRGB #-}
-- |Función auxiliar, dado un RGB y un valor, multiplica el RGB por este.
modRGB :: RGB -> Float -> RGB
modRGB :: RGB -> Float -> RGB
modRGB (RGB {Float
blue :: Float
green :: Float
red :: Float
blue :: RGB -> Float
green :: RGB -> Float
red :: RGB -> Float
..}) Float
f =
    Float -> Float -> Float -> RGB
RGB (Float
red Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f)
        (Float
green Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f)
        (Float
blue Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f)

{-# INLINE divRGB #-}
-- |Función auxiliar, dado un RGB y un valor, divide el RGB por este.
divRGB :: RGB -> Float -> RGB
divRGB :: RGB -> Float -> RGB
divRGB (RGB {Float
blue :: Float
green :: Float
red :: Float
blue :: RGB -> Float
green :: RGB -> Float
red :: RGB -> Float
..}) Float
f =
    Float -> Float -> Float -> RGB
RGB (Float
red Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
f)
        (Float
green Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
f)
        (Float
blue Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
f)

{-# INLINE scale #-}
scale :: RGB -> RGB
-- |Función auxiliar, dado un RGB(255) lo reescala al rango[0,1].
scale :: RGB -> RGB
scale RGB
x = RGB
x RGB -> RGB -> RGB
./ Float -> Float -> Float -> RGB
RGB Float
255 Float
255 Float
255

{-# INLINE prodRGB #-}
-- |Función auxiliar, dados dos RGBs, los multiplica  y reescala.
prodRGB ::  RGB -> RGB -> Float -> RGB
prodRGB :: RGB -> RGB -> Float -> RGB
prodRGB RGB
r0 RGB
r1 = RGB -> Float -> RGB
modRGB (RGB -> RGB
scale RGB
r0 RGB -> RGB -> RGB
forall a. Num a => a -> a -> a
* RGB
r1)

{-# INLINE nanRGB #-}
-- |Función auxiliar, comprueba la validez de los valores internos de un RGB.
nanRGB :: RGB -> Bool
nanRGB :: RGB -> Bool
nanRGB (RGB {Float
blue :: Float
green :: Float
red :: Float
blue :: RGB -> Float
green :: RGB -> Float
red :: RGB -> Float
..}) = Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
red Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
green Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
blue

-- |Función auxiliar, Convierte un RGB a un Float.
{-# INLINE rgbFloat #-}
rgbFloat :: RGB -> Float
rgbFloat :: RGB -> Float
rgbFloat (RGB {Float
blue :: Float
green :: Float
red :: Float
blue :: RGB -> Float
green :: RGB -> Float
red :: RGB -> Float
..}) = (Float
red Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
green Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
blue) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
3

-----------------------------------------------------------------------------------------------------------------------------------------------
--Bases y Matrices


-- Punto a Vector
-- |Función auxiliar, convierte de punto a vector.
pointToVector :: Point3D -> [Float]
pointToVector :: Point3D -> [Float]
pointToVector (Point3D {Float
zP :: Float
yP :: Float
xP :: Float
zP :: Point3D -> Float
yP :: Point3D -> Float
xP :: Point3D -> Float
..}) = [Float
xP, Float
yP, Float
zP]

-- Vector a Punto
-- |Función auxiliar, convierte de vector a punto.
vectorToPoint :: [Float] -> Point3D
vectorToPoint :: [Float] -> Point3D
vectorToPoint [Float
x, Float
y, Float
z] = Float -> Float -> Float -> Point3D
Point3D Float
x Float
y Float
z

--Generar Base con 3 Direcciones dadas(No comprueba que sean perpendiculares)
{-# INLINE generateBase #-}
-- |Función auxiliar, dadas 3 direcciones genera la base correspondiente(no comprueba que sean perpendiculares).
generateBase :: Direction -> Direction -> Direction -> Base
generateBase :: Direction -> Direction -> Direction -> Base
generateBase = Direction -> Direction -> Direction -> Base
Base

-- Base + Punto a Matriz
-- |Función auxiliar, convierte de base a matriz.
basePointMatrix :: Base -> [[Float]]
basePointMatrix :: Base -> [[Float]]
basePointMatrix (Base {Direction
d2 :: Direction
d1 :: Direction
d0 :: Direction
d2 :: Base -> Direction
d1 :: Base -> Direction
d0 :: Base -> Direction
..}) =
  [[Direction -> Float
xD Direction
d0, Direction -> Float
xD Direction
d1, Direction -> Float
xD Direction
d2],
   [Direction -> Float
yD Direction
d0, Direction -> Float
yD Direction
d1, Direction -> Float
yD Direction
d2],
   [Direction -> Float
zD Direction
d0, Direction -> Float
zD Direction
d1, Direction -> Float
zD Direction
d2]]

--Cambio de Base con punto y matriz en Global, devuelve punto visto en local
-- |Función auxiliar, realiza un cambio de base de global a local para un punto, con un nuevo origen.
cambioBase :: Point3D -> Base -> Point3D -> Point3D
cambioBase :: Point3D -> Base -> Point3D -> Point3D
cambioBase Point3D
nuevoOrigen Base
baseACambiar Point3D
puntoACambiarDeBase = Direction -> Point3D -> Point3D
movePoint (Point3D
nuevoOrigen Point3D -> Point3D -> Direction
#< Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) Point3D
puntoDeBaseCambiada
    where
        puntoDeBaseCambiada :: Point3D
puntoDeBaseCambiada = [Float] -> Point3D
vectorToPoint [Float]
vectorDeBaseCambiada
        vectorDeBaseCambiada :: [Float]
vectorDeBaseCambiada = [[Float]] -> [Float] -> [Float]
matrixVectorProduct [[Float]]
baseNueva (Point3D -> [Float]
pointToVector Point3D
puntoACambiarDeBase)
        baseNueva :: [[Float]]
baseNueva = Base -> [[Float]]
basePointMatrix Base
baseACambiar

--Cambio de Base con punto y matriz en Local, devuelve punto visto en global
-- |Función auxiliar, realiza un cambio de base de local a global para un punto, con el origen previo.
cambioBase' :: Point3D -> Base -> Point3D -> Point3D
cambioBase' :: Point3D -> Base -> Point3D -> Point3D
cambioBase' Point3D
nuevoOrigen Base
baseACambiar Point3D
puntoACambiarDeBase = Direction -> Point3D -> Point3D
movePoint (Point3D
nuevoOrigen Point3D -> Point3D -> Direction
#< Float -> Float -> Float -> Point3D
Point3D Float
0 Float
0 Float
0) Point3D
puntoDeBaseCambiada
    where
        puntoDeBaseCambiada :: Point3D
puntoDeBaseCambiada = Int -> Point3D -> Point3D
roundTo Int
5 (Point3D -> Point3D) -> Point3D -> Point3D
forall a b. (a -> b) -> a -> b
$ [Float] -> Point3D
vectorToPoint [Float]
vectorDeBaseCambiada
        vectorDeBaseCambiada :: [Float]
vectorDeBaseCambiada = [[Float]] -> [Float] -> [Float]
matrixVectorProduct ([[Float]] -> [[Float]]
forall a. [[a]] -> [[a]]
transposeMatrix [[Float]]
baseNueva) (Point3D -> [Float]
pointToVector Point3D
puntoACambiarDeBase)
        baseNueva :: [[Float]]
baseNueva = [[Float]] -> [[Float]]
invertMatrix (Base -> [[Float]]
basePointMatrix Base
baseACambiar)

-- Producto de matriz por vector
-- |Función auxiliar, calcula el producto de la matriz por el vector.
matrixVectorProduct :: [[Float]] -> [Float] -> [Float]
matrixVectorProduct :: [[Float]] -> [Float] -> [Float]
matrixVectorProduct [[Float]]
mat [Float]
vec =
  [[Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Float] -> Float) -> [Float] -> Float
forall a b. (a -> b) -> a -> b
$ (Float -> Float -> Float) -> [Float] -> [Float] -> [Float]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Float -> Float -> Float
forall a. Num a => a -> a -> a
(*) [Float]
row [Float]
vec | [Float]
row <- [[Float]]
mat]

-- Función de transposición de una matriz
-- |Función auxiliar, realiza una transposición de matriz.
transposeMatrix :: [[a]] -> [[a]]
transposeMatrix :: forall a. [[a]] -> [[a]]
transposeMatrix ([]:[[a]]
_) = []
transposeMatrix [[a]]
x = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
head [[a]]
x [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transposeMatrix (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
tail [[a]]
x)

-- |Función auxiliar, invierte una matriz.
invertMatrix :: [[Float]] -> [[Float]]
invertMatrix :: [[Float]] -> [[Float]]
invertMatrix [[Float
a, Float
b, Float
c], [Float
d, Float
e, Float
f], [Float
g, Float
h, Float
i]] =
  let det :: Float
det = Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
i Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
h) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
i Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g)
  in [[(Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
i Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
h) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det, (Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
i) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det, (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
e) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det],
      [(Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
i) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det, (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
i Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det, (Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det],
      [(Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det, (Float
g Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
h) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det, (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det]]