mesh-test.lisp

   1 ;; lets try creating and viewing some platonic solids
   2 (require '#:asdf)
   3 (asdf:oos 'asdf:load-op '#:cl-glfw)
   4 (asdf:oos 'asdf:load-op '#:cl-glfw-opengl)
   5 (asdf:oos 'asdf:load-op '#:cl-glfw-glu)
   6 (asdf:oos 'asdf:load-op '#:mixamesh)
   7
   8 (in-package :mixamesh)
   9
  10
  11 (defun make-octahedron ()
  12  (let ((result (make-instance 'wire-mesh)))
  13        (funcall result :add-vertex (make-vertex3d*  1.0  0.0  0.0 1.0))
  14        (funcall result :add-vertex (make-vertex3d* -1.0  0.0  0.0 1.0))
  15        (funcall result :add-vertex (make-vertex3d*  0.0  1.0  0.0 1.0))
  16        (funcall result :add-vertex (make-vertex3d*  0.0 -1.0  0.0 1.0))
  17        (funcall result :add-vertex (make-vertex3d*  0.0  0.0  1.0 1.0))
  18        (funcall result :add-vertex (make-vertex3d*  0.0  0.0 -1.0 1.0))
  19        (funcall result :add-face (make-triangle* 0 2 4))
  20        (funcall result :add-face (make-triangle* 2 0 5))
  21        (funcall result :add-face (make-triangle* 4 0 4))
  22        (funcall result :add-face (make-triangle* 0 3 5))
  23        (funcall result :add-face (make-triangle* 2 1 4))
  24        (funcall result :add-face (make-triangle* 1 2 5))
  25        (funcall result :add-face (make-triangle* 1 4 4))
  26        (funcall result :add-face (make-triangle* 3 1 5))
  27        result))
  28
  29 (defun make-tetrahedron ()
  30   (let ((result (make-instance 'wire-mesh)))
  31     (funcall result :add-vertex (make-vertex3d*  1.0  1.0  1.0 1.0))
  32     (funcall result :add-vertex (make-vertex3d*  1.0 -1.0 -1.0 1.0))
  33     (funcall result :add-vertex (make-vertex3d* -1.0  1.0 -1.0 1.0))
  34     (funcall result :add-vertex (make-vertex3d* -1.0 -1.0  1.0 1.0))
  35     (funcall result :add-face (make-triangle* 3 2 1))
  36     (funcall result :add-face (make-triangle* 2 3 0))
  37     (funcall result :add-face (make-triangle* 1 0 3))
  38     (funcall result :add-face (make-triangle* 0 1 2))
  39     result))
  40
  41
  42 (defun write-value (stream mesh)
  43   (format stream "Faces~%")
  44   (iterate
  45     (for (values a b c) in-triangles (faces-of mesh))
  46     (format stream "A ~A B ~A C ~A~%" a b c))
  47   (format stream "Vertices~%")
  48   (iterate
  49     (for (values x y z w) in-vertices (vertices-of mesh))
  50     (format stream "X ~A Y ~A Z ~A W ~A~%" x y z w)))
  51
  52
  53 (defun render (mesh)
  54   ;; wireframe renderer
  55   (gl:with-begin gl:+line-loop+
  56     (gl:color-3f 1.0 1.0 1.0)
  57     (iterate
  58       (for (values  a b c) in-triangles (faces-of mesh))
  59       (with-vertex3d
  60           (vertex3d-aref (vertices-of mesh) a)
  61           (x y z w)
  62         (gl:vertex-3f x y z))
  63       (with-vertex3d
  64           (vertex3d-aref (vertices-of mesh) b)
  65           (x y z w)
  66         (gl:vertex-3f x y z))
  67       (with-vertex3d
  68           (vertex3d-aref (vertices-of mesh) c)
  69           (x y z w)
  70         (gl:vertex-3f x y z)))))
  71
  72 (defun mixamesh-test ()
  73     (let ((frames 0)
  74           (cube (make-cube))
  75           t0
  76           t1)
  77       (glfw:do-window ("Mixamesh Test" 640 480)
  78           ((glfw:enable glfw:+sticky-keys+)
  79            (glfw:swap-interval 0)
  80            (setf t0 (glfw:get-time)
  81                  t1 (glfw:get-time)))
  82
  83         (when (eql (glfw:get-key glfw:+key-esc+) glfw:+press+)
  84           (return-from glfw:do-window))
  85
  86         (setf t1 (glfw:get-time))
  87
  88         (when (or (> (- t1 t0) 1)
  89                   (= frames 0))
  90           (glfw:set-window-title (format nil "Mixamesh test (~,1f FPS)" (/ frames (- t1 t0))))
  91           (setf frames 0
  92                 t0 t1))
  93
  94         (incf frames)
  95
  96         (destructuring-bind (width height) (glfw:get-window-size)
  97           (setf height (max height 1))
  98           (gl:viewport 0 0 width height)
  99
 100           (gl:clear-color 0 0 0 0)
 101           (gl:clear gl:+color-buffer-bit+)
 102
 103           (gl:matrix-mode gl:+projection+)
 104           (gl:load-identity)
 105           (glu:perspective 65 (/ width height) 1 100)
 106           (gl:matrix-mode gl:+modelview+)
 107           (gl:load-identity)
 108           (glu:look-at 4.5  4.50 1.0
 109                        4.5  4.5 20.0
 110                        0  1 0)
 111           (render cube)))))