A few years ago, I wrote a toy 3d viewing program. I think the code is kind of pretty, and it was fun to play with.

It implements simple wireframe viewing. The coordinate system is left-handed (+X is to the left, +Y up, and +Z forward), and rotations are positive in a left-hand sense (when the thumb of the left hand points from the origin along the axis of rotation, the fingers of the left hand curl in the positive direction). It's easiest to view transformations as moving the coordinate axes. Or, if you prefer to think of transformations moving the objects, then the transform declared last is applied first.

There's window system code for MCL and for CLX.

Including the code inline here is probably not the best thing to do, but there it is.

;;;-*- Mode: Lisp; Package: RENDER -*-

;;; Written by R. Matthew Emerson (rme@acm.org) in August 1999,
;;; and placed in the public domain.

(defpackage :render
  (:use :cl))
(in-package :render)

(defvar *window-width* 200)
(defvar *window-height* 200)

(defstruct (point
            (:constructor new-point (x y z &optional (w 1.0)))
            (:constructor))
  (x 0.0)
  (y 0.0)
  (z 0.0)
  (w 1.0))

;;; Operations on vectors/points.  Functions ignore w in all
;;; arguments.  Vector-valued functions produce results with w = 1.0

(defun vsub (p1 p2)
  (new-point (- (point-x p1) (point-x p2))
             (- (point-y p1) (point-y p2))
             (- (point-z p1) (point-z p2))))

(defun vadd (p1 p2)
  (new-point (+ (point-x p1) (point-x p2))
             (+ (point-y p1) (point-y p2))
             (+ (point-z p1) (point-z p2))))

(defun vscale (s pt)
  (new-point (* s (point-x pt))
             (* s (point-y pt))
             (* s (point-z pt))))

(defun vlength (pt)
  (let ((x (point-x pt))
        (y (point-y pt))
        (z (point-z pt)))
    (sqrt (+ (* x x) (* y y) (* z z)))))

(defun vnormalize (pt)
  (let ((d (vlength pt))
        (x (point-x pt))
        (y (point-y pt))
        (z (point-z pt)))
    (new-point (/ x d) (/ y d) (/ z d))))

(defun vcross (p1 p2)
  (new-point (- (* (point-y p1) (point-z p2))
                (* (point-z p1) (point-y p2)))
             (- (* (point-z p1) (point-x p2))
                (* (point-x p1) (point-z p2)))
             (- (* (point-x p1) (point-y p2))
                (* (point-y p1) (point-x p2)))))

(defun vdot (p1 p2)
  (+ (* (point-x p1) (point-x p2))
     (* (point-y p1) (point-y p2))
     (* (point-z p1) (point-z p2))))

(defun project-point (pt)
  "Project homogeneous point pt by dividing through by w."
  (let ((x (point-x pt))
        (y (point-y pt))
        (z (point-z pt))
        (w (point-w pt)))
    (new-point (/ x w) (/ y w) (/ z w))))


(defun to-radians (degrees)
  (* (/ pi 180.0) degrees))

(defun to-degrees (radians)
  (* (/ 180.0 pi) radians))

(defvar *transform-stack* (list (make-array '(4 4)
                                            :initial-contents
                                            '((1.0 0.0 0.0 0.0)
                                              (0.0 1.0 0.0 0.0)
                                              (0.0 0.0 1.0 0.0)
                                              (0.0 0.0 0.0 1.0)))))
(defvar *ctm* (car *transform-stack*))

(defun copy-matrix (matrix)
  (let ((copy (make-array '(4 4))))
    (dotimes (i 16)
      (setf (row-major-aref copy i) (row-major-aref matrix i)))
    copy))

(defun identity-matrix ()
  "Return a copy of the identity matrix."
  (make-array '(4 4) :initial-contents '((1.0 0.0 0.0 0.0)
                                         (0.0 1.0 0.0 0.0)
                                         (0.0 0.0 1.0 0.0)
                                         (0.0 0.0 0.0 1.0))))

(defun zero-matrix ()
  (make-array '(4 4) :initial-element 0.0))

(defun transform-begin ()
  "Push a copy of the current transformation onto the transformation stack."
  (push (copy-matrix *ctm*) *transform-stack*)
  (setf *ctm* (car *transform-stack*)))

(defun transform-end ()
  (when (null (pop *transform-stack*))
    (error "transform stack underflow"))
  (setf *ctm* (car *transform-stack*)))

(defmacro with-transform (&body body)
  `(progn
     (transform-begin)
     ,@body
     (transform-end)))

(defun reset-transform ()
  "Clear the current transformation to the identity matrix."
  (dotimes (i 16)
    (setf (row-major-aref *ctm* i) 0.0))
  (dotimes (i 4)
    (setf (aref *ctm* i i) 1.0)))

(defun matrix-multiply (m1 m2)
  (let ((m (zero-matrix))
        (tmp 0.0))
    (dotimes (i 4)
      (dotimes (j 4)
        (setf tmp 0.0)
        (dotimes (k 4)
          (incf tmp (* (aref m1 i k) (aref m2 k j))))
        (setf (aref m i j) tmp)))
    m))

(defun transform (matrix)
  "Replace current transformation with matrix."
  (dotimes (i 16)
    (setf (row-major-aref *ctm* i) (row-major-aref matrix i))))

(defun concat-transform (matrix)


  "Concatenate transformation specified by matrix onto the
current transformation."
  (let ((m (zero-matrix))
        (tmp 0.0))
    (dotimes (i 4)
      (dotimes (j 4)
        (setf tmp 0.0)
        (dotimes (k 4)
          (incf tmp (* (aref matrix i k) (aref *ctm* k j))))
        (setf (aref m i j) tmp)))
    (transform m)))


(defun translate (dx dy dz)
  "Concatenate a translation onto the current transformation."
  (let ((m (identity-matrix)))
    (setf (aref m 3 0) dx
          (aref m 3 1) dy
          (aref m 3 2) dz)
    (concat-transform m)))

(defun scale (sx sy sz)
  "Concatenate a scale transformation onth the current transformation."
  (let ((m (identity-matrix)))
    (setf (aref m 0 0) sx
          (aref m 1 1) sy
          (aref m 2 2) sz)
    (concat-transform m)))

;;; Graphics Gems I, p. 466
(defun rotate (angle dx dy dz)
  "Concatenate rotation of angle degrees around the axis specified by the
vector between the origin and the point (dx, dy, dz)."
  (let* ((u (vnormalize (new-point dx dy dz)))
         (dx (point-x u))
         (dy (point-y u))
         (dz (point-z u))
         (m (identity-matrix))
         (theta (to-radians angle))
         (s (sin theta))
         (c (cos theta))
         (b (- 1.0 c)))
    (setf (aref m 0 0) (+ (* b dx dx) c)
          (aref m 0 1) (+ (* b dx dy) (* s dz))
          (aref m 0 2) (- (* b dx dz) (* s dy))
          (aref m 1 0) (- (* b dx dy) (* s dz))
          (aref m 1 1) (+ (* b dy dy) c)
          (aref m 1 2) (+ (* b dy dz) (* s dx))
          (aref m 2 0) (+ (* b dx dz) (* s dy))
          (aref m 2 1) (- (* b dy dz) (* s dx))
          (aref m 2 2) (+ (* b dz dz) c))
    (concat-transform m)))

(defun perspective (fov near far)
  (let ((m (identity-matrix))
        (h (tan (to-radians (/ fov 2.0)))))
    (setf (aref m 2 2) (/ (* far h) (- far near))
          (aref m 2 3) h
          (aref m 3 2) (/ (* near far h) (- near far)) 
          (aref m 3 3) 0.0)
    (concat-transform m)))

(defun lookat (eye lookat up)
  (let* ((m (identity-matrix))
         (up (vnormalize up))
         (n (vnormalize (vsub lookat eye)))
         (u (vnormalize (vcross up n)))
         (v (vcross n u)))
    (setf (aref m 0 0) (point-x u)
          (aref m 0 1) (point-x v)
          (aref m 0 2) (point-x n)
          (aref m 1 0) (point-y u)
          (aref m 1 1) (point-y v)
          (aref m 1 2) (point-y n)
          (aref m 2 0) (point-z u)
          (aref m 2 1) (point-z v)
          (aref m 2 2) (point-z n))
    (concat-transform m)
    (translate (- (point-x eye)) (- (point-y eye)) (- (point-z eye)))))

(defun transform-point (pt)
  "Transform pt by current transformation."
  (let ((x (point-x pt))
        (y (point-y pt))
        (z (point-z pt))
        (w (point-w pt)))
    (new-point (+ (* x (aref *ctm* 0 0)) (* y (aref *ctm* 1 0))
                  (* z (aref *ctm* 2 0)) (* w (aref *ctm* 3 0)))
               (+ (* x (aref *ctm* 0 1)) (* y (aref *ctm* 1 1))
                  (* z (aref *ctm* 2 1)) (* w (aref *ctm* 3 1)))
               (+ (* x (aref *ctm* 0 2)) (* y (aref *ctm* 1 2))
                  (* z (aref *ctm* 2 2)) (* w (aref *ctm* 3 2)))
               (+ (* x (aref *ctm* 0 3)) (* y (aref *ctm* 1 3))
                  (* z (aref *ctm* 2 3)) (* w (aref *ctm* 3 3))))))

(defun viewport (xres yres)
  (let ((aspect (/ yres xres)))
    (translate (* 0.5 xres) (* 0.5 yres) 0.0)
    (scale (* 0.5 xres) (* 0.5 yres aspect) 1.0)))

(defun viewport-map (pt)
  (new-point (* 0.5 *window-width* (+ (point-x pt) 1.0))
             (- *window-height*
                (* 0.5 *window-height* (+ (point-y pt) 1.0)))
             (point-z pt)))

(defun draw-polygon (vertex-list)
  (let ((previous-vertex (car (last vertex-list))))
    (dolist (v vertex-list)
      (let ((s0 (project-point (transform-point previous-vertex)))
            (s1 (project-point (transform-point v))))
        (moveto (viewport-map s0))
        (lineto (viewport-map s1))
        (setf previous-vertex v)))))

(defun draw-axes ()
  (draw-polygon (list (new-point 0 0 0)
                      (new-point 1 0 0)))
  (draw-polygon (list (new-point 0 0 0)
                      (new-point 0 1 0)))
  (draw-polygon (list (new-point 0 0 0)
                      (new-point 0 0 1))))

(defun draw-cubie ()
  "Draw a cube with one corner cut off, like in MECG."
  (with-transform
      (translate -0.5 -0.5 -0.5)
    (draw-polygon (list (new-point 0 0 1)
                        (new-point 1 0 1)
                        (new-point 1 0.5 1)
                        (new-point 0.5 1 1)
                        (new-point 0 1 1)))
    (draw-polygon (list (new-point 1 0 1)
                        (new-point 1 0 0)
                        (new-point 1 1 0)
                        (new-point 1 1 0.5)
                        (new-point 1 0.5 1)))
    (draw-polygon (list (new-point 0 1 1)
                        (new-point 0.5 1 1)
                        (new-point 1 1 0.5)
                        (new-point 1 1 0)
                        (new-point 0 1 0)))
    (draw-polygon (list (new-point 0 0 1)
                        (new-point 0 1 1)
                        (new-point 0 1 0)
                        (new-point 0 0 0)))
    (draw-polygon (list (new-point 0 0 0)
                        (new-point 0 1 0)
                        (new-point 1 1 0)
                        (new-point 1 0 0)))
    (draw-polygon (list (new-point 0 0 1)
                        (new-point 0 0 0)
                        (new-point 1 0 0)
                        (new-point 1 0 1)))
    (draw-polygon (list (new-point 1 0.5 1)
                        (new-point 1 1 0.5)
                        (new-point 0.5 1 1)))
    ))

(defun camera ()
  (reset-transform)
  (perspective 60 0.0001 1000)
  (lookat (new-point 0 0 -3)
          (new-point 0 0 0)
          (new-point 0 1 0)))

;;; simple example:
;;; (in-package :render)
;;; (camera)
;;; (with-transform
;;;   (rotate 30 0 1 0)
;;;   (draw-cubie))

;;;; Machine-dependent section

;;;; use this with MCL


(defvar *win* (make-instance 'ccl:window :view-size #@(200 200)))

(defun moveto (vertex)
  (ccl:with-focused-view *win*
    (#_moveto (round (point-x vertex)) (round (point-y vertex)))))

(defun lineto (vertex)
  (ccl:with-focused-view *win*
    (#_lineto (round (point-x vertex)) (round (point-y vertex)))))


#|

;;;; use this with CLX

(eval-when (:compile-toplevel :load-toplevel)
  (require :clx))

(defvar *display* (xlib:open-display "localhost"))
(defvar *screen* (xlib:display-default-screen *display*))
(defvar *win* (xlib:create-window
               :parent (xlib:screen-root *screen*)
               :x 200
               :y 200
               :width *window-width*
               :height *window-height*
               :background (xlib:screen-white-pixel *screen*)))
(defvar *gcontext* (xlib:create-gcontext
                    :drawable *win*
                    :background (xlib:screen-white-pixel *screen*)
                    :foreground (xlib:screen-black-pixel *screen*)
                    :font (xlib:open-font *display* "fixed")))
(defvar *old-x* 0)
(defvar *old-y* 0)

(defun init-clx ()
  (xlib:map-window *win*)
  (xlib:display-force-output *display*))

(init-clx)

(defun lineto (vertex)
  (xlib:draw-line *win* *gcontext* *old-x* *old-y*
             (round (point-x vertex)) (round (point-y vertex)))
  (xlib:display-force-output *display*))

(defun moveto (vertex)
  (setf *old-x* (round (point-x vertex))
        *old-y* (round (point-y vertex))))

(defun clear-window ()
  (xlib:clear-area *win* :width *window-width* :height *window-height*)
  (xlib:display-force-output *display*))

|#

---

This page is presently Uncategorized: please add appropriate topic markers and remove this text