October 2004 - cells-cvs@common-lisp.net - mailman3.common-lisp.net

[cells-cvs] CVS update: cell-cultures/config/cellocore-config.lisp
by Kenny Tilton 21 Oct '04

21 Oct '04

Update of /project/cells/cvsroot/cell-cultures/config In directory common-lisp.net:/tmp/cvs-serv30733/config Removed Files: cellocore-config.lisp Log Message: cleaning up config process Date: Thu Oct 21 19:50:20 2004 Author: ktilton

1 0

[cells-cvs] CVS update: cell-cultures/cl-opengl/ogl-utils.lisp
by Kenny Tilton 19 Oct '04

19 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cl-opengl In directory common-lisp.net:/tmp/cvs-serv12927/cl-opengl Modified Files: ogl-utils.lisp Log Message: Delete copy of celtic mainly Date: Tue Oct 19 05:47:37 2004 Author: ktilton Index: cell-cultures/cl-opengl/ogl-utils.lisp diff -u cell-cultures/cl-opengl/ogl-utils.lisp:1.3 cell-cultures/cl-opengl/ogl-utils.lisp:1.4 --- cell-cultures/cl-opengl/ogl-utils.lisp:1.3 Fri Oct 15 05:37:55 2004 +++ cell-cultures/cl-opengl/ogl-utils.lisp Tue Oct 19 05:47:37 2004 @@ -244,3 +244,15 @@ (if (consp arg) (mapcan 'flatten arg) (list arg))) args)) + + +(defparameter *dump-matrix* (fgn-alloc 'glfloat 16 :dump-matrix)) +(defun dump-matrix (matrix-id msg) + (gl-get-floatv matrix-id *dump-matrix*) + (format t "~&~a > ~a matrix> ~{~a ~}" msg + (cond ((eql matrix-id gl_modelview_matrix) 'modelview) + ((eql matrix-id GL_PROJECTION_MATRIX) 'projection)) + (loop for n below 16 collecting (eltf *dump-matrix* n)))) + + +

1 0

[cells-cvs] CVS update: cell-cultures/ffi-extender/arrays.lisp
by Kenny Tilton 19 Oct '04

19 Oct '04

Update of /project/cells/cvsroot/cell-cultures/ffi-extender In directory common-lisp.net:/tmp/cvs-serv12927/ffi-extender Modified Files: arrays.lisp Log Message: Delete copy of celtic mainly Date: Tue Oct 19 05:47:38 2004 Author: ktilton Index: cell-cultures/ffi-extender/arrays.lisp diff -u cell-cultures/ffi-extender/arrays.lisp:1.1 cell-cultures/ffi-extender/arrays.lisp:1.2 --- cell-cultures/ffi-extender/arrays.lisp:1.1 Sat Jun 26 20:38:42 2004 +++ cell-cultures/ffi-extender/arrays.lisp Tue Oct 19 05:47:37 2004 @@ -79,8 +79,6 @@ (,ptr (uffi:allocate-foreign-object ,type ,amt))) (call-fgn-alloc ,type ,amt ,ptr (list ,@keys))))) - - (defun call-fgn-alloc (type amt ptr keys) ;;(print `(fgnalloc ,type ,amt ,keys)) (fgn-ptr (car (push (make-fgn :id keys

1 0

[cells-cvs] CVS update: cell-cultures/cellodemo/cellodemo.lpr cell-cultures/cellodemo/demo-window.lisp cell-cultures/cellodemo/hedron-decoration.lisp cell-cultures/cellodemo/hedron-render.lisp
by Kenny Tilton 19 Oct '04

19 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cellodemo In directory common-lisp.net:/tmp/cvs-serv12927/cellodemo Modified Files: cellodemo.lpr demo-window.lisp hedron-decoration.lisp hedron-render.lisp Log Message: Delete copy of celtic mainly Date: Tue Oct 19 05:47:33 2004 Author: ktilton Index: cell-cultures/cellodemo/cellodemo.lpr diff -u cell-cultures/cellodemo/cellodemo.lpr:1.3 cell-cultures/cellodemo/cellodemo.lpr:1.4 --- cell-cultures/cellodemo/cellodemo.lpr:1.3 Wed Sep 29 04:50:11 2004 +++ cell-cultures/cellodemo/cellodemo.lpr Tue Oct 19 05:47:33 2004 @@ -11,8 +11,8 @@ (make-instance 'module :name "tutor-geometry.lisp") (make-instance 'module :name "light-panel.lisp") (make-instance 'module :name "hedron-render.lisp") - (make-instance 'module :name - "hedron-decoration.lisp")) + (make-instance 'module :name "hedron-decoration.lisp") + (make-instance 'module :name "virtual-human.lisp")) :projects (list (make-instance 'project-module :name "..\\cello\\cello")) :libraries nil Index: cell-cultures/cellodemo/demo-window.lisp diff -u cell-cultures/cellodemo/demo-window.lisp:1.4 cell-cultures/cellodemo/demo-window.lisp:1.5 --- cell-cultures/cellodemo/demo-window.lisp:1.4 Fri Oct 15 05:37:30 2004 +++ cell-cultures/cellodemo/demo-window.lisp Tue Oct 19 05:47:33 2004 @@ -33,7 +33,7 @@ :focus (c-in nil) :display-continuous (c-in t) :clear-rgba (list 0 0 0 1) - :lb (c-in (downs 650))))) + :lb (c-in (downs 1000))))) (defun demo-scroller () (mk-part :demo-scroller (ix-zero-tl) @@ -118,8 +118,8 @@ (:close . "close-window")) :idler nil :ll 0 :lt 0 - :lr (c-in (scr2log 900)) - :lb (c-in (scr2log -900)) + :lr (c-in (scr2log 1000)) + :lb (c-in (scr2log -1500)) :fixed-lighting (list (make-instance 'light :id gl_light6 :enabled t Index: cell-cultures/cellodemo/hedron-decoration.lisp diff -u cell-cultures/cellodemo/hedron-decoration.lisp:1.3 cell-cultures/cellodemo/hedron-decoration.lisp:1.4 --- cell-cultures/cellodemo/hedron-decoration.lisp:1.3 Fri Oct 15 05:37:30 2004 +++ cell-cultures/cellodemo/hedron-decoration.lisp Tue Oct 19 05:47:33 2004 @@ -32,7 +32,7 @@ (mk-part :spinning (ct-check-text) :title$ "spinning") (mk-part :wireframe (ct-check-text) - :md-value (c-in nil) + :md-value (c-in t) :title$ "wireframe" :clipped nil :enabled t)) @@ -86,7 +86,7 @@ (a-row () (hedron-shapes) (test-image-group :shape-backer "Backdrops" "hedron-bkgs") - (test-image-group :shape-skin "Skin" "shapers" #+not "mandelbrot")) + (test-image-group :shape-skin "Skin" "shapers" "cloudy")) (hedron-texxing))))) (defun hedron-shapes () Index: cell-cultures/cellodemo/hedron-render.lisp diff -u cell-cultures/cellodemo/hedron-render.lisp:1.3 cell-cultures/cellodemo/hedron-render.lisp:1.4 --- cell-cultures/cellodemo/hedron-render.lisp:1.3 Fri Oct 15 05:37:30 2004 +++ cell-cultures/cellodemo/hedron-render.lisp Tue Oct 19 05:47:33 2004 @@ -58,43 +58,23 @@ (draw-test-nurb nurb)) (defparameter *hill* (make-ff-array :float 0 0 0 0 1 1 1 1)) -(defparameter *hill-controls* (make-ff-array :float -3.0 -3.0 -9 -3.0 -1.0 -9 -3.0 1.0 - -9 -3.0 3.0 -9 -1.0 -3.0 -9 -1.0 -1.0 9 -1.0 1.0 9 -1.0 - 3.0 -9 1.0 -3.0 -9 1.0 -1.0 9 1.0 1.0 9 1.0 3.0 -9 3.0 - -3.0 -9 3.0 -1.0 -9 3.0 1.0 -9 3.0 3.0 -9) - #+not (loop with fv = (fgn-alloc 'glfloat 48 :testnurb) - for u below 4 do - (loop for v below 4 - for base = (+ (* u 12) (* v 3)) - do (setf (eltf fv (+ base 0)) (* 2 (- u 1.5))) - (setf (eltf fv (+ base 1)) (* 2 (- v 1.5))) - (setf (eltf fv (+ base 2)) - (* 3 (if (and (or (eql u 1)(eql u 2)) - (or (eql v 1)(eql v 2))) - 3 -3)))) - finally (return fv))) - -(defparameter *dump-matrix* (fgn-alloc 'glfloat 16 :dump-matrix)) -(defun dump-matrix (matrix-id msg) - (gl-get-floatv matrix-id *dump-matrix*) - (format t "~&~a > ~a matrix> ~{~a ~}" msg - (cond ((eql matrix-id gl_modelview_matrix) 'modelview) - ((eql matrix-id GL_PROJECTION_MATRIX) 'projection)) - (loop for n below 16 collecting (eltf *dump-matrix* n)))) - -(defun dump-viewport ( msg) - (gl-get-floatv GL_VIEWPORT *dump-matrix*) - (format t "~&~a > viewport> ~{~a ~}" msg - (loop for n below 4 collecting (eltf *dump-matrix* n)))) - -;;;glGetFloatv(GL_MODELVIEW_MATRIX,modelview); -;;; glGetFloatv(GL_PROJECTION_MATRIX,projection); -;;; glGetIntegerv(GL_VIEWPORT,viewport); -;;; gluLoadSamplingMatrices (Nurb, modelview, projection, viewport); - +(defparameter *hill-controls* + (let ((m 3) (d 2)) + (loop with fv = (fgn-alloc 'glfloat 48 :testnurb) + for u below 4 do + (loop for v below 4 + for base = (+ (* u 12) (* v 3)) + do (setf (eltf fv (+ base 0)) (- (* m u) d)) + (setf (eltf fv (+ base 1)) (- (* m v) d)) + (setf (eltf fv (+ base 2)) + (* 3 (if (and (or (eql u 1)(eql u 2)) + (or (eql v 1)(eql v 2))) + d (- d))))) + finally (return fv)))) + (defun draw-test-nurb (nurb) - (glu-nurbs-property nurb glu_sampling_tolerance 5) - (glu-nurbs-property nurb glu_auto_load_matrix gl_false) + (glu-nurbs-property nurb glu_sampling_tolerance 1) + ;(glu-nurbs-property nurb glu_auto_load_matrix gl_false) (gl-enable gl_lighting) (gl-enable gl_light0) @@ -102,11 +82,23 @@ (gl-enable gl_auto_normal) (gl-enable gl_normalize) - (gl-rotatef 330 1 0 0) + ;(gl-rotatef 330 1 0 0) (gl-scalef .25 .25 .25) (glu-begin-surface nurb) (glu-nurbs-surface nurb 8 *hill* 8 *hill* 12 3 *hill-controls* 4 4 gl_map2_vertex_3) - (glu-end-surface nurb)) + (glu-end-surface nurb) + + (gl-point-size 5) + (gl-disable gl_lighting) + (gl-color3f 1 1 0) + (gl-begin gl_points) + (loop for u below 4 do + (loop for v below 4 + for base = (+ (* u 12) (* v 3)) + do (gl-vertex3f (eltf *hill-controls* (+ base 0)) + (eltf *hill-controls* (+ base 1)) + (eltf *hill-controls* (+ base 2))))) + (gl-end)) (defparameter *sponge-offset* (loop with fv = (fgn-alloc 'gldouble 3 :sponge) for n below 3 @@ -232,6 +224,6 @@ (gl-disable gl_texture_gen_r) (gl-disable gl_texture_gen_q) - (gl-matrix-mode gl_projection)) + #+hunh (gl-matrix-mode gl_projection)) (gl-matrix-mode gl_modelview))

1 0

[cells-cvs] CVS update: cell-cultures/ftgl-int/fgc.def cell-cultures/ftgl-int/FTGLFromC.cpp cell-cultures/ftgl-int/main.cpp
by Kenny Tilton 18 Oct '04

18 Oct '04

Update of /project/cells/cvsroot/cell-cultures/ftgl-int In directory common-lisp.net:/tmp/cvs-serv23354/ftgl-int Modified Files: FTGLFromC.cpp Added Files: fgc.def Removed Files: main.cpp Log Message: Bring FTGL glue up-to-date Date: Tue Oct 19 00:16:56 2004 Author: ktilton Index: cell-cultures/ftgl-int/FTGLFromC.cpp diff -u cell-cultures/ftgl-int/FTGLFromC.cpp:1.1 cell-cultures/ftgl-int/FTGLFromC.cpp:1.2 --- cell-cultures/ftgl-int/FTGLFromC.cpp:1.1 Sat Jun 26 20:38:42 2004 +++ cell-cultures/ftgl-int/FTGLFromC.cpp Tue Oct 19 00:16:55 2004 @@ -1,7 +1,26 @@ -/* CHANGED: frgo, 2004-02-22 */ -/* $Header: /project/cells/cvsroot/cell-cultures/ftgl-int/FTGLFromC.cpp,v 1.1 2004/06/26 18:38:42 ktilton Exp $ */ - #include <assert.h> +/* +;;; +;;; 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. +*/ #include "FTGLBitmapFont.h" #include "FTBitmapGlyph.h" @@ -17,128 +36,116 @@ #include "FTGLPolygonFont.h" #include "FTPolyGlyph.h" -#include "FTGLOutlineFont.h" -#include "FTOutlineGlyph.h" - -#include "FTGLExtrdFont.h" -#include "FTExtrdGlyph.h" +#include "FTGLOutlineFont.h" +#include "FTOutlineGlyph.h" -#ifdef _WIN32 -#define __stdcall __stdcall -#else -#define __stdcall -#endif +#include "FTGLExtrdFont.h" +#include "FTExtrdGlyph.h" -// make a new extrd ctor that takes a depth parm -bool FTGLExtrdFont::FaceDepth( float new_depth ) -{ - Depth( new_depth ); - - return FaceSize( this->FaceSize(), 96 ); // force new glyphs -} -#if defined(__cplusplus) extern "C" { -#endif -bool __stdcall fgcSetFaceSize( FTFont *f, - unsigned int faceSize, - unsigned int res ) -{ - return f->FaceSize( faceSize, res ); -} -float __stdcall fgcAscender( FTFont *f ) -{ - return f->Ascender(); + void __stdcall fgcBuildGlyphs( FTFont* f ) + { + f->BuildGlyphs(); + } + + bool __stdcall fgcSetFaceSize( FTFont* f + , unsigned int faceSize + , unsigned int res ) + { + return f->FaceSize( faceSize, res ); + } + + +float __stdcall fgcAscender( FTFont* f ) { + return f->Ascender( ); } -float __stdcall fgcDescender( FTFont *f ) -{ - return f->Descender( ); +float __stdcall fgcDescender( FTFont* f ) { + return f->Descender( ); } -float __stdcall fgcStringAdvance( FTFont *f, - const char *string ) -{ - return f->Advance( string ); +float __stdcall fgcStringAdvance( FTFont* f, const char* string ) { + return f->Advance( string ); } -float __stdcall fgcStringX( FTFont *f, - const char *string ) +int __stdcall fgcCharTexture( FTFont* f, int chr ) { + return ((FTGlyph *) f->FontGlyph( chr ))->glRendering(); + //return f->GlyphRendering( chr ); +} +/* +void FTFont::DoRender( const unsigned int chr, const unsigned int nextChr) { - float llx = 0.0f; /* frgo: clean inits for all vars ! */ - float lly = 0.0f; - float llz = 0.0f; - float urx = 0.0f; - float ury = 0.0f; - float urz = 0.0f; - - f->BBox( string, llx, lly, llz, urx, ury, urz ); - - return llx; /* frgo: Hm? This always returns 0.0 ... Why ? */ + CheckGlyph( chr); + + FTPoint kernAdvance = glyphList->Render( chr, nextChr, pen); + + pen.x += kernAdvance.x; + pen.y += kernAdvance.y; +}*/ + + + +float __stdcall fgcStringX( FTFont* f, const char* string ) { + float llx,lly,llz,urx,ury,urz; + + f->BBox( string, llx, lly, llz, urx, ury, urz ); + return llx; } -void __stdcall fgcRender( FTFont *f, - const char *string ) -{ - f->Render( string ); +void __stdcall fgcRender( FTFont* f, const char *string ) { + f->Render( string ); } -void __stdcall fgcFree( FTFont *f ) -{ - delete f; +void __stdcall fgcFree( FTFont* f ) { + delete f; } //--------- Bitmap ---------------------------------------------- -FTGLBitmapFont * __stdcall fgcBitmapMake( const char* fontname ) -{ - return new FTGLBitmapFont( fontname ); +FTGLBitmapFont* __stdcall fgcBitmapMake( const char* fontname ) { + return new FTGLBitmapFont( fontname ); } //--------- Pixmap ---------------------------------------------- -FTGLPixmapFont * __stdcall fgcPixmapMake( const char* fontname ) -{ - return new FTGLPixmapFont( fontname ); +FTGLPixmapFont* __stdcall fgcPixmapMake( const char* fontname ) { + return new FTGLPixmapFont( fontname ); } //--------- Texture ---------------------------------------------- -FTGLTextureFont * __stdcall fgcTextureMake( const char* fontname ) -{ - return new FTGLTextureFont( fontname ); +FTGLTextureFont* __stdcall fgcTextureMake( const char* fontname ) { + return new FTGLTextureFont( fontname ); } //--------- Polygon ---------------------------------------------- -FTGLPolygonFont * __stdcall fgcPolygonMake( const char* fontname ) -{ - return new FTGLPolygonFont( fontname ); +FTGLPolygonFont* __stdcall fgcPolygonMake( const char* fontname ) { + return new FTGLPolygonFont( fontname ); } //--------- Outline ---------------------------------------------- -FTGLOutlineFont * __stdcall fgcOutlineMake( const char* fontname ) -{ - return new FTGLOutlineFont( fontname ); +FTGLOutlineFont* __stdcall fgcOutlineMake( const char* fontname ) { + return new FTGLOutlineFont( fontname ); } //--------- Extruded Polygon ------------------------------------- -FTGLExtrdFont * __stdcall fgcExtrudedMake( const char* fontname ) -{ - return new FTGLExtrdFont( fontname ); +FTGLExtrdFont* __stdcall fgcExtrudedMake( const char* fontname ) { + return new FTGLExtrdFont( fontname ); } -bool __stdcall fgcSetFaceDepth( FTGLExtrdFont *f, - float depth ) -{ - return f->FaceDepth( depth ); + +bool __stdcall fgcSetFaceDepth( FTGLExtrdFont* f + , float depth ) { + f->Depth( depth ); + return true; } -#if defined(__cplusplus) -} // extern "C" -#endif + +}

1 0

[cells-cvs] CVS update: cell-cultures/clyde/cloucell/inspector-window.lisp
by Kenny Tilton 15 Oct '04

15 Oct '04

Update of /project/cells/cvsroot/cell-cultures/clyde/cloucell In directory common-lisp.net:/tmp/cvs-serv28025/clyde/cloucell Modified Files: inspector-window.lisp Log Message: Re-write of the core layout widgets under the ix-inline class, plus a new OpenGL example, viz., a simple nurb. Looks sweet, btw. Date: Fri Oct 15 05:38:03 2004 Author: ktilton Index: cell-cultures/clyde/cloucell/inspector-window.lisp diff -u cell-cultures/clyde/cloucell/inspector-window.lisp:1.1 cell-cultures/clyde/cloucell/inspector-window.lisp:1.2 --- cell-cultures/clyde/cloucell/inspector-window.lisp:1.1 Sun Jul 4 20:59:46 2004 +++ cell-cultures/clyde/cloucell/inspector-window.lisp Fri Oct 15 05:38:02 2004 @@ -56,7 +56,7 @@ (member prior-i h)) ;; toss "forward" chain from prior-i h))))))) -(defmodel target-view-container (ig-zero-tl) +(defmodel target-view-container (ix-zero-tl) () (:default-initargs :kid-slots (def-kid-slots

1 0

[cells-cvs] CVS update: cell-cultures/cl-opengl/gl-constants.lisp cell-cultures/cl-opengl/glu-functions.lisp cell-cultures/cl-opengl/glut-extras.lisp cell-cultures/cl-opengl/nehe-14.lisp cell-cultures/cl-opengl/ogl-macros.lisp cell-cultures/cl-opengl/ogl-utils.lisp
by Kenny Tilton 15 Oct '04

15 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cl-opengl In directory common-lisp.net:/tmp/cvs-serv28025/cl-opengl Modified Files: gl-constants.lisp glu-functions.lisp glut-extras.lisp nehe-14.lisp ogl-macros.lisp ogl-utils.lisp Log Message: Re-write of the core layout widgets under the ix-inline class, plus a new OpenGL example, viz., a simple nurb. Looks sweet, btw. Date: Fri Oct 15 05:37:56 2004 Author: ktilton Index: cell-cultures/cl-opengl/gl-constants.lisp diff -u cell-cultures/cl-opengl/gl-constants.lisp:1.1 cell-cultures/cl-opengl/gl-constants.lisp:1.2 --- cell-cultures/cl-opengl/gl-constants.lisp:1.1 Sat Jun 26 20:38:40 2004 +++ cell-cultures/cl-opengl/gl-constants.lisp Fri Oct 15 05:37:55 2004 @@ -172,8 +172,8 @@ (dfc gl_t4f_c4f_n3f_v4f #x2a2d) #| matrix mode |# -(dfc gl_model-view #x1700) -(dfc gl_projection #x1701) +(dfc gl_modelview #x1700) +(dfc gl_projection #x1701) (dfc gl_texture #x1702) #| display lists |# @@ -338,10 +338,10 @@ (dfc gl_matrix_mode #x0ba0) (dfc gl_normalize #x0ba1) (dfc gl_viewport #x0ba2) -(dfc gl_model-view_stack_depth #x0ba3) +(dfc gl_modelview_stack_depth #x0ba3) (dfc gl_projection_stack_depth #x0ba4) (dfc gl_texture_stack_depth #x0ba5) -(dfc gl_model-view_matrix #x0ba6) +(dfc gl_modelview_matrix #x0ba6) (dfc gl_projection_matrix #x0ba7) (dfc gl_texture_matrix #x0ba8) (dfc gl_attrib_stack_depth #x0bb0) Index: cell-cultures/cl-opengl/glu-functions.lisp diff -u cell-cultures/cl-opengl/glu-functions.lisp:1.1 cell-cultures/cl-opengl/glu-functions.lisp:1.2 --- cell-cultures/cl-opengl/glu-functions.lisp:1.1 Sat Jun 26 20:38:41 2004 +++ cell-cultures/cl-opengl/glu-functions.lisp Fri Oct 15 05:37:55 2004 @@ -22,9 +22,139 @@ (in-package :cl-opengl) +;;; *** Generic constants ****/ + +;;; Errors: (return value 0 = no error) */ +(dfc GLU_INVALID_ENUM 100900) +(dfc GLU_INVALID_VALUE 100901) +(dfc GLU_OUT_OF_MEMORY 100902) +(dfc GLU_INCOMPATIBLE_GL_VERSION 100903) + +;;; StringName */ +(dfc GLU_VERSION 100800) +(dfc GLU_EXTENSIONS 100801) + +;;; Boolean */ +(dfc GLU_TRUE 1) +(dfc GLU_FALSE 0) + + +;;; *** Quadric constants ****/ + +;;; QuadricNormal */ +(dfc GLU_SMOOTH 100000) +(dfc GLU_FLAT 100001) +(dfc GLU_NONE 100002) + +;;; QuadricDrawStyle */ +(dfc GLU_POINT 100010) +(dfc GLU_LINE 100011) +(dfc GLU_FILL 100012) +(dfc GLU_SILHOUETTE 100013) + +;;; QuadricOrientation */ +(dfc GLU_OUTSIDE 100020) +(dfc GLU_INSIDE 100021) + +;;; Callback types: */ +;;; GLU_ERROR 100103 */ + + +;;; *** Tesselation constants ****/ + +;;(dfc GLU_TESS_MAX_COORD 1.0e150) + +;;; TessProperty */ +(dfc GLU_TESS_WINDING_RULE 100140) +(dfc GLU_TESS_BOUNDARY_ONLY 100141) +(dfc GLU_TESS_TOLERANCE 100142) + +;;; TessWinding */ +(dfc GLU_TESS_WINDING_ODD 100130) +(dfc GLU_TESS_WINDING_NONZERO 100131) +(dfc GLU_TESS_WINDING_POSITIVE 100132) +(dfc GLU_TESS_WINDING_NEGATIVE 100133) +(dfc GLU_TESS_WINDING_ABS_GEQ_TWO 100134) + +;;; TessCallback */ +(dfc GLU_TESS_BEGIN 100100) ;;; void (CALLBACK*)(GLenum type) */ +(dfc GLU_TESS_VERTEX 100101) ;;; void (CALLBACK*)(void *data) */ +(dfc GLU_TESS_END 100102) ;;; void (CALLBACK*)(void) */ +(dfc GLU_TESS_ERROR 100103) ;;; void (CALLBACK*)(GLenum errno) */ +(dfc GLU_TESS_EDGE_FLAG 100104) ;;; void (CALLBACK*)(GLboolean boundaryEdge) */ +(dfc GLU_TESS_COMBINE 100105) ;;; void (CALLBACK*)(GLdouble coords[3], + ;;; void *data[4], + ;;; GLfloat weight[4], + ;;; void **dataOut) */ +(dfc GLU_TESS_BEGIN_DATA 100106) ;;; void (CALLBACK*)(GLenum type, + ;;; void *polygon_data) */ +(dfc GLU_TESS_VERTEX_DATA 100107) ;;; void (CALLBACK*)(void *data, + ;;; void *polygon_data) */ +(dfc GLU_TESS_END_DATA 100108) ;;; void (CALLBACK*)(void *polygon_data) */ +(dfc GLU_TESS_ERROR_DATA 100109) ;;; void (CALLBACK*)(GLenum errno, + ;;; void *polygon_data) */ +(dfc GLU_TESS_EDGE_FLAG_DATA 100110) ;;; void (CALLBACK*)(GLboolean boundaryEdge, + ;;; void *polygon_data) */ +(dfc GLU_TESS_COMBINE_DATA 100111) ;;; void (CALLBACK*)(GLdouble coords[3], + ;;; void *data[4], + ;;; GLfloat weight[4], + ;;; void **dataOut, + ;;; void *polygon_data) */ + +;;; TessError */ +(dfc GLU_TESS_ERROR1 100151) +(dfc GLU_TESS_ERROR2 100152) +(dfc GLU_TESS_ERROR3 100153) +(dfc GLU_TESS_ERROR4 100154) +(dfc GLU_TESS_ERROR5 100155) +(dfc GLU_TESS_ERROR6 100156) +(dfc GLU_TESS_ERROR7 100157) +(dfc GLU_TESS_ERROR8 100158) + +(dfc GLU_TESS_MISSING_BEGIN_POLYGON GLU_TESS_ERROR1) +(dfc GLU_TESS_MISSING_BEGIN_CONTOUR GLU_TESS_ERROR2) +(dfc GLU_TESS_MISSING_END_POLYGON GLU_TESS_ERROR3) +(dfc GLU_TESS_MISSING_END_CONTOUR GLU_TESS_ERROR4) +(dfc GLU_TESS_COORD_TOO_LARGE GLU_TESS_ERROR5) +(dfc GLU_TESS_NEED_COMBINE_CALLBACK GLU_TESS_ERROR6) + + +;;; **** NURBS constants ****/ + +;;; NurbsProperty */ +(dfc GLU_AUTO_LOAD_MATRIX 100200) +(dfc GLU_CULLING 100201) +(dfc GLU_SAMPLING_TOLERANCE 100203) +(dfc GLU_DISPLAY_MODE 100204) +(dfc GLU_PARAMETRIC_TOLERANCE 100202) +(dfc GLU_SAMPLING_METHOD 100205) +(dfc GLU_U_STEP 100206) +(dfc GLU_V_STEP 100207) + +;;; NurbsSampling */ +(dfc GLU_PATH_LENGTH 100215) +(dfc GLU_PARAMETRIC_ERROR 100216) +(dfc GLU_DOMAIN_DISTANCE 100217) + + +;;; NurbsTrim */ +(dfc GLU_MAP1_TRIM_2 100210) +(dfc GLU_MAP1_TRIM_3 100211) + +;;; NurbsDisplay */ + +(dfc GLU_OUTLINE_POLYGON 100240) +(dfc GLU_OUTLINE_PATCH 100241) + +;;; NurbsCallback */ +;;; GLU_ERROR 100103 */ + +;;; NurbsErrors */ +(dfc GLU_NURBS_ERROR1 100251) +(dfc GLU_NURBS_ERROR37 100287) + (defun-ogl (* glubyte) "gl-util" "gluErrorString" (glenum error)) -;;;(defun-ogl void "gl-util" "gluGetNurbsProperty" (GLUnurbs *nurb GLenum property GLfloat *data)) ;;;(defun-ogl GLubyte *"gl-util" "gluGetString" (GLenum name)) ;;;(defun-ogl void "gl-util" "gluGetTessProperty" (GLUtesselator *tess GLenum which GLdouble *data)) ;;;(defun-ogl void "gl-util" "gluLoadSamplingMatrices" (GLUnurbs *nurb GLfloat *model GLfloat *perspective GLint *view)) @@ -46,14 +176,27 @@ (defun-ogl :void "gl-util" "gluLookAt" (gldouble eye-x gldouble eye-y gldouble eye-z gldouble center-x gldouble center-y gldouble center-z gldouble upx gldouble upy gldouble upz)) -;;;(defun-ogl GLUnurbs *"gl-util" "gluNewNurbsRenderer" ()) + (defun-ogl (* :void) "gl-util" "gluNewQuadric" ()) + (defun-ogl :void "gl-util" "gluDeleteQuadric" (:void *quadric)) + +(defun-ogl (* :void) "gl-util" "gluNewNurbsRenderer" ()) +(defun-ogl :void "gl-util" "gluDeleteNurbsRenderer" (:void *nurb)) +(defun-ogl :void "gl-util" "gluBeginSurface" (:void *nurb)) +(defun-ogl :void "gl-util" "gluEndSurface" (:void *nurb)) +(defun-ogl :void "gl-util" "gluBeginCurve" (:void *nurb)) +(defun-ogl :void "gl-util" "gluEndCurve" (:void *nurb)) +(defun-ogl :void "gl-util" "gluBeginTrim" (:void *nurb)) +(defun-ogl :void "gl-util" "gluEndTrim" (:void *nurb)) + +(defun-ogl :void "gl-util" "gluGetNurbsProperty" (:void *nurb GLenum property GLfloat *data)) +(defun-ogl :void "gl-util" "gluNurbsCurve" (:void *nurb GLint knotCount GLfloat *knots GLint stride GLfloat *control GLint order GLenum type)) +(defun-ogl :void "gl-util" "gluNurbsProperty" (:void *nurb GLenum property GLfloat value)) +(defun-ogl :void "gl-util" "gluNurbsSurface" (:void *nurb GLint sKnotCount GLfloat *sKnots GLint tKnotCount GLfloat *tKnots GLint sStride GLint tStride GLfloat *control GLint sOrder GLint tOrder GLenum type)) + ;;;(defun-ogl GLUtesselator *"gl-util" "gluNewTess" ()) ;;;(defun-ogl void "gl-util" "gluNextContour" (GLUtesselator *tess GLenum type)) -;;;(defun-ogl void "gl-util" "gluNurbsCurve" (GLUnurbs *nurb GLint knotCount GLfloat *knots GLint stride GLfloat *control GLint order GLenum type)) -;;;(defun-ogl void "gl-util" "gluNurbsProperty" (GLUnurbs *nurb GLenum property GLfloat value)) -;;;(defun-ogl void "gl-util" "gluNurbsSurface" (GLUnurbs *nurb GLint sKnotCount GLfloat *sKnots GLint tKnotCount GLfloat *tKnots GLint sStride GLint tStride GLfloat *control GLint sOrder GLint tOrder GLenum type)) ;;;(defun-ogl :void "gl-util" "gluOrtho2D" (GLdouble left GLdouble right ;;; GLdouble bottom GLdouble top)) ;;;(defun-ogl void "gl-util" "gluPartialDisk" (GLUquadric *quad GLdouble inner GLdouble outer GLint slices GLint loops GLdouble start GLdouble sweep)) Index: cell-cultures/cl-opengl/glut-extras.lisp diff -u cell-cultures/cl-opengl/glut-extras.lisp:1.2 cell-cultures/cl-opengl/glut-extras.lisp:1.3 --- cell-cultures/cl-opengl/glut-extras.lisp:1.2 Fri Oct 1 06:01:29 2004 +++ cell-cultures/cl-opengl/glut-extras.lisp Fri Oct 15 05:37:55 2004 @@ -85,7 +85,7 @@ (let ((mmi (uffi:deref-array mm '(:array :int) 0))) (glgetintegerv (cond - ((eql mmi gl_model-view) gl_model-view_stack_depth) + ((eql mmi gl_modelview) gl_modelview_stack_depth) ((eql mmi gl_projection) gl_projection_stack_depth) ((eql mmi gl_texture) gl_texture_stack_depth) (t (break "bad matrix"))) @@ -99,7 +99,7 @@ (let ((mmi (uffi:deref-array mm '(:array :int) 0))) (unwind-protect (cond - ((eql mmi gl_model-view) :model-view) + ((eql mmi gl_modelview) :model-view) ((eql mmi gl_projection) :projection) ((eql mmi gl_texture) :texture) Index: cell-cultures/cl-opengl/nehe-14.lisp diff -u cell-cultures/cl-opengl/nehe-14.lisp:1.1 cell-cultures/cl-opengl/nehe-14.lisp:1.2 --- cell-cultures/cl-opengl/nehe-14.lisp:1.1 Sat Jun 26 20:38:41 2004 +++ cell-cultures/cl-opengl/nehe-14.lisp Fri Oct 15 05:37:55 2004 @@ -128,7 +128,7 @@ (glu-perspective 70 1 1 1000) (glu-look-at 0d0 0d0 5d0 0d0 0d0 0d0 0d0 1d0 0d0) - (gl-matrix-mode gl_model-view) + (gl-matrix-mode gl_modelview) (gl-load-identity) Index: cell-cultures/cl-opengl/ogl-macros.lisp diff -u cell-cultures/cl-opengl/ogl-macros.lisp:1.2 cell-cultures/cl-opengl/ogl-macros.lisp:1.3 --- cell-cultures/cl-opengl/ogl-macros.lisp:1.2 Fri Oct 1 06:01:29 2004 +++ cell-cultures/cl-opengl/ogl-macros.lisp Fri Oct 15 05:37:55 2004 @@ -50,8 +50,8 @@ (glec :with-matrix-push) (unwind-protect (progn - (when (eql gl_model-view_matrix mm-pushed) - (gl-get-integerv gl_model-view_stack_depth *stack-depth*) + (when (eql gl_modelview_matrix mm-pushed) + (gl-get-integerv gl_modelview_stack_depth *stack-depth*) (glec :get-stack-depth) (print `(with-matrix model matrix stack ,(aforef *stack-depth* 0)))) Index: cell-cultures/cl-opengl/ogl-utils.lisp diff -u cell-cultures/cl-opengl/ogl-utils.lisp:1.2 cell-cultures/cl-opengl/ogl-utils.lisp:1.3 --- cell-cultures/cl-opengl/ogl-utils.lisp:1.2 Fri Oct 1 06:01:29 2004 +++ cell-cultures/cl-opengl/ogl-utils.lisp Fri Oct 15 05:37:55 2004 @@ -47,7 +47,7 @@ (let (gl-s-plane gl-t-plane gl-r-plane gl-q-plane) (defun ogl-tex-gen-setup (mode tex-env tex-wrap scale &rest planes) - (ukt::trc nil "ogl-tex-gen-setup:" mode tex-env tex-wrap scale planes) + ;;(ukt::trc nil "ogl-tex-gen-setup:" mode tex-env tex-wrap scale planes) (gl-tex-envf gl_texture_env gl_texture_env_mode tex-env) (gl-tex-parameterf gl_texture_2d gl_texture_min_filter gl_linear ) (gl-tex-parameterf gl_texture_2d gl_texture_mag_filter gl_linear )

1 0

[cells-cvs] CVS update: cell-cultures/cl-magick/cl-magick.lisp cell-cultures/cl-magick/mgk-test.lisp cell-cultures/cl-magick/wand-texture.lisp
by Kenny Tilton 15 Oct '04

15 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cl-magick In directory common-lisp.net:/tmp/cvs-serv28025/cl-magick Modified Files: cl-magick.lisp mgk-test.lisp wand-texture.lisp Log Message: Re-write of the core layout widgets under the ix-inline class, plus a new OpenGL example, viz., a simple nurb. Looks sweet, btw. Date: Fri Oct 15 05:37:46 2004 Author: ktilton Index: cell-cultures/cl-magick/cl-magick.lisp diff -u cell-cultures/cl-magick/cl-magick.lisp:1.1 cell-cultures/cl-magick/cl-magick.lisp:1.2 --- cell-cultures/cl-magick/cl-magick.lisp:1.1 Sat Jun 26 20:38:39 2004 +++ cell-cultures/cl-magick/cl-magick.lisp Fri Oct 15 05:37:40 2004 @@ -93,15 +93,15 @@ (cl-magick-init) (let ((key (list* wand-type (namestring file-path$) iargs))) (or (let ((old (cdr (assoc key (wands-loaded) :test 'equal)))) ;;/// primitive test - #+shh (when old - (print `(wand-ensure-typed re-using prior load ,wand-type ,file-path$))) + #+shhh (when old + (print `(wand-ensure-typed re-using prior load ,wand-type ,file-path$))) old) (let ((wi (apply 'make-instance wand-type :file-path$ file-path$ iargs))) #+shhh (print `(wand-ensure-typed forced to load ,wand-type ,file-path$)) - (push (cons key wi) (wands-loaded)) - wi) + (push (cons key wi) (wands-loaded)) + wi) (error "Unable to load image file ~a" file-path$))))) #+allegro Index: cell-cultures/cl-magick/mgk-test.lisp diff -u cell-cultures/cl-magick/mgk-test.lisp:1.2 cell-cultures/cl-magick/mgk-test.lisp:1.3 --- cell-cultures/cl-magick/mgk-test.lisp:1.2 Fri Oct 1 06:01:19 2004 +++ cell-cultures/cl-magick/mgk-test.lisp Fri Oct 15 05:37:40 2004 @@ -300,7 +300,7 @@ (gl-matrix-mode gl_projection) (gl-load-identity) (glu-perspective 45 (/ width height) 0.1 100) - (gl-matrix-mode gl_model-view) + (gl-matrix-mode gl_modelview) (gl-load-identity))) (defun cl-magick-test () Index: cell-cultures/cl-magick/wand-texture.lisp diff -u cell-cultures/cl-magick/wand-texture.lisp:1.3 cell-cultures/cl-magick/wand-texture.lisp:1.4 --- cell-cultures/cl-magick/wand-texture.lisp:1.3 Fri Oct 1 06:01:19 2004 +++ cell-cultures/cl-magick/wand-texture.lisp Fri Oct 15 05:37:40 2004 @@ -28,8 +28,8 @@ (defclass wand-texture (wand-image ogl-texture)()) (defmethod wand-release :after ((wand wand-texture)) - (when (texture-name wand) - (ogl-texture-delete (texture-name wand)))) + (when (slot-value wand 'texture-name) + (ogl-texture-delete (slot-value wand 'texture-name)))) (defun best-fit-cons (c1 c2 c3) (flet ((bfit (a b c) @@ -45,13 +45,14 @@ (grow-sz (cons (expt 2 (ceiling (log (car (image-size self)) 2))) (expt 2 (ceiling (log (cdr (image-size self)) 2))))) (best-fit-sz (best-fit-cons trunc-sz (image-size self) grow-sz))) + #+shh (print `(texture-name> gennning texture ,self)) (unless (equal (image-size self) best-fit-sz) - ;;(print `(tex-refit ,(image-size self) to ,best-fit-sz)) + #+shhh (print `(texture-name> tex-refit ,(image-size self) to ,best-fit-sz)) (magick-scale-image (mgk-wand self) (car best-fit-sz) (cdr best-fit-sz)) ;;; gaussian-filter 0) (setf (image-size self) best-fit-sz)) - ;(print `(new image size ,(image-size self))) + #+shhh (print `(texture-name> new image size , self ,(image-size self))) (let ((tx (wand-image-to-texture self))) (if (plusp tx) (setf (texture-name self) tx) @@ -125,10 +126,10 @@ (flet ((vxy (tx ty) (let ((abs-x (+ left (* tx (- right left)))) (abs-y (+ top (downs (* ty (abs (- top bottom))))))) - ;;(print `(tex full,(cons tx ty) to-vertex ,(cons abs-x abs-y))) + ;(print `(tex full,(cons tx ty) to-vertex ,(cons abs-x abs-y))) (gl-tex-coord2f tx ty) (gl-vertex3f abs-x abs-y 0)))) (with-gl-begun (gl_quads) (vxy 0 0)(vxy 0 1)(vxy 1 1)(vxy 1 0))) - ))))R \ No newline at end of file + )))) \ No newline at end of file

1 0

[cells-cvs] CVS update: cell-cultures/cells/fm-utilities.lisp
by Kenny Tilton 15 Oct '04

15 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv28025/cells Modified Files: fm-utilities.lisp Log Message: Re-write of the core layout widgets under the ix-inline class, plus a new OpenGL example, viz., a simple nurb. Looks sweet, btw. Date: Fri Oct 15 05:37:38 2004 Author: ktilton Index: cell-cultures/cells/fm-utilities.lisp diff -u cell-cultures/cells/fm-utilities.lisp:1.1 cell-cultures/cells/fm-utilities.lisp:1.2 --- cell-cultures/cells/fm-utilities.lisp:1.1 Sat Jun 26 20:38:36 2004 +++ cell-cultures/cells/fm-utilities.lisp Fri Oct 15 05:37:38 2004 @@ -418,7 +418,7 @@ :must-find nil :global-search ,global-search)) -(defun fm! (starting md-name &optional (global-search t)) +(defun fm-other! (starting md-name &optional (global-search t)) (fm-find-one starting md-name :must-find t :global-search global-search)) @@ -436,12 +436,13 @@ :must-find nil :global-search ,global-search)) -(defmacro fm-other! (md-name &optional (starting 'self)) - `(fm-find-one ,starting ,(if (consp md-name) - `(list ',(car md-name) ,(cadr md-name)) - `',md-name) +(defmacro fm! (md-name &optional (starting 'self)) + `(without-c-dependency + (fm-find-one ,starting ,(if (consp md-name) + `(list ',(car md-name) ,(cadr md-name)) + `',md-name) :must-find t - :global-search nil)) + :global-search nil))) (defmacro fm-other?! (md-name &optional (starting 'self)) `(fm-find-one ,starting ,(if (consp md-name)

1 0

[cells-cvs] CVS update: cell-cultures/cells/cells-test/test-cyclicity.lisp
by Kenny Tilton 15 Oct '04

15 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cells/cells-test In directory common-lisp.net:/tmp/cvs-serv28025/cells/cells-test Modified Files: test-cyclicity.lisp Log Message: Re-write of the core layout widgets under the ix-inline class, plus a new OpenGL example, viz., a simple nurb. Looks sweet, btw. Date: Fri Oct 15 05:37:33 2004 Author: ktilton Index: cell-cultures/cells/cells-test/test-cyclicity.lisp diff -u cell-cultures/cells/cells-test/test-cyclicity.lisp:1.1 cell-cultures/cells/cells-test/test-cyclicity.lisp:1.2 --- cell-cultures/cells/cells-test/test-cyclicity.lisp:1.1 Sat Jun 26 20:38:37 2004 +++ cell-cultures/cells/cells-test/test-cyclicity.lisp Fri Oct 15 05:37:32 2004 @@ -67,7 +67,7 @@ (mapcan (lambda (router-id) (unless (find router-id visited-nodes) (multiple-value-bind (ups new-visiteds) - (contiguous-nodes-up (fm! node router-id) visited-nodes) + (contiguous-nodes-up (fm-other! node router-id) visited-nodes) (setf visited-nodes new-visiteds) ups))) (router-ids node))) @@ -84,9 +84,9 @@ :sys-node 'two :ring '(one two three four five six)))) (dump-net net "initially") - (setf (system-status (fm! net 'three)) 'down) + (setf (system-status (fm-other! net 'three)) 'down) (dump-net net "down goes three!!") - (setf (system-status (fm! net 'six)) 'down) + (setf (system-status (fm-other! net 'six)) 'down) (dump-net net "down goes six!!!")))) #+do-it

1 0