-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathRender.hs
executable file
·227 lines (207 loc) · 9.28 KB
/
Render.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
{-# LANGUAGE BangPatterns #-}
-- renderer function
module Render where
--
import Scenes
import Camera
-- math
import Math3D.Ray
import Math3D.Vector
import Math3D.CommonOps
-- spectral handling
import Spectral.SampledDistribution
import Spectral.SampledSpectrum
import Spectral.PbrtSpecdata
-- color handling
import Color.Pixel
import Color.ColorInterface
-- pdf
import Pdf.MixturePdf
import Pdf.HittablePdf
import Pdf.CosinePdf
import Pdf.PdfObj
import Pdf.Pdf
-- material
import Material.Scatter
import Material.ScatterRecord
-- hittable
import Hittable.HittableList
import Hittable.Hittable
import Hittable.HitRecord
-- utility etc
import Utility.Utils
import Utility.HelperTypes
import Random
-- third party
import GHC.Float
import Data.Foldable
import System.Random
import Debug.Trace
import Prelude hiding(subtract)
-- scene
import Scene.Scene
-- L = Le + Lr
-- L_1 = Le + \int brdf * L_0
-- L_2 = Le + \int brdf * L_1
-- L_2 = Le + \int brdf * (Le_1 + \int brdf * L_0)
rayColor :: RandomGen g => RandomResult Ray g -> HittableList -> HittableList -> ColorRecord -> Int -> RandomResult ColorRecord g
rayColor !rayr !world lights !background !depth =
if depth <= 0
then RandResult (emptyModelLike background, liftRandGen rayr)
else let hrec = emptyRecord 3
ray = liftRandVal rayr
gen = liftRandGen rayr
(hithrec, isHit, g1) = hit world gen ray 0.001 infty hrec
HRec { point = recp,
pnormal = recnorm,
hUVu = uu,
hUVv = vv,
matPtr = m } = hithrec
in if isHit
then let sout = scatter g1 m ray hithrec (stype background)
(g2, srec, isScattering) = sout
-- possible bug location
l_e = emitted m uu vv recp (wavelength ray) (stype background)
in if not isScattering
then RandResult (l_e, g2)
else let isSpec = isSpecularSR srec
in if isSpec
then let outray = RandResult (specularRaySR srec, g2)
resNColor = rayColor outray world lights background (depth-1)
attens = attenuationSR srec
f n = multiply n attens
in rfmap f resNColor
else -- start computing pdf values
let {
natten = attenuationSR srec;
mptr = matPtr hithrec;
-- cospdf = CosNormalPdf (pnormal hithrec);
cospdf = pdfPtrSR srec;
hpdf = HitPdf lights (point hithrec);
mpdf = MixPdf (NList cospdf [PdfCons hpdf]);
RandResult (rdir, g3) = generate hpdf g2;
rout = Rd {origin = point hithrec,
direction = toUnit rdir,
rtime = rtime ray,
wavelength = wavelength ray
};
RandResult (pval, g4) = pvalue hpdf g3 (direction rout);
routr = RandResult (rout, g4);
spdf = scattering_pdf mptr ray hithrec rout;
multv = if pval == 0.0 || isNaN pval
then 0.0
else spdf / pval;
res = let resNColor = rayColor routr world lights background (depth - 1)
f n = add l_e (multiplyS (multiply natten n) multv)
in rfmap f resNColor;
}
in res
{- in traceStack
(debugTraceStr [
show rout,
show spdf, show pval, show rdir,
show rcolor
])
(zeroV3, g5)
-}
else RandResult (background, g1)
getSceneCamera :: Scene -> Camera
getSceneCamera scn =
let cmfrom = cam_look_from scn
cmto = cam_look_to scn
cmvf = cam_vfov scn
cmvup = cam_vup scn
cm_fdist = cam_focus_distance scn
cm_apr = cam_aperture scn
aratio = aspect_ratio scn
in mkCam cmfrom cmto cmvup cmvf aratio cm_apr cm_fdist 0.0 0.0
foldColor :: RandomGen g => g -> (Int, Int) -> Camera -> Scene -> (PixelSpectrum, g)
foldColor rng coord cmra scene =
let samples = nb_samples scene
-- foldfn (a -> b -> a) ::
foldfn acc _ = let (pcols_, g_) = acc
RandResult (col, g2) = mkColor coord g_ cmra scene
in (pcols_ ++ [col], g2)
(pcols, g3) = foldl' foldfn ([], rng) [0..(samples - 1)]
in (foldl1 add pcols, g3)
mkColor :: RandomGen g => (Int, Int) -> g -> Camera -> Scene -> RandomResult PixelSpectrum g
mkColor coord rng cmr scene =
let imwimh = (img_width scene, img_height scene)
rayr = mkPixelRay imwimh coord rng cmr
RandResult (ray, rgen) = rayr
sceneObjects = scene_obj scene
sampleObjects = sample_obj scene
back = back_ground scene
depth = bounce_depth scene
rcolor = case back of
PixSpecTrichroma _ ->
let backColor = toColorRecord back (wavelength ray)
RandResult (sceneColor, g1) = rayColor rayr sceneObjects sampleObjects backColor depth
in case stype sceneColor of
RGB -> let [r, g, b] = vec2List $! colorData sceneColor
in if all isNaN [r, g, b]
then (PixSpecTrichroma (0.0, 0.0, 0.0), g1)
else (PixSpecTrichroma (r, g, b), g1)
--
_ -> traceStack
"Scene color model had change in evaluation"
(zeroPixelSpectrum, g1)
PixSpecSampled s ->
let fn acc wave =
let (lst, gen) = acc
r = RandResult (ray, gen)
backPower = toColorRecord back wave
rayr2 = RandResult (Rd{
origin = origin ray,
direction = direction ray,
rtime = rtime ray,
wavelength = wave
}, gen)
RandResult (scenePower, g1) =
rayColor rayr2 sceneObjects sampleObjects backPower depth
in case stype scenePower of
RGB -> traceStack
"Scene color model had change in evaluation"
([], g1)
_ -> let cval = colorData scenePower
-- since scenePower is a vector with
-- a single element
in if all isNaN (vec2List cval)
then (lst ++ [(wave, zeroLikeVector cval)], g1)
else (lst ++ [(wave, cval)], g1)
sampleStep = spectralSampleStride
lambdaStart = visibleWavelengthStart
lambdaEnd = visibleWavelengthEnd
wrange = [lambdaStart,
(lambdaStart + sampleStep)..lambdaEnd]
waveRange = map word2Float wrange
(wavePowers, ngen) = foldl fn ([], rgen) waveRange
(w:ws, powerVecs) = unzip wavePowers
--
(p:ps) = map sumD powerVecs
sampledWPower = fromWavesPowers
(fromList2NL p ps)
(fromList2NL w ws)
spect = fromSampledWave sampledWPower REFLECTANCE
in (PixSpecSampled spect, ngen)
in RandResult rcolor
foldPixels :: RandomGen g => g -> [(Int, Int)] -> Camera -> Scene -> [Pixel]
foldPixels gen lst cMra scne =
case lst of
[] -> []
((cy, cx):cc) ->
let (pc, g2) = foldColor gen (cy, cx) cMra scne
p = Pix {x = cx, y = cy, color = pc}
in p : foldPixels g2 cc cMra scne
renderScene :: RandomGen g => [(Int, Int)] -> g -> Scene -> [Pixel]
renderScene !cs !g scn =
let cam = getSceneCamera scn
in foldPixels g cs cam scn
mkPixelRay :: RandomGen g => (Int, Int) -> (Int, Int) -> g -> Camera -> RandomResult Ray g
mkPixelRay !(imw, imh) !(j,i) gen !cm =
let fnlst = fromList2NL randval [randval]
RandResult (lst, g2) = rfmap nl2List (randFoldlFixedRange2 gen fnlst)
(udouble:vdouble:_) = lst
u = (udouble + int2Double i) / int2Double (imw - 1)
v = (vdouble + int2Double j) / int2Double (imh - 1)
in getRay g2 cm u v