{-# LANGUAGE BangPatterns #-}
import Escena
import Elem3D
( Foton,
Luz(..),
RGB(..),
Base(Base),
Ray,
Direction(Direction),
Point3D(..),
escalatePoint,escalatePointt,
degToRad,
rotatePoint,movePoint, divRGB,rotatePointt
)
import Figuras
( Obj,
Shape(Sphere, Plane, Cylinder,Rectangle,Acelerator),
Plano(Plano),
Esfera(Esfera),
Cilindro(Cilindro),
Rectangulo(Rectangulo),
Camara(Camara),
BVH(BVH),
Point2D(..),
addFigMult,
parametricShapeCollision,
loadObjFile,
convertToCustomFormat, encenderShape ,encenderShapes, buildBVH
)
import Files (writePPM, rgbToString, readObject)
import Tone_map (gammaFunc,clamp)
import Funciones
( mediaLRGB,
generateRaysForPixels,
obtenerPrimeraColision,
listRay,
chunksOf, mulCam ,brdf, sumFlLuz)
import PathTracer (pathTracer, luzDirecta, luzArea)
import KdT ( createKD )
import PhotonMap ( photonMap )
import Data.KdTree.Static ( KdTree )
import Files (writeObject)
import Debug.Trace (trace,traceEventIO)
import System.Random (StdGen, newStdGen, split)
import Data.List (transpose)
import System.CPUTime (getCPUTime)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import Text.Read (readMaybe)
import PhotonMap (createPhoton)
import qualified Data.DList as DL
import qualified Data.Set as Set
{-# INLINE antialiasing #-}
antialiasing :: Int -> [Obj] -> [Obj]
antialiasing :: Int -> [Obj] -> [Obj]
antialiasing Int
n [Obj]
rayos = (Set Obj -> Obj) -> [Set Obj] -> [Obj]
forall a b. (a -> b) -> [a] -> [b]
map Set Obj -> Obj
obtenerPrimeraColision ([Set Obj] -> [Obj]) -> [Set Obj] -> [Obj]
forall a b. (a -> b) -> a -> b
$ ([Obj] -> Set Obj) -> [[Obj]] -> [Set Obj]
forall a b. (a -> b) -> [a] -> [b]
map [Obj] -> Set Obj
forall a. Ord a => [a] -> Set a
Set.fromList (Int -> [Obj] -> [[Obj]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
n [Obj]
rayos)
{-# INLINE listRayToRGB #-}
listRayToRGB :: [Luz] -> Set.Set Shape -> [Ray] -> StdGen -> Int -> [RGB]
listRayToRGB :: [Luz] -> Set Shape -> [Ray] -> StdGen -> Int -> [RGB]
listRayToRGB [Luz]
luz Set Shape
figuras [Ray]
rayos StdGen
gen Int
nRay = [RGB]
colorDirecto
where
antial :: [Obj]
antial = (Set Obj -> Obj) -> [Set Obj] -> [Obj]
forall a b. (a -> b) -> [a] -> [b]
map Set Obj -> Obj
listRay ([Set Obj] -> [Obj]) -> [Set Obj] -> [Obj]
forall a b. (a -> b) -> a -> b
$ Set Shape -> [Ray] -> [Set Obj]
parametricShapeCollision Set Shape
figuras [Ray]
rayos
rayColisions :: [Obj]
rayColisions = Int -> [Obj] -> [Obj]
antialiasing Int
nRay [Obj]
antial
([StdGen]
gens, [StdGen]
_) = Int -> [StdGen] -> ([StdGen], [StdGen])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Obj] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Obj]
rayColisions Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ppp) ([StdGen] -> ([StdGen], [StdGen]))
-> [StdGen] -> ([StdGen], [StdGen])
forall a b. (a -> b) -> a -> b
$ Int -> [StdGen] -> [StdGen]
forall a. Int -> [a] -> [a]
drop Int
1 ([StdGen] -> [StdGen]) -> [StdGen] -> [StdGen]
forall a b. (a -> b) -> a -> b
$ (StdGen -> StdGen) -> StdGen -> [StdGen]
forall a. (a -> a) -> a -> [a]
iterate ((StdGen, StdGen) -> StdGen
forall a b. (a, b) -> b
snd ((StdGen, StdGen) -> StdGen)
-> (StdGen -> (StdGen, StdGen)) -> StdGen -> StdGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split) StdGen
gen
ppp :: Int
ppp = Int
256
colorIndirecto :: [RGB]
colorIndirecto =(Obj -> StdGen -> RGB) -> [Obj] -> [StdGen] -> [RGB]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Float -> [Luz] -> Set Shape -> Int -> Obj -> StdGen -> RGB
pathTracer Float
1 [Luz]
luz Set Shape
figuras Int
ppp) [Obj]
rayColisions [StdGen]
gens
colorDirecto :: [RGB]
colorDirecto = (Obj -> RGB) -> [Obj] -> [RGB]
forall a b. (a -> b) -> [a] -> [b]
map ([Luz] -> Set Shape -> Obj -> RGB
luzDirecta [Luz]
luz Set Shape
figuras) [Obj]
rayColisions
colorArea :: [RGB]
colorArea = (Obj -> StdGen -> RGB) -> [Obj] -> [StdGen] -> [RGB]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Set Shape -> Int -> Obj -> StdGen -> RGB
luzArea Set Shape
figuras Int
ppp) [Obj]
rayColisions [StdGen]
gens
{-# INLINE listRayPhoton #-}
listRayPhoton :: KdTree Float Foton -> [Luz] ->Point3D -> Set.Set Shape -> [Ray] -> Int -> [RGB]
listRayPhoton :: KdTree Float Foton
-> [Luz] -> Point3D -> Set Shape -> [Ray] -> Int -> [RGB]
listRayPhoton KdTree Float Foton
kdt [Luz]
luces Point3D
cam Set Shape
figuras [Ray]
rayos Int
nRay = (Obj -> RGB) -> [Obj] -> [RGB]
forall a b. (a -> b) -> [a] -> [b]
map (KdTree Float Foton -> [Luz] -> Float -> Set Shape -> Obj -> RGB
photonMap KdTree Float Foton
kdt [Luz]
luces Float
radio Set Shape
figuras) [Obj]
rayColisions
where
!raySMPP :: [Obj]
raySMPP = (Set Obj -> Obj) -> [Set Obj] -> [Obj]
forall a b. (a -> b) -> [a] -> [b]
map Set Obj -> Obj
listRay ([Set Obj] -> [Obj]) -> [Set Obj] -> [Obj]
forall a b. (a -> b) -> a -> b
$ Set Shape -> [Ray] -> [Set Obj]
parametricShapeCollision Set Shape
figuras [Ray]
rayos
rayColisions :: [Obj]
rayColisions = Int -> [Obj] -> [Obj]
antialiasing Int
nRay [Obj]
raySMPP
radio :: Float
radio = Float
4
main :: IO ()
IO ()
main = do
let objFilePath2 :: String
objFilePath2 = String
"../meshes/haskell.obj"
([Point2D]
texturas2, [Point3D]
vertices2, [[TrianglePos]]
trianglesH2) <- String -> IO ([Point2D], [Point3D], [[TrianglePos]])
loadObjFile String
objFilePath2
let vertices2' :: [Point3D]
vertices2' = (Point3D -> Point3D) -> [Point3D] -> [Point3D]
forall a b. (a -> b) -> [a] -> [b]
map (Float -> Point3D -> Point3D
escalatePointt (Float
1.5)(Point3D -> Point3D) -> (Point3D -> Point3D) -> Point3D -> Point3D
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Direction -> Point3D -> Point3D
movePoint (Float -> Float -> Float -> Direction
Direction (-Float
3) (-Float
1) (-Float
7))(Point3D -> Point3D) -> (Point3D -> Point3D) -> Point3D -> Point3D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Float -> Point3D -> Point3D
rotatePointt Char
'Y' (Float
90)) [Point3D]
vertices2
origtrianglesH2 :: [TrianglePos]
origtrianglesH2 = ([TrianglePos] -> TrianglePos) -> [[TrianglePos]] -> [TrianglePos]
forall a b. (a -> b) -> [a] -> [b]
map ([TrianglePos] -> TrianglePos
forall a. [a] -> a
head) [[TrianglePos]]
trianglesH2
textTrianglesH2 :: [TrianglePos]
textTrianglesH2 = ([TrianglePos] -> TrianglePos) -> [[TrianglePos]] -> [TrianglePos]
forall a b. (a -> b) -> [a] -> [b]
map ([TrianglePos] -> Int -> TrianglePos
forall a. [a] -> Int -> a
!! Int
1) [[TrianglePos]]
trianglesH2
customTrianglesH2 :: [Triangulo]
customTrianglesH2 = RGB
-> (Float, Float, Float)
-> Float
-> Int
-> ([Point3D], [TrianglePos], [Point2D], [TrianglePos])
-> [Triangulo]
convertToCustomFormat (Float -> Float -> Float -> RGB
RGB Float
122 Float
10 Float
255) (Float
0.85, Float
0,Float
0) Float
0 (Set Shape -> Int
forall a. Set a -> Int
Set.size Set Shape
figuras) ([Point3D]
vertices2', [TrianglePos]
origtrianglesH2, [Point2D]
texturas2, [TrianglePos]
textTrianglesH2)
boundingVol'' :: BVH
boundingVol'' = Int -> [Triangulo] -> BVH
buildBVH Int
4000 [Triangulo]
customTrianglesH2
figuras''' :: Set Shape
figuras''' = [Shape] -> Set Shape
forall a. Ord a => [a] -> Set a
Set.fromList ([Shape] -> Set Shape) -> [Shape] -> Set Shape
forall a b. (a -> b) -> a -> b
$ [Shape] -> [Shape] -> [Shape]
addFigMult [BVH -> Shape
Acelerator BVH
boundingVol''] (Set Shape -> [Shape]
forall a. Set a -> [a]
Set.toList Set Shape
figuras)
[String]
args <- IO [String]
getArgs
case (String -> Maybe Int) -> [String] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe [String]
args of
[Just Int
nStr, Just Int
mStr, Just Int
oStr] -> do
StdGen
gen <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
StdGen
gen' <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
let n :: Int
n = Int
nStr :: Int
let etapaY :: Int
etapaY = Int
mStr :: Int
let etapaX :: Int
etapaX = Int
oStr :: Int
let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
etapaY Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
maxN)
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"The value of 'n' is: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n'
Integer
start <- IO Integer
getCPUTime
[Foton]
notkdt <- String -> IO [Foton]
forall a. Binary a => String -> IO a
readObject String
"./kd.bin"
let kdt :: KdTree Float Foton
kdt = [Foton] -> KdTree Float Foton
createKD [Foton]
notkdt
let cams :: [Camara]
cams = Camara -> Int -> Float -> [Camara]
mulCam Camara
camara Int
8 Float
0.2
rayitos :: [[Ray]]
rayitos = (Camara -> [Ray]) -> [Camara] -> [[Ray]]
forall a b. (a -> b) -> [a] -> [b]
map (\Camara
camara -> Int
-> Int
-> Int
-> Int
-> Camara
-> Float
-> Float
-> Int
-> StdGen
-> [Ray]
generateRaysForPixels (Int
maxNInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
etapasY) Int
etapasX Int
n' Int
etapaX Camara
camara (Float
pixFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
aspectR) Float
pix Int
nRay StdGen
gen) [Camara]
cams
a :: [[RGB]]
a = ([Ray] -> [RGB]) -> [[Ray]] -> [[RGB]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Ray]
rayos -> KdTree Float Foton
-> [Luz] -> Point3D -> Set Shape -> [Ray] -> Int -> [RGB]
listRayPhoton KdTree Float Foton
kdt [Luz]
luces Point3D
cam Set Shape
figuras''' [Ray]
rayos Int
nRay) [[Ray]]
rayitos
c :: [RGB]
c = [[RGB]] -> [RGB]
mediaLRGB [[RGB]]
a
fin :: String
fin = (RGB -> String) -> [RGB] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RGB -> String
rgbToString (Float -> Float -> [RGB] -> [RGB]
gammaFunc Float
fmx Float
gamma [RGB]
c)
String -> Int -> Int -> String -> IO ()
writePPM (String
"a" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
etapaY String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
etapaX String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".ppm") (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float
pixFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
aspectR) (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Float
pix) String
fin
Integer
end <- IO Integer
getCPUTime
let diff :: Float
diff = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
end Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
start) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
10Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
12) :: Float
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Tiempo de procesado de la imagen: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
diff String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" segundos"
String -> IO ()
traceEventIO String
"END"
[] -> do
StdGen
gen <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
Integer
start <- IO Integer
getCPUTime
let !kdt :: DList Foton
kdt = Float
-> DList Foton
-> Int
-> Int
-> Set Shape
-> [Luz]
-> StdGen
-> Int
-> DList Foton
createPhoton ([Luz] -> Float
sumFlLuz [Luz]
luces) ([Foton] -> DList Foton
forall a. [a] -> DList a
DL.fromList []) Int
0 (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Float
n) Set Shape
figuras''' [Luz]
luces StdGen
gen Int
nRebotes
Int -> IO ()
forall a. Show a => a -> IO ()
print (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ DList Foton -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length DList Foton
kdt
Integer
end <- IO Integer
getCPUTime
let diff :: Float
diff = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
end Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
start) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
10Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
12) :: Float
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Tiempo de creacion del kdt: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
diff String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" segundos"
String -> DList Foton -> IO ()
forall a. Binary a => String -> DList a -> IO ()
writeObject String
"./kd.bin" DList Foton
kdt
[Maybe Int]
_ -> do
String -> IO ()
putStrLn String
"Please provide an integer as the first argument."
IO ()
forall a. IO a
exitFailure