Advertisement
Guest User

Untitled

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