Patrick (patrickwonders) wrote,
Patrick
patrickwonders

  • Mood:

Lisp Package Dependencies

Some time back, xach posted information about all of the interdependcies amongst the Lisp packages available on Cliki. He had toyed with a few visualization techniques.

Me, I tweaked some old code visualization stuff I had written to output where everything was after it stabilized. Then, I tweaked my ray tracer to read that input and render the output.

So, start with Xach's dependency listing which is a list of lists. Each sublist is a package name followed by all of the packages it depends upon.

Plop that in my code visualization stuff. It creates a node for each package and a spring from package A to package B if package A depends upon package B. Every node repels every other node. The springs want to keep nodes one unit apart. Every node is attracted to the origin. Damp the motion a bit and eventually it all finds a steady state. Output where all of the springs and all of the nodes are.

Pull this information into the ray tracer. Draw red spheres at each node. Draw yellow cylinders for each spring. Put green bands around the parent's end of the spring. Sit the camera in the thick of it all. Render it with full 360-degree fish eye.

I'm not too happy with the color scheme here. But, I'm done futzing with it for the time being. Also, this is half of a stereo-pair. The other half is still rendering.

rendered dependencies

Top matter sorts of stuff..

(require :asdf)
(asdf:operate 'asdf:load-op 'cl-openmpi :verbose nil)
(asdf:operate 'asdf:load-op 'portable-threads :verbose nil)
(asdf:operate 'asdf:load-op 'com.nklein.rt :verbose nil)

(defvar dpd 5.0)

(defvar spring-color (rt:v 1.0 1.0 0.0 1.0))
(defvar band-color (rt:v 0.0 1.0 0.0 1.0))

Springs and points

(defun spring-color-banding (&key position)
  (if (plusp (cos (coerce (* 8.0 pi (max (aref position 0) 0.0))
			  '(single-float -10000.0 10000.0))))
      spring-color
      band-color))

(defun draw-spring (spring)
  (let ((start (first spring))
	(end (second spring)))
    (let ((length (* 0.5 (rt:magnitude (rt:v- start end)))))
      (rt:with-translation (rt:v* (rt:v+ start end) 0.5)
	(rt:with-look-at start
	  (rt:with-scaling (rt:v length 0.125 0.125)
	    (rt:with-color (rt:c #'spring-color-banding
				 :diffuseness 0.8
				 :specularity 0.2)
	      (rt:cylinder :round-dimensions '(1 2)))))))))

(defun draw-point (point)
  (rt:with-translation point
    (rt:with-scaling (rt:v 0.25 0.25 0.25)
      (rt:with-color (rt:c (rt:v 1.0 0.0 0.0)
			   :diffuseness 1.0
			   :specularity 0.1)
	(rt:sphere)))))

The universe in which these springs sit...

(defun my-universe (springs points)
  (rt:universe (:spatial-dimensions 3
		:color-dimensions 4
		:ambient-light (rt:v 0.3 0.3 0.3)
		:sky-color (rt:v 0.3 0.5 0.9))

    ;; put some lights out there
    (rt:with-translation (rt:v 0.0 -5.0 -2.0)
      (rt:light :color (rt:v 0.7 0.7 0.7)))
    (rt:with-translation (rt:v 0.0 5.0 4.0)
      (rt:light :color (rt:v 0.7 0.7 0.7)))

    ;; put the springs and points out there
    (mapc #'draw-spring springs)
    (mapc #'draw-point points)

    ;; put some cameras and a backdrop out there
    (let ((eye-position (rt:v -1.0 0.25 0.75))
	  (eye-offset (rt:v 0.0 0.25 0.0))
	  (aspect (rt:v 1.0 1.0))
	  (field-of-view 360.0))
      (rt:with-translation eye-position
	(rt:with-look-at (rt:v 0 0 0)
	  (rt:with-translation (rt:v* eye-offset -1.0)
	    (rt:camera :name :main-camera-l
			     :aspect aspect
			     :field-of-view field-of-view))
	  (rt:with-translation (rt:v* eye-offset 1.0)
	    (rt:camera :name :main-camera-r
			     :aspect aspect
			     :field-of-view field-of-view)))))))

Actually rendering the universe...

(defun render-viewpoint (base-name extension camera-name universe)
  (let ((name (make-pathname :name (concatenate 'string base-name extension)
			     :type "png")))
    (format t "NAME: ~A~%" name)
    (rt:render-png :dots-per-degree (rt:v dpd dpd)
		   :border 1
		   :border-color (rt:v 0.0 0.0 0.0 0.0)
		   :universe universe
		   :filename name
		   :camera-name camera-name)))

(defun render-universe (base-name universe)
  (render-viewpoint base-name "-l" :main-camera-l universe)
  (render-viewpoint base-name "-r" :main-camera-r universe))

(defun render-files (files)
  (rt:with-workers (1)
    (dolist (filename files)
      (unwind-protect
	   (with-open-file (in filename :direction :input)
	     (let ((springs (read in nil))
		   (points (read in nil))
		   (name (pathname-name filename)))
	       (let ((uu (my-universe springs points)))
		 (render-universe name uu))))))))

(render-files (rest sb-ext:*posix-argv*))

(sb-ext:quit)
Tags: lisp, rt
Subscribe
  • Post a new comment

    Error

    default userpic

    Your reply will be screened

  • 0 comments