- cello-cvs@common-lisp.net - mailman3.common-lisp.net

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 01 Oct '06

01 Oct '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv14796 Modified Files: kt-opengl.lisp Log Message: Code cleanup. --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/10/01 12:29:44 1.7 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/10/01 13:03:32 1.8 @@ -21,7 +21,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Id: kt-opengl.lisp,v 1.7 2006/10/01 12:29:44 fgoenninger Exp $ +;;; $Id: kt-opengl.lisp,v 1.8 2006/10/01 13:03:32 fgoenninger Exp $ (pushnew :kt-opengl *features*) @@ -127,25 +127,3 @@ when (zerop ec) do (cells::trc "kt-opengl-reset sees zero error code") (loop-finish) do (cells::trc "kt-opengl-init sees error" ec))) - -(defun gl-boolean-test (value) - #+allegro (not (eql value #\null)) - #-allegro (not (zerop value))) - -(defun dump-lists (min max) - (loop with start - and end - for lx from min to max - when (let ((is (gl-is-list lx))) - (when (gl-boolean-test is) - (print (list "dl test" lx is (char-code is)))) - (gl-boolean-test is)) - do (if start - (if end - (if (eql lx (1+ end)) - (setf end lx) - (print `(gl ,start to ,end))) - (if (eql lx (1+ start)) - (setf end lx) - (print `(gl ,start)))) - (setf start lx))))

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 01 Oct '06

01 Oct '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv9580 Modified Files: ogl-utils.lisp Log Message: Code cleanup. --- /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/08/28 18:36:40 1.6 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/10/01 12:30:14 1.7 @@ -22,7 +22,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Id: ogl-utils.lisp,v 1.6 2006/08/28 18:36:40 fgoenninger Exp $ +;;; $Id: ogl-utils.lisp,v 1.7 2006/10/01 12:30:14 fgoenninger Exp $ (in-package :kt-opengl) @@ -252,3 +252,25 @@ (if (consp arg) (mapcan 'flatten arg) (list arg))) args)) + +(defun gl-boolean-test (value) + #+allegro (not (eql value #\null)) + #-allegro (not (zerop value))) + +(defun dump-lists (min max) + (loop with start + and end + for lx from min to max + when (let ((is (gl-is-list lx))) + (when (gl-boolean-test is) + (print (list "dl test" lx is (char-code is)))) + (gl-boolean-test is)) + do (if start + (if end + (if (eql lx (1+ end)) + (setf end lx) + (print `(gl ,start to ,end))) + (if (eql lx (1+ start)) + (setf end lx) + (print `(gl ,start)))) + (setf start lx))))

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 01 Oct '06

01 Oct '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv9463 Modified Files: ogl-macros.lisp Log Message: Code cleanup. --- /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/08/28 21:45:28 1.8 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/10/01 12:30:01 1.9 @@ -24,9 +24,6 @@ (in-package :kt-opengl) -(eval-when (:compile-toplevel :load-toplevel :execute) - (export '(with-gl-translation))) - (defvar *stack-depth* (fgn-alloc :int 1 :ignore)) @@ -127,15 +124,6 @@ ,@body (gl-translatef (- ,dx)(- ,dy)(- ,dz)))))) - - -(defun kt-opengl-reset () - (loop for ec = (glgeterror) - for n below 10 - when (zerop ec) do (cells::trc "kt-opengl-reset sees zero error code") - (loop-finish) - do (cells::trc "kt-opengl-init sees error" ec))) - (defun glec (&optional (id :anon) announce-success) (if (and (boundp '*gl-begun*) *gl-begun*) (progn (cells:trc nil "not checking error inside gl.begin" id))

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 01 Oct '06

01 Oct '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv9432 Modified Files: kt-opengl.lisp Log Message: Code cleanup. --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/08/28 21:45:27 1.6 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/10/01 12:29:44 1.7 @@ -21,86 +21,88 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Id: kt-opengl.lisp,v 1.6 2006/08/28 21:45:27 ktilton Exp $ +;;; $Id: kt-opengl.lisp,v 1.7 2006/10/01 12:29:44 fgoenninger Exp $ (pushnew :kt-opengl *features*) (defpackage #:kt-opengl (:nicknames #:ogl) (:use #:common-lisp #:cffi #:ffx) - (:export #:*ogl-listing-p* - #:glut-get-window - #:glut-set-window - #:glut-post-redisplay + (:export + + #:kt-opengl-init + #:kt-opengl-reset + #:glec + + #:*ogl-listing-p* + #:*selecting* + #:with-matrix #:with-attrib #:with-client-attrib #:with-gl-begun + #:with-gl-param + #:with-bitmap-shifted + #:with-gl-parami + #:with-gl-paramf + #:with-gl-paramd + #:with-gl-integers + #:with-gl-floats + #:with-gl-doubles + #:with-display-list + #:with-gl-translation + #:gl-pushm #:gl-popm - #:glut-callback-set - #:kt-opengl-init + #:closed-stream-p - #:*selecting* - #:kt-opengl-reset - #:kt-opengl-set-home-dir - #:kt-opengl-get-home-dir - #:cl-glut-set-home-dir - #:cl-glut-get-home-dir - #:kt-opengl-set-gl-dll-filename - #:kt-opengl-get-gl-dll-filename - #:kt-opengl-set-glu-dll-filename - #:kt-opengl-get-glu-dll-filename - #:cl-glut-set-dll-filename - #:cl-glut-get-dll-filename + + #:ncalc-normalf + #:ncalc-normalfv + + #:ogl-get-int + #:ogl-get-boolean + + #:v3f + #:make-v3f + #:v3f-x + #:v3f-y + #:v3f-z + + #:xlin + #:xlout + #:farther + #:nearer + + #:texture-name #:ogl-texture - #:ncalc-normalf #:ncalc-normalfv #:ogl-get-int #:ogl-get-boolean - #:v3f #:make-v3f #:v3f-x #:v3f-y #:v3f-z - #:with-gl-param #:xlin #:xlout - #:farther #:nearer - #:ogl-texture-delete #:ogl-texture-gen #:ogl-tex-gen-setup - #:ogl-bounds #:ogl-scissor-box #:ogl-raster-pos-get - #:ogl-pen-move #:with-bitmap-shifted - #:texture-name #:ogl-list-cache #:ogl-lists-delete - #:eltgli #:ogl-tex-activate #:gl-name #:glec + #:ogl-texture-gen + #:ogl-texture-delete + #:ogl-tex-gen-setup + #:ogl-tex-activate + + #:ogl-bounds + #:ogl-scissor-box + #:ogl-raster-pos-get + + #:ogl-pen-move + + #:ogl-list-cache + #:ogl-lists-delete + + #:eltgli + + #:gl-name #:gl-get-integers #:gl-get-floats #:gl-get-doubles - #:with-gl-parami - #:with-gl-paramf - #:with-gl-paramd - #:with-gl-integers - #:with-gl-floats - #:with-gl-doubles - #:with-display-list )) (in-package :kt-opengl) (defvar *selecting*) -(defparameter *win32-opengl-loc* (namestring - (make-pathname - ;;#+lispworks :host #-lispworks :device "c" - :directory '(:absolute "windows" "system32") - :name "opengl32" - :type "dll"))) - -(defparameter *win32-glu-loc* (namestring - (make-pathname - ;;#+lispworks :host #-lispworks :device "c" - :directory '(:absolute "windows" "system32") - :name "opengl32" - :type "dll"))) - -(define-foreign-library OpenGL - (:windows (:or "/windows/system32/opengl32.dll")) - (:darwin (:or (:framework "OpenGL")))) - -(define-foreign-library GLU - (:windows (:or "/windows/system32/glu32.dll"))) - (defparameter *opengl-dll* nil) (defun kt-opengl-init () @@ -119,6 +121,13 @@ (eval-when (:load-toplevel :execute) (kt-opengl-init)) +(defun kt-opengl-reset () + (loop for ec = (glgeterror) + for n below 10 + when (zerop ec) do (cells::trc "kt-opengl-reset sees zero error code") + (loop-finish) + do (cells::trc "kt-opengl-init sees error" ec))) + (defun gl-boolean-test (value) #+allegro (not (eql value #\null)) #-allegro (not (zerop value)))

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 01 Oct '06

01 Oct '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv9393 Modified Files: kt-opengl.asd Log Message: Added: New files defpackage and kt-opengl-config. --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.asd 2006/09/16 19:17:09 1.3 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.asd 2006/10/01 12:29:24 1.4 @@ -15,7 +15,9 @@ :long-description "Poorly implemented bindings to half of OpenGL" :depends-on (:cffi-extender :cells) :serial t - :components ((:file "kt-opengl") + :components ((:file "defpackage") + (:file "kt-opengl-config") + (:file "kt-opengl") (:file "gl-def") (:file "gl-constants") (:file "gl-functions")

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 01 Oct '06

01 Oct '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv9341 Added Files: defpackage.lisp Log Message: Added to CVS. --- /project/cello/cvsroot/cello/kt-opengl/defpackage.lisp 2006/10/01 12:28:58 NONE +++ /project/cello/cvsroot/cello/kt-opengl/defpackage.lisp 2006/10/01 12:28:58 1.1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; Copyright © 2004 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. ;;; $Id: defpackage.lisp,v 1.1 2006/10/01 12:28:58 fgoenninger Exp $ (pushnew :kt-opengl *features*) (defpackage #:kt-opengl (:nicknames #:ogl) (:use #:common-lisp #:cffi #:ffx) (:export #:kt-opengl-init #:kt-opengl-reset #:glec #:*ogl-listing-p* #:*selecting* #:with-matrix #:with-attrib #:with-client-attrib #:with-gl-begun #:with-gl-param #:with-bitmap-shifted #:with-gl-parami #:with-gl-paramf #:with-gl-paramd #:with-gl-integers #:with-gl-floats #:with-gl-doubles #:with-display-list #:with-gl-translation #:gl-pushm #:gl-popm #:closed-stream-p #:ncalc-normalf #:ncalc-normalfv #:ogl-get-int #:ogl-get-boolean #:v3f #:make-v3f #:v3f-x #:v3f-y #:v3f-z #:xlin #:xlout #:farther #:nearer #:texture-name #:ogl-texture #:ogl-texture-gen #:ogl-texture-delete #:ogl-tex-gen-setup #:ogl-tex-activate #:ogl-bounds #:ogl-scissor-box #:ogl-raster-pos-get #:ogl-pen-move #:ogl-list-cache #:ogl-lists-delete #:eltgli #:gl-name #:gl-get-integers #:gl-get-floats #:gl-get-doubles ))

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 01 Oct '06

01 Oct '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv9289 Added Files: kt-opengl-config.lisp Log Message: Added: CFFI foreign lib definitions. --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl-config.lisp 2006/10/01 12:28:20 NONE +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl-config.lisp 2006/10/01 12:28:20 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cello; -*- ;;; ;;; Copyright © 2004 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal ;;; in the Software without restriction, including without limitation the rights ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;;; copies of the Software, and to permit persons to whom the Software is furnished ;;; to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. (in-package :kt-opengl) (define-foreign-library OpenGL (:windows (:or "/windows/system32/opengl32.dll")) (:darwin (:or (:framework "OpenGL")))) (define-foreign-library GLU (:windows (:or "/windows/system32/glu32.dll")))

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 01 Oct '06

01 Oct '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv19248 Removed Files: cl-opengl-config.lisp Log Message: Removed.

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 01 Oct '06

01 Oct '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv19208 Removed Files: cl-opengl-config-2.lisp Log Message: Removed.

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 01 Oct '06

01 Oct '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv17675 Modified Files: colors.lisp Log Message: Added: Constant +NO-COLOR-CHANGE+ for macro with-color. --- /project/cello/cvsroot/cello/kt-opengl/colors.lisp 2006/09/19 11:27:07 1.3 +++ /project/cello/cvsroot/cello/kt-opengl/colors.lisp 2006/10/01 09:34:08 1.4 @@ -20,7 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER ;;; DEALINGS IN THE SOFTWARE. ;;; -;;; $Id: colors.lisp,v 1.3 2006/09/19 11:27:07 fgoenninger Exp $ +;;; $Id: colors.lisp,v 1.4 2006/10/01 09:34:08 fgoenninger Exp $ (in-package #:kt-opengl) @@ -176,16 +176,18 @@ (defmacro with-color (rgba &body body) (let ((ptr (gensym))) - `(with-foreign-object (,ptr 'glint 4) - (gl-get-integerv GL_CURRENT_COLOR ,ptr) - (unwind-protect - (progn - (set-color ,rgba) - ,@body) - (glcolor4i (mem-aref ,ptr 'glint 0) - (mem-aref ,ptr 'glint 1) - (mem-aref ,ptr 'glint 2) - (mem-aref ,ptr 'glint 3)))))) + `(if ,rgba + (with-foreign-object (,ptr 'glint 4) + (gl-get-integerv GL_CURRENT_COLOR ,ptr) + (unwind-protect + (progn + (set-color ,rgba) + ,@body) + (glcolor4i (mem-aref ,ptr 'glint 0) + (mem-aref ,ptr 'glint 1) + (mem-aref ,ptr 'glint 2) + (mem-aref ,ptr 'glint 3)))) + ,@body))) ;;; --------------------------------------------------------------------------- ;;; EXPORT SYMBOLS @@ -207,12 +209,16 @@ make-opengl-rgba rgba-clear-color *known-colors* + +NO-COLOR-CHANGE+ ) ;;; =========================================================================== ;;; Color definitions ;;; =========================================================================== +(defconstant +NO-COLOR-CHANGE+ nil + "Macro WITH-COLOR uses NIL as a discriminator for determining when to not change color but just to execute the body") + ;;; RGBA simple colors (define-ogl-rgba-color +RED+ 255 0 0 255)

1 0