From: Joe Marshall
Subject: An afternoon's amusement
Date: 
Message-ID: <acjsmkiu.fsf@ccs.neu.edu>
Over in comp.lang.scheme people are playing with a simple ray-tracer
written by Jon Harrop.  Jan Van lint ported it from OCaml to Scheme
and I tweaked it to run on Common Lisp.

The code (right now) is not optimized *in the least*.  3-space vectors
are represented as lists, all arithmetic is generic, etc.

I amused myself for a few hours making it run fast on MIT Scheme, so I
thought people here might want to try their hand at it in Common
Lisp.  If you are a newbie, this is a great opportunity to learn about
type declarations.

I tested and ran this, so it ought to just run.  The output is a
100x100 `pgm' file.  It'll probably take a minute or two to generate
using this unoptimized code.

~jrm

----------------
;; Jon Harrop's simple ray tracer
;; Scheme port by Jan Van lint
;; CL conversion by jrm

(defconstant infinity 10000.0)
(defconstant epsilon 1.0e-5)
(defun s*v (s b) (map 'list #'(lambda (x) (* s x)) b))
(defun v+v (a b) (map 'list #'+ a b))
(defun v-v (a b) (map 'list #'- a b))
(defun dot (a b) (apply #'+ (map 'list #'* a b)))
(defun unitise (r) (s*v (/ (sqrt (dot r r))) r))

(defun ray-sphere (orig dir center radius)
   (let* ((v (v-v center orig))
          (b (dot v dir))
          (disc (+ (- (* b b) (dot v v)) (* radius radius))))
     (if (< disc 0.0) infinity
         (let ((t2 (+ b (sqrt disc))))
           (if (< t2 0.0) infinity
               (let ((t1 (- b (sqrt disc))))
                 (if (> t1 0.0) t1 t2)))))))

(defun fold-right (func accum list)
  (cond ((consp list) (funcall func (car list)
                               (fold-right func accum (cdr list))))
        ((null list) accum)
        (t (error "bad list"))))

(defun intersect (orig dir obj)
  (labels ((lp (obj hit)
               (let ((l (ray-sphere orig dir (car obj) (cadr obj))))
                 (if (>= l (car hit)) hit
                   (if (null (cddr obj))
                       (list l (unitise (v+v orig (v-v (s*v l dir) (car obj)))))
                     (fold-right #'lp hit (cddr obj)))))))

    (lp obj (list infinity '(0.0 0.0 0.0)))))

(defparameter neg_light (unitise '(1.0 3.0 -2.0)))
(defparameter orig '(0.0 0.0 -4.0))

(defun raytrace (dir scene)
   (let* ((hit (intersect orig dir scene))
          (lam (car hit))
          (normal (cadr hit)))
     (if (>= lam infinity) 0.05
         (let ((g (dot normal neg_light))
               (p (v+v orig (v+v (s*v lam dir) (s*v (sqrt epsilon) normal)))))
           (if (< (car (intersect p neg_light scene)) infinity) 0.0
             (if (> g 0.0) g 0.0))))))

(defun create (level c r)
   (let ((obj (list c r))
         (a (* 3.0 (/ r (sqrt 12.0)))))
     (if (= level 1) obj
         (let ((aux (lambda (x z)
                      (create (- level 1) (v+v c (list x a z)) (* 0.5 r)))))
           (list c (* 3.0 r)
                 obj (funcall aux (- a) (- a)) (funcall aux a (- a)) (funcall aux (- a) a)
                 (funcall aux a a))))))

(defparameter level 6)
;(defun n (string->number (car *argv*)))
(defparameter n 100)
(defparameter ss 4)
(defparameter scene (create level '(0.0 -1.0 0.0) 1.0))
(defparameter ss2 (float (* ss ss)))

(defun aux (x d) (+ (- x (/ n 2.0)) (/ d ss)))

(defun g (x y)
  (let ((sum 0.0))
    (dotimes (dx ss)
      (dotimes (dy ss)
        (incf sum
              (raytrace (unitise (list (aux x (float dx))
                                       (aux (- (- (float n) 1.0) y) (float dy))
                                       (float n)))
                        scene))))
    sum))

(defun pixel (stream x y)
  (write-byte
   (floor (+ 0.5 (* 255.0 (/ (g (float x) (float y)) ss2))))
   stream))

(defun write-ascii (thing stream)
  (etypecase thing
    (character (write-byte (char-code thing) stream))
    (string (dotimes (i (length thing))
                (write-byte (char-code (char thing i)) stream)))
    (integer (write-ascii (format nil "~d" thing) stream))))

(defun doit ()
  ;; (gc-flip)
  (with-open-file (stream "lisp.pgm"
                          :direction :output
                          :element-type '(unsigned-byte 8)
                          :if-exists :supersede)
      (mapc (lambda (x)
              (write-ascii x stream))
            (list "P5" #\newline
                  n #\space n
                  #\newline 255
                  #\newline))
      (do ((y 0 (+ y 1)))
          ((>= y n))
        (write-char #\.)
        (force-output)
        (do ((x 0 (+ x 1)))
            ((>= x n))
          (pixel stream x y)))))

From: Bulent Murtezaoglu
Subject: Re: An afternoon's amusement
Date: 
Message-ID: <87br48i4kv.fsf@p4.internal>
>>>>> "JM" == Joe Marshall <···@ccs.neu.edu> writes:

    JM> Over in comp.lang.scheme people are playing with a simple
    JM> ray-tracer written by Jon Harrop.  Jan Van lint ported it from
    JM> OCaml to Scheme and I tweaked it to run on Common Lisp. [...]

Raytracing again?  Also see (from 7 years ago):

http://groups-beta.google.com/group/comp.lang.lisp/browse_frm/thread/ee481e354a7c8ccc/f29016f62fadda7e

cheers,

BM
From: Joe Marshall
Subject: Re: An afternoon's amusement
Date: 
Message-ID: <mznskw6s.fsf@ccs.neu.edu>
Bulent Murtezaoglu <··@acm.org> writes:

>>>>>> "JM" == Joe Marshall <···@ccs.neu.edu> writes:
>
>     JM> Over in comp.lang.scheme people are playing with a simple
>     JM> ray-tracer written by Jon Harrop.  Jan Van lint ported it from
>     JM> OCaml to Scheme and I tweaked it to run on Common Lisp. [...]
>
> Raytracing again?  Also see (from 7 years ago):

You have a better memory than I!
From: Bulent Murtezaoglu
Subject: Re: An afternoon's amusement
Date: 
Message-ID: <877jewi2bt.fsf@p4.internal>
>>>>> "JM" == Joe Marshall <···@ccs.neu.edu> writes:
[...]
    JM> You have a better memory than I!

You're not the one who sank time into optimizing it.  I apparently
took notes of just how much time it took too.  But had I really had a
good memory I would have remembered what Steve Haflich eventually did
starting with Graham's original code:

http://www.dynamiclearningcenter.com/samples/ray-tracing/spheres.html

cheers,

BM
From: Frank Buss
Subject: Re: An afternoon's amusement
Date: 
Message-ID: <egrm9i2b9t3k$.7lt1x48p98k2$.dlg@40tude.net>
Bulent Murtezaoglu wrote:

> Raytracing again?  Also see (from 7 years ago):
> 
> http://groups-beta.google.com/group/comp.lang.lisp/browse_frm/thread/ee481e354a7c8ccc/f29016f62fadda7e

that's nice, now I know that my PC with LispWorks is 15 times faster than
an Indigo^2 from 1998 with ACL 4.3.1 :-)

-- 
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
From: Förster vom Silberwald
Subject: Re: An afternoon's amusement
Date: 
Message-ID: <1123581883.071028.65600@g43g2000cwa.googlegroups.com>
Joe Marshall wrote:
> Over in comp.lang.scheme people are playing with a simple ray-tracer
> written by Jon Harrop.  Jan Van lint ported it from OCaml to Scheme
> and I tweaked it to run on Common Lisp.

I have been lost on comp.lang.scheme. Do you have some up-to-date
timing results from your MIT runs?

Your MIT code takes 72 seconds on your 800 MHz P3.

The Lisp code takes 60 to 120 seconds, so as you write it - right?

Schneewittchen
From: Joe Marshall
Subject: Re: An afternoon's amusement
Date: 
Message-ID: <64ufl0gz.fsf@ccs.neu.edu>
"F�rster vom Silberwald" <··········@hotmail.com> writes:

> Joe Marshall wrote:
>> Over in comp.lang.scheme people are playing with a simple ray-tracer
>> written by Jon Harrop.  Jan Van lint ported it from OCaml to Scheme
>> and I tweaked it to run on Common Lisp.
>
> I have been lost on comp.lang.scheme. Do you have some up-to-date
> timing results from your MIT runs?
>
> Your MIT code takes 72 seconds on your 800 MHz P3.

The unoptimized, but compiled MIT-Scheme code takes 72 seconds.

> The Lisp code takes 60 to 120 seconds, so as you write it - right?

I tested and debugged the Lisp code on CLisp, so it takes longer, but
I didn't bother measuring it.