Browse code
feat: fixup diffuse material, add metalic and transparent materials
Edward authored on 23/03/2021 05:13:41Showing 2 changed files
| ... | ... |
@@ -35,7 +35,7 @@ |
| 35 | 35 |
(rand-min-max min max) |
| 36 | 36 |
(rand-min-max min max))) |
| 37 | 37 |
|
| 38 |
-(declaim (inline vec+ vec* vec- vec/ random-in-unit-sphere)) |
|
| 38 |
+(declaim (inline vec+ vec* vec- vec/ random-in-unit-sphere negate)) |
|
| 39 | 39 |
(defun random-in-unit-sphere () |
| 40 | 40 |
(loop for p = (rand-vec3-min-max -1.0d0 1.0d0) |
| 41 | 41 |
while (>= (length-squared p) |
| ... | ... |
@@ -97,6 +97,12 @@ |
| 97 | 97 |
(vec3 (* vec1 a1) |
| 98 | 98 |
(* vec1 b1) |
| 99 | 99 |
(* vec1 c1)))))) |
| 100 |
+(defun negate (vec) |
|
| 101 |
+ (fw.lu:vector-destructuring-bind (x y z) vec |
|
| 102 |
+ (vec3 (- x) |
|
| 103 |
+ (- y) |
|
| 104 |
+ (- z)))) |
|
| 105 |
+ |
|
| 100 | 106 |
(defun vec/ (vec it) |
| 101 | 107 |
(declare (optimize (speed 3))) |
| 102 | 108 |
(vec* (/ 1.0 it) |
| ... | ... |
@@ -128,6 +134,14 @@ |
| 128 | 134 |
(vec/ v |
| 129 | 135 |
(vec-length v))) |
| 130 | 136 |
|
| 137 |
+(declaim (inline near-zero)) |
|
| 138 |
+(defun near-zero (vec) |
|
| 139 |
+ (fw.lu:vector-destructuring-bind (x y z) vec |
|
| 140 |
+ (let* ((s 1.0d-8)) |
|
| 141 |
+ (and (< (abs x) s) |
|
| 142 |
+ (< (abs y) s) |
|
| 143 |
+ (< (abs z) s))))) |
|
| 144 |
+ |
|
| 131 | 145 |
(defun call-with-ppm-header (stream size callback &optional (colors 255)) |
| 132 | 146 |
(format stream "P3~%~d ~d~%~d~%" |
| 133 | 147 |
(size-width size) |
| ... | ... |
@@ -220,7 +234,9 @@ |
| 220 | 234 |
:initform (vec3 (random 1.0d0) |
| 221 | 235 |
(random 1.0d0) |
| 222 | 236 |
(random 1.0d0))) |
| 223 |
- (material :initarg :material :reader .material :initform (lambertian-material (random 0.8))))) |
|
| 237 |
+ (material :initarg :material |
|
| 238 |
+ :reader .material |
|
| 239 |
+ :initform (lambertian-material (random 0.8))))) |
|
| 224 | 240 |
|
| 225 | 241 |
(defgeneric hit (thing ray t-min t-max) |
| 226 | 242 |
(:method ((things list) (r ray) (t-min real) (t-max real)) |
| ... | ... |
@@ -288,23 +304,113 @@ |
| 288 | 304 |
|
| 289 | 305 |
(defgeneric scatter (material ray-in rec)) |
| 290 | 306 |
|
| 291 |
-(defun original-material (rec world depth) |
|
| 307 |
+(defun original-material (rec ray world depth) |
|
| 308 |
+ (declare (ignore ray world depth)) |
|
| 292 | 309 |
(vec* 0.5 |
| 293 | 310 |
(vec+ #(1 1 1) |
| 294 | 311 |
(.normal rec)))) |
| 295 | 312 |
|
| 296 | 313 |
(defun lambertian-material (albedo) |
| 297 |
- (lambda (rec world depth) |
|
| 298 |
- (let ((target (vec+ (vec+ (.p rec) |
|
| 299 |
- (.normal rec)) |
|
| 300 |
- (random-unit-vector)))) |
|
| 301 |
- (vec* (material-color (.thing rec)) |
|
| 302 |
- (vec* albedo |
|
| 303 |
- (ray-color (ray (.p rec) |
|
| 304 |
- (vec- target |
|
| 305 |
- (.p rec))) |
|
| 306 |
- world |
|
| 307 |
- (1- depth))))))) |
|
| 314 |
+ (lambda (rec ray world depth) |
|
| 315 |
+ (declare (ignore ray)) |
|
| 316 |
+ (let ((scatter-direction (vec+ (.normal rec) |
|
| 317 |
+ (random-unit-vector)))) |
|
| 318 |
+ (when (near-zero scatter-direction) |
|
| 319 |
+ (setf scatter-direction (.normal rec))) |
|
| 320 |
+ |
|
| 321 |
+ (vec* albedo |
|
| 322 |
+ (ray-color (ray (.p rec) |
|
| 323 |
+ scatter-direction) |
|
| 324 |
+ world |
|
| 325 |
+ (1- depth)))))) |
|
| 326 |
+ |
|
| 327 |
+(defun reflect (v n) |
|
| 328 |
+ (vec- v |
|
| 329 |
+ (vec* 2.0d0 |
|
| 330 |
+ (vec* (dot v n) |
|
| 331 |
+ n)))) |
|
| 332 |
+ |
|
| 333 |
+(defun refract (uv n eta*/eta) |
|
| 334 |
+ (let* ((cos-theta (min 1.0d0 |
|
| 335 |
+ (dot (negate uv) |
|
| 336 |
+ n))) |
|
| 337 |
+ (out-perp (vec* eta*/eta |
|
| 338 |
+ (vec+ uv |
|
| 339 |
+ (vec* cos-theta |
|
| 340 |
+ n)))) |
|
| 341 |
+ (out-parallel (vec* (- (sqrt (abs (- 1.0d0 |
|
| 342 |
+ (length-squared out-perp))))) |
|
| 343 |
+ n))) |
|
| 344 |
+ (vec+ out-perp out-parallel))) |
|
| 345 |
+ |
|
| 346 |
+(defun metal-material (albedo) |
|
| 347 |
+ (lambda (rec ray world depth) |
|
| 348 |
+ (with-slots (direction) ray |
|
| 349 |
+ (let* ((reflected (reflect (unit-vector direction) |
|
| 350 |
+ (.normal rec))) |
|
| 351 |
+ (scattered (ray (.p rec) reflected))) |
|
| 352 |
+ (vec* albedo |
|
| 353 |
+ (ray-color scattered |
|
| 354 |
+ world |
|
| 355 |
+ (1- depth))))))) |
|
| 356 |
+ |
|
| 357 |
+(defun fuzzy-metal-material (albedo fuzz) |
|
| 358 |
+ (lambda (rec ray world depth) |
|
| 359 |
+ (with-slots (direction) ray |
|
| 360 |
+ (let* ((reflected (reflect (unit-vector direction) |
|
| 361 |
+ (.normal rec))) |
|
| 362 |
+ (scattered (ray (.p rec) |
|
| 363 |
+ (vec+ reflected |
|
| 364 |
+ (vec* fuzz |
|
| 365 |
+ (random-in-unit-sphere)))))) |
|
| 366 |
+ (vec* albedo |
|
| 367 |
+ (ray-color scattered |
|
| 368 |
+ world |
|
| 369 |
+ (1- depth))))))) |
|
| 370 |
+ |
|
| 371 |
+(defun reflectance (cosine ref-idx) |
|
| 372 |
+ (let* ((r0 (/ (- 1 ref-idx) |
|
| 373 |
+ (+ 1 ref-idx))) |
|
| 374 |
+ (r0 (* r0 r0))) |
|
| 375 |
+ (+ r0 |
|
| 376 |
+ (* (- 1 r0) |
|
| 377 |
+ (expt (- 1 cosine) |
|
| 378 |
+ 5))))) |
|
| 379 |
+ |
|
| 380 |
+(defun dielectric-material (ir &optional (fuzz 0)) |
|
| 381 |
+ (lambda (rec ray world depth) |
|
| 382 |
+ (with-slots (direction) ray |
|
| 383 |
+ (let* ((attenuation (vec3 1.0d0 1.0d0 1.0d0)) |
|
| 384 |
+ (refraction-ratio (if (.front-face rec) |
|
| 385 |
+ (/ 1.0d0 ir) |
|
| 386 |
+ ir)) |
|
| 387 |
+ (unit-direction (unit-vector direction)) |
|
| 388 |
+ (normal (.normal rec)) |
|
| 389 |
+ (cos-theta (min 1.0d0 |
|
| 390 |
+ (dot (negate unit-direction) |
|
| 391 |
+ normal))) |
|
| 392 |
+ (sin-theta (sqrt (- 1 |
|
| 393 |
+ (* cos-theta cos-theta)))) |
|
| 394 |
+ (cannot-refract (> (* refraction-ratio |
|
| 395 |
+ sin-theta) |
|
| 396 |
+ 1.0d0)) |
|
| 397 |
+ (direction (if (or cannot-refract |
|
| 398 |
+ (> (reflectance cos-theta |
|
| 399 |
+ refraction-ratio) |
|
| 400 |
+ (random 1.0d0))) |
|
| 401 |
+ (reflect unit-direction |
|
| 402 |
+ normal) |
|
| 403 |
+ (refract unit-direction |
|
| 404 |
+ normal |
|
| 405 |
+ refraction-ratio))) |
|
| 406 |
+ (scattered (ray (.p rec) |
|
| 407 |
+ (vec+ direction |
|
| 408 |
+ (vec* fuzz |
|
| 409 |
+ (random-in-unit-sphere)))))) |
|
| 410 |
+ (vec* attenuation |
|
| 411 |
+ (ray-color scattered |
|
| 412 |
+ world |
|
| 413 |
+ (1- depth))))))) |
|
| 308 | 414 |
|
| 309 | 415 |
(defgeneric ray-color (ray world depth) |
| 310 | 416 |
(:method :around (r w (depth integer)) |
| ... | ... |
@@ -316,7 +422,7 @@ |
| 316 | 422 |
(hit world ray 0.001d0 infinity) |
| 317 | 423 |
(when hit-p |
| 318 | 424 |
(return-from ray-color |
| 319 |
- (funcall (.material rec) rec world depth))) |
|
| 425 |
+ (funcall (.material rec) rec ray world depth))) |
|
| 320 | 426 |
(with-slots (direction) ray |
| 321 | 427 |
(let* ((unit-direction (unit-vector direction)) |
| 322 | 428 |
(it (+ (* 0.5 (v3-y unit-direction)) |
| ... | ... |
@@ -335,9 +441,9 @@ |
| 335 | 441 |
|
| 336 | 442 |
(defun camera (&key |
| 337 | 443 |
(aspect-ratio 16/9) |
| 338 |
- (viewport-height 4.0d0) |
|
| 444 |
+ (viewport-height 2.0d0) |
|
| 339 | 445 |
(viewport-width (* aspect-ratio viewport-height)) |
| 340 |
- (focal-length 0.8d0)) |
|
| 446 |
+ (focal-length 1.0d0)) |
|
| 341 | 447 |
(let ((origin (vec3 0d0 0.0d0 0.0d0)) |
| 342 | 448 |
(horizontal (vec3 viewport-width 0.0d0 0.0d0)) |
| 343 | 449 |
(vertical (vec3 0.0d0 viewport-height 0.0d0))) |
| ... | ... |
@@ -406,8 +512,8 @@ |
| 406 | 512 |
(u-loop j image-width image-height camera world max-depth c)))) |
| 407 | 513 |
:name (format nil "worker-~d" id)))) |
| 408 | 514 |
|
| 409 |
-(defun start-workers () |
|
| 410 |
- (loop for x below 8 |
|
| 515 |
+(defun start-workers (&optional (n 8)) |
|
| 516 |
+ (loop for x below n |
|
| 411 | 517 |
collect (start-worker x))) |
| 412 | 518 |
|
| 413 | 519 |
(defun shuffle (seq) |
| ... | ... |
@@ -419,27 +525,169 @@ |
| 419 | 525 |
finally (return (coerce arr (type-of seq)))))) |
| 420 | 526 |
|
| 421 | 527 |
(defun raytrace (out &optional (*samples-per-pixel* 10) (image-width 400) (max-depth 50)) |
| 422 |
- (let* ((world (append (list (sphere #(0 0 -1) 0.5 |
|
| 528 |
+ (let* ((world (append (list (sphere #(0 0 -1) .5 |
|
| 423 | 529 |
#(0.5 0.5 0.0) |
| 424 |
- #'original-material)) |
|
| 530 |
+ (dielectric-material 0.4) |
|
| 531 |
+ #+(or) |
|
| 532 |
+ (lambda (rec ray world depth) |
|
| 533 |
+ (declare (ignore rec world depth)) |
|
| 534 |
+ (with-slots (direction) ray |
|
| 535 |
+ (fw.lu:vector-destructuring-bind |
|
| 536 |
+ (x y z) (unit-vector direction) |
|
| 537 |
+ (vector (abs x) |
|
| 538 |
+ (abs y) |
|
| 539 |
+ (abs z))))))) |
|
| 425 | 540 |
(loop repeat 30 |
| 426 |
- collect (sphere (vector (rand-min-max -1.5 1.5) |
|
| 427 |
- (rand-min-max -1.5 1.5) |
|
| 428 |
- (rand-min-max -1.5d0 -1.0d0)) |
|
| 541 |
+ collect (sphere (vector (rand-min-max -3 3) |
|
| 542 |
+ (rand-min-max -0.5 2) |
|
| 543 |
+ (rand-min-max -1.5d0 -0.5d0)) |
|
| 429 | 544 |
(rand-min-max 0.2 0.5) |
| 430 | 545 |
(vector (random 1.0d0) |
| 431 | 546 |
(random 1.0d0) |
| 432 | 547 |
(random 1.0d0)) |
| 433 |
- (if (= 1 (random 2)) |
|
| 434 |
- (lambertian-material |
|
| 435 |
- (rand-min-max 0.25 0.75)) |
|
| 436 |
- #'original-material))) |
|
| 548 |
+ (case (random 5) |
|
| 549 |
+ (0 (lambertian-material |
|
| 550 |
+ (rand-min-max 0.25 0.75))) |
|
| 551 |
+ (1 (metal-material |
|
| 552 |
+ (rand-min-max 0.25 0.75))) |
|
| 553 |
+ (2 (fuzzy-metal-material |
|
| 554 |
+ (rand-min-max 0.25 0.75) |
|
| 555 |
+ (rand-min-max 0.01 0.75))) |
|
| 556 |
+ (3 (dielectric-material |
|
| 557 |
+ (rand-min-max 0.1 2.4))) |
|
| 558 |
+ (4 #'original-material) |
|
| 559 |
+ (5 |
|
| 560 |
+ (lambda (rec ray world depth) |
|
| 561 |
+ (declare (ignore rec world depth)) |
|
| 562 |
+ (vector 1d0 1d0 1d0) |
|
| 563 |
+ #+(or) |
|
| 564 |
+ (with-slots (direction) ray |
|
| 565 |
+ (fw.lu:vector-destructuring-bind |
|
| 566 |
+ (x y z) (unit-vector direction) |
|
| 567 |
+ (vector (abs x) |
|
| 568 |
+ (abs y) |
|
| 569 |
+ (abs z))))))))) |
|
| 570 |
+ ;; #+(or) |
|
| 437 | 571 |
(list (sphere #(0 -100.5 -1) 100 |
| 438 | 572 |
#(0.5 0.5 0.5) |
| 439 | 573 |
(lambertian-material 0.2))))) |
| 440 | 574 |
(aspect-ratio 4/3) |
| 441 | 575 |
(image-height (* (floor (/ image-width aspect-ratio)))) |
| 442 | 576 |
|
| 577 |
+ (camera (camera :focal-length 1.0d0))) |
|
| 578 |
+ (let ((mailbox (sb-concurrency:make-mailbox))) |
|
| 579 |
+ (loop for j in (shuffle (loop for x from 0 to image-height collect x)) |
|
| 580 |
+ do |
|
| 581 |
+ (sb-concurrency:send-message |
|
| 582 |
+ (aref *thread-queues* |
|
| 583 |
+ (mod j |
|
| 584 |
+ (length *thread-queues*))) |
|
| 585 |
+ (list *samples-per-pixel* |
|
| 586 |
+ j image-width |
|
| 587 |
+ image-height camera |
|
| 588 |
+ world max-depth |
|
| 589 |
+ (lambda (a b) |
|
| 590 |
+ (sb-concurrency:send-message |
|
| 591 |
+ mailbox |
|
| 592 |
+ (list a b)))))) |
|
| 593 |
+ (write-colors nil |
|
| 594 |
+ (lambda (c) |
|
| 595 |
+ (loop with messages = 0 |
|
| 596 |
+ for it = (sb-concurrency:receive-message mailbox :timeout 2) |
|
| 597 |
+ while it |
|
| 598 |
+ do (destructuring-bind (color pos) it |
|
| 599 |
+ (funcall c color pos)))) |
|
| 600 |
+ image-width)))) |
|
| 601 |
+ |
|
| 602 |
+(defun refraction-scene |
|
| 603 |
+ (out &optional (*samples-per-pixel* 10) (image-width 400) (max-depth 50)) |
|
| 604 |
+ (let* ((world (list (sphere #(0 0 -1) .5 |
|
| 605 |
+ #(0.5 0.5 0.0) |
|
| 606 |
+ (lambertian-material #(0.7 0.3 0.3))) |
|
| 607 |
+ (sphere #(-1 0 -1) 0.5 |
|
| 608 |
+ #(0 0 0) |
|
| 609 |
+ (dielectric-material 1.5)) |
|
| 610 |
+ (sphere #(-1 0 -1) -0.4 |
|
| 611 |
+ #(0 0 0) |
|
| 612 |
+ (dielectric-material 1.5)) |
|
| 613 |
+ (sphere #(-1 0 -1) -0.2 |
|
| 614 |
+ #(0 0 0) |
|
| 615 |
+ (lambertian-material |
|
| 616 |
+ #(0.8 0.6 0.2))) |
|
| 617 |
+ #+(or) |
|
| 618 |
+ (sphere #(1 0 -1) 0.5 |
|
| 619 |
+ #(0 0 0) |
|
| 620 |
+ (dielectric-material 2.4)) |
|
| 621 |
+ #+(or) |
|
| 622 |
+ (sphere #(-2 0 -1) 0.5 |
|
| 623 |
+ #(0 0 0) |
|
| 624 |
+ (metal-material #(0.8 0.8 0.8))) |
|
| 625 |
+ (sphere #(1 0 -1) 0.5 |
|
| 626 |
+ #(0 0 0) |
|
| 627 |
+ (metal-material #(0.8 0.6 0.2))) |
|
| 628 |
+ (sphere #(0 -100.5 -1) 100 |
|
| 629 |
+ #(0.5 0.5 0.5) |
|
| 630 |
+ (lambertian-material #(0.8 0.8 0.0))))) |
|
| 631 |
+ (aspect-ratio 16/9) |
|
| 632 |
+ (image-height (* (floor (/ image-width aspect-ratio)))) |
|
| 633 |
+ |
|
| 634 |
+ (camera (camera))) |
|
| 635 |
+ (let ((mailbox (sb-concurrency:make-mailbox))) |
|
| 636 |
+ (loop for j in (shuffle (loop for x from 0 to image-height collect x)) |
|
| 637 |
+ do |
|
| 638 |
+ (sb-concurrency:send-message |
|
| 639 |
+ (aref *thread-queues* |
|
| 640 |
+ (mod j |
|
| 641 |
+ (length *thread-queues*))) |
|
| 642 |
+ (list *samples-per-pixel* |
|
| 643 |
+ j image-width |
|
| 644 |
+ image-height camera |
|
| 645 |
+ world max-depth |
|
| 646 |
+ (lambda (a b) |
|
| 647 |
+ (sb-concurrency:send-message |
|
| 648 |
+ mailbox |
|
| 649 |
+ (list a b)))))) |
|
| 650 |
+ (write-colors nil |
|
| 651 |
+ (lambda (c) |
|
| 652 |
+ (loop with messages = 0 |
|
| 653 |
+ for it = (sb-concurrency:receive-message mailbox :timeout 2) |
|
| 654 |
+ while it |
|
| 655 |
+ do (destructuring-bind (color pos) it |
|
| 656 |
+ (funcall c color pos)))) |
|
| 657 |
+ image-width)))) |
|
| 658 |
+ |
|
| 659 |
+(defun refraction-scene1 |
|
| 660 |
+ (out &optional (*samples-per-pixel* 10) (image-width 400) (max-depth 50)) |
|
| 661 |
+ (let* ((world (list (sphere #(0 0 -1) 1 |
|
| 662 |
+ #(0.5 0.5 0.0) |
|
| 663 |
+ (dielectric-material 2.4)) |
|
| 664 |
+ (sphere #(-0.5 0 -1) 0.5 |
|
| 665 |
+ #(0 0 0) |
|
| 666 |
+ (dielectric-material 1.5 0.2)) |
|
| 667 |
+ (sphere #(-0.5 0 -1) -0.4 |
|
| 668 |
+ #(0 0 0) |
|
| 669 |
+ (dielectric-material 1.5 0.2)) |
|
| 670 |
+ (sphere #(-0.5 0 -1) -0.2 |
|
| 671 |
+ #(0 0 0) |
|
| 672 |
+ (metal-material |
|
| 673 |
+ #(0.8 0.6 0.2))) |
|
| 674 |
+ #+(or) |
|
| 675 |
+ (sphere #(1 0 -1) 0.5 |
|
| 676 |
+ #(0 0 0) |
|
| 677 |
+ (dielectric-material 2.4)) |
|
| 678 |
+ #+(or) |
|
| 679 |
+ (sphere #(-2 0 -1) 0.5 |
|
| 680 |
+ #(0 0 0) |
|
| 681 |
+ (metal-material #(0.8 0.8 0.8))) |
|
| 682 |
+ (sphere #(0.5 0 -1) 0.5 |
|
| 683 |
+ #(0 0 0) |
|
| 684 |
+ (metal-material #(0.8 0.6 0.2))) |
|
| 685 |
+ (sphere #(0 -100.5 -1) 100 |
|
| 686 |
+ #(0.5 0.5 0.5) |
|
| 687 |
+ (lambertian-material #(0.8 0.8 0.0))))) |
|
| 688 |
+ (aspect-ratio 16/9) |
|
| 689 |
+ (image-height (* (floor (/ image-width aspect-ratio)))) |
|
| 690 |
+ |
|
| 443 | 691 |
(camera (camera))) |
| 444 | 692 |
(let ((mailbox (sb-concurrency:make-mailbox))) |
| 445 | 693 |
(loop for j in (shuffle (loop for x from 0 to image-height collect x)) |