The "first step" is available.
It does nothing except for one important thing: being the first step, it empowers me to continue work on it.
1: ; version 0.1 2: ; Features: 3: ; main render loop. 4: ; results' display function. 5: 6: ; All physical sizes will be called "meters". 7: ; They correspont to units from the scene. 8: 9: ; --------------------------------------------------- 10: ; Stubs. 11: (defun init-screen (camera the-format) "Stub.") 12: (defun update-screen (screen x y pixel) "Stub.") 13: (defun store-to-file (screen name the-format) "Stub.") 14: ; --------------------------------------------------- 15: 16: (defvar *SMALL-NUM* 0.0001) 17: 18: 19: ; Vectors 20: 21: (defstruct V3D "Vector. Just x y z." x y z) 22: 23: (defun V3D- (A B) "Difference between two 3D vectors." 24: (make-V3D :x (- (V3D-x A) (V3D-x B)) 25: :y (- (V3D-y A) (V3D-y B)) 26: :z (- (V3D-z A) (V3D-z B)))) 27: 28: (defun V3D+2or1 (A B) "Sum of 3D vectors." 29: (if (null a) 30: (make-v3d :x 0 :y 0 :z 0) 31: (if (null b) A 32: (make-v3d :x (+ (V3D-x A) (V3D-x b)) 33: :y (+ (V3D-y A) (V3D-y b)) 34: :z (+ (V3D-z A) (V3D-z b)))))) 35: 36: (defun v3d+ (&rest args) (reduce #'v3d+2or1 args)) 37: 38: (defun V3D^ (A B) 39: "Cross product of vectors in 3D." 40: (make-V3D :x (- (* (V3D-y A) (V3D-z B)) (* (V3D-z A) (V3D-y B))) 41: :y (- (* (V3D-z A) (V3D-x B)) (* (V3D-x A) (V3D-z B))) 42: :z (- (* (V3D-x A) (V3D-y B)) (* (V3D-y A) (V3D-x B))))) 43: 44: (defun V3D* (A B) 45: "Dot product of two vectors in 3D." 46: (+ (* (V3D-x A) (V3D-x B)) 47: (* (V3D-y A) (V3D-y B)) 48: (* (V3D-z A) (V3D-z B)))) 49: 50: (defun V3D-NULL-P (a) 51: "Checks if the vector is zero length." 52: (and (eql (v3d-x a) 0) 53: (eql (v3d-y a) 0) 54: (eql (v3d-z a) 0))) 55: 56: (defun V3D-NORMA (A) 57: "Returns normalized A." 58: (let ((l (sqrt (+ (* (v3d-x a) (v3d-x a)) 59: (* (v3d-y a) (v3d-y a)) 60: (* (v3d-z a) (v3d-z a)))))) 61: (if (v3d-null-p a) 62: nil ; cannot normalize empty vector 63: (make-v3d :x (/ (v3d-x a) l) 64: :y (/ (v3d-y a) l) 65: :z (/ (v3d-z a) l))))) 66: 67: (defun V3D-SCALE (A S) ; A is vector, S is scalar 68: "Scaling." 69: (make-v3d :x (* (v3d-x A) S) 70: :y (* (v3d-y A) S) 71: :z (* (v3d-z A) S))) 72: 73: (defun v3d-length (a b) 74: "The length of the vector." 75: (let ((dx (- (v3d-x a) (v3d-x b))) 76: (dy (- (v3d-y a) (v3d-y b))) 77: (dz (- (v3d-z a) (v3d-z b)))) 78: (sqrt (+ (* dx dx) (* dy dy) (* dz dz))))) 79: 80: ; 81: ; Useful structures. 82: (defstruct T3D "Triangle. Just 3 vertices." 83: v0 v1 v2 ; positions 84: color) ; temporar, for testing 85: (defstruct R3D "Ray. Just 2 vectors." p0 p1) 86: (defstruct C3D "Camera." 87: from to up ; vectors. up is correct and normalized 88: d w-px h-px w-m h-m) ; px=pixels m=meters d=distance to screen 89: (defstruct W3D "World." light geometry cameras) 90: (defstruct PIXEL3D position color depth) 91: ; 92: 93: (defun start-new-line () "Stub." (format t "~%")) 94: 95: (defun show-pixel (x y pixel) 96: "Stub." 97: (if (null pixel) 98: (format t "0 0 0 ") 99: (format t "~a " (pixel3d-color pixel)))) 100: 101: (defun load-world (&key light-filename geometry-filename cameras-filename) 102: (make-w3d :light (eval (with-open-file (in light-filename) 103: (with-standard-io-syntax (read in)))) 104: :geometry (eval (with-open-file (in geometry-filename) 105: (with-standard-io-syntax (read in)))) 106: :cameras (eval (with-open-file (in cameras-filename) 107: (with-standard-io-syntax (read in)))))) 108: 109: (defun emit-ray (camera x y) 110: "Emits one ray using given camera." 111: (let* ((w (/ (c3d-w-m camera) 112: (c3d-w-px camera))) ; physical pixel width 113: (h (/ (c3d-h-m camera) 114: (c3d-h-px camera))) ; physical pixel height 115: (f (v3d-scale (v3d-norma (v3d- (c3d-to camera) (c3d-from camera))) 116: (c3d-d camera))) ; front 117: (r (v3d-norma (v3d^ f (c3d-up camera)))) ; right 118: (r-ph (v3d-scale r w)) ; physical right step (pixel size) 119: (u-ph (v3d-scale (c3d-up camera) h)) 120: (to (v3d+ (c3d-from camera) ; ->eye 121: f ; eye->center 122: (v3d-scale r-ph (+ (/ (- 1 (c3d-w-px camera)) 2) x)) ; -(w-1)/2+x * r-ph. center->left 123: (v3d-scale u-ph (- (/ (- (c3d-h-px camera) 1) 2) y))))) ; left->lefttop 124: (make-r3d :p0 (c3d-from camera) :p1 to))) 125: 126: (defun render (&key world camera 127: (file-format 'RAW-RGBA) (name nil) 128: (new-line-hook nil) (display-pixel-hook nil)) 129: "Renders the \"world\" on \"screen\"." 130: (let ((screen (init-screen camera file-format))) 131: (dotimes (y (c3d-h-px camera)) 132: (when new-line-hook (funcall new-line-hook)) ; newline jump 133: (dotimes (x (c3d-w-px camera)) 134: ; actual rendering is done here 135: (let ((pixel (render-pixel world (emit-ray camera x y)))) 136: (when display-pixel-hook (funcall display-pixel-hook x y pixel)) 137: (update-screen screen x y pixel) ; here the rendered pixel is stored 138: ; TODO: add the interrupt ability here. 139: (when name (store-to-file screen name file-format))))))) 140: 141: (defun render-test () 142: (let* ((w (load-world :light-filename "H:/raytrace/lights.data" 143: :geometry-filename "h:/raytrace/geometry.data" 144: :cameras-filename "h:/raytrace/cameras.data")) 145: (c (first (w3d-cameras w)))) 146: (render :world w :camera c 147: :new-line-hook 'start-new-line 148: :display-pixel-hook 'show-pixel))) 149: 150: (defun intersect-ray-triangle (ray tri) 151: "Intersects ray with given triangle and returns T if intersected. 152: After the resulting color data is returned. If not intersected, 153: then NIL is returned." 154: ; get triangle edge vectors and plane normal 155: (block nil 156: (let* ((u (v3d- (t3d-v1 tri) (t3d-v0 tri))) 157: (v (v3d- (t3d-v2 tri) (t3d-v0 tri))) 158: (n (v3d^ u v))) ; cross product 159: (if (v3d-null-p n) 160: nil ; triangle is degenerate 161: (let* ((dir (v3d- (r3d-p1 ray) (r3d-p0 ray))) ; ray direction vector 162: (w0 (v3d- (r3d-p0 ray) (t3d-v0 tri))) ; w0 = R.P0 - T.V0 163: (a (- (v3d* n w0))) ; a = -dot(n,w0) 164: (b (v3d* n dir))) ; b = dot(n,dir) 165: (if (< (abs b) *SMALL-NUM*) 166: nil ; ray is parallel to the triangle plane 167: (let ((r (/ a b))) ; get intersect point of ray with plane 168: (if (< r 0) ; ray goes away from triangle 169: nil ; no intersect 170: ; intersect point of ray and plane 171: (let* ((i (v3d+ (r3d-p0 ray) 172: (make-v3d :x (* r (v3d-x dir)) 173: :y (* r (v3d-y dir)) 174: :z (* r (v3d-z dir))))) 175: (uu (v3d* u u)) 176: (uv (v3d* u v)) 177: (vv (v3d* v v)) 178: (w (v3d- i (t3d-v0 tri))) 179: (wu (v3d* w u)) 180: (wv (v3d* w v)) 181: (d (- (* uv uv) (* uu vv))) 182: (s (/ (- (* uv wv) (* vv wu)) d))) 183: (if (or (< s 0) (> s 1)) 184: nil ; point is outside of the triangle 185: (let ((tt (/ (- (* uv wu) (* uu wv)) d))) 186: (if (or (< tt 0) (> (+ s tt) 1)) 187: ; point is outside: 188: nil 189: ; point is inside: 190: (return 191: (make-pixel3d 192: :position i 193: :color (t3d-color tri) 194: :depth (v3d-length i (r3d-p0 ray)))))))))))))))) 195: 196: (defun compare2pixels (a b) ; takes two pixels 197: (if (null a) 198: b 199: (if (null b) 200: a 201: (if (< (pixel3d-depth a) (pixel3d-depth b)) 202: a 203: b)))) 204: 205: (defun compare-pixels (&rest args) 206: (reduce #'compare2pixels args)) 207: 208: (defun render-pixel (world ray) 209: (reduce #'compare-pixels 210: (mapcar #'(lambda (tri) 211: (intersect-ray-triangle ray tri)) 212: (w3d-geometry world))))
No comments:
Post a Comment