#lang racket

(module defs typed/racket
  (provide run-no-render)

  (require racket/flonum
           racket/future)

  ;; basic structs -------------------------------------------
  (struct: color ([r : Byte] [g : Byte] [b : Byte] [a : Byte]))
  (struct: pixel ([r : Flonum] [g : Flonum] [b : Flonum]))
  (struct: vec ([x : Flonum] [y : Flonum] [z : Flonum]))
  (struct: ray ([from : vec] [dir : vec]))
  (struct: int-res ([int? : Boolean] [t : Flonum] [p : point]))
  (struct: sphere3D ([center : vec] [radius : Flonum] [col : color]))
  (struct: point ([col : color] [norm : Flonum] [mat : Flonum]))

  ;; helper funcs --------------------------------------------

  (: format-vec (vec -> String))
  (define (format-vec v)
    (format "(~a, ~a, ~a)" (vec-x v) (vec-y v) (vec-z v)))

  (: print-sphere3D (sphere3D -> Void))
  (define (print-sphere3D s)
    (printf "sphere3D: (center: ~a, R: ~a)\n " (format-vec (sphere3D-center s))
            (sphere3D-radius s)))

  (: format-point (point -> String))
  (define (format-point p)
    (format "(color: ~a, norm: ~a, material: ~a)"
            (point-col p)
            (point-norm p)
            (point-mat p)))

  (: print-int-res (int-res -> Void))
  (define (print-int-res ir)
    (printf "intersection: (~a, dis: ~a, point: ~a)\n"
            (int-res-int? ir)
            (int-res-t ir)
            (format-point (int-res-p ir))))


  ;; basic constatns -----------------------------------------
  (define cam-direction (vec 0.0 0.0 1.0))
  (define screen-width  640.0)
  (define screen-height 480.0)

  (define col-red (color 255 0 0 0))
  (define col-navy (color 0 155  120 0))
  (define col-green (color 0 255  0 0))
  (define col-blue (color 0 100 200 0))
  (define col-black (color 0 0 0 0))

  (define sph-list
    (list (sphere3D (vec 100.0 100.0 0.0) 130.0 col-red)
          (sphere3D (vec 200.0 150.0 22.0) 120.0 col-blue)
          (sphere3D (vec 500.0 300.0 0.0) 49.0 col-navy)))

  ;; vector stuff --------------------------------------------

  (: scalar-mult (vec vec -> Flonum))
  (define (scalar-mult v1 v2)
    (fl+ (fl* (vec-x v2) (vec-x v1) )
         (fl+   (fl* (vec-y v2) (vec-y v1) )
                (fl* (vec-z v2) (vec-z v1) ))))

  (: sqr-norm (vec -> Flonum))
  (define (sqr-norm v)
    (scalar-mult v v))

  (: vec-length (vec -> Flonum))
  (define (vec-length v)
    (flsqrt (sqr-norm v)))

  (: normalize-vec (vec -> vec))
  (define (normalize-vec v)
    (let* ([x (vec-x v)]    [y (vec-y v)] [z (vec-z v)]
                                [len (vec-length v)])
      (vec (fl/ x len) (fl/ y len) (fl/ z len))))

  (: subtract-vec (vec vec -> vec))
  (define (subtract-vec v2 v1)
    (vec (fl- (vec-x v2) (vec-x v1) )
         (fl- (vec-y v2) (vec-y v1) )
         (fl- (vec-z v2) (vec-z v1) )))

  (: get-closer-res (int-res int-res -> int-res))
  (define (get-closer-res i1 i2)
    (if (and (fl> (int-res-t i1) (int-res-t i2))
             (int-res-int? i2))
        i2
        i1))

  ;; sphere3D intersection
  (: screen-ray (Flonum Flonum -> ray))
  (define (screen-ray x y)
    (ray (vec x y -1000.0) cam-direction))

  (define null-point
    (point col-black 0.0 0.0))

  (: hit-sphere3D (ray sphere3D -> int-res))
  (define (hit-sphere3D r s)
    (let* ([dist-vector (subtract-vec (sphere3D-center s) (ray-from r))]
           [B (scalar-mult dist-vector (ray-dir r))]
           [D (fl+ (fl* B B) (fl+ (fl- 0.0 (sqr-norm dist-vector)) (fl* (sphere3D-radius s)
                                                                        (sphere3D-radius s))))])
      (if (fl> D 0.0)
          (let ([t0 (fl- B (flsqrt D))]
                [t1 (fl+ B (flsqrt D))])
            (if (and (fl> t0 0.1)
                     (fl< t0 t1))
                (int-res #t t0 (point (sphere3D-col s) 0.0 0.0))
                (int-res #t t1 (point (sphere3D-col s) 0.0 0.0))))
          (int-res #f 0.0 null-point))))

  (: ray-cast (Flonum Flonum (Listof sphere3D) -> int-res))
  (define (ray-cast x y object-list)
    (let ([view-ray (screen-ray x y)])
      (let loop ([closest-int  (int-res #f 10000.0 null-point)]
                 [object-list  object-list])
        (cond [(empty? object-list)  closest-int]
              [else
               (define obj (first object-list))
               (loop (get-closer-res closest-int (hit-sphere3D view-ray obj))
                     (rest object-list))]))))

  (: render-half-scene-dummy ((Listof sphere3D) Flonum Flonum -> Boolean))
  (define (render-half-scene-dummy object-list x-start x-end)
    (let x-loop ([x x-start])
      (cond
        [(x . fl< . x-end)
         (let y-loop ([y 0.0])
           (cond
             [(y . fl< . screen-height)
              (let* ([ray-res (ray-cast x y object-list)]
                     [pix-col (point-col (int-res-p ray-res))])
                (y-loop (fl+ y 1.0)))]
             [else  (x-loop (fl+ x 1.0))]))]
        [else  #t])))

  (: render-scene-dummy ((Listof sphere3D) -> Void))
  (define (render-scene-dummy object-list)
    (define screen-width/2 (fl/ screen-width 2.0))
    (define f1
      (future
       (lambda ()
         (render-half-scene-dummy object-list
                                  0.0
                                  screen-width/2))))
    (define f2
      (future
       (lambda ()
         (render-half-scene-dummy object-list
                                  screen-width/2
                                  screen-width))))
    (touch f1)
    (touch f2)
    (void))

  (define (run-no-render)
    (render-scene-dummy sph-list))
  )

(require 'defs
         future-visualizer)

(visualize-futures-thunk run-no-render)