Advertisement
Guest User

Untitled

a guest
Feb 21st, 2013
133
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 4.91 KB | None | 0 0
  1. #lang racket/gui
  2. (require racket/flonum)
  3. (require racket/future)
  4.  
  5. ;; basic structs -------------------------------------------
  6. (struct pixel (r g b))
  7. (struct vec (x y z))
  8. (struct ray (from dir))
  9. (struct int-res (int? t p))
  10. (struct sphere3D (center radius col))
  11. (struct point (col norm mat))
  12. (struct color (r g b a))
  13.  
  14. ;; helper funcs --------------------------------------------
  15. (define (format-vec v)
  16.   (format "(~a, ~a, ~a)" (vec-x v) (vec-y v) (vec-z v)))
  17.  
  18. (define (print-sphere3D s)
  19.   (printf "sphere3D: (center: ~a, R: ~a)\n " (format-vec (sphere3D-center s))
  20.           (sphere3D-radius s)))
  21.  
  22. (define (format-point p)
  23.   (format "(color: ~a, norm: ~a, material: ~a)"
  24.           (point-col p)
  25.           (point-norm p)
  26.           (point-mat p)))
  27.  
  28. (define (print-int-res ir)
  29.   (printf "intersection: (~a, dis: ~a, point: ~a)\n"
  30.           (int-res-int? ir)
  31.           (int-res-t ir)
  32.           (format-point (int-res-p ir))))
  33.  
  34.  
  35. ;; basic constatns -----------------------------------------
  36. (define cam-direction (vec 0.0 0.0 1.0))
  37. (define screen-width  640)
  38. (define screen-height 480)
  39.  
  40. (define col-red (make-object color% 255 0 0 0))
  41. (define col-navy (make-object color% 0 155  120 0))
  42. (define col-green (make-object color% 0 255  0 0))
  43. (define col-blue (make-object color% 0 100 200 0))
  44. (define col-black (make-object color% 0 0 0 0))
  45.  
  46. (define sph-list
  47.   (list (sphere3D (vec 100.0 100.0 0.0) 130.0 col-red)
  48.       (sphere3D (vec 200.0 150.0 22.0) 120.0 col-blue)
  49.       (sphere3D (vec 500.0 300.0 0.0) 49.0 col-navy)))
  50.  
  51. ;; vector stuff --------------------------------------------
  52. (define (scalar-mult v1 v2)
  53.   (fl+ (fl* (vec-x v2) (vec-x v1) )
  54.        (fl+   (fl* (vec-y v2) (vec-y v1) )
  55.           (fl* (vec-z v2) (vec-z v1) ))))
  56.  
  57. (define (sqr-norm v)
  58.   (scalar-mult v v))
  59.  
  60. (define (vec-length v)
  61.   (flsqrt (sqr-norm v)))
  62.  
  63. (define (normalize-vec v)
  64.   (let* ([x (vec-x v)]  [y (vec-y v)] [z (vec-z v)]
  65.                            [len (vec-length v)])
  66.     (vec (fl/ x len) (fl/ y len) (fl/ z len))))
  67.  
  68. (define (subtract-vec v2 v1)
  69.   (vec (fl- (vec-x v2) (vec-x v1) )
  70.        (fl- (vec-y v2) (vec-y v1) )
  71.        (fl- (vec-z v2) (vec-z v1) )))
  72.  
  73. (define (get-closer-res i1 i2)
  74.   (if (and (fl> (int-res-t i1) (int-res-t i2))
  75.            (int-res-int? i2))
  76.       i2
  77.       i1))
  78.  
  79. ;; sphere3D intersection
  80. (define (screen-ray x y)
  81.   (ray (vec (->fl x) (->fl y) -1000.0) cam-direction))
  82.  
  83. (define null-point
  84.   (point col-black 0 0))
  85.  
  86. (define (hit-sphere3D r s)
  87.   (let* ([dist-vector (subtract-vec (sphere3D-center s) (ray-from r))]
  88.          [B (scalar-mult dist-vector (ray-dir r))]
  89.          [D (fl+ (fl* B B) (fl+ (fl- 0.0 (sqr-norm dist-vector)) (flexpt (sphere3D-radius s) 2.0)))])
  90.     (if (fl> D 0.0)
  91.         (let ([t0 (fl- B (flsqrt D))]
  92.               [t1 (fl+ B (flsqrt D))])
  93.           (if (and (fl> t0 0.1)
  94.                    (fl< t0 t1))
  95.               (int-res #t t0 (point (sphere3D-col s) 0.0 0.0))
  96.               (int-res #t t1 (point (sphere3D-col s) 0.0 0.0))))
  97.         (int-res #f 0.0 null-point))))
  98.  
  99.  
  100. (define (ray-cast x y object-list)
  101.   (let ([view-ray (screen-ray x y)])
  102.     (for/fold ([closest-int (int-res #f 10000.0 null-point)])
  103.     ([obj (in-list object-list)])
  104.       (get-closer-res closest-int
  105.                       (hit-sphere3D view-ray obj)))))
  106.  
  107. (define (render-scene object-list dc bmp)
  108.   (let* ([f (future
  109.        (lambda ()  
  110.          (for* ([x (in-range (/ screen-width 2))]
  111.             [y (in-range screen-height)])
  112.            (let* ([ray-res (ray-cast x y object-list)]
  113.               [pix-col (point-col (int-res-p ray-res))])
  114.          (send bmp set-pixel x y pix-col)))
  115.          ))])
  116.  
  117.     (for* ([x (in-range (/ screen-width 2) screen-width)]
  118.        [y (in-range screen-height)])
  119.       (let* ([ray-res (ray-cast x y object-list)]
  120.          [pix-col (point-col (int-res-p ray-res))])
  121.     (send bmp set-pixel x y pix-col)))
  122.     (touch f)))
  123.  
  124. (define (render-scene-dummy object-list)
  125.   (let* ([f (future
  126.        (lambda ()  
  127.          (for* ([x (in-range (/ screen-width 2))]
  128.             [y (in-range screen-height)])
  129.            (let* ([ray-res (ray-cast x y object-list)]
  130.               [pix-col (point-col (int-res-p ray-res))])
  131.          #t))
  132.          ))])
  133.  
  134.     (for* ([x (in-range (/ screen-width 2) screen-width)]
  135.        [y (in-range screen-height)])
  136.       (let* ([ray-res (ray-cast x y object-list)]
  137.          [pix-col (point-col (int-res-p ray-res))])
  138.     #t))
  139.     (touch f)))
  140.  
  141. (define (make-scene-bitmap w h)
  142.   (new bitmap-dc% [bitmap (make-object bitmap% w h)])
  143. )
  144.  
  145. (define (run-no-render)
  146.   (render-scene-dummy sph-list))
  147.  
  148. (require racket/gui)
  149.  
  150. (define (run-tracer)
  151.   (let* ([frame (new frame% [label "racket ray tracer"]
  152.              [width screen-width]
  153.              [height screen-height])]
  154.      [canvas (new canvas% [parent frame])]
  155.      [dc (send canvas get-dc)]
  156.      [bmp (make-scene-bitmap screen-width screen-height)])
  157. ; Show the frame
  158.     (send frame show #t)
  159. ; Wait a second to let the window get ready
  160.     (sleep/yield 1)
  161. ; Draw the scene
  162.     (printf "rendering scene...")
  163.     (time
  164.      (render-scene sph-list dc bmp))
  165.     (send dc draw-bitmap (send bmp get-bitmap) 0 0)
  166.     frame))
  167.  
  168. ;; (run-tracer)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement