Browse code
chore(raytracer): more updates, fix symbols
Edward authored on 26/03/2021 04:03:16Showing 3 changed files
- raytracing_in_one_weekend/1.lisp
- raytracing_in_one_weekend/package.lisp
- raytracing_in_one_weekend/scenes.lisp
| ... | ... |
@@ -11,6 +11,12 @@ |
| 11 | 11 |
|
| 12 | 12 |
(defpackage :fwoar.lisp-sandbox.material |
| 13 | 13 |
(:use :cl) |
| 14 |
+ (:import-from :fwoar.lisp-sandbox.1 |
|
| 15 |
+ #:.normal :.p :reflectance :reflect :refract |
|
| 16 |
+ #:random-in-unit-sphere :vec3 :random-unit-vector |
|
| 17 |
+ #:near-zero :dot :negate :.front-face :vec* :vec+ |
|
| 18 |
+ #:vec- :vec/ :ray :ray-color :unit-vector :direction |
|
| 19 |
+ #:origin) |
|
| 14 | 20 |
(:export #:original-material |
| 15 | 21 |
#:lambertian-material |
| 16 | 22 |
#:metal-material |
| ... | ... |
@@ -19,10 +25,13 @@ |
| 19 | 25 |
|
| 20 | 26 |
(defpackage :fwoar.lisp-sandbox.1 |
| 21 | 27 |
(:use :cl) |
| 22 |
- (:import :fwoar.lisp-sandbox.material |
|
| 23 |
- #:original-material |
|
| 24 |
- #:lambertian-material |
|
| 25 |
- #:metal-material |
|
| 26 |
- #:fuzzy-metal-material |
|
| 27 |
- #:dielectric-material) |
|
| 28 |
- (:export )) |
|
| 28 |
+ (:import-from :fwoar.lisp-sandbox.material |
|
| 29 |
+ #:original-material |
|
| 30 |
+ #:lambertian-material |
|
| 31 |
+ #:metal-material |
|
| 32 |
+ #:fuzzy-metal-material |
|
| 33 |
+ #:dielectric-material) |
|
| 34 |
+ (:export #:.normal :.p :reflectance :reflect :refract |
|
| 35 |
+ #:random-in-unit-sphere :vec3 :random-unit-vector |
|
| 36 |
+ #:near-zero :dot :negate :.front-face :vec* :vec+ :vec- |
|
| 37 |
+ #:vec/ :ray :ray-color :unit-vector)) |
| ... | ... |
@@ -189,6 +189,225 @@ |
| 189 | 189 |
(funcall c color pos)))) |
| 190 | 190 |
image-width)))) |
| 191 | 191 |
|
| 192 |
+(defun refraction-scene2 |
|
| 193 |
+ (&optional (*samples-per-pixel* 10) (image-width 400) (max-depth 50) (rows nil rows-p)) |
|
| 194 |
+ (let* ((world (list (sphere #( 0.0 0 -1.0) 0.1 #(0.5 0.5 0.0) (dielectric-material 1.5)) |
|
| 195 |
+ (sphere #( 0.0 0 -1.4) 0.2 #(0.5 0.5 0.0) (dielectric-material 1.7)) |
|
| 196 |
+ (sphere #( 0.0 0 -2.4) 0.8 #(0.5 0.5 0.0) (dielectric-material 1.9)) |
|
| 197 |
+ (sphere #(-0.0 0 -3.6) 1.0 #(0.5 0.5 0.0) (dielectric-material 2.1)) |
|
| 198 |
+ (sphere #(-0.0 0 -5.0) 1.2 #(0.5 0.5 0.0) (dielectric-material 2.3)) |
|
| 199 |
+ (sphere #(-0.0 0 -6.6) 1.4 #(0.5 0.5 0.0) (dielectric-material 2.5)) |
|
| 200 |
+ #+foo (sphere #(-0.0 0 -1) -0.2 |
|
| 201 |
+ #(0 0 0) |
|
| 202 |
+ (metal-material #(0.859375d0 0.859375d0 0.796875d0))) |
|
| 203 |
+ #+foo (sphere #(0.6 0.0 -1) 0.2 |
|
| 204 |
+ #(0 0 0) |
|
| 205 |
+ (metal-material #(0.859375d0 0.859375d0 0.796875d0))) |
|
| 206 |
+ #+foo (sphere #(0 1 -1) 0.2 |
|
| 207 |
+ nil |
|
| 208 |
+ (lambda (rec ray world depth) |
|
| 209 |
+ (declare (ignore rec ray world depth)) |
|
| 210 |
+ #(1.0d0 1.0d0 1.0d0))) |
|
| 211 |
+ (sphere #(0 -1000.5 -1.5) 1000 |
|
| 212 |
+ #(0.5 0.5 0.5) |
|
| 213 |
+ (lambertian-material #(0.8 0.0 0.0)))) |
|
| 214 |
+ #+(or) |
|
| 215 |
+ (list |
|
| 216 |
+ (sphere #(-0.0 0 -1) 0.2 |
|
| 217 |
+ #(0 0 0) |
|
| 218 |
+ (metal-material |
|
| 219 |
+ #(0.8 0.6 0.2))) |
|
| 220 |
+ (sphere #(0 -100.5 -1.5) 100 |
|
| 221 |
+ #(0.5 0.5 0.5) |
|
| 222 |
+ (lambertian-material #(0.8 0.8 0.0))))) |
|
| 223 |
+ (aspect-ratio 16/9) |
|
| 224 |
+ (image-height (* (floor (/ image-width aspect-ratio)))) |
|
| 225 |
+ |
|
| 226 |
+ (camera (camera))) |
|
| 227 |
+ (let ((mailbox (sb-concurrency:make-mailbox))) |
|
| 228 |
+ (loop for j in (if rows-p |
|
| 229 |
+ rows |
|
| 230 |
+ (shuffle (loop for x from 0 to image-height collect x))) |
|
| 231 |
+ do |
|
| 232 |
+ (sb-concurrency:send-message |
|
| 233 |
+ (aref *thread-queues* |
|
| 234 |
+ (mod j |
|
| 235 |
+ (length *thread-queues*))) |
|
| 236 |
+ (list *samples-per-pixel* |
|
| 237 |
+ j image-width |
|
| 238 |
+ image-height camera |
|
| 239 |
+ world max-depth |
|
| 240 |
+ (lambda (a b) |
|
| 241 |
+ (sb-concurrency:send-message |
|
| 242 |
+ mailbox |
|
| 243 |
+ (list a b)))))) |
|
| 244 |
+ (write-colors nil |
|
| 245 |
+ (lambda (c) |
|
| 246 |
+ (loop with messages = 0 |
|
| 247 |
+ for it = (sb-concurrency:receive-message mailbox :timeout 2) |
|
| 248 |
+ while it |
|
| 249 |
+ do (destructuring-bind (color pos) it |
|
| 250 |
+ (funcall c color pos)))) |
|
| 251 |
+ image-width)))) |
|
| 252 |
+ |
|
| 253 |
+(defvar *planets* |
|
| 254 |
+ '(:mercury 3031/7917 |
|
| 255 |
+ :venus 7520/7917 |
|
| 256 |
+ :earth 7917/7917 |
|
| 257 |
+ :mars 4212/7917)) |
|
| 258 |
+ |
|
| 259 |
+(defun scene-3 |
|
| 260 |
+ (&optional (*samples-per-pixel* 10) (image-width 400) (max-depth 50) (rows nil rows-p)) |
|
| 261 |
+ (let* ((world (list (sphere #(-2.25 0 -2) |
|
| 262 |
+ (* 0.5 (getf *planets* :mercury)) |
|
| 263 |
+ nil |
|
| 264 |
+ (metal-material #(0.8 0.8 0))) |
|
| 265 |
+ (sphere #(-0.75 0 -2) |
|
| 266 |
+ (* 0.5 (getf *planets* :venus)) |
|
| 267 |
+ nil |
|
| 268 |
+ (metal-material #(0.0 0.8 0))) |
|
| 269 |
+ (sphere #(0.75 0 -2) |
|
| 270 |
+ (* 0.5 (getf *planets* :earth)) |
|
| 271 |
+ nil |
|
| 272 |
+ (metal-material #(0.0 0.0 0.8))) |
|
| 273 |
+ (sphere #(2.25 -0 -2) |
|
| 274 |
+ (* 0.5 (getf *planets* :mars)) |
|
| 275 |
+ nil |
|
| 276 |
+ (metal-material #(0.8 0.0 0.0))))) |
|
| 277 |
+ |
|
| 278 |
+ (aspect-ratio 16/9) |
|
| 279 |
+ (image-height (* (floor (/ image-width aspect-ratio)))) |
|
| 280 |
+ |
|
| 281 |
+ (camera (camera))) |
|
| 282 |
+ (let ((mailbox (sb-concurrency:make-mailbox))) |
|
| 283 |
+ (loop for j in (if rows-p |
|
| 284 |
+ rows |
|
| 285 |
+ (shuffle (loop for x from 0 to image-height collect x))) |
|
| 286 |
+ do |
|
| 287 |
+ (sb-concurrency:send-message |
|
| 288 |
+ (aref *thread-queues* |
|
| 289 |
+ (mod j |
|
| 290 |
+ (length *thread-queues*))) |
|
| 291 |
+ (list *samples-per-pixel* |
|
| 292 |
+ j image-width |
|
| 293 |
+ image-height camera |
|
| 294 |
+ world max-depth |
|
| 295 |
+ (lambda (a b) |
|
| 296 |
+ (sb-concurrency:send-message |
|
| 297 |
+ mailbox |
|
| 298 |
+ (list a b)))))) |
|
| 299 |
+ (write-colors nil |
|
| 300 |
+ (lambda (c) |
|
| 301 |
+ (loop with messages = 0 |
|
| 302 |
+ for it = (sb-concurrency:receive-message mailbox :timeout 2) |
|
| 303 |
+ while it |
|
| 304 |
+ do (destructuring-bind (color pos) it |
|
| 305 |
+ (funcall c color pos)))) |
|
| 306 |
+ image-width)))) |
|
| 307 |
+ |
|
| 308 |
+(defun scene-4 |
|
| 309 |
+ (&optional (*samples-per-pixel* 10) (image-width 400) (max-depth 50) (rows nil rows-p)) |
|
| 310 |
+ (let* ((world (append (loop for ti from 0 by (/ pi 7) |
|
| 311 |
+ for x from 0 |
|
| 312 |
+ repeat 20 |
|
| 313 |
+ collect |
|
| 314 |
+ (sphere |
|
| 315 |
+ (vector (- (* 2 (sin ti)) 1) |
|
| 316 |
+ (- (* 2 (cos ti)) 1) |
|
| 317 |
+ (+ -0.5 (* -0.3 x))) |
|
| 318 |
+ 0.25 |
|
| 319 |
+ nil |
|
| 320 |
+ (case (random 3) |
|
| 321 |
+ (0 (metal-material (vector (/ (mod (* 20 x) |
|
| 322 |
+ 256) |
|
| 323 |
+ 256d0) |
|
| 324 |
+ (/ (mod (* 20 x) |
|
| 325 |
+ 256) |
|
| 326 |
+ 256d0) |
|
| 327 |
+ (/ (mod (* 20 x) |
|
| 328 |
+ 256) |
|
| 329 |
+ 256d0)))) |
|
| 330 |
+ (1 (lambertian-material (vector (/ (mod (* 20 x) |
|
| 331 |
+ 256) |
|
| 332 |
+ 256d0) |
|
| 333 |
+ (/ (mod (* 20 x) |
|
| 334 |
+ 256) |
|
| 335 |
+ 256d0) |
|
| 336 |
+ (/ (mod (* 20 x) |
|
| 337 |
+ 256) |
|
| 338 |
+ 256d0)))) |
|
| 339 |
+ (2 (dielectric-material (rand-min-max 1.4 2.5) |
|
| 340 |
+ (rand-min-max 0 0.2)))))) |
|
| 341 |
+ (loop for ti from 0 by (/ pi 7) |
|
| 342 |
+ for x from 0 |
|
| 343 |
+ repeat 20 |
|
| 344 |
+ collect |
|
| 345 |
+ (sphere |
|
| 346 |
+ (vector (- (sin (+ ti (/ pi 14))) 0.5) |
|
| 347 |
+ (- (cos (+ ti (/ pi 14))) 0.5) |
|
| 348 |
+ (+ -0.5 (* -0.3 x))) |
|
| 349 |
+ 0.25 |
|
| 350 |
+ nil |
|
| 351 |
+ (case (random 3) |
|
| 352 |
+ (0 (metal-material (vector (/ (mod (* 20 x) |
|
| 353 |
+ 256) |
|
| 354 |
+ 256d0) |
|
| 355 |
+ (/ (mod (* 20 x) |
|
| 356 |
+ 256) |
|
| 357 |
+ 256d0) |
|
| 358 |
+ (/ (mod (* 20 x) |
|
| 359 |
+ 256) |
|
| 360 |
+ 256d0)))) |
|
| 361 |
+ (1 (lambertian-material (vector (/ (mod (* 20 x) |
|
| 362 |
+ 256) |
|
| 363 |
+ 256d0) |
|
| 364 |
+ (/ (mod (* 20 x) |
|
| 365 |
+ 256) |
|
| 366 |
+ 256d0) |
|
| 367 |
+ (/ (mod (* 20 x) |
|
| 368 |
+ 256) |
|
| 369 |
+ 256d0)))) |
|
| 370 |
+ (2 (dielectric-material (rand-min-max 1.4 2.5) |
|
| 371 |
+ (rand-min-max 0 0.2))))))) |
|
| 372 |
+ #+(or) |
|
| 373 |
+ (list |
|
| 374 |
+ (sphere #(-0.0 0 -1) 0.2 |
|
| 375 |
+ #(0 0 0) |
|
| 376 |
+ (metal-material |
|
| 377 |
+ #(0.8 0.6 0.2))) |
|
| 378 |
+ (sphere #(0 -100.5 -1.5) 100 |
|
| 379 |
+ #(0.5 0.5 0.5) |
|
| 380 |
+ (lambertian-material #(0.8 0.8 0.0))))) |
|
| 381 |
+ (aspect-ratio 16/9) |
|
| 382 |
+ (image-height (* (floor (/ image-width aspect-ratio)))) |
|
| 383 |
+ |
|
| 384 |
+ (camera (camera))) |
|
| 385 |
+ (let ((mailbox (sb-concurrency:make-mailbox))) |
|
| 386 |
+ (loop for j in (if rows-p |
|
| 387 |
+ rows |
|
| 388 |
+ (shuffle (loop for x from 0 to image-height collect x))) |
|
| 389 |
+ do |
|
| 390 |
+ (sb-concurrency:send-message |
|
| 391 |
+ (aref *thread-queues* |
|
| 392 |
+ (mod j |
|
| 393 |
+ (length *thread-queues*))) |
|
| 394 |
+ (list *samples-per-pixel* |
|
| 395 |
+ j image-width |
|
| 396 |
+ image-height camera |
|
| 397 |
+ world max-depth |
|
| 398 |
+ (lambda (a b) |
|
| 399 |
+ (sb-concurrency:send-message |
|
| 400 |
+ mailbox |
|
| 401 |
+ (list a b)))))) |
|
| 402 |
+ (write-colors nil |
|
| 403 |
+ (lambda (c) |
|
| 404 |
+ (loop with messages = 0 |
|
| 405 |
+ for it = (sb-concurrency:receive-message mailbox :timeout 2) |
|
| 406 |
+ while it |
|
| 407 |
+ do (destructuring-bind (color pos) it |
|
| 408 |
+ (funcall c color pos)))) |
|
| 409 |
+ image-width)))) |
|
| 410 |
+ |
|
| 192 | 411 |
(defun sample-image (out) |
| 193 | 412 |
(let ((image-width 256) |
| 194 | 413 |
(image-height 256)) |
| ... | ... |
@@ -216,3 +435,47 @@ |
| 216 | 435 |
:b b)))))) |
| 217 | 436 |
image-width)) |
| 218 | 437 |
(1- #.(expt 2 8)))))) |
| 438 |
+ |
|
| 439 |
+#+(or) |
|
| 440 |
+((list 'quote |
|
| 441 |
+ (loop for ti from 0 by (/ pi 7) |
|
| 442 |
+ for x from 0 |
|
| 443 |
+ repeat 20 |
|
| 444 |
+ collect (list (vector (- (* 2 (sin ti)) 1) |
|
| 445 |
+ (- (* 2 (cos ti)) 1) |
|
| 446 |
+ (+ -0.2 (* -0.3 x))) |
|
| 447 |
+ 0.25 |
|
| 448 |
+ nil |
|
| 449 |
+ (list (vector (/ (mod (* 20 x) |
|
| 450 |
+ 256) |
|
| 451 |
+ 256d0) |
|
| 452 |
+ (/ (mod (* 20 x) |
|
| 453 |
+ 256) |
|
| 454 |
+ 256d0) |
|
| 455 |
+ (/ (mod (* 20 x) |
|
| 456 |
+ 256) |
|
| 457 |
+ 256d0)))))) |
|
| 458 |
+ |
|
| 459 |
+ '((#(-1.0 1.0 -0.2) 0.25 NIL) |
|
| 460 |
+ (#(-0.13223252176488376d0 0.8019377358048383d0 -0.5) 0.25 NIL) |
|
| 461 |
+ (#(0.5636629649360596d0 0.2469796037174672d0 -0.8) 0.25 NIL) |
|
| 462 |
+ (#(0.9498558243636472d0 -0.5549581320873711d0 -1.1) 0.25 NIL) |
|
| 463 |
+ (#(0.9498558243636472d0 -1.4450418679126287d0 -1.4000001) 0.25 NIL) |
|
| 464 |
+ (#(0.5636629649360598d0 -2.2469796037174667d0 -1.7) 0.25 NIL) |
|
| 465 |
+ (#(-0.13223252176488354d0 -2.801937735804838d0 -2.0) 0.25 NIL) |
|
| 466 |
+ (#(-0.9999999999999998d0 -3.0d0 -2.3000002) 0.25 NIL) |
|
| 467 |
+ (#(-1.8677674782351161d0 -2.801937735804838d0 -2.6000001) 0.25 NIL) |
|
| 468 |
+ (#(-2.5636629649360594d0 -2.246979603717467d0 -2.9) 0.25 NIL) |
|
| 469 |
+ (#(-2.949855824363647d0 -1.4450418679126291d0 -3.2) 0.25 NIL) |
|
| 470 |
+ (#(-2.949855824363647d0 -0.5549581320873715d0 -3.5000002) 0.25 NIL) |
|
| 471 |
+ (#(-2.56366296493606d0 0.24697960371746674d0 -3.8000002) 0.25 NIL) |
|
| 472 |
+ (#(-1.8677674782351166d0 0.8019377358048381d0 -4.1) 0.25 NIL) |
|
| 473 |
+ (#(-1.0000000000000004d0 1.0d0 -4.4) 0.25 NIL) |
|
| 474 |
+ (#(-0.1322325217648842d0 0.8019377358048385d0 -4.7) 0.25 NIL) |
|
| 475 |
+ (#(0.5636629649360592d0 0.2469796037174674d0 -5.0) 0.25 NIL) |
|
| 476 |
+ (#(0.949855824363647d0 -0.5549581320873707d0 -5.3) 0.25 NIL) |
|
| 477 |
+ (#(0.9498558243636475d0 -1.4450418679126282d0 -5.6) 0.25 NIL) |
|
| 478 |
+ (#(0.56366296493606d0 -2.2469796037174667d0 -5.9) 0.25 NIL)) |
|
| 479 |
+ |
|
| 480 |
+ (/ 1960 60.0) |
|
| 481 |
+ ) |