Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Tessellation again #26

Merged
merged 57 commits into from

3 participants

@dardoria

Hi,
I've reworked the code that does tessellation applying your comments.
I've also ported the quadrics and the bezcurve examples.

Thanks
Boian

dardoria added some commits
@dardoria dardoria Start of completion of support for tessellation 2256e01
@dardoria dardoria Continue with callbacks definitions. Define a few methods for tessell…
…ator.
f758862
@dardoria dardoria Rename tesselator to tessellator. Fix typos. 3fb00dc
@dardoria dardoria More on tessellation. 5bb2f4a
@dardoria dardoria Register callbacks. Follow the model of glut window events. ff901ad
@dardoria dardoria Continue on tessellation. First drop of example. 51a0313
@dardoria dardoria 179d555
@dardoria dardoria Clean-up names. Continue working on redbook example and bug fixing. f0f3499
@dardoria dardoria Fixes. 44fc82d
@dardoria dardoria Add gitingore e0046b9
@dardoria dardoria More fixes. c6baab5
@dardoria dardoria Declare correct values for tessellation type enum. Clean up tessellat…
…ion callbacks to use the user-data ones. I will probably revisti this but for now it is a good simplificaion.
f394524
@dardoria dardoria Fixes for polygn tessellation 529a936
@dardoria dardoria Start glu-tess-property c4ec5cb
@dardoria dardoria set glu-tess-proeprty 96a815f
@dardoria dardoria tess-combine-data e836d6e
@dardoria dardoria Set colors of the star 5a4ebfb
@dardoria dardoria Add tess-wind example 09de13a
@dardoria dardoria Minor fixes and cleanup e1fb06c
@dardoria dardoria Added delete tess d93ef2c
@dardoria dardoria Apply comments from 3b:
- remove tess prefixes for enums
- use with-new-list
- rename cb to callback
- use enum for winding options instead of constants
310b66a
@dardoria dardoria Close parens. 1da03c4
@dardoria dardoria Add with-tess-polygon and with-tess-contour macros. 99d7071
@dardoria dardoria Free memory allocated with tess-vertex. e343121
@dardoria dardoria Cleanup data created from tess-combine-callback. 74d49d8
@dardoria dardoria Add missing files in asd definitions. Fix number of arguments to meth…
…ods to match the definitions.
4926564
@dardoria dardoria Free data allocated with tess-vertex and tess-callback. e202943
@dardoria dardoria Start rearraning stuff to remove need to deal with cffi in callbacks. ce5fb27
@dardoria dardoria Continue rearranging stuff for easier consumption. Tess-wind example …
…works, tess obly partially.
cc462d2
@dardoria dardoria Few stylistic changes. d687d1e
@dardoria dardoria Use different names for init functions. When both tess and tess-wind …
…were loaded, tess was calling the init function of init-wind which killed glut...
fc50c27
@dardoria dardoria Convert combined vertex-data to array of gl-arrays. d8c6b20
@dardoria dardoria Quadrics example and a function. 972de43
@dardoria dardoria Clear vertex data length of tessellator object. 2323626
@dardoria dardoria Bezcurve example (needs fixing). 6ca2c82
@dardoria dardoria Finish bezcurve example. 7c29fbe
@dardoria dardoria Explicitly declare generic functions for tessellators. 906c247
@dardoria dardoria Restore lines deleted by mistake. 1ddaa8f
examples/redbook/bezcurve.lisp
@@ -0,0 +1,66 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;; bezcurve.lisp --- Lisp version of bezcurve.c (Red Book examples)
+;;;
+;;; This program uses evaluators to draw a Bezier curve.
+
+(in-package #:cl-glut-examples)
+
+(defvar control-points (make-array '(4 3) :initial-contents
@3b Owner
3b added a note

put ** on special variables: *control-points*

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
examples/redbook/bezcurve.lisp
((51 lines not shown))
+ (/ (* 5 height) width) -5 5)
+ (gl:ortho (/ (* -5 width) height) (/ (* 5 width) height)
+ -5 5 -5 5))
+ (gl:matrix-mode :modelview)
+ (gl:load-identity))
+
+(defmethod glut:keyboard ((w bezcurve-window) key x y)
+ (declare (ignore x y))
+ (when (eql key #\Esc)
+ (glut:destroy-current-window)))
+
+(defun rb-bezcurve ()
+ (setf glut:*run-main-loop-after-display* nil)
+ (glut:display-window (make-instance 'bezcurve-window))
+ (init-bezcurve)
+ (glut:main-loop))
@3b Owner
3b added a note

rb-bezcurve should bind glut:*run-main-loop-after-display* locally with LET instead of using SETF so it doesn't affect other code using glut

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
examples/redbook/quadric.lisp
((91 lines not shown))
+ (glu:quadric-draw-style quadric-obj :line) ;;all polygons wireframe
+ (glu:quadric-normals quadric-obj :none)
+ (gl:with-new-list ((+ 2 *start-list*) :compile)
+ (glu:disk quadric-obj 0.25 1 20 4))
+
+
+ (glu:quadric-draw-style quadric-obj :silhouette) ;;boundary only
+ (glu:quadric-normals quadric-obj :none)
+ (gl:with-new-list ((+ 3 *start-list*) :compile)
+ (glu:partial-disk quadric-obj 0 1 20 4 0 225))))
+
+(defun rb-quadric ()
+ (setf glut:*run-main-loop-after-display* nil)
+ (glut:display-window (make-instance 'quadric-window))
+ (init-quadric)
+ (glut:main-loop))
@3b Owner
3b added a note

same issue as rb-bezcurve about binding glut:*run-main-loop-after-display* locally. Probably should also add a local binding of *start-list* so it doesn't conflict with the one in tess.lisp

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
examples/redbook/quadric.lisp
((60 lines not shown))
+ (gl:clear-color 0 0 0 0)
+ (gl:material :front :ambient mat-ambient)
+ (gl:material :front :specular mat-specular)
+ (gl:material :front :shininess mat-shininess)
+ (gl:light :light0 :position light-position)
+ (gl:light-model :light-model-ambient model-ambient)
+ (gl:enable :lighting)
+ (gl:enable :light0)
+ (gl:enable :depth-test)
+
+ ;; Create 4 display lists, each with a different quadric object.
+ ;; Different drawing styles and surface normal specifications
+ ;; are demonstrated.
+
+ (setf *start-list* (gl:gen-lists 4))
+ (setf quadric-obj (glu:new-quadric))
@3b Owner
3b added a note

Should quadric-obj be deleted somewhere? possibly a with-quadric macro that automatically cleans it up would be better here?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
examples/redbook/tess-wind.lisp
((137 lines not shown))
+
+(defmethod glu:combine-data-callback ((tess winding-tessellator) coords vertex-data weight polygon-adata)
+ (loop for i from 0 below 3
+ collect (gl:glaref coords i)))
+
+(defun init-tess-wind ()
+ (gl:clear-color 0 0 0 0)
+ (gl:shade-model :flat)
+ (setf *list* (gl:gen-lists 4))
+ (make-new-lists))
+
+(defun rb-tess-wind ()
+ (setf glut:*run-main-loop-after-display* nil)
+ (glut:display-window (make-instance 'tess-wind-window))
+ (init-tess-wind)
+ (glut:main-loop))
@3b Owner
3b added a note

same as other examples, bind glut:*r-m-l-a-d* and *list* locally in rb-tess-wind

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
examples/redbook/tess.lisp
((110 lines not shown))
+ ;;smooth shaded, self-intersecting star
+ (setf tobj (make-instance 'star-tessellator))
+ (gl:with-new-list ((1+ *start-list*) :compile)
+ (gl:shade-model :smooth)
+ (glu:tess-property tobj :winding-rule :positive)
+ (glu:with-tess-polygon (tobj nil)
+ (glu:with-tess-contour tobj
+ (loop for coords in star
+ do (glu:tess-vertex tobj coords)))))
+ (glu:tess-delete tobj)))
+
+(defun rb-tess ()
+ (setf glut:*run-main-loop-after-display* nil)
+ (glut:display-window (make-instance 'tess-window))
+ (init-tess)
+ (glut:main-loop))
@3b Owner
3b added a note

same as other examples, bind glut:*r-m-l-a-d* and *start-list* locally

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
glu/interface.lisp
((50 lines not shown))
+(defmacro init-tessellation-callbacks (&body callback-specs)
+ `(progn
+ (setq *tess-callbacks* '())
+ ,@(loop for (name callback-type args) in callback-specs
+ collect `(init-tessellation-callback ,name ,callback-type ,args))))
+
+(defmacro with-tess-polygon ((tess-obj polygon-data) &body body)
+ `(unwind-protect (tess-begin-polygon ,tess-obj ,polygon-data)
+ (progn ,@body)
+ (tess-end-polygon ,tess-obj)))
+
+(defmacro with-tess-contour (tess-obj &body body)
+ `(unwind-protect (tess-begin-contour ,tess-obj)
+ (progn ,@body)
+ (tess-end-contour ,tess-obj)))
+
@3b Owner
3b added a note

shouldn't with-tess-polygon and with-tess-contour be

  `(unwind-protect
        (progn
          (tess-begin-...)
          ,@body)
     (tess-end-...))

?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
glu/interface.lisp
((105 lines not shown))
+
+(defmethod tess-begin-contour ((tess tessellator))
+ (glu-tess-begin-contour (glu-tessellator tess)))
+
+(defmethod tess-vertex ((tess tessellator) coords &optional (vertex-data nil))
+ (let* ((coords-data (list-to-pointer coords))
+ (vertex-data-pointer (if vertex-data
+ (list-to-pointer vertex-data)
+ coords-data)))
+ (glu-tess-vertex (glu-tessellator tess) coords-data vertex-data-pointer)
+ (save-data-to-free coords-data tess)
+ (save-data-to-free vertex-data-pointer tess)
+ (if (and (< 0 (vertex-data-length tess))
+ (not (= (vertex-data-length tess) (length coords))))
+ (warn "Vertex coordinates data must have the same length for one polygon.")
+ (setf (vertex-data-length tess) (length coords)))))
@3b Owner
3b added a note

shouldn't these be looking at the length of VERTEX-DATA instead of COORDS (at least when VERTEX-DATA is provided)?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
glu/interface.lisp
((168 lines not shown))
+
+;;;; Functions
+(defun register-callbacks (tess)
+ "When creating an object instance check what methods it specializes and regiser appropriate callbacks for each of them."
+ (loop for tess-callback in *tess-callbacks*
+ when (compute-applicable-methods
+ (tess-callback-generic-function tess-callback)
+ (cons tess (loop repeat (tess-callback-arg-count tess-callback) collect t)))
+ do (glu-tess-callback (glu-tessellator tess)
+ (tess-callback-callback-type tess-callback)
+ (get-callback (tess-callback-callback tess-callback)))))
+
+(defun save-data-to-free (data-to-free tess)
+ (when (and (pointerp data-to-free)
+ (not (null-pointer-p data-to-free)))
+ (pushnew data-to-free (data tess) :test 'cffi:pointer-eq)))
@3b Owner
3b added a note

This PUSHNEW was showing up in profiles when I was testing, might be nice to have an option to just PUSH when the caller knows the pointer was freshly allocated, which I think is true for most of the calls.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
glu/interface.lisp
((196 lines not shown))
+ (when (and (pointerp vertex-data)
+ (not (null-pointer-p vertex-data))
+ (< 0 (vertex-data-length tessellator)))
+ (gl::make-gl-array-from-pointer vertex-data '%gl:double (vertex-data-length tessellator))))
+
+(defun ->combine-vertex-data-array (vertex-data tessellator)
+ (let ((result (cl:make-array 4)))
+ (loop for i from 0 below 4
+ do (setf (aref result i) (->vertex-data-array (mem-aref vertex-data ':pointer i) tessellator)))
+ result))
+
+(defun ->polygon-data-array (polygon-data tessellator)
+ (when (and (pointerp polygon-data)
+ (not (null-pointer-p polygon-data))
+ (< 0 (polygon-data-length tessellator)))
+ (gl::make-gl-array-from-pointer polygon-data '%gl:double (polygon-data-length tessellator))))
@3b Owner
3b added a note

->polygon-data-array doesn't look right, i don't see anything setting polygon-data-length in the rest of the code, and I don't think anything requires it to be an array of doubles anyway.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
glu/interface.lisp
((204 lines not shown))
+ do (setf (aref result i) (->vertex-data-array (mem-aref vertex-data ':pointer i) tessellator)))
+ result))
+
+(defun ->polygon-data-array (polygon-data tessellator)
+ (when (and (pointerp polygon-data)
+ (not (null-pointer-p polygon-data))
+ (< 0 (polygon-data-length tessellator)))
+ (gl::make-gl-array-from-pointer polygon-data '%gl:double (polygon-data-length tessellator))))
+
+(defun list-to-pointer (list)
+ (when list
+ (let* ((list-length (length list))
+ (pointer (foreign-alloc '%gl:double :count list-length)))
+ (loop for i from 0 below list-length
+ do (setf (mem-aref pointer '%gl:double i)
+ (float (elt list i))))
@3b Owner
3b added a note

I'd write that loop as

(loop
   for elt in list
   for i from 0
   do (setf (mem-aref pointer '%gl:double i)
            (float elt 1d0)))

calling ELT for every element could get slow if the list is long

Though it might be better to accept any sequence, not just a LIST, in which case it could be better to use MAP instead of LOOP

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
glu/interface.lisp
((98 lines not shown))
+ (glu-delete-tess (glu-tessellator tess))
+ (free-tess-data tess))
+
+(defmethod tess-begin-polygon ((tess tessellator) &optional (polygon-data nil))
+ (setf *active-tessellator* tess)
+ (glu-tess-begin-polygon (glu-tessellator tess)
+ (or polygon-data (null-pointer))))
+
+(defmethod tess-begin-contour ((tess tessellator))
+ (glu-tess-begin-contour (glu-tessellator tess)))
+
+(defmethod tess-vertex ((tess tessellator) coords &optional (vertex-data nil))
+ (let* ((coords-data (list-to-pointer coords))
+ (vertex-data-pointer (if vertex-data
+ (list-to-pointer vertex-data)
+ coords-data)))
@3b Owner
3b added a note

Would probably be nicer if COORDS and VERTEX-DATA could be VECTORs (or sequence in general) in addition to LISTs

Might also be good to support passing a gl:gl-array instead of a lisp sequence.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
examples/redbook/tess.lisp
((59 lines not shown))
+
+(defmethod glu:combine-data-callback ((tess star-tessellator) coords vertex-data weight polygon-data)
+ (let ((vertex '()))
+ (loop for i from 3 downto 0
+ do (push (gl:glaref coords i) vertex))
+
+ (loop for i from 5 downto 0
+ do (push (+ (* (gl:glaref weight 0)
+ (gl:glaref (aref vertex-data 0) i))
+ (* (gl:glaref weight 1)
+ (gl:glaref (aref vertex-data 1) i))
+ (* (gl:glaref weight 2)
+ (gl:glaref (aref vertex-data 2) i))
+ (* (gl:glaref weight 3)
+ (gl:glaref (aref vertex-data 3) i)))
+ vertex))
@3b Owner
3b added a note

these loops don't look right... first loops 1 too many times, i think, and second should only be looking at elements 3,4,5. If so, i think the loops need to be swapped as well..
Might be simpler (or at least more obvious what is happening) to just pre-allocate storage for the right number of elements and assign them directly rather than looping in reverse with PUSH

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
@3b
Owner
3b commented

OK, looks like it is getting closer to done I think...

Main remaining major issues I see are the global *active-tessellator* variable and the handling of the polygon-data.

I think instead of a global for the *active-tessellator* and a raw CFFI pointer for polygon-data, it might be better to store the user data in the tessellator object, and use the polygon-data argument to pass some value the callbacks could use to look up the tessellator object in a global hash table or something.

Might also be interesting to allow users to specify a gl-array type to use with the vertex-data to allow accessing components by name instead of counting indices. (not completely sure about the performance of gl-array stuff yet though, so don't know if i'd want to require it or not)

unknown and others added some commits
unknown changed function names in emit-gl-array-bind-clause for tex-coord, ed…
…ge-flag, and vertex-attrib to ,func-name. (was giving errors for not having %gl:tex-coord)
09206d3
@3b typo fix glut:get-modifers -> glut:get-modifiers, closes #24 514d468
@3b update molview example from hcsw.org/downloads/molview.lisp (new lice…
…nse)
1df3dfe
@3b add enums for more mouse buttons
not sure how many are valid, but my mouse seems to return clicks for
buttons it doesn't even have...
202dd14
@dardoria dardoria Merge remote-tracking branch 'upstream/master' 9c2e0bc
@dardoria dardoria Rename *start-lists* in tess, tess-wind, quadric and bezcurve. Set ru…
…n-main-loop-after-display locally. Apply other changes recommended by 3b.
ac68589
@luismbo

I think you should use window slots for these variables as the other examples do.

Makes sense. I wanted to stay close to the C examples as much as possible that's why I went with the global vars.

@luismbo

This setup doesn't work well with run-all-examples since it'll forcefully run the main loop and thus halt at this example. Why the explicit call too init-bezcurve? Can you use an display-window :before/:after instead?

Same comment here about wanted to be close to the c example. I will change it.

@luismbo

I think you want GLUT:DISPLAY-WINDOW :BEFORE here. GLUT:DISPLAY runs on every iteration of GLUT's main loop.

(This comment applies to the other GLUT:DISPLAY :BEFORE methods.)

@3b

should be :edge-flag-data instead of :edge-flag

@3b 3b merged commit 4001e8f into from
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Aug 18, 2010
  1. @dardoria
Commits on Aug 19, 2010
  1. @dardoria
  2. @dardoria
Commits on Aug 24, 2010
  1. @dardoria

    More on tessellation.

    dardoria authored
Commits on Aug 25, 2010
  1. @dardoria
Commits on Oct 5, 2010
  1. @dardoria
  2. @dardoria

    No commit message

    dardoria authored
Commits on Oct 7, 2010
  1. @dardoria
Commits on Oct 27, 2010
  1. @dardoria

    Fixes.

    dardoria authored
  2. @dardoria

    Add gitingore

    dardoria authored
Commits on Nov 1, 2010
  1. @dardoria

    More fixes.

    dardoria authored
Commits on Nov 4, 2010
  1. @dardoria

    Declare correct values for tessellation type enum. Clean up tessellat…

    dardoria authored
    …ion callbacks to use the user-data ones. I will probably revisti this but for now it is a good simplificaion.
Commits on Jan 25, 2011
  1. @dardoria

    Fixes for polygn tessellation

    dardoria authored
Commits on Jan 26, 2011
  1. @dardoria

    Start glu-tess-property

    dardoria authored
Commits on Jan 27, 2011
  1. @dardoria

    set glu-tess-proeprty

    dardoria authored
Commits on Jan 28, 2011
  1. @dardoria

    tess-combine-data

    dardoria authored
Commits on Jan 31, 2011
  1. @dardoria

    Set colors of the star

    dardoria authored
  2. @dardoria

    Add tess-wind example

    dardoria authored
Commits on Feb 1, 2011
  1. @dardoria

    Minor fixes and cleanup

    dardoria authored
Commits on Feb 15, 2011
  1. @dardoria

    Added delete tess

    dardoria authored
Commits on Feb 24, 2011
  1. @dardoria

    Apply comments from 3b:

    dardoria authored
    - remove tess prefixes for enums
    - use with-new-list
    - rename cb to callback
    - use enum for winding options instead of constants
  2. @dardoria

    Close parens.

    dardoria authored
Commits on Feb 28, 2011
  1. @dardoria
Commits on Mar 8, 2011
  1. @dardoria
Commits on Mar 12, 2011
  1. @dardoria
Commits on Mar 18, 2011
  1. @dardoria

    Add missing files in asd definitions. Fix number of arguments to meth…

    dardoria authored
    …ods to match the definitions.
  2. @dardoria
Commits on Mar 19, 2011
  1. @dardoria
Commits on Mar 21, 2011
  1. @dardoria

    Continue rearranging stuff for easier consumption. Tess-wind example …

    dardoria authored
    …works, tess obly partially.
Commits on Mar 22, 2011
  1. @dardoria

    Few stylistic changes.

    dardoria authored
  2. @dardoria

    Use different names for init functions. When both tess and tess-wind …

    dardoria authored
    …were loaded, tess was calling the init function of init-wind which killed glut...
Commits on Mar 31, 2011
  1. @dardoria
Commits on Apr 19, 2011
  1. @dardoria
Commits on May 2, 2011
  1. @dardoria
Commits on May 3, 2011
  1. @dardoria
Commits on May 9, 2011
  1. @dardoria

    Finish bezcurve example.

    dardoria authored
  2. @dardoria
  3. @dardoria
Commits on May 21, 2011
  1. @dardoria

    changed function names in emit-gl-array-bind-clause for tex-coord, ed…

    unknown authored dardoria committed
    …ge-flag, and vertex-attrib to ,func-name. (was giving errors for not having %gl:tex-coord)
  2. @dardoria

    typo fix glut:get-modifers -> glut:get-modifiers, closes #24

    authored dardoria committed
  3. @dardoria

    update molview example from hcsw.org/downloads/molview.lisp (new lice…

    authored dardoria committed
    …nse)
  4. @dardoria

    add enums for more mouse buttons

    authored dardoria committed
    not sure how many are valid, but my mouse seems to return clicks for
    buttons it doesn't even have...
  5. @dardoria
  6. @dardoria

    Rename *start-lists* in tess, tess-wind, quadric and bezcurve. Set ru…

    dardoria authored
    …n-main-loop-after-display locally. Apply other changes recommended by 3b.
Commits on Jun 6, 2011
  1. @dardoria
Commits on Jun 14, 2011
  1. @dardoria
  2. @dardoria
Commits on Jun 22, 2011
  1. @dardoria
Commits on Jul 4, 2011
  1. @dardoria
  2. @dardoria
Commits on Jul 5, 2011
  1. @dardoria
Commits on Jul 7, 2011
  1. @dardoria

    Use arbitrary vertex-data.

    dardoria authored
Commits on Jul 8, 2011
  1. @dardoria
  2. @dardoria
Commits on Jul 18, 2011
  1. @dardoria

    Small refactoring.

    dardoria authored
Commits on Oct 11, 2011
  1. @dardoria
Commits on Oct 8, 2013
  1. @dardoria

    Merge changes from 3b

    dardoria authored
This page is out of date. Refresh to see the latest.
View
4 .gitignore
@@ -1,3 +1,3 @@
-*fasl
+*.fasl
*lx64fsl
-*~
+*~
View
3  cl-glu.asd
@@ -42,6 +42,7 @@
:components
((:file "package")
(:file "library")
- (:file "glu")))))
+ (:file "glu")
+ (:file "interface")))))
;; vim: ft=lisp et
View
6 cl-glut-examples.asd
@@ -52,7 +52,11 @@
(:file "list")
(:file "stroke")
(:file "smooth")
- (:file "movelight")))
+ (:file "movelight")
+ (:file "tess")
+ (:file "tess-wind")
+ (:file "quadric")
+ (:file "bezcurve")))
(:module "mesademos"
:depends-on ("examples")
:components
View
2  examples/examples.lisp
@@ -10,7 +10,7 @@
(defparameter +examples+
'(("Redbook Examples"
rb-double rb-hello #|rb-varray|# rb-lines rb-polys rb-cube rb-model
- rb-clip rb-planet rb-robot rb-list rb-stroke rb-smooth rb-movelight)
+ rb-clip rb-planet rb-robot rb-list rb-stroke rb-smooth rb-movelight rb-tess rb-tess-wind rb-quadric rb-bezcurve)
("Mesa Demos"
gears)
("SGI Samples")
View
2  examples/misc/molview.lisp
@@ -168,7 +168,7 @@
(defmethod glut:keyboard ((window mol-window) key x y)
(declare (ignore x y))
- (case key
+ (case (code-char key)
(#\x (incf view-rotx spin-speed))
(#\X (decf view-rotx spin-speed))
(#\y (incf view-roty spin-speed))
View
61 examples/redbook/bezcurve.lisp
@@ -0,0 +1,61 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;; bezcurve.lisp --- Lisp version of bezcurve.c (Red Book examples)
+;;;
+;;; This program uses evaluators to draw a Bezier curve.
+
+(in-package #:cl-glut-examples)
+
+(defclass bezcurve-window (glut:window)
+ ((control-points :accessor control-points :initform (make-array '(4 3) :initial-contents
+ '((-4 -4 0) (-2 4 0)
+ (2 -4 0) (4 4 0)))))
+ (:default-initargs :width 500 :height 500 :title "bezcurve.lisp"
+ :mode '(:single :rgb)))
+
+(defmethod glut:display-window :before ((window bezcurve-window))
+ (gl:clear-color 0 0 0 0)
+ (gl:shade-model :flat)
+ (gl:map1 :map1-vertex-3 0 1 (control-points window))
+ (gl:enable :map1-vertex-3))
+
+(defmethod glut:display ((window bezcurve-window))
+ (gl:clear :color-buffer-bit)
+ (gl:color 1 1 1)
+
+ (gl:with-primitive :line-strip
+ (loop for i from 0 to 30
+ do (gl:eval-coord-1 (/ i 30))))
+
+ ;; The following code displays the control points as dots.
+ (gl:point-size 5)
+ (gl:color 1 1 0)
+
+ (gl:with-primitive :points
+ (loop for i from 0 below 4
+ for l = (* 3 i)
+ do (gl:vertex
+ (row-major-aref (control-points window) l)
+ (row-major-aref (control-points window) (+ 1 l))
+ (row-major-aref (control-points window) (+ 2 l)))))
+ (gl:flush))
+
+(defmethod glut:reshape ((w bezcurve-window) width height)
+ (gl:viewport 0 0 width height)
+ (gl:matrix-mode :projection)
+ (gl:load-identity)
+
+ (if (<= width height)
+ (gl:ortho -5 5 (/ (* -5 height) width)
+ (/ (* 5 height) width) -5 5)
+ (gl:ortho (/ (* -5 width) height) (/ (* 5 width) height)
+ -5 5 -5 5))
+ (gl:matrix-mode :modelview)
+ (gl:load-identity))
+
+(defmethod glut:keyboard ((w bezcurve-window) key x y)
+ (declare (ignore x y))
+ (when (eql key #\Esc)
+ (glut:destroy-current-window)))
+
+(defun rb-bezcurve ()
+ (glut:display-window (make-instance 'bezcurve-window)))
View
103 examples/redbook/quadric.lisp
@@ -0,0 +1,103 @@
+
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;; quadric.lisp --- Lisp version of quadric.c (Red Book examples)
+;;;
+
+(in-package #:cl-glut-examples)
+
+(defclass quadric-window (glut:window)
+ ((start-list :accessor start-list))
+ (:default-initargs :width 500 :height 500 :title "quadric.lisp"
+ :mode '(:single :rgb :depth)))
+
+(defmethod glut:display-window :before ((window quadric-window))
+ (let ((quadric-obj)
+ (mat-ambient '(0.5 0.5 0.5 1.0))
+ (mat-specular '(1.0 1.0 1.0 1.0))
+ (mat-shininess 50)
+ (light-position '(1.0 1.0 1.0 0.0))
+ (model-ambient '(0.5 0.5 0.5 1.0)))
+ (gl:clear-color 0 0 0 0)
+ (gl:material :front :ambient mat-ambient)
+ (gl:material :front :specular mat-specular)
+ (gl:material :front :shininess mat-shininess)
+ (gl:light :light0 :position light-position)
+ (gl:light-model :light-model-ambient model-ambient)
+ (gl:enable :lighting)
+ (gl:enable :light0)
+ (gl:enable :depth-test)
+
+ ;; Create 4 display lists, each with a different quadric object.
+ ;; Different drawing styles and surface normal specifications
+ ;; are demonstrated.
+
+ (setf (start-list window) (gl:gen-lists 4))
+ (setf quadric-obj (glu:new-quadric))
+
+ ;;todo
+ ;; gluQuadricCallback(qobj, GLU_ERROR,
+ ;; (GLvoid (CALLBACK*) ()) errorCallback);
+
+ (glu:quadric-draw-style quadric-obj :fill) ;;smooth shaded
+ (glu:quadric-normals quadric-obj :smooth)
+ (gl:with-new-list ((start-list window) :compile)
+ (glu:sphere quadric-obj 0.75 15 10))
+
+ (glu:quadric-draw-style quadric-obj :fill) ;;flat shaded
+ (glu:quadric-normals quadric-obj :flat)
+ (gl:with-new-list ((1+ (start-list window)) :compile)
+ (glu:cylinder quadric-obj 0.5 0.3 1 15 5))
+
+ (glu:quadric-draw-style quadric-obj :line) ;;all polygons wireframe
+ (glu:quadric-normals quadric-obj :none)
+ (gl:with-new-list ((+ 2 (start-list window)) :compile)
+ (glu:disk quadric-obj 0.25 1 20 4))
+
+ (glu:quadric-draw-style quadric-obj :silhouette) ;;boundary only
+ (glu:quadric-normals quadric-obj :none)
+ (gl:with-new-list ((+ 3 (start-list window)) :compile)
+ (glu:partial-disk quadric-obj 0 1 20 4 0 225))
+
+ (glu:delete-quadric quadric-obj)))
+
+(defmethod glut:display ((window quadric-window))
+ (gl:clear :color-buffer :depth-buffer-bit)
+ (gl:with-pushed-matrix
+ (gl:enable :lighting)
+ (gl:shade-model :smooth)
+ (gl:translate -1.0 -1.0 0.0)
+ (gl:call-list (start-list window))
+ (gl:shade-model :flat)
+ (gl:translate 0.0 2.0 0.0)
+ (gl:with-pushed-matrix
+ (gl:rotate 300.0 1.0 0.0 0.0)
+ (gl:call-list (1+ (start-list window))))
+ (gl:disable :lighting)
+ (gl:color 0.0 1.0 1.0)
+ (gl:translate 2.0 -2.0 0.0)
+ (gl:call-list (+ 2 (start-list window)))
+ (gl:color 1.0 1.0 0.0)
+ (gl:translate 0.0 2.0 0.0)
+ (gl:call-list (+ 3 (start-list window))))
+ (gl:flush))
+
+(defmethod glut:reshape ((w quadric-window) width height)
+ (gl:viewport 0 0 width height)
+ (gl:matrix-mode :projection)
+ (gl:load-identity)
+
+ (if (<= width height)
+ (gl:ortho -2.5 2.5 (/ (* -2.5 height) width)
+ (/ (* 2.5 height) width) -10.0 10.0)
+ (gl:ortho (/ (* -2.5 width) height) (/ (* 2.5 width) height)
+ -2.5 2.5 -10 10))
+ (gl:matrix-mode :modelview)
+ (gl:load-identity))
+
+(defmethod glut:keyboard ((w quadric-window) key x y)
+ (declare (ignore x y))
+ (when (eql key #\Esc)
+ (glut:destroy-current-window)))
+
+(defun rb-quadric ()
+ (glut:display-window (make-instance 'quadric-window)))
View
144 examples/redbook/tess-wind.lisp
@@ -0,0 +1,144 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;; tess-wind.lisp --- Lisp version of tesswind.c (Red Book examples)
+;;;
+;;; Original C version contains the following copyright notice:
+;;; Copyright (c) 1993-1997, Silicon Graphics, Inc.
+;;; ALL RIGHTS RESERVED
+
+(in-package #:cl-glut-examples)
+
+
+(defclass winding-tessellator (glu:tessellator)
+ ())
+
+(defclass tess-wind-window (glut:window)
+ ((current-winding :accessor current-winding :initform :odd)
+ (wind-list :accessor wind-list))
+ (:default-initargs :width 500 :height 500 :title "tess-wind.lisp"
+ :mode '(:single :rgb)))
+
+(defmethod glut:display-window :before ((window tess-wind-window))
+ (gl:clear-color 0 0 0 0)
+ (gl:shade-model :flat)
+ (setf (wind-list window) (gl:gen-lists 4))
+ (make-new-lists window))
+
+(defmethod glut:display ((window tess-wind-window))
+ (gl:clear :color-buffer)
+ (gl:color 1 1 1)
+ (gl:with-pushed-matrix
+ (gl:call-list (wind-list window))
+ (gl:translate 0 500 0)
+ (gl:call-list (1+ (wind-list window)))
+ (gl:translate 500 -500 0)
+ (gl:call-list (+ 2 (wind-list window)))
+ (gl:translate 0 500 0)
+ (gl:call-list (+ 3 (wind-list window))))
+ (gl:flush))
+
+(defmethod glut:reshape ((w tess-wind-window) width height)
+ (gl:viewport 0 0 width height)
+ (gl:matrix-mode :projection)
+ (gl:load-identity)
+ (if (<= width height)
+ (glu:ortho-2d 0 1000 0 (* 1000 (/ height width)))
+ (glu:ortho-2d 0 (* 1000 (/ width height)) 0 1000))
+ (gl:matrix-mode :modelview)
+ (gl:load-identity))
+
+(defmethod glut:keyboard ((window tess-wind-window) key x y)
+ (case key
+ ((#\w #\W)
+ (progn
+ (cond ((equal (current-winding window) :odd)
+ (setf (current-winding window) :nonzero))
+ ((equal (current-winding window) :nonzero)
+ (setf (current-winding window) :positive))
+ ((equal (current-winding window) :positive)
+ (setf (current-winding window) :negative))
+ ((equal (current-winding window) :negative)
+ (setf (current-winding window) :abs-geq-two))
+ ((equal (current-winding window) :abs-geq-two)
+ (setf (current-winding window) :odd)))
+ (make-new-lists window)
+ (glut:post-redisplay)))
+ (#\Esc
+ (glut:destroy-current-window))))
+
+(defmethod glu:vertex-data-callback ((tess winding-tessellator) vertex-data polygon-data)
+ (gl:vertex (first vertex-data)(second vertex-data)(third vertex-data)))
+
+(defmethod glu:combine-data-callback ((tess winding-tessellator) coords vertex-data weight polygon-data)
+ (loop for i from 0 below 3
+ collect (gl:glaref coords i)))
+
+(defun make-new-lists (window)
+ (let ((tobj (make-instance 'winding-tessellator))
+ (rects '((50 50 0) (300 50 0)
+ (300 300 0) (50 300 0)
+ (100 100 0) (250 100 0)
+ (250 250 0) (100 250 0)
+ (150 150 0) (200 150 0)
+ (200 200 0) (150 200 0)))
+ (spiral '((400 250 0) (400 50 0)
+ (50 50 0) (50 400 0)
+ (350 400 0) (350 100 0)
+ (100 100 0) (100 350 0)
+ (300 350 0) (300 150 0)
+ (150 150 0) (150 300 0)
+ (250 300 0) (250 200 0)
+ (200 200 0) (200 250 0)))
+ (quad1 '((50 150 0) (350 150 0)
+ (350 200 0) (50 200 0)))
+ (quad2 '((100 100 0) (300 100 0)
+ (300 350 0) (100 350 0)))
+ (tri '((200 50 0) (250 300 0)
+ (150 300 0))))
+
+ (glu:tess-property tobj :winding-rule (current-winding window))
+
+ (gl:with-new-list ((wind-list window) :compile)
+ (glu:with-tess-polygon (tobj)
+ (glu:with-tess-contour tobj
+ (loop for i from 0 below 4
+ do (glu:tess-vertex tobj (nth i rects)(nth i rects))))
+ (glu:with-tess-contour tobj
+ (loop for i from 4 below 8
+ do (glu:tess-vertex tobj (nth i rects)(nth i rects))))
+ (glu:with-tess-contour tobj
+ (loop for i from 8 below 12
+ do (glu:tess-vertex tobj (nth i rects)(nth i rects))))))
+
+ (gl:with-new-list ((1+ (wind-list window)) :compile)
+ (glu:with-tess-polygon (tobj)
+ (glu:with-tess-contour tobj
+ (loop for i from 0 below 4
+ do (glu:tess-vertex tobj (nth i rects)(nth i rects))))
+ (glu:with-tess-contour tobj
+ (loop for i from 7 downto 4
+ do (glu:tess-vertex tobj (nth i rects)(nth i rects))))
+ (glu:with-tess-contour tobj
+ (loop for i from 11 downto 8
+ do (glu:tess-vertex tobj (nth i rects)(nth i rects))))))
+
+ (gl:with-new-list ((+ 2 (wind-list window)) :compile)
+ (glu:with-tess-polygon (tobj)
+ (glu:with-tess-contour tobj
+ (loop for coords in spiral
+ do (glu:tess-vertex tobj coords coords)))))
+
+ (gl:with-new-list ((+ 3 (wind-list window)) :compile)
+ (glu:with-tess-polygon (tobj)
+ (glu:with-tess-contour tobj
+ (loop for coords in quad1
+ do (glu:tess-vertex tobj coords coords)))
+ (glu:with-tess-contour tobj
+ (loop for coords in quad2
+ do (glu:tess-vertex tobj coords coords)))
+ (glu:with-tess-contour tobj
+ (loop for coords in tri
+ do (glu:tess-vertex tobj coords coords)))))
+ (glu:tess-delete tobj)))
+
+(defun rb-tess-wind ()
+ (glut:display-window (make-instance 'tess-wind-window)))
View
118 examples/redbook/tess.lisp
@@ -0,0 +1,118 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;; tess.lisp --- Lisp version of tess.c (Red Book examples)
+;;;
+;;; Original C version contains the following copyright notice:
+;;; Copyright (c) 1993-1997, Silicon Graphics, Inc.
+;;; ALL RIGHTS RESERVED
+
+;;;
+;;; This program demonstrates polygon tessellation.
+;;; Two tesselated objects are drawn. The first is a
+;;; rectangle with a triangular hole. The second is a
+;;; smooth shaded, self-intersecting star.
+;;;
+;;; Note the exterior rectangle is drawn with its vertices
+;;; in counter-clockwise order, but its interior clockwise.
+;;; Note the combineCallback is needed for the self-intersecting
+;;; star. Also note that removing the TessProperty for the
+;;; star will make the interior unshaded (WINDING_ODD).
+
+(in-package #:cl-glut-examples)
+
+(defclass tess-window (glut:window)
+ ((start-list :accessor start-list))
+ (:default-initargs :width 500 :height 500 :title "tess.lisp"
+ :mode '(:single :rgb)))
+
+(defclass example-tessellator (glu:tessellator)
+ ())
+
+(defclass star-tessellator (glu:tessellator)
+ ())
+
+(defmethod glut:display-window :before ((window tess-window))
+ (let ((tobj (make-instance 'example-tessellator))
+ (rect '((50 50 0)
+ (200 50 0)
+ (200 200 0)
+ (50 200 0)))
+ (tri '((75 75 0)
+ (125 175 0)
+ (175 75 0)))
+ (star '((250 50 0 1 0 1)
+ (325 200 0 1 1 0)
+ (400 50 0 0 1 1)
+ (250 150 0 1 0 0)
+ (400 150 0 0 1 0))))
+
+ (gl:clear-color 0 0 0 0)
+ (setf (start-list window) (gl:gen-lists 2))
+
+ ;; need to initialize tess property in case it is messed up
+ (glu:tess-property tobj :winding-rule :positive)
+
+ ;;rectangle with triangular hole inside
+ (gl:with-new-list ((start-list window) :compile)
+ (gl:shade-model :flat)
+ (glu:with-tess-polygon (tobj)
+ (glu:with-tess-contour tobj
+ (loop for coords in rect
+ do (glu:tess-vertex tobj coords coords)))
+ (glu:with-tess-contour tobj
+ (loop for coords in tri
+ do (glu:tess-vertex tobj coords coords)))))
+ (glu:tess-delete tobj)
+
+ ;;smooth shaded, self-intersecting star
+ (setf tobj (make-instance 'star-tessellator))
+ (gl:with-new-list ((1+ (start-list window)) :compile)
+ (gl:shade-model :smooth)
+ (glu:tess-property tobj :winding-rule :positive)
+ (glu:with-tess-polygon (tobj)
+ (glu:with-tess-contour tobj
+ (loop for coords in star
+ do (glu:tess-vertex tobj coords coords)))))
+ (glu:tess-delete tobj)))
+
+(defmethod glut:display ((window tess-window))
+ (gl:clear :color-buffer)
+ (gl:color 1 1 1)
+ (gl:call-list (start-list window))
+ (gl:call-list (1+ (start-list window)))
+ (gl:flush))
+
+(defmethod glut:reshape ((w tess-window) width height)
+ (gl:viewport 0 0 width height)
+ (gl:matrix-mode :projection)
+ (gl:load-identity)
+ (glu:ortho-2d 0 width 0 height))
+
+(defmethod glut:keyboard ((w tess-window) key x y)
+ (declare (ignore x y))
+ (when (eql key #\Esc)
+ (glut:destroy-current-window)))
+
+(defmethod glu:vertex-data-callback ((tess example-tessellator) vertex-data polygon-data)
+ (gl:vertex (first vertex-data) (second vertex-data) (third vertex-data)))
+
+(defmethod glu:vertex-data-callback ((tess star-tessellator) vertex-data polygon-data)
+ (gl:color (fourth vertex-data) (fifth vertex-data) (sixth vertex-data))
+ (gl:vertex (first vertex-data) (second vertex-data) (third vertex-data)))
+
+(defmethod glu:combine-data-callback ((tess star-tessellator) coords vertex-data weight polygon-data)
+ (nconc
+ (loop for i from 0 below 3
+ collect (gl:glaref coords i))
+
+ (loop for i from 3 below 6
+ collect (+ (* (gl:glaref weight 0)
+ (nth i (aref vertex-data 0)))
+ (* (gl:glaref weight 1)
+ (nth i (aref vertex-data 1)))
+ (* (gl:glaref weight 2)
+ (nth i (aref vertex-data 2)))
+ (* (gl:glaref weight 3)
+ (nth i (aref vertex-data 3)))))))
+
+(defun rb-tess ()
+ (glut:display-window (make-instance 'tess-window)))
View
99 glu/glu.lisp
@@ -254,47 +254,79 @@
;;;; 5. Polygon Tessellation
-;;; TODO: make an object for these too..
-
;;;; 5.1 The Tessellation Object
+(defctype tess-pointer :pointer)
-(defctype tesselator :pointer)
-
-(defcfun ("gluNewTess" new-tess) tesselator)
+(defcfun ("gluNewTess" glu-new-tess) tess-pointer)
-(defcfun ("gluDeleteTess" delete-tess) :void
- (tess-obj tesselator))
+(defcfun ("gluDeleteTess" glu-delete-tess) :void
+ (tess-obj tess-pointer))
;;;; 5.2 Polygon Definition
-(defcfun ("gluTessBeginPolygon" tess-begin-polygon) :void
- (tess tesselator)
+(defcfun ("gluTessBeginPolygon" glu-tess-begin-polygon) :void
+ (tess tess-pointer)
(polygon-data :pointer))
-(defcfun ("gluTessBeginContour" tess-begin-contour) :void
- (tess tesselator))
+(defcfun ("gluTessBeginContour" glu-tess-begin-contour) :void
+ (tess tess-pointer))
-(defcfun ("gluTessVertex" tess-vertex) :void
- (tess tesselator)
+(defcfun ("gluTessVertex" glu-tess-vertex) :void
+ (tess tess-pointer)
(coords :pointer) ; GLdouble coords[3]
(vertex-data :pointer))
+
+(defcfun ("gluTessEndContour" glu-tess-end-contour) :void
+ (tess tess-pointer))
-(defcfun ("gluTessEndContour" tess-end-contour) :void
- (tess tesselator))
-
-(defcfun ("gluTessEndPolygon" tess-end-polygon) :void
- (tess tesselator))
+(defcfun ("gluTessEndPolygon" glu-tess-end-polygon) :void
+ (tess tess-pointer))
;;;; 5.3 Callbacks
-;;; TODO
-;;(defcfun ("gluTessCallback" tess-callback) :void
-;; )
+(defcenum (tessellation-type %gl:enum)
+ (:begin 100100)
+ :vertex
+ :end
+ :error
+ :edge-flag
+ :combine
+ :begin-data
+ :vertex-data
+ :end-data
+ :error-data
+ :edge-flag-data
+ :combine-data)
+
+(defcfun ("gluTessCallback" glu-tess-callback) :void
+ (tess tess-pointer) (type tessellation-type) (callback :pointer))
;;;; 5.4 Control Over Tessellation
-
-;;(defcfun ("gluTessProperty" tess-property) :void
-;; )
+(defcenum (tess-property %gl:enum)
+ (:winding-rule 100140)
+ :boundary-only
+ :tolerance)
+
+(defcenum (tess-winding-rule %gl:double)
+ (:odd 100130)
+ :nonzero
+ :positive
+ :negative
+ :abs-geq-two)
+
+(defcfun ("gluTessProperty" %glu-tess-property) :void
+ (tess tess-pointer)
+ (which tess-property)
+ (value %gl:double))
+
+(defun glu-tess-property (tess which value)
+ (let ((cffi-value
+ (ecase which
+ (:winding-rule (cffi:foreign-enum-value 'tess-winding-rule value))
+ (:boundary-only (cffi:foreign-enum-value '%gl:boolean value))
+ (:tolerance value))))
+ (%glu-tess-property tess which cffi-value)))
+
;;;; 5.7 Backwards Compatibility
@@ -343,7 +375,15 @@
(quadric-object quadric-obj)
(normals glu-normals))
-;; gluQuadricDrawStyle
+(defcenum draw-styles
+ (:point #x186AA)
+ :line
+ :fill
+ :silhouette)
+
+(defcfun ("gluQuadricDrawStyle" quadric-draw-style) :void
+ (quadric-object quadric-obj)
+ (draw-style draw-styles))
;;;; 6.4 Quadrics Primitives
@@ -455,7 +495,14 @@
:out-of-memory
:incompatible-gl-version
:invalid-operation
- ;; plus NURBS, Quadrics and Tesselation errors?
+ ;;Tesselation errors
+ (:tess-missing-begin-polygon 100151)
+ (:tess-missing-begin-contour 100152)
+ (:tess-missing-end-polygon 100153)
+ (:tess-missing-end-contour 100154)
+ (:tess-coord-too-large 100155)
+ (:tess-need-combine-callback 100156)
+ ;; plus NURBS, Quadrics
;; probably not necessary
)
View
286 glu/interface.lisp
@@ -0,0 +1,286 @@
+;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
+;;;
+;;; interface.lisp --- CLOS interface to GLU routines.
+;;;
+;;; Copyright (c) 2010, Boian Tzonev <boiantz@gmail.com>
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;; o Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+;;; o Redistributions in binary form must reproduce the above copyright
+;;; notice, this list of conditions and the following disclaimer in the
+;;; documentation and/or other materials provided with the distribution.
+;;; o Neither the name of the author nor the names of the contributors may
+;;; be used to endorse or promote products derived from this software
+;;; without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-glu)
+
+;;;; Polygon Tessellation
+(defparameter *tessellators* (make-hash-table))
+
+(defparameter *tess-callbacks* '())
+
+(defstruct tess-callback name generic-function callback callback-type arg-count)
+
+(defmacro init-tessellation-callback (name callback-type arg-count)
+ (let ((tessellation-callback (gl::symbolicate "%" name))
+ (tessellation-name (intern (symbol-name name) '#:keyword)))
+ `(push (make-tess-callback :name ,tessellation-name :generic-function #',name
+ :callback ',tessellation-callback :callback-type ,callback-type
+ :arg-count ,arg-count)
+ *tess-callbacks*)))
+
+(defmacro init-tessellation-callbacks (&body callback-specs)
+ `(progn
+ (setq *tess-callbacks* '())
+ ,@(loop for (name callback-type args) in callback-specs
+ collect `(init-tessellation-callback ,name ,callback-type ,args))))
+
+(defmacro with-tess-polygon ((tess-obj &optional (polygon-data nil)) &body body)
+ `(progn (tess-begin-polygon ,tess-obj ,polygon-data)
+ (unwind-protect (progn ,@body)
+ (tess-end-polygon ,tess-obj))))
+
+(defmacro with-tess-contour (tess-obj &body body)
+ `(progn (tess-begin-contour ,tess-obj)
+ (unwind-protect (progn ,@body)
+ (tess-end-contour ,tess-obj))))
+
+(defclass tessellator ()
+ ((glu-tessellator :reader glu-tessellator)
+ (id :reader id)
+ (data-to-free :accessor data :initform '())
+ (vertex-data :accessor vertex-data :initform (make-hash-table))
+ (polygon-data :accessor polygon-data :initform (make-hash-table))))
+
+;;methods
+(defgeneric tess-delete (tessellator))
+(defgeneric tess-begin-polygon (tessellator &optional polygon-data))
+(defgeneric tess-begin-contour (tessellator))
+(defgeneric tess-vertex (tessellator coords &optional vertex-data))
+(defgeneric tess-end-contour (tessellator))
+(defgeneric tess-end-polygon (tessellator))
+(defgeneric tess-property (tessellator which value))
+
+;;callbacks
+(defgeneric begin-data-callback (tessellator type polygon-data))
+(defgeneric edge-flag-data-callback (tessellator flag polygon-data))
+(defgeneric end-data-callback (tessellator polygon-data))
+(defgeneric vertex-data-callback (tessellator vertex-data polygon-data))
+(defgeneric error-data-callback (tessellator error-number polygon-data))
+(defgeneric combine-data-callback (tessellator coords vertex-data weight polygon-data))
+
+(defmethod initialize-instance :after ((obj tessellator) &key)
+ (let ((tess (glu-new-tess)))
+ (if (null-pointer-p tess)
+ (error "Error creating tessellator object")
+ (progn
+ (let ((tessellator-id (pointer-address tess)))
+ (setf (slot-value obj 'glu-tessellator) tess)
+ (setf (slot-value obj 'id) tessellator-id)
+ ;;put the tessellator object in the table of known tessellators
+ ;;key of the tessellator is the pointer address of its corresponding glu-tessellator
+ (when (nth-value 1 (gethash tessellator-id *tessellators*))
+ (warn "A tessellator with this id is already registred"))
+ (setf (gethash tessellator-id *tessellators*) obj))
+ (register-callbacks obj)))))
+
+(defmethod tess-delete ((tess tessellator))
+ (remhash (id tess) *tessellators*)
+ (free-tess-data tess)
+ (glu-delete-tess (glu-tessellator tess)))
+
+(defmethod tess-begin-polygon ((tess tessellator) &optional (polygon-data nil))
+ (let* ((polygon-data-id
+ (or (loop for value being the hash-values of (polygon-data tess)
+ using (hash-key key)
+ when (eq value polygon-data)
+ return key)
+ (hash-table-count (polygon-data tess))))
+ (foreign-key (foreign-alloc :uint64 :initial-contents (list (id tess) polygon-data-id))))
+
+ (setf (gethash polygon-data-id (polygon-data tess)) polygon-data)
+
+ (save-data-to-free foreign-key tess)
+ (glu-tess-begin-polygon (glu-tessellator tess) foreign-key)))
+
+(defmethod tess-begin-contour ((tess tessellator))
+ (glu-tess-begin-contour (glu-tessellator tess)))
+
+(defmethod tess-vertex ((tess tessellator) coords &optional vertex-data)
+ (let* ((coords-data (coords-to-pointer coords))
+ (vertex-data-pointer (vertex-data-to-pointer tess vertex-data)))
+
+ (save-data-to-free coords-data tess)
+ (glu-tess-vertex (glu-tessellator tess) coords-data vertex-data-pointer)))
+
+(defmethod tess-end-contour ((tess tessellator))
+ (glu-tess-end-contour (glu-tessellator tess)))
+
+(defmethod tess-end-polygon ((tess tessellator))
+ (glu-tess-end-polygon (glu-tessellator tess))
+ (free-tess-data tess))
+
+(defmethod tess-property ((tess tessellator) which value)
+ (glu-tess-property (glu-tessellator tess) which value))
+
+;;;; Callbacks
+(defmethod begin-data-callback ((tess tessellator) which polygon-data)
+ (declare (ignore polygon-data))
+ (gl:begin which))
+
+(defmethod error-data-callback ((tess tessellator) error-code polygon-data)
+ (declare (ignore polygon-data))
+ (free-tess-data tess)
+ (error "Tessellation error: ~A~%" (error-string error-code)))
+
+(defmethod end-data-callback ((tess tessellator) polygon-data)
+ (declare (ignore polygon-data))
+ (gl:end))
+
+(defcallback %begin-data-callback :void ((type :unsigned-int) (polygon-data-pointer :pointer))
+ (let* ((tess (get-tessellator polygon-data-pointer))
+ (polygon-data (get-polygon-data tess polygon-data-pointer)))
+ (begin-data-callback tess type polygon-data)))
+
+(defcallback %edge-flag-data-callback :void ((flag %gl:boolean) (polygon-data-pointer :pointer))
+ (let* ((tess (get-tessellator polygon-data-pointer))
+ (polygon-data (get-polygon-data tess polygon-data-pointer)))
+ (edge-flag-data-callback tess flag polygon-data)))
+
+(defcallback %end-data-callback :void ((polygon-data-pointer :pointer))
+ (let* ((tess (get-tessellator polygon-data-pointer))
+ (polygon-data (get-polygon-data tess polygon-data-pointer)))
+ (end-data-callback tess polygon-data)))
+
+(defcallback %vertex-data-callback :void ((vertex-data-pointer :pointer) (polygon-data-pointer :pointer))
+ (let* ((tess (get-tessellator polygon-data-pointer))
+ (polygon-data (get-polygon-data tess polygon-data-pointer))
+ (vertex-data (get-vertex-data tess vertex-data-pointer)))
+ (vertex-data-callback tess vertex-data polygon-data)))
+
+(defcallback %error-data-callback :void ((error-number :unsigned-int) (polygon-data-pointer :pointer))
+ (let* ((tess (get-tessellator polygon-data-pointer))
+ (polygon-data (get-polygon-data tess polygon-data-pointer)))
+ (error-data-callback tess error-number polygon-data)))
+
+(defcallback %combine-data-callback :void ((coords (:pointer %gl:double)) (vertex-data-pointer :pointer) (weight (:pointer %gl:float)) (out-data :pointer) (polygon-data-pointer :pointer))
+ (let* ((tess (get-tessellator polygon-data-pointer))
+ (polygon-data (get-polygon-data tess polygon-data-pointer))
+ (coords-array (gl::make-gl-array-from-pointer coords '%gl:double 3))
+ (vertex-data-array (->combine-vertex-data-array tess vertex-data-pointer))
+ (weight-array (gl::make-gl-array-from-pointer weight '%gl:float 4))
+ (combined-result (combine-data-callback tess coords-array vertex-data-array weight-array polygon-data))
+ (combined-result-pointer (vertex-data-to-pointer tess combined-result)))
+ (setf (cffi:mem-ref out-data :pointer) combined-result-pointer)))
+
+;;;; Functions
+(defun register-callbacks (tess)
+ "When creating an object instance check what methods it specializes and regiser appropriate callbacks for each of them."
+ (loop for tess-callback in *tess-callbacks*
+ when (compute-applicable-methods
+ (tess-callback-generic-function tess-callback)
+ (cons tess (loop repeat (tess-callback-arg-count tess-callback) collect t)))
+ do (glu-tess-callback (glu-tessellator tess)
+ (tess-callback-callback-type tess-callback)
+ (get-callback (tess-callback-callback tess-callback)))))
+
+(defun save-data-to-free (data-to-free tess)
+ (when (and (pointerp data-to-free)
+ (not (null-pointer-p data-to-free)))
+ (push data-to-free (data tess))))
+
+(defun free-tess-data (tess)
+ "Free data allocated with tess-vertex and tess-combine-callback"
+ (loop for pointer in (data tess)
+ when (and (pointerp pointer)
+ (not (null-pointer-p pointer)))
+ do (foreign-free pointer))
+ (setf (data tess) nil)
+ (clrhash (vertex-data tess))
+ (clrhash (polygon-data tess)))
+
+(defun vertex-data-to-pointer (tess vertex-data)
+ (let* ((vertex-data-id
+ (or (loop for value being the hash-values of (vertex-data tess)
+ using (hash-key key)
+ when (eq value vertex-data)
+ return key)
+ (hash-table-count (vertex-data tess))))
+ (vertex-data-pointer (foreign-alloc :uint64 :initial-element vertex-data-id)))
+
+ (setf (gethash vertex-data-id (vertex-data tess)) vertex-data)
+ (save-data-to-free vertex-data-pointer tess)
+ vertex-data-pointer))
+
+(defun ->combine-vertex-data-array (tess vertex-data)
+ (let ((result (make-array 4)))
+ (loop for i from 0 below 4
+ do (setf (aref result i)
+ (get-vertex-data tess (mem-aref vertex-data ':pointer i))))
+ result))
+
+(defun coords-to-pointer (coords)
+ (etypecase coords
+ (sequence
+ (let* ((coords-length (length coords))
+ (pointer (foreign-alloc '%gl:double :count coords-length)))
+ (etypecase coords
+ (list
+ (loop for elt in coords
+ for i from 0
+ do (setf (mem-aref pointer '%gl:double i)
+ (float elt))))
+ (vector
+ (loop for elt across coords
+ for i from 0
+ do (setf (mem-aref pointer '%gl:double i)
+ (float elt)))))
+ pointer))
+ (gl:gl-array
+ (if (not (equal (gl::gl-array-type coords) '%gl:double))
+ (error "Coordinates must have type gl:double")
+ (gl::gl-array-pointer coords)))))
+
+(defun get-tessellator (polygon-data-pointer)
+ (unless (null-pointer-p polygon-data-pointer)
+ (let ((tessellator-id (mem-aref polygon-data-pointer :uint64 0)))
+ (or
+ (gethash tessellator-id *tessellators*)
+ (error "Unable to get tessellator with id ~a" tessellator-id)))))
+
+(defun get-polygon-data (tess polygon-data-pointer)
+ (unless (null-pointer-p polygon-data-pointer)
+ (let ((polygon-data-id (mem-aref polygon-data-pointer :uint64 1)))
+ (gethash polygon-data-id (polygon-data tess)))))
+
+(defun get-vertex-data (tess vertex-data-pointer)
+ (unless (null-pointer-p vertex-data-pointer)
+ (let ((vertex-data-id (mem-ref vertex-data-pointer :uint64)))
+ (gethash vertex-data-id (vertex-data tess)))))
+
+;;Initialize information about defined callbacks. The actual definition is handled separately.
+(init-tessellation-callbacks
+ (begin-data-callback :begin-data 2)
+ (edge-flag-data-callback :edge-flag-data 2)
+ (end-data-callback :end-data 1)
+ (vertex-data-callback :vertex-data 2)
+ (error-data-callback :error-data 2)
+ (combine-data-callback :combine-data 4))
View
30 glu/package.lisp
@@ -40,9 +40,14 @@
#:quadric-texture
#:quadric-orientation
#:quadric-normals
+ #:quadric-draw-style
#:new-quadric
+ #:delete-quadric
#:quadric-normals
#:sphere
+ #:cylinder
+ #:disk
+ #:partial-disk
#:build-2d-mipmaps
#:get-string
#:check-extension
@@ -53,4 +58,27 @@
#:pick-matrix
#:project
#:un-project
- #:un-project4))
+ #:un-project4
+ ;; Tessellation
+ #:tessellator
+ #:tess-delete
+ ;; Tessellator methods
+ #:tess-begin-polygon
+ #:tess-begin-contour
+ #:tess-vertex
+ #:tess-end-contour
+ #:tess-end-polygon
+ #:tess-begin
+ #:tess-error
+ #:tess-end
+ #:tess-property
+ ;; Tessellator callbacks
+ #:begin-data-callback
+ #:edge-flag-data-callback
+ #:end-data-callback
+ #:vertex-data-callback
+ #:error-data-callback
+ #:combine-data-callback
+ ;; Tessellator macros
+ #:with-tess-polygon
+ #:with-tess-contour))
Something went wrong with that request. Please try again.