Permalink
Browse files

CL-GLUT update

- Fix foreign-symbol-pointer usage in glut/fonts.lisp.
- Move enums next to the DEFCFUNs where they're used.
- Rework the CL-GLUT CLOS interface.
- Reorganize examples and rewrite them using the updated CLOS interface.

darcs-hash:20060624235928-28748-1313f74037779aec829a3f2e5041b6638e9d9c2c.gz
  • Loading branch information...
1 parent 751d353 commit d19d431fa11b2de049c81dbf01140f7af91a9cc0 @luismbo luismbo committed Jun 24, 2006
Showing with 893 additions and 775 deletions.
  1. +4 −0 README
  2. +28 −27 cl-glut-examples.asd
  3. +11 −12 cl-glut.asd
  4. +0 −6 examples/README
  5. +34 −0 examples/examples.lisp
  6. +11 −13 examples/mesademos/gears.lisp
  7. +0 −7 examples/mesademos/package.lisp
  8. +8 −11 examples/misc/glut-teapot.lisp
  9. +0 −8 examples/misc/package.lisp
  10. +38 −0 examples/redbook/COPYRIGHT
  11. +10 −14 examples/redbook/{rb7-clip.lisp → clip.lisp}
  12. +10 −13 examples/redbook/{rb5-cube.lisp → cube.lisp}
  13. +8 −12 examples/redbook/{rb2-double.lisp → double.lisp}
  14. +44 −0 examples/redbook/hello.lisp
  15. +10 −13 examples/redbook/{rb3-lines.lisp → lines.lisp}
  16. +10 −13 examples/redbook/{rb10-list.lisp → list.lisp}
  17. +9 −13 examples/redbook/{rb6-model.lisp → model.lisp}
  18. +9 −13 examples/redbook/{rb13-movelight.lisp → movelight.lisp}
  19. +0 −48 examples/redbook/package.lisp
  20. +10 −13 examples/redbook/{rb8-planet.lisp → planet.lisp}
  21. +9 −12 examples/redbook/{rb4-polys.lisp → polys.lisp}
  22. +0 −48 examples/redbook/rb1-hello.lisp
  23. +10 −13 examples/redbook/{rb9-robot.lisp → robot.lisp}
  24. +10 −14 examples/redbook/{rb12-smooth.lisp → smooth.lisp}
  25. +11 −14 examples/redbook/{rb11-stroke.lisp → stroke.lisp}
  26. +113 −0 examples/redbook/varray.lisp
  27. +35 −0 gl/util.lisp
  28. +66 −1 glut/callbacks.lisp
  29. +10 −9 glut/fonts.lisp
  30. +7 −22 glut/init.lisp
  31. +187 −126 glut/interface.lisp
  32. +2 −2 glut/library.lisp
  33. +1 −0 glut/main.lisp
  34. +29 −7 glut/misc.lisp
  35. +4 −0 glut/overlay.lisp
  36. +120 −0 glut/state.lisp
  37. +0 −271 glut/types.lisp
  38. +25 −0 glut/window.lisp
View
4 README
@@ -1,3 +1,7 @@
cl-opengl is a set of bindings and utilities for accessing the OpenGL,
GLU and GLUT APIs using CFFI.
+The examples/ directory contains a couple of examples using cl-glut,
+cl-opengl and cl-glu. Note, however, that you can use each of these
+independently. In particular, you can use a windowing toolkit other
+than (Free)GLUT, if you wish.
View
@@ -40,38 +40,39 @@
:components
((:module "examples"
:components
- ((:module "redbook"
+ ((:file "examples")
+ (:module "redbook"
+ :depends-on ("examples")
:components
- ((:file "package")
- (:file "rb1-hello" :depends-on ("package"))
- (:file "rb2-double" :depends-on ("package"))
- (:file "rb3-lines" :depends-on ("package"))
- (:file "rb4-polys" :depends-on ("package"))
- (:file "rb5-cube" :depends-on ("package"))
- (:file "rb6-model" :depends-on ("package"))
- (:file "rb7-clip" :depends-on ("package"))
- (:file "rb8-planet" :depends-on ("package"))
- (:file "rb9-robot" :depends-on ("package"))
- (:file "rb10-list" :depends-on ("package"))
- (:file "rb11-stroke" :depends-on ("package"))
- (:file "rb12-smooth" :depends-on ("package"))
- (:file "rb13-movelight" :depends-on ("package"))))
+ ((:file "hello")
+ (:file "double")
+ (:file "lines")
+ (:file "polys")
+ (:file "cube")
+ (:file "model")
+ (:file "clip")
+ (:file "planet")
+ (:file "robot")
+ (:file "list")
+ (:file "stroke")
+ (:file "smooth")
+ (:file "movelight")))
(:module "mesademos"
+ :depends-on ("examples")
:components
((:file "gears-raw")
- (:file "package")
- #+nil(:file "bounce" :depends-on ("mesademos"))
- #+nil(:file "gamma" :depends-on ("mesademos"))
- (:file "gears" :depends-on ("package"))
- #+nil(:file "offset" :depends-on ("mesademos"))
- #+nil(:file "reflect" :depends-on ("mesademos"))
- #+nil(:file "spin" :depends-on ("mesademos"))
- #+nil(:file "tess-demo" :depends-on ("mesademos"))
- #+nil(:file "texobj" :depends-on ("mesademos"))
- #+nil(:file "trdemo" :depends-on ("mesademos"))))
+ #+nil(:file "bounce")
+ #+nil(:file "gamma")
+ (:file "gears")
+ #+nil(:file "offset")
+ #+nil(:file "reflect")
+ #+nil(:file "spin")
+ #+nil(:file "tess-demo")
+ #+nil(:file "texobj")
+ #+nil(:file "trdemo")))
(:module "misc"
+ :depends-on ("examples")
:components
- ((:file "package")
- (:file "glut-teapot" :depends-on ("package"))))))))
+ ((:file "glut-teapot")))))))
;;; vim: ft=lisp et
View
@@ -45,18 +45,17 @@
:components
((:file "package")
(:file "library" :depends-on ("package"))
- (:file "types" :depends-on ("library"))
- (:file "state" :depends-on ("types"))
- (:file "init" :depends-on ("types" "state"))
- (:file "main" :depends-on ("types" "init"))
- (:file "window" :depends-on ("types"))
- (:file "overlay" :depends-on ("types"))
- (:file "menu" :depends-on ("types"))
- (:file "callbacks" :depends-on ("types"))
- (:file "misc" :depends-on ("types"))
- (:file "fonts" :depends-on ("types"))
- (:file "geometry" :depends-on ("types"))
+ (:file "state" :depends-on ("library"))
+ (:file "init" :depends-on ("library" "state"))
+ (:file "main" :depends-on ("library" "init"))
+ (:file "window" :depends-on ("library"))
+ (:file "overlay" :depends-on ("library"))
+ (:file "menu" :depends-on ("library"))
+ (:file "callbacks" :depends-on ("library"))
+ (:file "misc" :depends-on ("library"))
+ (:file "fonts" :depends-on ("library"))
+ (:file "geometry" :depends-on ("library"))
(:file "interface"
- :depends-on ("init" "main" "window" "types" "callbacks"))))))
+ :depends-on ("init" "main" "window" "library" "callbacks"))))))
;; vim: ft=lisp et
View
@@ -1,6 +0,0 @@
-These sub-directories contain a couple of examples using cl-glut,
-cl-opengl and cl-glu. Note, however, that you can use each of these
-independently.
-
-In particular, you can use a windowing toolkit other than (Free)GLUT,
-if you wish.
View
@@ -0,0 +1,34 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+
+(defpackage #:cl-glut-examples
+ (:use #:cl)
+ (:export #:list-examples #:run-examples))
+
+(in-package #:cl-glut-examples)
+
+(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)
+ ("Mesa Demos"
+ gears)
+ ("SGI Samples")
+ ("Other Examples"
+ glut-teapot)))
+
+;;; export symbols
+(dolist (section +examples+)
+ (export (cdr section) '#:cl-glut-examples))
+
+(defun list-examples ()
+ (format t "~&CL-GLUT-EXAMPLES contains the following examples:~%~%")
+ (dolist (section +examples+)
+ (format t "~&~A:~%~{~@[~<~%~:; ~:@(~A~)~>~]~}~%~%"
+ (car section) (cdr section))))
+
+(defun run-examples ()
+ "Run all the cl-glut examples."
+ (let ((glut:*run-main-loop-after-display* nil))
+ (dolist (section +examples+)
+ (mapc #'funcall (cdr section)))
+ (glut:main-loop)))
@@ -5,7 +5,7 @@
;;; (lispier version)
-(in-package #:mesademos)
+(in-package #:cl-glut-examples)
;(declaim (optimize (speed 3) (safety 0) (compilation-speed 0) (debug 0)))
@@ -121,9 +121,10 @@
gear1 gear2 gear3
(angle :initform 0.0)
(count :initform 1)
- (t0 :initform 0)))
+ (t0 :initform 0))
+ (:default-initargs :title "Gears" :mode '(:double :rgb :depth)))
-(defmethod initialize-instance :after ((window gears-window) &key)
+(defmethod glut:display-window :before ((window gears-window))
(with-slots (gear1 gear2 gear3) window
(gl:light :light0 :position #(5.0 5.0 10.0 0.0))
(gl:enable :cull-face :lighting :light0 :depth-test)
@@ -189,10 +190,11 @@
(defmethod glut:keyboard ((window gears-window) key x y)
(declare (ignore x y))
(case key
- (#\z (incf (slot-value window 'view-rotz) 5.0))
- (#\Z (decf (slot-value window 'view-rotz) 5.0))
- (#\Esc (glut:leave-main-loop)))
- (glut:post-redisplay))
+ (#\z (incf (slot-value window 'view-rotz) 5.0)
+ (glut:post-redisplay))
+ (#\Z (decf (slot-value window 'view-rotz) 5.0)
+ (glut:post-redisplay))
+ (#\Esc (glut:destroy-current-window))))
(defmethod glut:special ((window gears-window) special-key x y)
(declare (ignore x y))
@@ -204,7 +206,7 @@
(:key-right (decf view-roty 5.0)))
(glut:post-redisplay)))
-(defmethod glut:reshape ((window gears-window) width height)
+(defmethod glut:reshape ((w gears-window) width height)
(gl:viewport 0 0 width height)
(gl:matrix-mode :projection)
(gl:load-identity)
@@ -220,8 +222,4 @@
(t (glut:disable-event w :idle))))
(defun gears ()
- (glut:init-display-mode :double :rgb :depth)
- (make-instance 'gears-window :title "Gears"
- :events '(:visibility :reshape :special
- :keyboard :display :idle))
- (glut:main-loop))
+ (glut:display-window (make-instance 'gears-window)))
@@ -1,7 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-
-(in-package #:cl-user)
-
-(defpackage #:mesademos
- (:use #:cl)
- (:export #:gears))
@@ -1,12 +1,14 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;; glut-teapot.lisp --- Simple usage of glut:solid-teapot.
-(in-package #:misc-glut-examples)
+(in-package #:cl-glut-examples)
(defclass glut-teapot-window (glut:window)
- ())
+ ()
+ (:default-initargs :width 250 :height 250 :title "glut-teapot.lisp"
+ :mode '(:single :rgb :depth)))
-(defmethod initialize-instance :after ((w glut-teapot-window) &key)
+(defmethod glut:display-window :before ((w glut-teapot-window))
(gl:clear-color 0 0 0 0)
(gl:cull-face :back)
(gl:depth-func :less)
@@ -40,12 +42,7 @@
(defmethod glut:keyboard ((window glut-teapot-window) key x y)
(declare (ignore x y))
(when (eql key #\Esc)
- (glut:leave-main-loop)))
+ (glut:destroy-current-window)))
-(defun teapot ()
- (glut:init-display-mode :single :rgb :depth)
- (make-instance 'glut-teapot-window
- :width 250 :height 250
- :title "glut-teapot.lisp"
- :events '(:display :keyboard :reshape))
- (glut:main-loop))
+(defun glut-teapot ()
+ (glut:display-window (make-instance 'glut-teapot-window)))
@@ -1,8 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;; package.lisp --- Package definition for misc-glut-examples.
-
-(in-package #:cl-user)
-
-(defpackage #:misc-glut-examples
- (:use #:cl)
- (:export #:teapot))
View
@@ -0,0 +1,38 @@
+The original Red Book examples carry the following copyright and
+permission notices:
+
+Copyright (c) 1993-1997, Silicon Graphics, Inc.
+ALL RIGHTS RESERVED
+
+Permission to use, copy, modify, and distribute this software for any
+purpose and without fee is hereby granted, provided that the above
+copyright notice appear in all copies and that both the copyright
+notice and this permission notice appear in supporting documentation,
+and that the name of Silicon Graphics, Inc. not be used in advertising
+or publicity pertaining to distribution of the software without
+specific, written prior permission.
+
+THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS" AND
+WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE, INCLUDING
+WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR FITNESS FOR A
+PARTICULAR PURPOSE. IN NO EVENT SHALL SILICON GRAPHICS, INC. BE
+LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT, SPECIAL, INCIDENTAL,
+INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY KIND, OR ANY DAMAGES
+WHATSOEVER, INCLUDING WITHOUT LIMITATION, LOSS OF PROFIT, LOSS OF USE,
+SAVINGS OR REVENUE, OR THE CLAIMS OF THIRD PARTIES, WHETHER OR NOT
+SILICON GRAPHICS, INC. HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+LOSS, HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ARISING OUT OF OR
+IN CONNECTION WITH THE POSSESSION, USE OR PERFORMANCE OF THIS
+SOFTWARE.
+
+US Government Users Restricted Rights
+
+Use, duplication, or disclosure by the Government is subject to
+restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
+(c)(1)(ii) of the Rights in Technical Data and Computer Software
+clause at DFARS 252.227-7013 and/or in similar or successor clauses in
+the FAR or the DOD or NASA FAR Supplement. Unpublished-- rights
+reserved under the copyright laws of the United States.
+Contractor/manufacturer is Silicon Graphics, Inc., 2011 N. Shoreline
+Blvd., Mountain View, CA 94039-7311. OpenGL(R) is a registered
+trademark of Silicon Graphics, Inc.
@@ -1,18 +1,20 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;; rb7-clip.lisp --- Lisp version of clip.c (Red Book examples)
+;;; clip.lisp --- Lisp version of clip.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 arbitrary clipping planes.
-(in-package #:redbook-examples)
+(in-package #:cl-glut-examples)
(defclass clip-window (glut:window)
- ())
+ ()
+ (:default-initargs :pos-x 100 :pos-y 100 :width 500 :height 500
+ :mode '(:single :rgb) :title "clip.lisp"))
-(defmethod initialize-instance :after ((w clip-window) &key)
+(defmethod glut:display-window :before ((w clip-window))
(gl:clear-color 0 0 0 0)
(gl:shade-model :flat))
@@ -42,13 +44,7 @@
(defmethod glut:keyboard ((w clip-window) key x y)
(declare (ignore x y))
(when (eql key #\Esc)
- (glut:leave-main-loop)))
-
-(defun rb7 ()
- (glut:init-display-mode :single :rgb)
- (make-instance 'clip-window
- :pos-x 100 :pos-y 100
- :width 500 :height 500
- :title "rb7-clip.lisp"
- :events '(:display :reshape :keyboard))
- (glut:main-loop))
+ (glut:destroy-current-window)))
+
+(defun rb-clip ()
+ (glut:display-window (make-instance 'clip-window)))
@@ -1,5 +1,5 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;; rb5-cube.lisp --- Lisp version of cube.c (Red Book examples)
+;;; cube.lisp --- Lisp version of cube.c (Red Book examples)
;;;
;;; Original C version contains the following copyright notice:
;;; Copyright (c) 1993-1997, Silicon Graphics, Inc.
@@ -9,12 +9,14 @@
;;; GL:SCALE and a single viewing transformation, GLU:LOOK-AT.
;;; A wireframe cube is rendered.
-(in-package #:redbook-examples)
+(in-package #:cl-glut-examples)
(defclass cube-window (glut:window)
- ())
+ ()
+ (:default-initargs :width 500 :height 500 :title "cube.lisp"
+ :mode '(:single :rgb)))
-(defmethod initialize-instance :after ((w cube-window) &key)
+(defmethod glut:display-window :before ((w cube-window))
(gl:clear-color 0 0 0 0)
(gl:shade-model :flat))
@@ -39,12 +41,7 @@
(defmethod glut:keyboard ((w cube-window) key x y)
(declare (ignore x y))
(when (eql key #\Esc)
- (glut:leave-main-loop)))
-
-(defun rb5 ()
- (glut:init-display-mode :single :rgb)
- (make-instance 'cube-window
- :width 500 :height 500
- :title "rb5-cube.lisp"
- :events '(:display :reshape :keyboard))
- (glut:main-loop))
+ (glut:destroy-current-window)))
+
+(defun rb-cube ()
+ (glut:display-window (make-instance 'cube-window)))
Oops, something went wrong.

0 comments on commit d19d431

Please sign in to comment.