new file mode 100644

@@ -0,0 +1 @@

+*.fasl

@@ -79,7 +79,7 @@

   (let ((obj-dist (point-x origin))

         (r_sqr (expt radius 2)))

     (lambda (point &optional out-point extracted-point)

-      ;(declare (inline) (optimize (speed 3)))

+      (declare (inline) (optimize (speed 3)))

       (let* ((out-point (or out-point (make-point :x 0 :y 0 :z 0)))

              (point (or extracted-point (extract-projected-point point obj-dist out-point))))

         (let ((d_o (c-distance origin point)))

@@ -92,12 +92,30 @@

                     0)

                   point))))))

+(defun make-interesting-cb (origin radius)

+  (let ((obj-dist (point-x origin))

+        (r_sqr (expt radius 3)))

+    (lambda (point &optional out-point extracted-point)

+      (declare (inline) (optimize (speed 3)))

+      (let* ((out-point (or out-point (make-point :x 0 :y 0 :z 0)))

+             (point (or extracted-point (extract-projected-point point obj-dist out-point))))

+        (let ((d_o (c-distance origin point)))

+          (values (if (<= d_o radius)

+                      (ceiling (* (/ (expt (- r_sqr

+                                              (expt d_o

+                                                    3))

+                                           0.33)

+                                     radius)

+                                  #. (expt 2 7))) 

+                      0)

+                  point))))))

+

 (defun make-donut-cb (origin radius width)

   (let ((pos-cb (make-sphere-cb origin radius))

         (neg-cb (make-neg-sphere-cb origin (- radius width)))

         (obj-dist (point-x origin)))

     (lambda (point &optional out-point)

-      ;(declare (inline) (optimize (speed 3)))

+      (declare (inline) (optimize (speed 3)))

       (let* ((out-point (or out-point (make-point :x 0 :y 0 :z 0))) 

              (extracted-point (extract-projected-point point obj-dist out-point)))

         (+ (funcall pos-cb point out-point extracted-point)

@@ -162,12 +180,11 @@

 (defun main (&rest args)

   (declare (ignore args))

-  ;(sb-profile:profile intercept-coordinate c-distance)

+  ;;(sb-profile:profile intercept-coordinate c-distance)

   (let ((the-plane (make-instance 'plane

-                                  :cells (make-array '(2048 2048))

+                                  :cells (make-array '(512 512))

                                   :distance 50))

-        (lparallel:*kernel* (lparallel:make-kernel 32))

-        (sphere (make-instance 'shape)))

+        (lparallel:*kernel* (lparallel:make-kernel 8)))

     (labels ((100- (x) (- x 100))

              (random-coord () (100- (random 200))))

@@ -175,9 +192,12 @@

         (run-plane the-plane

           (apply #'combine-shapes

                  (loop for _ from 0 to 100

-                       collect (defshape make-sphere-cb

-                                         (vector (1+ (random 50)) (random-coord) (random-coord))

-                                         (+ 3 (random 30))))))))

+                            collect (defshape make-donut-cb

+                                        (vector (1+ (random 50))

+                                                (random-coord)

+                                                (random-coord))

+                                      (+ 3 (random 30))

+                                      3))))))

     (with-open-file (s "/tmp/spheres.pgm" :direction :output :if-exists :supersede)

       (write-sequence (array-to-pgm (cells the-plane))