debian/0000755000000000000000000000000012075406771007177 5ustar debian/docs0000644000000000000000000000002011350555232010032 0ustar README examples debian/watch0000644000000000000000000000006310556032350010215 0ustar version=3 http://sf.net/gauche/Gauche-gl-(.*)\.tgz debian/gauche-gl.info0000644000000000000000000000007011350566740011703 0ustar doc/gauche-gl-refe.info*.gz doc/gauche-gl-refj.info*.gz debian/source/0000755000000000000000000000000011350554623010472 5ustar debian/source/format0000644000000000000000000000001411350554623011700 0ustar 3.0 (quilt) debian/patches/0000755000000000000000000000000012075206767010631 5ustar debian/patches/series0000644000000000000000000000005512075206604012034 0ustar # 00_new_api_0.9.patch 01_no_path_xtra.patch debian/patches/00_new_api_0.9.patch0000644000000000000000000046722111350564040014157 0ustar Description: upstream change Origin: svn revision 7080 Reviewed-By: NIIBE Yutaka Last-Update: 2010-03-19 =================================================================== --- gauche-gl-0.4.4.orig/ChangeLog (revision 301) +++ gauche-gl-0.4.4/ChangeLog (working copy) @@ -1,3 +1,83 @@ +2009-03-04 Shiro Kawai + + * src/*.stub: Updated uses of obsoleted (return "...") to + (call "..."). + +2008-10-15 Shiro Kawai + + * src/math3d-lib.stub (quatf-set4!): Added. + +2008-06-10 Shiro Kawai + + * src/gauche-math3d.c (Scm_AxesToQuatfv): clamp the cos(theta) value + to avoid getting NaN from rounding error when we take acosf. + +2008-06-09 Shiro Kawai + + * src/math3d-lib.stub (f32vector->matrix4f!): added. + (matrix4f->rotation!, matrix4f->translation!): changed the argument + order to be consistent of other linear update APIs. + +2008-06-08 Shiro Kawai + + * lib/gl/simple/viewer.scm: changed to keep callback and local + state for each window individually. APIs may take optional + window name. Without explicit window name, those APIs touches + the global default settings, which will affect the windows + created after the call. + + * src/gauche-glut.c (Scm_GlutRegisterCallback), + src/gauche-glut.h, + src/glut-lib.stub (glut-display-func etc): Rewrote to support + per-window callbacks properly---the old version kept one + closure per callback, so it was impossible to register different + callbacks for multiple windows, and also it worked incorrectly + since the last registered closure were called for all windows. + Now we manage closure vectors associated to each window. + +2008-06-06 Shiro Kawai + + * lib/gl/simple/image.scm, lib/gl/simple-image.scm: Moved + gl.simple-image to gl.simple.image. + + * lib/gl/simple/viewer.scm: added. + * examples/simple/minimum-viewer.scm: added. + +2008-06-05 Shiro Kawai + + * src/gauche-math3d.c, src/gauche/math3d.h (Scm_VectorsToQuatf, + Scm_AxesToQuatf): renamed from Scm_{Two|Four}Vectors... + * src/math3d-lib.stub (vectors->quatf, axes->quatf): renamed + accordingly. + + * repository migrated to subversion. + + * src/math3d-lib.stub (quatf-conjugate!, 4vectors->quatf, + 4vectors->quatf!): added. + +2008-06-04 Shiro Kawai + + * src/glext-lib.stub (gl-active-texture, gl-client-active-texture): + added sans '-arb' versions, which were added in GL1.3. + + * src/math3d-lib.stub (vector4f-norm, matrix4f->translation, + matrix4f->translation!, 2vectors->quatf, 2vectors->quatf!, + vector4f-mul, vector4f-mul!, vector4f-div): added. + +2007-08-05 Shiro Kawai + + * src/gl-lib.stub (gl-tex-coord-pointer, gl-index-pointer): Wrong GL + functions were called. + +2007-08-04 Shiro Kawai + + * src/glext-lib.stub: Added support of the framebuffer object + extension. + * src/gl-lib.stub (gl-tex-image-2d): allow passing #f to the texture + texels array so that it is possible to allocate texture memory but + not initialize it. It is useful when you want to render to + the texture. + 2007-07-09 Shiro Kawai * release 0.4.4 =================================================================== --- gauche-gl-0.4.4.orig/src/gl-lib.stub (revision 301) +++ gauche-gl-0.4.4/src/gl-lib.stub (working copy) @@ -1,7 +1,7 @@ ;;; ;;; gl-lib.stub - glue functions for GL ;;; -;;; Copyright(C) 2001-2005 by Shiro Kawai (shiro@acm.org) +;;; Copyright (c) 2001-2008 Shiro Kawai ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, @@ -31,6 +31,15 @@ } while (0) " +(define-cise-stmt assert-vector-type&size + [(_ type size var) + (let* ([TYPE (string-upcase (x->string type))] + [pred (string->symbol #`"SCM_,|TYPE|P")] + [getsize (string->symbol #`"SCM_,|TYPE|_SIZE")] + [msg #`",type of size ,size required,, but got %S"]) + `(when (or (not (,pred ,var)) (!= (,getsize ,var) ,size)) + (Scm_Error ,msg ,var)))]) + ;; NB: this should be taken care of by genstub. (define-type "ScmUVector*" "uniform vector" "SCM_UVECTORP" "SCM_UVECTOR") @@ -45,401 +54,295 @@ ;; stuff ;; -(define-cproc list->gl-boolean-vector (lis) - (return "Scm_ListToGLBooleanVector")) +(define-cproc list->gl-boolean-vector (lis) Scm_ListToGLBooleanVector) +(define-cproc gl-boolean-vector (&rest lis) Scm_ListToGLBooleanVector) +(define-cproc gl-boolean-vector? (obj) :: SCM_GL_BOOLEAN_VECTOR_P) -(define-cproc gl-boolean-vector (&rest lis) - (return "Scm_ListToGLBooleanVector")) - -(define-cproc gl-boolean-vector? (obj) - (return "SCM_GL_BOOLEAN_VECTOR_P")) - (define-cproc make-gl-boolean-vector (size:: &optional (init:: #f)) - (return "Scm_MakeGLBooleanVector")) + Scm_MakeGLBooleanVector) (define-cproc gl-boolean-vector-copy (bv::) - "SCM_RETURN(Scm_MakeGLBooleanVectorFromArray(bv->size, bv->elements));") + (result (Scm_MakeGLBooleanVectorFromArray (-> bv size) (-> bv elements)))) (define-cproc gl-boolean-vector-ref (bv:: k:: &optional fallback) - "if (k < 0 || k >= bv->size) { - if (SCM_UNBOUNDP(fallback)) { - Scm_Error(\"argument out of bound: %d\", k); - } - SCM_RETURN(fallback); - } else { - SCM_RETURN(SCM_MAKE_BOOL(bv->elements[k])); - }") + (cond [(or (< k 0) (>= k (-> bv size))) + (when (SCM_UNBOUNDP fallback) + (Scm_Error "argument out of bound: %d" k)) + (result fallback)] + [else + (result (SCM_MAKE_BOOL (aref (-> bv elements) k)))])) (define-cproc gl-boolean-vector-set! (bv:: k:: value) - "if (k < 0 || k >= bv->size) { - Scm_Error(\"argument out of bound: %d\", k); - } else { - bv->elements[k] = SCM_FALSEP(value)? GL_FALSE : GL_TRUE; - } - SCM_RETURN(SCM_UNDEFINED);") + :: + (if (or (< k 0) (>= k (-> bv size))) + (Scm_Error "argument out of bound: %d" k) + (= (aref (-> bv elements) k) (?: (SCM_FALSEP value) GL_FALSE GL_TRUE)))) -(define-cproc gl-boolean-vector-length (bv::) - "SCM_RETURN(SCM_MAKE_INT(bv->size));") +(define-cproc gl-boolean-vector-length (bv::) :: + (result (-> bv size))) (define-cproc gl-boolean-vector-fill! (bv:: fill) - "int i; - GLboolean val = SCM_FALSEP(fill)? GL_FALSE : GL_TRUE; - for (i=0; isize; i++) { - bv->elements[i] = val; - } - SCM_RETURN(SCM_OBJ(bv));") + (let* ([val::GLboolean (?: (SCM_FALSEP fill) GL_FALSE GL_TRUE)]) + (dotimes [i (-> bv size)] (= (aref (-> bv elements) i) val))) + (result (SCM_OBJ bv))) ;;============================================================= ;; Miscellaneous ;; -(define-cproc gl-clear-index (c::) - (return "glClearIndex")) - +(define-cproc gl-clear-index (c::) :: glClearIndex) (define-cproc gl-clear-color (r:: g:: b:: a::) - (return "glClearColor")) - -(define-cproc gl-clear (mask::) - (return "glClear")) - -(define-cproc gl-index-mask (mask::) - (return "glIndexMask")) - + :: glClearColor) +(define-cproc gl-clear (mask::) :: glClear) +(define-cproc gl-index-mask (mask::) :: glIndexMask) (define-cproc gl-color-mask (r:: g:: b:: a::) - (return "glColorMask")) + :: glColorMask) (define-cproc gl-alpha-func (func:: ref::) - (return "glAlphaFunc")) - + :: glAlphaFunc) (define-cproc gl-blend-func (sfactor:: dfactor::) - (return "glBlendFunc")) - -(define-cproc gl-logic-op (opcode::) - (return "glLogicOp")) - -(define-cproc gl-cull-face (mode::) - (return "glCullFace")) - -(define-cproc gl-front-face (mode::) - (return "glFrontFace")) - -(define-cproc gl-point-size (size::) - (return "glPointSize")) - -(define-cproc gl-line-width (width::) - (return "glLineWidth")) - + :: glBlendFunc) +(define-cproc gl-logic-op (opcode::) :: glLogicOp) +(define-cproc gl-cull-face (mode::) :: glCullFace) +(define-cproc gl-front-face (mode::) :: glFrontFace) +(define-cproc gl-point-size (size::) :: glPointSize) +(define-cproc gl-line-width (width::) :: glLineWidth) (define-cproc gl-line-stipple (factor:: pat::) - (return "glLineStipple")) - + :: glLineStipple) (define-cproc gl-polygon-mode (face:: mode::) - (return "glPolygonMode")) - + :: glPolygonMode) (define-cproc gl-polygon-offset (factor:: units::) - (return "glPolygonOffset")) + :: glPolygonOffset) -(define-cproc gl-polygon-stipple (mask) - " if (!SCM_U8VECTORP(mask) || SCM_U8VECTOR_SIZE(mask) != 128) { - Scm_Error(\"u8vector of size 128 required, but got %S\", mask); - } - glPolygonStipple(SCM_U8VECTOR_ELEMENTS(mask)); - SCM_RETURN(SCM_UNDEFINED);") +(define-cproc gl-polygon-stipple (mask) :: + (assert-vector-type&size u8vector 128 mask) + (glPolygonStipple (SCM_U8VECTOR_ELEMENTS mask))) -(define-cproc gl-edge-flag (flag) - "if (SCM_GL_BOOLEAN_VECTOR_P(flag)) { - glEdgeFlagv(SCM_GL_BOOLEAN_VECTOR(flag)->elements); - } else { - glEdgeFlag(!SCM_FALSEP(flag)); - } - SCM_RETURN(SCM_UNDEFINED);") +(define-cproc gl-edge-flag (flag) :: + (if (SCM_GL_BOOLEAN_VECTOR_P flag) + (glEdgeFlagv (-> (SCM_GL_BOOLEAN_VECTOR flag) elements)) + (glEdgeFlag (not (SCM_FALSEP flag))))) (define-cproc gl-scissor (x:: y:: width:: height::) - (return "glScissor")) + :: glScissor) -(define-cproc gl-clip-plane (plane:: equation) - "if (!SCM_F64VECTORP(equation) || SCM_F64VECTOR_SIZE(equation) != 4) { - Scm_Error(\"f64vector of size 4 required for EQUATION, but got %S\", equation); - } - glClipPlane(plane, SCM_F64VECTOR_ELEMENTS(equation)); - SCM_RETURN(SCM_UNDEFINED);") +(define-cproc gl-clip-plane (plane:: equation) :: + (assert-vector-type&size f64vector 4 equation) + (glClipPlane plane (SCM_F64VECTOR_ELEMENTS equation))) (define-cproc gl-get-clip-plane (plane::) - " ScmF64Vector *v = SCM_F64VECTOR(Scm_MakeF64Vector(4, 0.0)); - glGetClipPlane(plane, SCM_F64VECTOR_ELEMENTS(v)); - SCM_RETURN(SCM_OBJ(v));") + (let* ([v::ScmF64Vector* (SCM_F64VECTOR (Scm_MakeF64Vector 4 0.0))]) + (glGetClipPlane plane (SCM_F64VECTOR_ELEMENTS v)) + (result (SCM_OBJ v)))) -(define-cproc gl-draw-buffer (mode::) - (return "glDrawBuffer")) +(define-cproc gl-draw-buffer (mode::) :: glDrawBuffer) +(define-cproc gl-read-buffer (mode::) :: glReadBuffer) -(define-cproc gl-read-buffer (mode::) - (return "glReadBuffer")) +(define-cproc gl-enable (cap::) :: glEnable) +(define-cproc gl-disable (cap::) :: glDisable) +(define-cproc gl-is-enabled (cap::) :: glIsEnabled) -(define-cproc gl-enable (cap::) - (return "glEnable")) - -(define-cproc gl-disable (cap::) - (return "glDisable")) - -(define-cproc gl-is-enabled (cap::) - (return "glIsEnabled")) - (define-cproc gl-enable-client-state (cap::) - (return "glEnableClientState")) - + :: glEnableClientState) (define-cproc gl-disable-client-state (cap::) - (return "glDisableClientState")) + :: glDisableClientState) ;; Gauche-gl specific (define-cproc gl-state-vector-size (state::) - (return "Scm_GLStateInfoSize")) + :: Scm_GLStateInfoSize) +(define-cise-stmt with-state-info-size + [(_ var state name . body) + `(let* ([,var :: int (Scm_GLStateInfoSize ,state)]) + (when (<= ,var 0) + (Scm_Error ,#`"you can't query state %x by ,name" ,state)) + ,@body)]) + (define-cproc gl-get-boolean (state::) - "int vsize = Scm_GLStateInfoSize(state); - if (vsize <= 0) - Scm_Error(\"you can't query state %x by glGetBooleanv\", state); - if (vsize == 1) { - GLboolean b; - glGetBooleanv((GLenum)state, &b); - SCM_RETURN(SCM_MAKE_BOOL(b)); - } else { - ScmObj v = Scm_MakeGLBooleanVector(vsize, GL_FALSE); - glGetBooleanv((GLenum)state, SCM_GL_BOOLEAN_VECTOR(v)->elements); - SCM_RETURN(v); - }") + (with-state-info-size + vsize state gl-get-boolean + (if (== vsize 1) + (let* ([b::GLboolean]) + (glGetBooleanv (cast GLenum state) (& b)) + (result (SCM_MAKE_BOOL b))) + (let* ([v (Scm_MakeGLBooleanVector vsize GL_FALSE)]) + (glGetBooleanv (cast GLenum state) + (-> (SCM_GL_BOOLEAN_VECTOR v) elements)) + (result v))))) -(define-cproc gl-get-boolean! (vec state::) - "int vsize; - if (!SCM_GL_BOOLEAN_VECTOR_P(vec)) - Scm_Error(\"gl-boolean-vector required, but got %S\", vec); - vsize = Scm_GLStateInfoSize(state); - if (vsize != SCM_GL_BOOLEAN_VECTOR_SIZE(vec)) - Scm_Error(\"state %x needs a vector of size %d, but got %S\", - state, vsize, vec); - glGetBooleanv((GLenum)state, SCM_GL_BOOLEAN_VECTOR(vec)->elements); - SCM_RETURN(SCM_OBJ(vec));") +(define-cproc gl-get-boolean! (vec:: state::) + (with-state-info-size + vsize state gl-get-boolean! + (when (!= vsize (SCM_GL_BOOLEAN_VECTOR_SIZE vec)) + (Scm_Error "state %x needs a vector of size %d, but got %S" + state vsize (SCM_OBJ vec))) + (glGetBooleanv (cast GLenum state) (-> vec elements)) + (result (SCM_OBJ vec)))) (define-cproc gl-get-integer (state::) - "int vsize = Scm_GLStateInfoSize(state); - if (vsize <= 0) - Scm_Error(\"you can't query state %x by glGetIntegerv\", state); - if (vsize == 1) { - GLint i; - glGetIntegerv((GLenum)state, &i); - SCM_RETURN(Scm_MakeInteger(i)); - } else { - ScmS32Vector *v = SCM_S32VECTOR(Scm_MakeS32Vector(vsize, 0)); - glGetIntegerv((GLenum)state, (GLint*)SCM_S32VECTOR_ELEMENTS(v)); - SCM_RETURN(SCM_OBJ(v)); - }") + (with-state-info-size + vsize state gl-get-integer + (if (== vsize 1) + (let* ([i::GLint]) + (glGetIntegerv (cast GLenum state) (& i)) + (result (Scm_MakeInteger i))) + (let* ([v::ScmS32Vector* (SCM_S32VECTOR (Scm_MakeS32Vector vsize 0))]) + (glGetIntegerv (cast GLenum state) + (cast GLint* (SCM_S32VECTOR_ELEMENTS v))) + (result (SCM_OBJ v)))))) -(define-cproc gl-get-integer! (vec state::) - "int vsize; - if (!SCM_S32VECTORP(vec)) Scm_Error(\"s32vector required, but got %S\", vec); - vsize = Scm_GLStateInfoSize(state); - if (vsize != SCM_S32VECTOR_SIZE(vec)) - Scm_Error(\"state %x needs a vector of size %d, but got %S\", - state, vsize, vec); - glGetIntegerv((GLenum)state, (GLint*)SCM_S32VECTOR_ELEMENTS(vec)); - SCM_RETURN(SCM_OBJ(vec));") +(define-cproc gl-get-integer! (vec:: state::) + (with-state-info-size + vsize state gl-get-integer! + (when (!= vsize (SCM_S32VECTOR_SIZE vec)) + (Scm_Error "state %x needs a vector of size %d, but got %S" + state vsize vec)) + (glGetIntegerv (cast GLenum state) + (cast GLint* (SCM_S32VECTOR_ELEMENTS vec))) + (result (SCM_OBJ vec)))) (define-cproc gl-get-float (state::) - "int vsize = Scm_GLStateInfoSize(state); - if (vsize <= 0) - Scm_Error(\"you can't query state %x by glGetFloatv\", state); - if (vsize == 1) { - GLfloat v; - glGetFloatv((GLenum)state, &v); - SCM_RETURN(Scm_MakeFlonum((double)v)); - } else { - ScmF32Vector *v = SCM_F32VECTOR(Scm_MakeF32Vector(vsize, 0)); - glGetFloatv((GLenum)state, SCM_F32VECTOR_ELEMENTS(v)); - SCM_RETURN(SCM_OBJ(v)); - }") + (with-state-info-size + vsize state gl-get-float + (if (== vsize 1) + (let* ([v::GLfloat]) + (glGetFloatv (cast GLenum state) (& v)) + (result (Scm_MakeFlonum (cast double v)))) + (let* ([v::ScmF32Vector* (SCM_F32VECTOR (Scm_MakeF32Vector vsize 0))]) + (glGetFloatv (cast GLenum state) (SCM_F32VECTOR_ELEMENTS v)) + (result (SCM_OBJ v)))))) -(define-cproc gl-get-float! (vec state::) - "int vsize; - if (!SCM_F32VECTORP(vec)) Scm_Error(\"s32vector required, but got %S\", vec); - vsize = Scm_GLStateInfoSize(state); - if (vsize != SCM_F32VECTOR_SIZE(vec)) - Scm_Error(\"state %x needs a vector of size %d, but got %S\", - state, vsize, vec); - glGetFloatv((GLenum)state, SCM_F32VECTOR_ELEMENTS(vec)); - SCM_RETURN(SCM_OBJ(vec));") +(define-cproc gl-get-float! (vec:: state::) + (with-state-info-size + vsize state gl-get-float! + (when (!= vsize (SCM_F32VECTOR_SIZE vec)) + (Scm_Error "state %x needs a vector of size %d, but got %S" + state vsize vec)) + (glGetFloatv (cast GLenum state) (SCM_F32VECTOR_ELEMENTS vec)) + (result (SCM_OBJ vec)))) (define-cproc gl-get-double (state::) - "int vsize = Scm_GLStateInfoSize(state); - if (vsize <= 0) - Scm_Error(\"you can't query state %x by glGetDoublev\", state); - if (vsize == 1) { - GLdouble v; - glGetDoublev((GLenum)state, &v); - SCM_RETURN(Scm_MakeFlonum(v)); - } else { - ScmF64Vector *v = SCM_F64VECTOR(Scm_MakeF64Vector(vsize, 0)); - glGetDoublev((GLenum)state, SCM_F64VECTOR_ELEMENTS(v)); - SCM_RETURN(SCM_OBJ(v)); - }") + (with-state-info-size + vsize state gl-get-double + (if (== vsize 1) + (let* ([v::GLdouble]) + (glGetDoublev (cast GLenum state) (& v)) + (result (Scm_MakeFlonum v))) + (let* ([v::ScmF64Vector* (SCM_F64VECTOR (Scm_MakeF64Vector vsize 0))]) + (glGetDoublev (cast GLenum state) (SCM_F64VECTOR_ELEMENTS v)) + (result (SCM_OBJ v)))))) -(define-cproc gl-get-double! (vec state::) - "int vsize; - if (!SCM_F64VECTORP(vec)) Scm_Error(\"s32vector required, but got %S\", vec); - vsize = Scm_GLStateInfoSize(state); - if (vsize != SCM_F64VECTOR_SIZE(vec)) - Scm_Error(\"state %x needs a vector of size %d, but got %S\", - state, vsize, vec); - glGetDoublev((GLenum)state, SCM_F64VECTOR_ELEMENTS(vec)); - SCM_RETURN(SCM_OBJ(vec));") +(define-cproc gl-get-double! (vec:: state::) + (with-state-info-size + vsize state gl-get-double! + (when (!= vsize (SCM_F64VECTOR_SIZE vec)) + (Scm_Error "state %x needs a vector of size %d, but got %S" + state vsize vec)) + (glGetDoublev (cast GLenum state) (SCM_F64VECTOR_ELEMENTS vec)) + (result (SCM_OBJ vec)))) ;; glGetPointerv -(define-cproc gl-push-attrib (mask::) - (return "glPushAttrib")) +(define-cproc gl-push-attrib (mask::):: glPushAttrib) +(define-cproc gl-pop-attrib () :: glPopAttrib) +(define-cproc gl-push-client-attrib (mask::):: glPushClientAttrib) +(define-cproc gl-pop-client-attrib () :: glPopClientAttrib) -(define-cproc gl-pop-attrib () - (return "glPopAttrib")) +(define-cproc gl-render-mode (mode::) :: glRenderMode) -(define-cproc gl-push-client-attrib (mask::) - (return "glPushClientAttrib")) - -(define-cproc gl-pop-client-attrib () - (return "glPopClientAttrib")) - -(define-cproc gl-render-mode (mode::) - (return "glRenderMode")) - -(define-cproc gl-get-error () - (return "glGetError")) - +(define-cproc gl-get-error () :: glGetError) (define-cproc gl-get-string (name::) - "const GLubyte *s = glGetString(name); - if (s) SCM_RETURN(Scm_MakeString((const char*)s, -1, -1, SCM_MAKSTR_COPYING)); - else SCM_RETURN(SCM_FALSE);") + (let* ([s::(const GLubyte*) (glGetString name)]) + (if s + (result (Scm_MakeString (cast (const char*) s) -1 -1 SCM_MAKSTR_COPYING)) + (result SCM_FALSE)))) -(define-cproc gl-flush () - (return "glFlush")) +(define-cproc gl-flush () :: glFlush) +(define-cproc gl-finish () :: glFinish) +(define-cproc gl-hint (target:: mode::) :: glHint) -(define-cproc gl-finish () - (return "glFinish")) - -(define-cproc gl-hint (target:: mode::) - (return "glHint")) - ;;============================================================= ;; Depth Buffer ;; -(define-cproc gl-clear-depth (depth::) - (return "glClearDepth")) +(define-cproc gl-clear-depth (depth::):: glClearDepth) +(define-cproc gl-depth-func (func::):: glDepthFunc) +(define-cproc gl-depth-mask (flag::):: glDepthMask) +(define-cproc gl-depth-range (nearv:: farv::):: glDepthRange) -(define-cproc gl-depth-func (func::) - (return "glDepthFunc")) - -(define-cproc gl-depth-mask (flag::) - (return "glDepthMask")) - -(define-cproc gl-depth-range (nearv:: farv::) - (return "glDepthRange")) - ;;============================================================= ;; Accumulation Buffer ;; (define-cproc gl-clear-accum (r:: g:: b:: a::) - (return "glClearAccum")) + :: glClearAccum) +(define-cproc gl-accum (op:: value::) :: glAccum) -(define-cproc gl-accum (op:: value::) - (return "glAccum")) - ;;============================================================= ;; Transformation ;; -(define-cproc gl-matrix-mode (mode::) - (return "glMatrixMode")) +(define-cproc gl-matrix-mode (mode::) :: glMatrixMode) (define-cproc gl-ortho (left:: right:: bottom:: top:: nearv:: farv::) - (return "glOrtho")) + :: glOrtho) (define-cproc gl-frustum (left:: right:: bottom:: top:: nearv:: farv::) - (return "glFrustum")) + :: glFrustum) (define-cproc gl-viewport (x:: y:: width:: height::) - (return "glViewport")) + :: glViewport) -(define-cproc gl-push-matrix () - (return "glPushMatrix")) +(define-cproc gl-push-matrix () :: glPushMatrix) +(define-cproc gl-pop-matrix () :: glPopMatrix) +(define-cproc gl-load-identity () :: glLoadIdentity) -(define-cproc gl-pop-matrix () - (return "glPopMatrix")) +(define-cproc gl-load-matrix (m) :: + (cond [(SCM_MATRIX4FP m) (glLoadMatrixf (SCM_MATRIX4F_D m))] + [(and (SCM_F32VECTORP m) (== (SCM_F32VECTOR_SIZE m) 16)) + (glLoadMatrixf (SCM_F32VECTOR_ELEMENTS m))] + [(and (SCM_F64VECTORP m) (== (SCM_F64VECTOR_SIZE m) 16)) + (glLoadMatrixd (SCM_F64VECTOR_ELEMENTS m))] + [else (Scm_Error "matrix4f, or f32vector or f64vector of length 16 \ + is required, but got %S" m)])) -(define-cproc gl-load-identity () - (return "glLoadIdentity")) +(define-cproc gl-mult-matrix (m) :: + (cond [(SCM_MATRIX4FP m) (glMultMatrixf (SCM_MATRIX4F_D m))] + [(and (SCM_F32VECTORP m) (== (SCM_F32VECTOR_SIZE m) 16)) + (glMultMatrixf (SCM_F32VECTOR_ELEMENTS m))] + [(and (SCM_F64VECTORP m) (== (SCM_F64VECTOR_SIZE m) 16)) + (glMultMatrixd (SCM_F64VECTOR_ELEMENTS m))] + [else (Scm_Error "matrix4f, or f32vector or f64vector of length 16 \ + is required, but got %S" m)])) -(define-cproc gl-load-matrix (m) - "if (SCM_MATRIX4FP(m)) { - glLoadMatrixf(SCM_MATRIX4F_D(m)); - } else if (SCM_F32VECTORP(m) && SCM_F32VECTOR_SIZE(m) == 16) { - glLoadMatrixf(SCM_F32VECTOR_ELEMENTS(m)); - } else if (SCM_F64VECTORP(m) && SCM_F64VECTOR_SIZE(m) == 16) { - glLoadMatrixd(SCM_F64VECTOR_ELEMENTS(m)); - } else { - Scm_Error(\"matrix4f, or f32vector or f64vector of length 16 is required, but got %S\", m); - } - SCM_RETURN(SCM_UNDEFINED);") - -(define-cproc gl-mult-matrix (m) - "if (SCM_MATRIX4FP(m)) { - glMultMatrixf(SCM_MATRIX4F_D(m)); - } else if (SCM_F32VECTORP(m) && SCM_F32VECTOR_SIZE(m) == 16) { - glMultMatrixf(SCM_F32VECTOR_ELEMENTS(m)); - } else if (SCM_F64VECTORP(m) && SCM_F64VECTOR_SIZE(m) == 16) { - glMultMatrixd(SCM_F64VECTOR_ELEMENTS(m)); - } else { - Scm_Error(\"matrix4f, or f32vector or f64vector of length 16 is required, but got %S\", m); - } - SCM_RETURN(SCM_UNDEFINED);") - (define-cproc gl-rotate (angle:: x:: y:: z::) - (return "glRotated")) - + :: glRotated) (define-cproc gl-scale (x:: y:: z::) - (return "glScaled")) - + :: glScaled) (define-cproc gl-translate (x:: y:: z::) - (return "glTranslated")) + :: glTranslated) ;;============================================================= ;; Display lists ;; -(define-cproc gl-is-list (list::) - (return "glIsList")) +(define-cproc gl-is-list (list::):: glIsList) +(define-cproc gl-delete-lists (list:: range::) :: glDeleteLists) +(define-cproc gl-gen-lists (range::) :: glGenLists) +(define-cproc gl-new-list (list:: mode::) :: glNewList) +(define-cproc gl-end-list () :: glEndList) +(define-cproc gl-call-list (list::) :: glCallList) -(define-cproc gl-delete-lists (list:: range::) - (return "glDeleteLists")) - -(define-cproc gl-gen-lists (range::) - (return "glGenLists")) - -(define-cproc gl-new-list (list:: mode::) - (return "glNewList")) - -(define-cproc gl-end-list () - (return "glEndList")) - -(define-cproc gl-call-list (list::) - (return "glCallList")) - ;; this may be called as ;; (gl-call-lists array) ;; (gl-call-lists size array) @@ -536,19 +439,15 @@ Scm_Error(\"given type %d doesn't match the passed array (u8vector)\", type); SCM_RETURN(SCM_UNDEFINED);") -(define-cproc gl-list-base (base::) - (return "glListBase")) +(define-cproc gl-list-base (base::) :: glListBase) ;;============================================================= ;; Drawing functions ;; -(define-cproc gl-begin (mode::) - (return "glBegin")) +(define-cproc gl-begin (mode::) :: glBegin) +(define-cproc gl-end () :: glEnd) -(define-cproc gl-end () - (return "glEnd")) - (define-cproc gl-vertex (v &rest args) "if (SCM_POINT4FP(v) || SCM_VECTOR4FP(v)) { glVertex3fv(SCM_VECTOR4F_D(v)); @@ -926,20 +825,20 @@ Scm_Error(\"bad argument for offset: %d, must be 0 or positive\", offset); } if (SCM_S32VECTORP(vec)) { - glNormalPointer(GL_INT, stride*sizeof(GLint), - (void*)(SCM_S32VECTOR_ELEMENTS(vec)+offset)); + glIndexPointer(GL_INT, stride*sizeof(GLint), + (void*)(SCM_S32VECTOR_ELEMENTS(vec)+offset)); } else if (SCM_S16VECTORP(vec)) { - glNormalPointer(GL_SHORT, stride*sizeof(GLshort), - (void*)(SCM_S16VECTOR_ELEMENTS(vec)+offset)); + glIndexPointer(GL_SHORT, stride*sizeof(GLshort), + (void*)(SCM_S16VECTOR_ELEMENTS(vec)+offset)); } else if (SCM_U8VECTORP(vec)) { - glNormalPointer(GL_UNSIGNED_BYTE, stride*sizeof(GLubyte), - (void*)(SCM_U8VECTOR_ELEMENTS(vec)+offset)); + glIndexPointer(GL_UNSIGNED_BYTE, stride*sizeof(GLubyte), + (void*)(SCM_U8VECTOR_ELEMENTS(vec)+offset)); } else if (SCM_F32VECTORP(vec)) { - glNormalPointer(GL_FLOAT, stride*sizeof(GLfloat), - (void*)(SCM_F32VECTOR_ELEMENTS(vec)+offset)); + glIndexPointer(GL_FLOAT, stride*sizeof(GLfloat), + (void*)(SCM_F32VECTOR_ELEMENTS(vec)+offset)); } else if (SCM_F64VECTORP(vec)) { - glNormalPointer(GL_DOUBLE, stride*sizeof(GLdouble), - (void*)(SCM_F64VECTOR_ELEMENTS(vec)+offset)); + glIndexPointer(GL_DOUBLE, stride*sizeof(GLdouble), + (void*)(SCM_F64VECTOR_ELEMENTS(vec)+offset)); } else { Scm_Error(\"bad argument for vec: %S, must be f32, f64, u8, s16 or s32 vector\", vec); } @@ -958,17 +857,17 @@ Scm_Error(\"bad argument for offset: %d, must be 0 or positive\", offset); } if (SCM_F32VECTORP(vec)) { - glColorPointer(size, GL_FLOAT, stride*sizeof(GLfloat), - (void*)(SCM_F32VECTOR_ELEMENTS(vec)+offset)); + glTexCoordPointer(size, GL_FLOAT, stride*sizeof(GLfloat), + (void*)(SCM_F32VECTOR_ELEMENTS(vec)+offset)); } else if (SCM_F64VECTORP(vec)) { - glColorPointer(size, GL_DOUBLE, stride*sizeof(GLdouble), - (void*)(SCM_F64VECTOR_ELEMENTS(vec)+offset)); + glTexCoordPointer(size, GL_DOUBLE, stride*sizeof(GLdouble), + (void*)(SCM_F64VECTOR_ELEMENTS(vec)+offset)); } else if (SCM_S32VECTORP(vec)) { - glColorPointer(size, GL_INT, stride*sizeof(GLint), - (void*)(SCM_S32VECTOR_ELEMENTS(vec)+offset)); + glTexCoordPointer(size, GL_INT, stride*sizeof(GLint), + (void*)(SCM_S32VECTOR_ELEMENTS(vec)+offset)); } else if (SCM_S16VECTORP(vec)) { - glColorPointer(size, GL_SHORT, stride*sizeof(GLshort), - (void*)(SCM_S16VECTOR_ELEMENTS(vec)+offset)); + glTexCoordPointer(size, GL_SHORT, stride*sizeof(GLshort), + (void*)(SCM_S16VECTOR_ELEMENTS(vec)+offset)); } else { Scm_Error(\"bad argument for vec: %S, must be f32, f64, s16 or s32vector\", vec); } @@ -1006,7 +905,7 @@ (define-cproc gl-draw-arrays (mode:: first:: count::) - (return "glDrawArrays")) + :: glDrawArrays) ;; Note: we don't allow non-uniform vector for the interleaved arrays, so ;; the color component must be float. @@ -1028,8 +927,7 @@ ;; Lighting ;; -(define-cproc gl-shade-model (mode::) - (return "glShadeModel")) +(define-cproc gl-shade-model (mode::) :: glShadeModel) (define-cproc gl-light (light:: pname:: param) "switch (pname) { @@ -1162,14 +1060,14 @@ }") (define-cproc gl-color-material (face:: mode::) - (return "glColorMaterial")) + :: glColorMaterial) ;;============================================================= ;; Raster functions ;; (define-cproc gl-pixel-zoom (xfactor:: yfactor::) - (return "glPixelZoom")) + :: glPixelZoom) (define-cproc gl-pixel-store (pname:: param) "if (SCM_EXACTP(param)) { @@ -1273,31 +1171,29 @@ (define-cproc gl-draw-pixels (width:: height:: format:: type:: pixels) - " int elttype, size, packed; - size = Scm_GLPixelDataSize(width, height, format, type, &elttype, &packed); - glDrawPixels(width, height, format, type, - Scm_GLPixelDataCheck(pixels, elttype, size)); - SCM_RETURN(SCM_UNDEFINED);") + :: + (let* ([elttype::int] [packed::int] + [size::int (Scm_GLPixelDataSize width height format type + (& elttype) (& packed))]) + (glDrawPixels width height format type + (Scm_GLPixelDataCheck pixels elttype size)))) (define-cproc gl-copy-pixels (x:: y:: width:: height:: type::) - (return "glCopyPixels")) + :: glCopyPixels) ;;============================================================= ;; Stenciling ;; (define-cproc gl-stencil-func (func:: ref:: mask::) - (return "glStencilFunc")) - + :: glStencilFunc) (define-cproc gl-stencil-mask (mask::) - (return "glStencilMask")) - + :: glStencilMask) (define-cproc gl-stencil-op (func:: zfail:: zpass::) - (return "glStencilOp")) - + :: glStencilOp) (define-cproc gl-clear-stencil (s::) - (return "glClearStencil")) + :: glClearStencil) ;;============================================================= ;; Texture mapping @@ -1439,22 +1335,30 @@ SCM_RETURN(SCM_UNDEFINED); }") -;; Caller must ensure vector has enough length +;; Caller must ensure vector has enough length, since we need to get +;; pixel store parameters to check that, which is expensive. +;; We allow #f to TEXELS just to allcate texture area (to be used +;; as a render target via framebuffer object). (define-cproc gl-tex-image-1d (target:: level:: internalformat:: width:: border:: format:: type:: texels) "int elttype, size; void *texelptr; size = Scm_GLPixelDataSize(width, 1, format, type, &elttype, NULL); - texelptr = Scm_GLPixelDataCheck(texels, elttype, size); - if (texelptr) { + if (SCM_FALSEP(texels)) { + texelptr = NULL; + } else { + texelptr = Scm_GLPixelDataCheck(texels, elttype, size); glTexImage1D(target, level, internalformat, width, border, format, type, texelptr); } SCM_RETURN(SCM_UNDEFINED);") -;; caller must ensure vector has enough length +;; Caller must ensure vector has enough length, since we need to get +;; pixel store parameters to check that, which is expensive. +;; We allow #f to TEXELS just to allcate texture area (to be used +;; as a render target via framebuffer object). (define-cproc gl-tex-image-2d (target:: level:: internalformat:: width:: height:: @@ -1462,100 +1366,97 @@ type:: texels) "int elttype, size; void *texelptr; size = Scm_GLPixelDataSize(width, height, format, type, &elttype, NULL); - texelptr = Scm_GLPixelDataCheck(texels, elttype, size); - if (texelptr) { - glTexImage2D(target, level, internalformat, width, height, border, format, type, texelptr); + if (SCM_FALSEP(texels)) { + texelptr = NULL; + } else { + texelptr = Scm_GLPixelDataCheck(texels, elttype, size); + glTexImage2D(target, level, internalformat, width, height, border, format, type, texelptr); } SCM_RETURN(SCM_UNDEFINED);") ; gl-get-tex-image (define-cproc gl-gen-textures (size::) - "ScmObj vec; - if (size <= 0) Scm_Error(\"size must be a positive integer, but got %d\", size); - vec = Scm_MakeU32Vector(size, 0); - glGenTextures(size, (GLuint*)SCM_U32VECTOR_ELEMENTS(vec)); - SCM_RETURN(vec);") + (when (<= size 0) + (Scm_Error "size must be a positive integer, but got %d" size)) + (let* ([vec (Scm_MakeU32Vector size 0)]) + (glGenTextures size (cast GLuint* (SCM_U32VECTOR_ELEMENTS vec))) + (result vec))) -(define-cproc gl-delete-textures (names) - "if (!SCM_U32VECTORP(names)) Scm_Error(\"texture names must be an u32vector, but got %S\", names); - glDeleteTextures(SCM_U32VECTOR_SIZE(names), - (GLuint*)SCM_U32VECTOR_ELEMENTS(names)); - SCM_RETURN(SCM_UNDEFINED);") +(define-cproc gl-delete-textures (names::) :: + (glDeleteTextures (SCM_U32VECTOR_SIZE names) + (cast GLuint* (SCM_U32VECTOR_ELEMENTS names)))) -(define-cproc gl-bind-texture (target:: name::) - "glBindTexture(target, name); - SCM_RETURN(SCM_UNDEFINED);") +(define-cproc gl-bind-texture (target:: name::) :: + glBindTexture) (define-cproc gl-prioritize-textures (names:: priorities::) - "int n = SCM_U32VECTOR_SIZE(names); - if (n != SCM_F32VECTOR_SIZE(priorities)) { - Scm_Error(\"priority vector length doesn't match the names vector length %d: %S\", n, priorities); - } - glPrioritizeTextures(n, (GLuint*)SCM_U32VECTOR_ELEMENTS(names), - SCM_F32VECTOR_ELEMENTS(priorities)); - SCM_RETURN(SCM_UNDEFINED);") + :: + (let* ([n::int (SCM_U32VECTOR_SIZE names)]) + (when (!= n (SCM_F32VECTOR_SIZE priorities)) + (Scm_Error "priority vector length doesn't match \ + the names vector length %d: %S" n priorities)) + (glPrioritizeTextures n (cast GLuint* (SCM_U32VECTOR_ELEMENTS names)) + (SCM_F32VECTOR_ELEMENTS priorities)))) (define-cproc gl-are-textures-resident! (names:: res::) - "GLboolean b; int n; - n = SCM_U32VECTOR_SIZE(names); - b = glAreTexturesResident(n, (GLuint*)SCM_U32VECTOR_ELEMENTS(names), - SCM_GL_BOOLEAN_VECTOR_ELEMENTS(res)); - SCM_RETURN(SCM_MAKE_BOOL(b));") + :: + (glAreTexturesResident (SCM_U32VECTOR_SIZE names) + (cast GLuint* (SCM_U32VECTOR_ELEMENTS names)) + (SCM_GL_BOOLEAN_VECTOR_ELEMENTS res))) -(define-cproc gl-is-texture (name::) - "SCM_RETURN(SCM_MAKE_INT(glIsTexture(name)));") +(define-cproc gl-is-texture (name::) :: glIsTexture) (define-cproc gl-tex-sub-image-1d (target:: level:: xoffset:: width:: format:: type:: texels) - "int elttype, size; void *texelptr; - size = Scm_GLPixelDataSize(width, 1, format, type, &elttype, NULL); - texelptr = Scm_GLPixelDataCheck(texels, elttype, size); - if (texelptr) { - glTexSubImage1D(target, level, xoffset, width, format, type, texelptr); - } - SCM_RETURN(SCM_UNDEFINED);") + :: + (let* ([elttype::int] + [size::int (Scm_GLPixelDataSize width 1 format type (& elttype) NULL)] + [texelptr::void* (Scm_GLPixelDataCheck texels elttype size)]) + (when texelptr + (glTexSubImage1D target level xoffset width format type texelptr)))) (define-cproc gl-tex-sub-image-2d (target:: level:: xoffset:: yoffset:: width:: height:: format:: type:: texels) - "int elttype, size; void *texelptr; - size = Scm_GLPixelDataSize(width, height, format, type, &elttype, NULL); - texelptr = Scm_GLPixelDataCheck(texels, elttype, size); - if (texelptr) { - glTexSubImage2D(target, level, xoffset, yoffset, width, height, format, type, texelptr); - } - SCM_RETURN(SCM_UNDEFINED);") + :: + (let* ([elttype::int] + [size::int + (Scm_GLPixelDataSize width height format type (& elttype) NULL)] + [texelptr::void* (Scm_GLPixelDataCheck texels elttype size)]) + (when texelptr + (glTexSubImage2D target level xoffset yoffset width height + format type texelptr)))) (define-cproc gl-copy-tex-image-1d (target:: level:: internal-format:: x:: y:: width:: border::) - (return "glCopyTexImage1D")) + :: glCopyTexImage1D) (define-cproc gl-copy-tex-image-2d (target:: level:: internal-format:: x:: y:: width:: height:: border::) - (return "glCopyTexImage2D")) + :: glCopyTexImage2D) (define-cproc gl-copy-tex-sub-image-1d (target:: level:: xoffset:: x:: y:: width::) - (return "glCopyTexSubImage1D")) + :: glCopyTexSubImage1D) (define-cproc gl-copy-tex-sub-image-2d (target:: level:: xoffset:: yoffset:: x:: y:: width:: height::) - (return "glCopyTexSubImage2D")) + :: glCopyTexSubImage2D) ;;============================================================= ;; Evaluators @@ -1576,36 +1477,20 @@ ;; Fog ;; -(define-cproc gl-fog (pname:: param) - "switch (pname) { - case GL_FOG_MODE:; - case GL_FOG_INDEX:; - if (SCM_INTP(param)) { - glFogi(pname, SCM_INT_VALUE(param)); - } else { - Scm_Error(\"integer parameter required, but got %S\", param); - } - break; - case GL_FOG_DENSITY:; - case GL_FOG_START:; - case GL_FOG_END:; - if (SCM_REALP(param)) { - glFogf(pname, (GLfloat)Scm_GetDouble(param)); - } else { - Scm_Error(\"real number parameter required, but got %S\", param); - } - break; - case GL_FOG_COLOR: - if (SCM_F32VECTORP(param) && SCM_F32VECTOR_SIZE(param) == 4) { - glFogfv(pname, SCM_F32VECTOR_ELEMENTS(param)); - } else { - Scm_Error(\"f32 vector of size 4 is required, but got %S\", param); - } - break; - default: - Scm_Error(\"unknown or unsupported glFog pname: %d\", pname); - } - SCM_RETURN(SCM_UNDEFINED);") +(define-cproc gl-fog (pname:: param) :: + (case pname + [(GL_FOG_MODE GL_FOG_INDEX) + (if (SCM_INTP param) + (glFogi pname (SCM_INT_VALUE param)) + (Scm_Error "integer parameter required, but got %S" param))] + [(GL_FOG_DENSITY GL_FOG_START GL_FOG_END) + (if (SCM_REALP param) + (glFogf pname (cast GLfloat (Scm_GetDouble param))) + (Scm_Error "real number parameter required, but got %S" param))] + [(GL_FOG_COLOR) + (assert-vector-type&size f32vector 4 param) + (glFogfv pname (SCM_F32VECTOR_ELEMENTS param))] + [else (Scm_Error "unknown or unsupported glFog pname: %d" pname)])) ;;============================================================= ;; Selection and feedback @@ -1613,30 +1498,21 @@ (define-cproc gl-feedback-buffer (type:: buffer::) - "glFeedbackBuffer(SCM_F32VECTOR_SIZE(buffer), type, - SCM_F32VECTOR_ELEMENTS(buffer)); - SCM_RETURN(SCM_UNDEFINED);") + :: + (glFeedbackBuffer (SCM_F32VECTOR_SIZE buffer) type + (SCM_F32VECTOR_ELEMENTS buffer))) -(define-cproc gl-select-buffer (buffer::) - "glSelectBuffer(SCM_U32VECTOR_SIZE(buffer), - (GLuint*)SCM_U32VECTOR_ELEMENTS(buffer)); - SCM_RETURN(SCM_UNDEFINED);") +(define-cproc gl-select-buffer (buffer::) :: + (glSelectBuffer (SCM_U32VECTOR_SIZE buffer) + (cast GLuint* (SCM_U32VECTOR_ELEMENTS buffer)))) -(define-cproc gl-pass-through (token::) - (return "glPassThrough")) +(define-cproc gl-pass-through (token::) :: glPassThrough) -(define-cproc gl-init-names () - (return "glInitNames")) +(define-cproc gl-init-names () :: glInitNames) +(define-cproc gl-load-name (name::) :: glLoadName) +(define-cproc gl-push-name (name::) :: glPushName) +(define-cproc gl-pop-name () :: glPopName) -(define-cproc gl-load-name (name::) - (return "glLoadName")) - -(define-cproc gl-push-name (name::) - (return "glPushName")) - -(define-cproc gl-pop-name () - (return "glPopName")) - ;; Local variables: ;; mode: scheme ;; end: =================================================================== --- gauche-gl-0.4.4.orig/src/gauche-glut.c (revision 301) +++ gauche-gl-0.4.4/src/gauche-glut.c (working copy) @@ -1,7 +1,7 @@ /* * gauche-glut.c - Gauche GLUT binding * - * Copyright(C) 2001 by Shiro Kawai (shiro@acm.org) + * Copyright (c) 2001-2008 Shiro Kawai * * Permission to use, copy, modify, distribute this software and * accompanying documentation for any purpose is hereby granted, @@ -27,6 +27,10 @@ extern void Scm_Init_glut_lib(ScmModule *mod); +/*================================================================ + * Glut font + */ + SCM_DEFINE_BUILTIN_CLASS_SIMPLE(Scm_GlutFontClass, NULL); static ScmObj makeGlutFont(void *ptr) @@ -37,6 +41,250 @@ return SCM_OBJ(gf); } +/*================================================================ + * Callback support. + * + * Glut callbacks are associated to the "current window". + * unfortunately the callback interface doesn't allow us + * to pass extra data pointer, so our C callback routine + * doesn't know which Scheme closure to be called. We maintain + * that information in our table. + * + * TODO: We don't want to use Scm_ApplyRec, for we need to cons + * the arguments (display is ok, but motion and passiveMotion generates + * garbages which will eventurally trigger GC.) Rewrite *_cb functions + * after we implement Scm_ApplyRec0, Scm_ApplyRec1, .., etc. in + * Gauche core. + */ + +static ScmObj ScmGlutCallbackTable = SCM_UNDEFINED; /* set by init routine */ + +static ScmObj get_callback(int type) +{ + int win = glutGetWindow(); + ScmObj entry = Scm_HashTableRef(SCM_HASH_TABLE(ScmGlutCallbackTable), + SCM_MAKE_INT(win), SCM_FALSE); + SCM_ASSERT(type >= 0 && type < SCM_GLUT_NUM_WINDOW_CBS); + if (SCM_VECTORP(entry)) { + return SCM_VECTOR_ELEMENT(entry, type); + } else { + return SCM_FALSE; + } +} + +#define define_callback(name, num, arglist, args) \ + static void SCM_CPP_CAT(name, _cb) arglist \ + { \ + ScmObj cb = get_callback(SCM_CPP_CAT(SCM_GLUT_CB_, num)); \ + if (!SCM_FALSEP(cb)) { \ + Scm_ApplyRec(cb, args); \ + } \ + } + +define_callback(display, DISPLAY, (void), SCM_NIL) + + +define_callback(overlay_display, OVERLAY_DISPLAY, (void), SCM_NIL) +define_callback(reshape, RESHAPE, (int w, int h), + SCM_LIST2(SCM_MAKE_INT(w), SCM_MAKE_INT(h))); +define_callback(keyboard, KEYBOARD, (unsigned char key, int w, int h), + SCM_LIST3(SCM_MAKE_INT(key), SCM_MAKE_INT(w), SCM_MAKE_INT(h))) +define_callback(keyboard_up, KEYBOARD_UP, (unsigned char key, int w, int h), + SCM_LIST3(SCM_MAKE_INT(key), SCM_MAKE_INT(w), SCM_MAKE_INT(h))) +define_callback(mouse, MOUSE, (int button, int state, int x, int y), + SCM_LIST4(SCM_MAKE_INT(button), SCM_MAKE_INT(state), + SCM_MAKE_INT(x), SCM_MAKE_INT(y))) +define_callback(motion, MOTION, (int x, int y), + SCM_LIST2(SCM_MAKE_INT(x), SCM_MAKE_INT(y))) +define_callback(passive_motion, PASSIVE_MOTION, (int x, int y), + SCM_LIST2(SCM_MAKE_INT(x), SCM_MAKE_INT(y))) +define_callback(visibility, VISIBILITY, (int state), + SCM_LIST1(SCM_MAKE_INT(state))) +define_callback(entry, ENTRY, (int state), + SCM_LIST1(SCM_MAKE_INT(state))) +define_callback(special, SPECIAL, (int key, int w, int h), + SCM_LIST3(SCM_MAKE_INT(key), SCM_MAKE_INT(w), SCM_MAKE_INT(h))) +define_callback(special_up, SPECIAL_UP, (int key, int w, int h), + SCM_LIST3(SCM_MAKE_INT(key), SCM_MAKE_INT(w), SCM_MAKE_INT(h))) +define_callback(spaceball_motion, SPACEBALL_MOTION, (int x, int y, int z), + SCM_LIST3(SCM_MAKE_INT(x), SCM_MAKE_INT(y), SCM_MAKE_INT(z))) +define_callback(spaceball_rotate, SPACEBALL_ROTATE, (int x, int y, int z), + SCM_LIST3(SCM_MAKE_INT(x), SCM_MAKE_INT(y), SCM_MAKE_INT(z))) +define_callback(spaceball_button, SPACEBALL_BUTTON, (int button, int state), + SCM_LIST2(SCM_MAKE_INT(button), SCM_MAKE_INT(state))) +define_callback(button_box, BUTTON_BOX, (int button, int state), + SCM_LIST2(SCM_MAKE_INT(button), SCM_MAKE_INT(state))) +define_callback(dials, DIALS, (int dial, int value), + SCM_LIST2(SCM_MAKE_INT(dial), SCM_MAKE_INT(value))) +define_callback(tablet_motion, TABLET_MOTION, (int x, int y), + SCM_LIST2(SCM_MAKE_INT(x), SCM_MAKE_INT(y))) +define_callback(tablet_button, TABLET_BUTTON, + (int button, int state, int x, int y), + SCM_LIST4(SCM_MAKE_INT(button), + SCM_MAKE_INT(state), + SCM_MAKE_INT(x), + SCM_MAKE_INT(y))) +define_callback(menu_status, MENU_STATUS, (int status, int x, int y), + SCM_LIST3(SCM_MAKE_INT(status), + SCM_MAKE_INT(x), SCM_MAKE_INT(y))) +define_callback(window_status, WINDOW_STATUS, (int status), + SCM_LIST1(SCM_MAKE_INT(status))) +define_callback(joystick, JOYSTICK, (unsigned int mask, int x, int y, int z), + SCM_LIST4(SCM_MAKE_INT(mask), + SCM_MAKE_INT(x), SCM_MAKE_INT(y), SCM_MAKE_INT(z))) + +/* global callbacks */ +static ScmObj idle_closure = SCM_FALSE; + +static void idle_cb(void) +{ + if (!SCM_FALSEP(idle_closure)) { + Scm_ApplyRec(idle_closure, SCM_NIL); + } +} + +static ScmObj timer_closure = SCM_FALSE; + +static void timer_cb(int value) +{ + if (!SCM_FALSEP(timer_closure)) { + Scm_ApplyRec(timer_closure, SCM_LIST1(Scm_MakeInteger(value))); + } +} + + +/* NB: these functions are new addition by freeglut. we provide + dummy functions for older versions. */ +#if !(GLUT_API_VERSION >= 4 || GLUT_XLIB_IMPLEMENTATION >= 13) +static void glutKeyboardUpFunc(void (*fn)(unsigned char, int, int)) +{ + Scm_Warn("glutKeyboardUpFunc unsupported in this version of GLUT"); +} +static void glutSpecialUpFunc(void (*fn)(int, int, int)) +{ + Scm_Warn("glutSpecialUpFunc unsupported in this version of GLUT"); +} +static void glutJoystickFunc(void (*fn)(unsigned int, int, int, int), + int interval) +{ + Scm_Warn("glutJoystickFunc unsupported in this version of GLUT"); +} +static void glutWindowStatusFunc(void (*fn)(unsigned int, int, int, int)) +{ + Scm_Warn("glutWindowStatusFunc unsupported in this version of GLUT"); +} +#endif + + +#define define_registrar(glutfn, cbname) \ + static void SCM_CPP_CAT(register_, cbname)(int flag, int xtra) \ + { \ + if (flag) { \ + glutfn(SCM_CPP_CAT(cbname, _cb)); \ + } else { \ + glutfn(NULL); \ + } \ + } + +define_registrar(glutDisplayFunc, display) +define_registrar(glutOverlayDisplayFunc, overlay_display) +define_registrar(glutReshapeFunc, reshape) +define_registrar(glutKeyboardFunc, keyboard) +define_registrar(glutKeyboardUpFunc, keyboard_up) +define_registrar(glutMouseFunc, mouse) +define_registrar(glutMotionFunc, motion) +define_registrar(glutPassiveMotionFunc, passive_motion) +define_registrar(glutVisibilityFunc, visibility) +define_registrar(glutEntryFunc, entry) +define_registrar(glutSpecialFunc, special) +define_registrar(glutSpecialUpFunc, special_up) +define_registrar(glutSpaceballMotionFunc, spaceball_motion) +define_registrar(glutSpaceballRotateFunc, spaceball_rotate) +define_registrar(glutSpaceballButtonFunc, spaceball_button) +define_registrar(glutButtonBoxFunc, button_box) +define_registrar(glutDialsFunc, dials) +define_registrar(glutTabletMotionFunc, tablet_motion) +define_registrar(glutTabletButtonFunc, tablet_button) +define_registrar(glutMenuStatusFunc, menu_status) +define_registrar(glutWindowStatusFunc, window_status) + +/* joystick fn is a bit different */ +static void register_joystick(int flag, int interval) +{ + if (flag) { + glutJoystickFunc(joystick_cb, interval); + } else { + glutJoystickFunc(NULL, interval); + } +} + + +/* NB: order must match SCM_GLUT_CB_* enums */ +static void (*registrars[])(int flag, int xtra) = { + register_display, + register_overlay_display, + register_reshape, + register_keyboard, + register_mouse, + register_motion, + register_passive_motion, + register_visibility, + register_entry, + register_special, + register_spaceball_motion, + register_spaceball_rotate, + register_spaceball_button, + register_button_box, + register_dials, + register_tablet_motion, + register_tablet_button, + register_menu_status, + register_window_status, + register_keyboard_up, + register_special_up, + register_joystick, +}; + +/* + * External entry to manage registering callbacks + * 'xtra1' and 'xtra2' are ignored by most callbacks; only the two callbacks + * use them: + * glutTimerFunc: xtra1 for millliseconds, xtra2 for value + * glutJoystickFunc: xtra1 for interval + */ +void Scm_GlutRegisterCallback(int type, ScmObj closure, int xtra1, int xtra2) +{ + SCM_ASSERT(type >= 0 && type < SCM_GLUT_NUM_CBS); + if (type < SCM_GLUT_NUM_WINDOW_CBS) { + int win = glutGetWindow(); + ScmObj entry = Scm_HashTableRef(SCM_HASH_TABLE(ScmGlutCallbackTable), + SCM_MAKE_INT(win), SCM_FALSE); + + if (SCM_EQ(entry, SCM_FALSE)) { + entry = Scm_MakeVector(SCM_GLUT_NUM_WINDOW_CBS, SCM_FALSE); + Scm_HashTableSet(SCM_HASH_TABLE(ScmGlutCallbackTable), + SCM_MAKE_INT(win), entry, 0); + } + SCM_VECTOR_ELEMENT(entry, type) = closure; + registrars[type](!SCM_FALSEP(closure), xtra1); + } else if (type == SCM_GLUT_CB_IDLE) { + idle_closure = closure; + if (SCM_FALSEP(closure)) { + glutIdleFunc(NULL); + } else { + glutIdleFunc(idle_cb); + } + } else { + timer_closure = closure; + if (!SCM_FALSEP(closure)) { + glutTimerFunc(xtra1, timer_cb, xtra2); + } + } +} + +/*================================================================ + * Initialization + */ void Scm_Init_libgauche_glut(void) { ScmModule *mod; @@ -44,6 +292,9 @@ mod = SCM_MODULE(SCM_FIND_MODULE("gl.glut", TRUE)); Scm_Init_glut_lib(mod); + /* Callback table */ + ScmGlutCallbackTable = Scm_MakeHashTableSimple(SCM_HASH_EQV, 0); + /* Glut built-in fonts */ #define DEFFONT(name) Scm_DefineConst(mod, SCM_SYMBOL(SCM_INTERN(#name)), makeGlutFont(name)) /* Stroke font constants (use these in GLUT program). */ =================================================================== --- gauche-gl-0.4.4.orig/src/gauche-glut.h (revision 301) +++ gauche-gl-0.4.4/src/gauche-glut.h (working copy) @@ -1,7 +1,7 @@ /* * gauche-glut.h - Gauche GLUT binding * - * Copyright(C) 2001 by Shiro Kawai (shiro@acm.org) + * Copyright (c) 2001-2008 Shiro Kawai * * Permission to use, copy, modify, distribute this software and * accompanying documentation for any purpose is hereby granted, @@ -29,5 +29,43 @@ #define SCM_GLUT_FONT_P(obj) (SCM_XTYPEP(obj, SCM_CLASS_GLUT_FONT)) #define SCM_GLUT_FONT(obj) ((ScmGlutFont*)(obj)) +/* glut callback table */ +enum { + /* per-window callbacks */ + SCM_GLUT_CB_DISPLAY, + SCM_GLUT_CB_OVERLAY_DISPLAY, + SCM_GLUT_CB_RESHAPE, + SCM_GLUT_CB_KEYBOARD, + SCM_GLUT_CB_MOUSE, + SCM_GLUT_CB_MOTION, + SCM_GLUT_CB_PASSIVE_MOTION, + SCM_GLUT_CB_VISIBILITY, + SCM_GLUT_CB_ENTRY, + SCM_GLUT_CB_SPECIAL, + SCM_GLUT_CB_SPACEBALL_MOTION, + SCM_GLUT_CB_SPACEBALL_ROTATE, + SCM_GLUT_CB_SPACEBALL_BUTTON, + SCM_GLUT_CB_BUTTON_BOX, + SCM_GLUT_CB_DIALS, + SCM_GLUT_CB_TABLET_MOTION, + SCM_GLUT_CB_TABLET_BUTTON, + SCM_GLUT_CB_MENU_STATUS, + SCM_GLUT_CB_WINDOW_STATUS, /* freeglut addition (glut API version 4) */ + SCM_GLUT_CB_KEYBOARD_UP, /* freeglut addition (glut API version 4) */ + SCM_GLUT_CB_SPECIAL_UP, /* freeglut addition (glut API version 4) */ + SCM_GLUT_CB_JOYSTICK, /* freeglut addition (glut API version 4) */ + + SCM_GLUT_NUM_WINDOW_CBS, /* marker */ + + /* global callbacks */ + SCM_GLUT_CB_IDLE = SCM_GLUT_NUM_WINDOW_CBS, + SCM_GLUT_CB_TIMER, + + SCM_GLUT_NUM_CBS +}; + +extern void Scm_GlutRegisterCallback(int type, ScmObj closure, + int xtra1, int xtra2); + #endif /*GAUCHE_GLUT_H */ =================================================================== --- gauche-gl-0.4.4.orig/src/gauche-math3d.c (revision 301) +++ gauche-gl-0.4.4/src/gauche-math3d.c (working copy) @@ -1,7 +1,7 @@ /* * gauche-math3d.c - 3D vector and matrix arithmetics * - * Copyright(C) 2002-2003 by Shiro Kawai (shiro@acm.org) + * Copyright (c) 2002-2008 Shiro Kawai * * Permission to use, copy, modify, distribute this software and * accompanying documentation for any purpose is hereby granted, @@ -1224,6 +1224,18 @@ } /* + * Transform a vector/point by quaternion + * calculates qvq* + */ +void Scm_QuatfTransformv(float r[], const float q[], const float v[]) +{ + float qconj[4], s[4]; + SCM_QUATF_CONJUGATEV(qconj, q); + Scm_QuatfMulv(s, q, v); + Scm_QuatfMulv(r, s, qconj); +} + +/* * Interpolation */ void Scm_QuatfSlerp(float r[], const float p[], const float q[], float t) @@ -1246,7 +1258,57 @@ */ +/* + * Vectors -> Quaternion + * Return a quaternion that represents the rotation to rotate V to W. + * NOTE: if V = -W, we can't determine a unique rotation. This routine + * returns #,(quatf e0 e1 e2 e3) where eN is very small number. + * It's caller's responsibility to detect the case. + */ +void Scm_VectorsToQuatfv(float r[], const float v[], const float w[]) +{ + float p[4], c, s2, f; + SCM_VECTOR4F_CROSSV(p, v, w); + c = SCM_VECTOR4F_DOTV(v, w); /* cos(t) */ + s2 = SCM_VECTOR4F_DOTV(p, p); /* sin^2(t) */ + if (s2 > 0) { /* NB: should we consider epsilon? */ + f = sqrtf((1-c) / (2*s2)); /* sin(t/2)/sin(t) sans sign */ + } else { + f = 0.0f; + } + r[0] = f*p[0]; + r[1] = f*p[1]; + r[2] = f*p[2]; + r[3] = sqrtf((1+c)/2); +} +/* + * Axes -> Quaternion + * + * (v1, v2) and (w1,w2) are pair of perpendicular unit vectors. Calculates + * a rotation that transforms v1 to w1 and v2 to w2. + */ +void Scm_AxesToQuatfv(float r[], + const float v1[], + const float v2[], + const float w1[], + const float w2[]) +{ + float q1[4], q2[4], c, t, s2, axis[4], wt[4]; + Scm_VectorsToQuatfv(q1, v1, w1); + Scm_QuatfTransformv(wt, q1, v2); + SCM_VECTOR4F_CROSSV(axis, wt, w2); + SCM_VECTOR4F_NORMALIZEV(axis); + c = SCM_VECTOR4F_DOTV(w2, wt); /* cos(t) */ + if (c < -1.0f) c = -1.0f; + else if (c > 1.0f) c = 1.0f; + t = acosf(c); + s2 = sinf(t/2); + q2[0] = axis[0] * s2; q2[1] = axis[1] * s2; q2[2] = axis[2] * s2; + q2[3] = cosf(t/2); + Scm_QuatfMulv(r, q2, q1); +} + /*============================================================= * Initialization */ =================================================================== --- gauche-gl-0.4.4.orig/src/glut-lib.stub (revision 301) +++ gauche-gl-0.4.4/src/glut-lib.stub (working copy) @@ -1,7 +1,7 @@ ;;; ;;; glut-lib.stub - glue functions for GLUT ;;; -;;; Copyright(C) 2001-2002 by Shiro Kawai (shiro@acm.org) +;;; Copyright (c) 2001-2008 Shiro Kawai ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, @@ -36,31 +36,21 @@ ;; ;; glut-init -;; Takes list of args instead of C-style argc/argv +;; Takes list of args instead of C-style argc/argv, and returns +;; (possibly modified) args. + (define-cproc glut-init (args) - " - int argc, i; - char **argv; - ScmObj ap; + (body + (let* ((argc :: int (Scm_Length args)) + (argv :: char**)) + (when (< argc 0) (SCM_TYPE_ERROR args "list")) + (set! argv (Scm_ListToCStringArray args TRUE NULL)) + (glutInit (& argc) argv) + (result + (Scm_CStringArrayToList (cast |const char**| argv) argc 0))))) - argc = Scm_Length(args); - if (argc < 0) Scm_Error(\"list expected, but got %S\", args); - argv = SCM_NEW2(char **, argc * sizeof(char*)); - i = 0; - SCM_FOR_EACH(ap, args) { - if (!SCM_STRINGP(SCM_CAR(ap))) { - Scm_Error(\"string expected, but got %S\", SCM_CAR(ap)); - } - argv[i] = Scm_GetString(SCM_STRING(SCM_CAR(ap))); - i++; - } - glutInit(&argc, argv); - SCM_RETURN(Scm_MakeInteger(argc)); - ") - (define-cproc glut-init-display-mode (mode::) - "glutInitDisplayMode(mode); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutInitDisplayMode")) (define-cproc glut-init-display-string (string::) " @@ -70,32 +60,26 @@ SCM_RETURN(SCM_UNDEFINED);") (define-cproc glut-init-window-size (width:: height::) - "glutInitWindowSize(width, height); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutInitWindowSize")) (define-cproc glut-init-window-position (x:: y::) - "glutInitWindowPosition(x, y); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutInitWindowPosition")) (define-cproc glut-main-loop () - "glutMainLoop(); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutMainLoop")) -(define-cproc glut-create-window (name::) - "SCM_RETURN(Scm_MakeInteger(glutCreateWindow(Scm_GetStringConst(name))));") +(define-cproc glut-create-window (name::) + (call "glutCreateWindow")) (define-cproc glut-create-sub-window (win:: x:: y:: width:: height::) - "int win = glutCreateSubWindow(win, x, y, width, height); - SCM_RETURN(Scm_MakeInteger(win));") + (call "glutCreateSubWindow")) (define-cproc glut-destroy-window (win::) - "glutDestroyWindow(win); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutDestroyWindow")) (define-cproc glut-post-redisplay () - "glutPostRedisplay(); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutPostRedisplay")) (define-cproc glut-post-window-redisplay (win::) "#if (GLUT_API_VERSION >= 4 || GLUT_XLIB_IMPLEMENTATION >= 11) @@ -104,51 +88,40 @@ SCM_RETURN(SCM_UNDEFINED);") (define-cproc glut-swap-buffers () - "glutSwapBuffers(); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutSwapBuffers")) (define-cproc glut-get-window () - "SCM_RETURN(Scm_MakeInteger(glutGetWindow()));") + (call "glutGetWindow")) (define-cproc glut-set-window (win::) - "glutSetWindow(win); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutSetWindow")) -(define-cproc glut-set-window-title (title::) - "glutSetWindowTitle(Scm_GetStringConst(title)); - SCM_RETURN(SCM_UNDEFINED);") +(define-cproc glut-set-window-title (title::) + (call "glutSetWindowTitle")) -(define-cproc glut-set-icon-title (title::) - "glutSetIconTitle(Scm_GetStringConst(title)); - SCM_RETURN(SCM_UNDEFINED);") +(define-cproc glut-set-icon-title (title::) + (call "glutSetIconTitle")) (define-cproc glut-position-window (x:: y::) - "glutPositionWindow(x, y); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutPositionWindow")) (define-cproc glut-reshape-window (width:: height::) - "glutReshapeWindow(width, height); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutReshapeWindow")) (define-cproc glut-push-window () - "glutPushWindow(); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutPushWindow")) (define-cproc glut-pop-window () - "glutPopWindow(); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutPopWindow")) (define-cproc glut-iconify-window () - "glutIconifyWindow(); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutIconifyWindow")) (define-cproc glut-show-window () - "glutShowWindow(); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutShowWindow")) (define-cproc glut-hide-window () - "glutHideWindow(); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutHideWindow")) (define-cproc glut-full-screen () "#if (GLUT_API_VERSION >= 3) @@ -288,525 +261,83 @@ ;; Callbacks ;; -;; GLUT callbacks doesn't allow function to carry closure information, -;; hence static variables. +;; Most Glut callbacks are associated to the "current window". +;; Scm_GlutRegisterCallback handles the association. -;; display --------------- -"static ScmObj display_fn = SCM_FALSE; - static void display_callback(void) - { - if (SCM_PROCEDUREP(display_fn)) { - Scm_ApplyRec(display_fn, SCM_NIL); - } - }" - (define-cproc glut-display-func (fn) - " display_fn = fn; - if (SCM_PROCEDUREP(display_fn)) { - glutDisplayFunc(display_callback); - } else { - glutDisplayFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; reshape --------------- -"static ScmObj reshape_fn = SCM_FALSE; - static void reshape_callback(int w, int h) - { - if (SCM_PROCEDUREP(reshape_fn)) { - Scm_ApplyRec(reshape_fn, SCM_LIST2(SCM_MAKE_INT(w), SCM_MAKE_INT(h))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_DISPLAY fn 0 0))) +(define-cproc glut-overlay-display-func (fn) + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_OVERLAY_DISPLAY fn 0 0))) (define-cproc glut-reshape-func (fn) - " reshape_fn = fn; - if (SCM_PROCEDUREP(reshape_fn)) { - glutReshapeFunc(reshape_callback); - } else { - glutReshapeFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; keyboard --------------- -"static ScmObj keyboard_fn = SCM_FALSE; - static void keyboard_callback(unsigned char key, int x, int y) - { - if (SCM_PROCEDUREP(keyboard_fn)) { - Scm_ApplyRec(keyboard_fn, SCM_LIST3(SCM_MAKE_INT(key), - SCM_MAKE_INT(x), - SCM_MAKE_INT(y))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_RESHAPE fn 0 0))) (define-cproc glut-keyboard-func (fn) - " keyboard_fn = fn; - if (SCM_PROCEDUREP(keyboard_fn)) { - glutKeyboardFunc(keyboard_callback); - } else { - glutKeyboardFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; mouse --------------- -"static ScmObj mouse_fn = SCM_FALSE; - static void mouse_callback(int button, int state, int x, int y) - { - if (SCM_PROCEDUREP(mouse_fn)) { - Scm_ApplyRec(mouse_fn, SCM_LIST4(SCM_MAKE_INT(button), - SCM_MAKE_INT(state), - SCM_MAKE_INT(x), - SCM_MAKE_INT(y))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_KEYBOARD fn 0 0))) +(define-cproc glut-keyboard-up-func (fn) + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_KEYBOARD_UP fn 0 0))) (define-cproc glut-mouse-func (fn) - " mouse_fn = fn; - if (SCM_PROCEDUREP(mouse_fn)) { - glutMouseFunc(mouse_callback); - } else { - glutMouseFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; motion --------------- -"static ScmObj motion_fn = SCM_FALSE; - static void motion_callback(int x, int y) - { - if (SCM_PROCEDUREP(motion_fn)) { - Scm_ApplyRec(motion_fn, SCM_LIST2(SCM_MAKE_INT(x), - SCM_MAKE_INT(y))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_MOUSE fn 0 0))) (define-cproc glut-motion-func (fn) - " motion_fn = fn; - if (SCM_PROCEDUREP(motion_fn)) { - glutMotionFunc(motion_callback); - } else { - glutMotionFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; passiveMotion --------------- -"static ScmObj passive_motion_fn = SCM_FALSE; - static void passive_motion_callback(int x, int y) - { - if (SCM_PROCEDUREP(passive_motion_fn)) { - Scm_ApplyRec(passive_motion_fn, SCM_LIST2(SCM_MAKE_INT(x), - SCM_MAKE_INT(y))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_MOTION fn 0 0))) (define-cproc glut-passive-motion-func (fn) - " passive_motion_fn = fn; - if (SCM_PROCEDUREP(passive_motion_fn)) { - glutPassiveMotionFunc(passive_motion_callback); - } else { - glutPassiveMotionFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; Entry --------------- -"static ScmObj entry_fn = SCM_FALSE; - static void entry_callback(int state) - { - if (SCM_PROCEDUREP(entry_fn)) { - Scm_ApplyRec(entry_fn, SCM_LIST1(SCM_MAKE_INT(state))); - } - }" - -(define-cproc glut-entry-func (fn) - " entry_fn = fn; - if (SCM_PROCEDUREP(entry_fn)) { - glutEntryFunc(entry_callback); - } else { - glutEntryFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; Visibility --------------- -"static ScmObj visibility_fn = SCM_FALSE; - static void visibility_callback(int state) - { - if (SCM_PROCEDUREP(visibility_fn)) { - Scm_ApplyRec(visibility_fn, SCM_LIST1(SCM_MAKE_INT(state))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_PASSIVE_MOTION fn 0 0))) (define-cproc glut-visibility-func (fn) - " visibility_fn = fn; - if (SCM_PROCEDUREP(visibility_fn)) { - glutVisibilityFunc(visibility_callback); - } else { - glutVisibilityFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; Idle --------------- -"static ScmObj idle_fn = SCM_FALSE; - static void idle_callback(void) - { - if (SCM_PROCEDUREP(idle_fn)) { - Scm_ApplyRec(idle_fn, SCM_NIL); - } - }" - -(define-cproc glut-idle-func (fn) - " idle_fn = fn; - if (SCM_PROCEDUREP(idle_fn)) { - glutIdleFunc(idle_callback); - } else { - glutIdleFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; Timer --------------- -"/* TODO: glut-timer-func can not use multiple timer entry. This is not correct implementation. */ -static ScmObj timer_fn = SCM_FALSE; - static void timer_callback(int value) - { - if (SCM_PROCEDUREP(timer_fn)) { - Scm_ApplyRec(timer_fn, SCM_LIST1(SCM_MAKE_INT(value))); - } - }" - -(define-cproc glut-timer-func (millis:: fn value::) - " timer_fn = fn; - glutTimerFunc(millis, timer_callback, value); - SCM_RETURN(SCM_UNDEFINED);") - -;; MenuState --------------- -"static ScmObj menu_state_fn = SCM_FALSE; - static void menu_state_callback(int state) - { - if (SCM_PROCEDUREP(menu_state_fn)) { - Scm_ApplyRec(menu_state_fn, SCM_LIST1(SCM_MAKE_INT(state))); - } - }" - -(define-cproc glut-menu-state-func (fn) - " menu_state_fn = fn; - if (SCM_PROCEDUREP(menu_state_fn)) { - glutMenuStateFunc(menu_state_callback); - } else { - glutMenuStateFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; Special ------------------ -"static ScmObj special_fn = SCM_FALSE; - static void special_callback(int key, int x, int y) - { - if (SCM_PROCEDUREP(special_fn)) { - Scm_ApplyRec(special_fn, SCM_LIST3(SCM_MAKE_INT(key), - SCM_MAKE_INT(x), - SCM_MAKE_INT(y))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_VISIBILITY fn 0 0))) +(define-cproc glut-entry-func (fn) + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_ENTRY fn 0 0))) (define-cproc glut-special-func (fn) - " special_fn = fn; - if (SCM_PROCEDUREP(special_fn)) { - glutSpecialFunc(special_callback); - } else { - glutSpecialFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; SpaceballMotion ----------- -"static ScmObj spaceball_motion_fn = SCM_FALSE; - static void spaceball_motion_callback(int x, int y, int z) - { - if (SCM_PROCEDUREP(spaceball_motion_fn)) { - Scm_ApplyRec(spaceball_motion_fn, SCM_LIST3(SCM_MAKE_INT(x), - SCM_MAKE_INT(y), - SCM_MAKE_INT(z))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_SPECIAL fn 0 0))) +(define-cproc glut-special-up-func (fn) + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_SPECIAL_UP fn 0 0))) (define-cproc glut-spaceball-motion-func (fn) - " spaceball_motion_fn = fn; - if (SCM_PROCEDUREP(spaceball_motion_fn)) { - glutSpaceballMotionFunc(spaceball_motion_callback); - } else { - glutSpaceballMotionFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; SpaceballRotate ---------------------- -"static ScmObj spaceball_rotate_fn = SCM_FALSE; - static void spaceball_rotate_callback(int x, int y, int z) - { - if (SCM_PROCEDUREP(spaceball_rotate_fn)) { - Scm_ApplyRec(spaceball_rotate_fn, SCM_LIST3(SCM_MAKE_INT(x), - SCM_MAKE_INT(y), - SCM_MAKE_INT(z))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_SPACEBALL_MOTION fn 0 0))) (define-cproc glut-spaceball-rotate-func (fn) - " spaceball_rotate_fn = fn; - if (SCM_PROCEDUREP(spaceball_rotate_fn)) { - glutSpaceballRotateFunc(spaceball_rotate_callback); - } else { - glutSpaceballRotateFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; SpaceballButton ---------------------- -"static ScmObj spaceball_button_fn = SCM_FALSE; - static void spaceball_button_callback(int button, int state) - { - if (SCM_PROCEDUREP(spaceball_button_fn)) { - Scm_ApplyRec(spaceball_button_fn, SCM_LIST2(SCM_MAKE_INT(button), - SCM_MAKE_INT(state))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_SPACEBALL_ROTATE fn 0 0))) (define-cproc glut-spaceball-button-func (fn) - " spaceball_button_fn = fn; - if (SCM_PROCEDUREP(spaceball_button_fn)) { - glutSpaceballButtonFunc(spaceball_button_callback); - } else { - glutSpaceballButtonFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; ButtonBox ---------------------------- -"static ScmObj button_box_fn = SCM_FALSE; - static void button_box_callback(int button, int state) - { - if (SCM_PROCEDUREP(button_box_fn)) { - Scm_ApplyRec(button_box_fn, SCM_LIST2(SCM_MAKE_INT(button), - SCM_MAKE_INT(state))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_SPACEBALL_BUTTON fn 0 0))) (define-cproc glut-button-box-func (fn) - " button_box_fn = fn; - if (SCM_PROCEDUREP(button_box_fn)) { - glutButtonBoxFunc(button_box_callback); - } else { - glutButtonBoxFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; Dials ----------------------------------- -"static ScmObj dials_fn = SCM_FALSE; - static void dials_callback(int button, int state) - { - if (SCM_PROCEDUREP(dials_fn)) { - Scm_ApplyRec(dials_fn, SCM_LIST2(SCM_MAKE_INT(button), - SCM_MAKE_INT(state))); - } - }" - -(define-cproc glut-dials-func (fn) - " dials_fn = fn; - if (SCM_PROCEDUREP(dials_fn)) { - glutDialsFunc(dials_callback); - } else { - glutDialsFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; TabletMotion ------------------------- -"static ScmObj tablet_motion_fn = SCM_FALSE; - static void tablet_motion_callback(int x, int y) - { - if (SCM_PROCEDUREP(tablet_motion_fn)) { - Scm_ApplyRec(tablet_motion_fn, SCM_LIST2(SCM_MAKE_INT(x), - SCM_MAKE_INT(y))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_BUTTON_BOX fn 0 0))) +(define-cproc glut-dials (fn) + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_DIALS fn 0 0))) (define-cproc glut-tablet-motion-func (fn) - " tablet_motion_fn = fn; - if (SCM_PROCEDUREP(tablet_motion_fn)) { - glutTabletMotionFunc(tablet_motion_callback); - } else { - glutTabletMotionFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; TabletButton ------------------------- -"static ScmObj tablet_button_fn = SCM_FALSE; - static void tablet_button_callback(int button, int state, int x, int y) - { - if (SCM_PROCEDUREP(tablet_button_fn)) { - Scm_ApplyRec(tablet_button_fn, SCM_LIST4(SCM_MAKE_INT(button), - SCM_MAKE_INT(state), - SCM_MAKE_INT(x), - SCM_MAKE_INT(y))); - } - }" - + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_TABLET_MOTION fn 0 0))) (define-cproc glut-tablet-button-func (fn) - " tablet_button_fn = fn; - if (SCM_PROCEDUREP(tablet_button_fn)) { - glutTabletButtonFunc(tablet_button_callback); - } else { - glutTabletButtonFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_TABLET_BUTTON fn 0 0))) +(define-cproc glut-menu-status (fn) + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_MENU_STATUS fn 0 0))) +(define-cproc glut-window-status (fn) + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_WINDOW_STATUS fn 0 0))) +(define-cproc glut-joystick-func (fn interval::) + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_JOYSTICK fn interval 0))) -;; MenuStatus ----------------------------- -"static ScmObj menu_status_fn = SCM_FALSE; - static void menu_status_callback(int state, int x, int y) - { - if (SCM_PROCEDUREP(menu_status_fn)) { - Scm_ApplyRec(menu_status_fn, SCM_LIST3(SCM_MAKE_INT(state), - SCM_MAKE_INT(x), - SCM_MAKE_INT(y))); - } - }" +(define-cproc glut-idle-func (fn) + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_IDLE fn 0 0))) +(define-cproc glut-timer-func (millis:: fn value::) + (body (Scm_GlutRegisterCallback SCM_GLUT_CB_TIMER fn millis value))) -(define-cproc glut-menu-status-func (fn) - " menu_status_fn = fn; - if (SCM_PROCEDUREP(menu_status_fn)) { - glutMenuStatusFunc(menu_status_callback); - } else { - glutMenuStatusFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") -;; OverlayDisplay -"static ScmObj overlay_display_fn = SCM_FALSE; - static void overlay_display_callback(void) - { - if (SCM_PROCEDUREP(overlay_display_fn)) { - Scm_ApplyRec(overlay_display_fn, SCM_NIL); - } - }" - -(define-cproc glut-ovelay-display-func (fn) - " overlay_display_fn = fn; - if (SCM_PROCEDUREP(overlay_display_fn)) { - glutOverlayDisplayFunc(overlay_display_callback); - } else { - glutOverlayDisplayFunc(NULL); - } - SCM_RETURN(SCM_UNDEFINED);") - -;; WindowStatus --------------------------------- -"#if (GLUT_API_VERSION >= 4 || GLUT_XLIB_IMPLEMENTATION >= 9) - static ScmObj window_status_fn = SCM_FALSE; - static void window_status_callback(int state) - { - if (SCM_PROCEDUREP(window_status_fn)) { - Scm_ApplyRec(window_status_fn, SCM_LIST1(SCM_MAKE_INT(state))); - } - } -#endif" - -(define-cproc glut-window-status-func (fn) - "#if (GLUT_API_VERSION >= 4 || GLUT_XLIB_IMPLEMENTATION >= 9) - window_status_fn = fn; - if (SCM_PROCEDUREP(window_status_fn)) { - glutWindowStatusFunc(window_status_callback); - } else { - glutWindowStatusFunc(NULL); - } -#endif - SCM_RETURN(SCM_UNDEFINED);") - -;; KeyboardUp ---------------------------- -"#if (GLUT_API_VERSION >= 4 || GLUT_XLIB_IMPLEMENTATION >= 13) - static ScmObj keyboard_up_fn = SCM_FALSE; - static void keyboard_up_callback(unsigned char key, int x, int y) - { - if (SCM_PROCEDUREP(keyboard_up_fn)) { - Scm_ApplyRec(keyboard_up_fn, SCM_LIST3(SCM_MAKE_INT(key), - SCM_MAKE_INT(x), - SCM_MAKE_INT(y))); - } - } -#endif" - -(define-cproc glut-keyboard-up-func (fn) - "#if (GLUT_API_VERSION >= 4 || GLUT_XLIB_IMPLEMENTATION >= 13) - keyboard_up_fn = fn; - if (SCM_PROCEDUREP(keyboard_up_fn)) { - glutKeyboardUpFunc(keyboard_up_callback); - } else { - glutKeyboardUpFunc(NULL); - } -#endif - SCM_RETURN(SCM_UNDEFINED);") - -;; SpecialUp -------------------------------- -"#if (GLUT_API_VERSION >= 4 || GLUT_XLIB_IMPLEMENTATION >= 13) - static ScmObj special_up_fn = SCM_FALSE; - static void special_up_callback(int key, int x, int y) - { - if (SCM_PROCEDUREP(special_up_fn)) { - Scm_ApplyRec(special_up_fn, SCM_LIST3(SCM_MAKE_INT(key), - SCM_MAKE_INT(x), - SCM_MAKE_INT(y))); - } - } -#endif" - -(define-cproc glut-special-up-func (fn) - "#if (GLUT_API_VERSION >= 4 || GLUT_XLIB_IMPLEMENTATION >= 13) - special_up_fn = fn; - if (SCM_PROCEDUREP(special_up_fn)) { - glutSpecialUpFunc(special_up_callback); - } else { - glutSpecialUpFunc(NULL); - } -#endif - SCM_RETURN(SCM_UNDEFINED);") - -;; Joystick ------------------------------------ -"#if (GLUT_API_VERSION >= 4 || GLUT_XLIB_IMPLEMENTATION >= 13) - static ScmObj joystick_fn = SCM_FALSE; - static void joystick_callback(unsigned int mask, int x, int y, int z) - { - if (SCM_PROCEDUREP(joystick_fn)) { - Scm_ApplyRec(joystick_fn, SCM_LIST4(Scm_MakeIntegerFromUI(mask), - SCM_MAKE_INT(x), - SCM_MAKE_INT(y), - SCM_MAKE_INT(z))); - } - } -#endif" - -(define-cproc glut-joystick-func (fn interval::) - "#if (GLUT_API_VERSION >= 4 || GLUT_XLIB_IMPLEMENTATION >= 13) - joystick_fn = fn; - if (SCM_PROCEDUREP(joystick_fn)) { - glutJoystickFunc(joystick_callback, interval); - } else { - glutJoystickFunc(NULL, interval); - } -#endif - SCM_RETURN(SCM_UNDEFINED);") - ;;======================================================== ;; Colormap ;; (define-cproc glut-set-color (index:: r:: g:: b::) - (return "glutSetColor")) + (call "glutSetColor")) (define-cproc glut-get-color (index:: component::) "SCM_RETURN(Scm_MakeFlonum((double)glutGetColor(index, component)));") (define-cproc glut-copy-colormap (win::) - "glutCopyColormap(win); - SCM_RETURN(SCM_UNDEFINED);") + (call "glutCopyColormap")) ;;======================================================== ;; state retrieval ;; (define-cproc glut-get (type::) - "SCM_RETURN(Scm_MakeInteger(glutGet(type)));") + (call "glutGet")) (define-cproc glut-device-get (type::) - "SCM_RETURN(Scm_MakeInteger(glutDeviceGet(type)));") + (call "glutDeviceGet")) (define-cproc glut-extension-supported (name::) "#if (GLUT_API_VERSION >= 2) @@ -871,62 +402,62 @@ ;; (define-cproc glut-wire-sphere (radius:: slices:: stacks::) - (return "glutWireSphere")) + (call "glutWireSphere")) (define-cproc glut-solid-sphere (radius:: slices:: stacks::) - (return "glutSolidSphere")) + (call "glutSolidSphere")) (define-cproc glut-wire-cone (radius:: height:: slices:: stacks::) - (return "glutWireCone")) + (call "glutWireCone")) (define-cproc glut-solid-cone (radius:: height:: slices:: stacks::) - (return "glutSolidCone")) + (call "glutSolidCone")) (define-cproc glut-wire-cube (size::) - (return "glutWireCube")) + (call "glutWireCube")) (define-cproc glut-solid-cube (size::) - (return "glutSolidCube")) + (call "glutSolidCube")) (define-cproc glut-wire-torus (inner:: outer:: sides:: rings::) - (return "glutWireTorus")) + (call "glutWireTorus")) (define-cproc glut-solid-torus (inner:: outer:: sides:: rings::) - (return "glutSolidTorus")) + (call "glutSolidTorus")) (define-cproc glut-wire-dodecahedron () - (return "glutWireDodecahedron")) + (call "glutWireDodecahedron")) (define-cproc glut-solid-dodecahedron () - (return "glutSolidDodecahedron")) + (call "glutSolidDodecahedron")) (define-cproc glut-wire-teapot (size::) - (return "glutWireTeapot")) + (call "glutWireTeapot")) (define-cproc glut-solid-teapot (size::) - (return "glutSolidTeapot")) + (call "glutSolidTeapot")) (define-cproc glut-wire-octahedron () - (return "glutWireOctahedron")) + (call "glutWireOctahedron")) (define-cproc glut-solid-octahedron () - (return "glutSolidOctahedron")) + (call "glutSolidOctahedron")) (define-cproc glut-wire-tetrahedron () - (return "glutWireTetrahedron")) + (call "glutWireTetrahedron")) (define-cproc glut-solid-tetrahedron () - (return "glutSolidTetrahedron")) + (call "glutSolidTetrahedron")) (define-cproc glut-wire-icosahedron () - (return "glutWireIcosahedron")) + (call "glutWireIcosahedron")) (define-cproc glut-solid-icosahedron () - (return "glutSolidIcosahedron")) + (call "glutSolidIcosahedron")) ;;======================================================== ;; Video resize =================================================================== --- gauche-gl-0.4.4.orig/src/gauche/math3d.h (revision 301) +++ gauche-gl-0.4.4/src/gauche/math3d.h (working copy) @@ -1,7 +1,7 @@ /* * gauche/math3d.h - 3D vector and matrix arithmetic * - * Copyright(C) 2002-2003 by Shiro Kawai (shiro@acm.org) + * Copyright (c) 2002-2008 Shiro Kawai * * Permission to use, copy, modify, distribute this software and * accompanying documentation for any purpose is hereby granted, @@ -275,6 +275,14 @@ } \ } while (0) +#define SCM_QUATF_CONJUGATEV(q, p) \ + do { \ + q[0] = -p[0]; \ + q[1] = -p[1]; \ + q[2] = -p[2]; \ + q[3] = p[3]; \ + } while (0) + extern ScmObj Scm_MakeQuatf(float x, float y, float z, float w); extern ScmObj Scm_MakeQuatfv(const float d[4]); extern ScmObj Scm_MakeQuatfvShared(float d[4]); @@ -289,7 +297,6 @@ extern ScmObj Scm_QuatfMul(const ScmQuatf *p, const ScmQuatf *q); extern void Scm_QuatfMulv(float *r, const float *p, const float *q); extern ScmObj Scm_QuatfNormalize(const ScmQuatf *q); -extern ScmObj Scm_QuatfNormalizev(float *q); extern ScmObj Scm_QuatfNormalizeX(ScmQuatf *q); /* q[] must be a unit quaternion */ @@ -298,9 +305,20 @@ /* m[] must be an orthogonal matrix */ extern void Scm_Matrix4fToQuatfv(float *q, const float *m); +/* q[] must be a unit quaternion */ +extern void Scm_QuatfTransformv(float r[], const float q[], const float v[]); + /* p[] and q[] must be unit quaternions */ extern void Scm_QuatfSlerp(float *r, const float *p, const float *q, float t); +/* v[], v1[], v2[], w[], w1[] and w2[] must be unit vectors */ +extern void Scm_VectorsToQuatfv(float *r, const float *v, const float *w); +extern void Scm_AxesToQuatfv(float r[], + const float v1[], + const float v2[], + const float w1[], + const float w2[]); + /*============================================================= * Matrix */ =================================================================== --- gauche-gl-0.4.4.orig/src/math3d-lib.stub (revision 301) +++ gauche-gl-0.4.4/src/math3d-lib.stub (working copy) @@ -1,7 +1,7 @@ ;;; ;;; math3d-lib.stub - 3d vector arithmetics ;;; -;;; Copyright(C) 2002-2003 by Shiro Kawai (shiro@acm.org) +;;; Copyright (c) 2002-2008 Shiro Kawai ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, @@ -40,19 +40,19 @@ (define-cproc vector4f (x:: y:: z:: &optional (w:: 0.0)) - (return "Scm_MakeVector4f")) + (call "Scm_MakeVector4f")) (define-cproc vector4f? (obj) - (return "SCM_VECTOR4FP")) + (call "SCM_VECTOR4FP")) (define-cproc make-vector4f () "SCM_RETURN(Scm_MakeVector4fv(NULL));") (define-cproc list->vector4f (l::) - (return "Scm_ListToVector4f")) + (call "Scm_ListToVector4f")) (define-cproc vector4f->list (v::) - (return "Scm_Vector4fToList")) + (call "Scm_Vector4fToList")) (define-cproc f32vector->vector4f (v:: &optional (start:: 0)) @@ -86,31 +86,70 @@ (setter vector4f-set!)) (define-cproc vector4f-dot (x:: y::) - (return "Scm_Vector4fDot")) + (call "Scm_Vector4fDot")) (define-cproc vector4f-cross (x:: y::) - (return "Scm_Vector4fCross")) + (call "Scm_Vector4fCross")) +(define-cproc vector4f-norm (v::) + (expr (SCM_VECTOR4F_NORMV (SCM_VECTOR4F_D v)))) + (define-cproc vector4f-normalize (x::) - (return "Scm_Vector4fNormalize")) + (call "Scm_Vector4fNormalize")) (define-cproc vector4f-normalize! (x::) - (return "Scm_Vector4fNormalizeX")) + (call "Scm_Vector4fNormalizeX")) (define-cproc vector4f-add (x:: y::) - (return "Scm_Vector4fAdd")) + (call "Scm_Vector4fAdd")) (define-cproc vector4f-add! (x:: y::) "Scm_Vector4fAddv(SCM_VECTOR4F_D(x), SCM_VECTOR4F_D(x), SCM_VECTOR4F_D(y)); SCM_RETURN(SCM_OBJ(x));") (define-cproc vector4f-sub (x:: y::) - (return "Scm_Vector4fSub")) + (call "Scm_Vector4fSub")) (define-cproc vector4f-sub! (x:: y::) "Scm_Vector4fSubv(SCM_VECTOR4F_D(x), SCM_VECTOR4F_D(x), SCM_VECTOR4F_D(y)); SCM_RETURN(SCM_OBJ(x));") +(define-cise-stmt vec4-eltwise + [(_ stmts ...) + (letrec ((replace (lambda (form i) + (match form + ['_ i] + [(xs ...) (map (cut replace <> i) xs)] + [_ form])))) + `(begin ,@(append-map (lambda (stmt) + (map (cute replace stmt <>) '(0 1 2 3))) + stmts)))]) + +(define-cproc vector4f-mul (x:: f::) + (body + (let* ((|r[4]| :: float)) + (vec4-eltwise (set! (aref r _) (* (SCM_VECTOR4F_REF x _) f))) + (return (Scm_MakeVector4fv r))))) + +(define-cproc vector4f-mul! (x:: f::) + (body + (vec4-eltwise + (set! (SCM_VECTOR4F_REF x _) (* (SCM_VECTOR4F_REF x _) f))) + (return (SCM_OBJ x)))) + +(define-cproc vector4f-div (x:: f::) + (body + (let* ((|r[4]| :: float)) + (vec4-eltwise + (set! (aref r _) (/ (SCM_VECTOR4F_REF x _) f))) + (return (Scm_MakeVector4fv r))))) + +(define-cproc vector4f-div! (x:: f::) + (body + (vec4-eltwise + (set! (SCM_VECTOR4F_REF x _) (/ (SCM_VECTOR4F_REF x _) f))) + (return (SCM_OBJ x)))) + ;; VectorArray -------------------------------------------------- (define-cproc make-vector4f-array (len:: &optional init) @@ -126,13 +165,13 @@ SCM_RETURN(va);") (define-cproc vector4f-array? (obj) - (return "SCM_VECTOR4F_ARRAY_P")) + (call "SCM_VECTOR4F_ARRAY_P")) (define-cproc vector4f-array-length (v::) - (return "SCM_VECTOR4F_ARRAY_SIZE")) + (call "SCM_VECTOR4F_ARRAY_SIZE")) (define-cproc f32vector->vector4f-array/shared (v::) - (return "Scm_MakeVector4fArrayV")) + (call "Scm_MakeVector4fArrayV")) (define-cproc vector4f-array->f32vector (a::) "SCM_RETURN(Scm_MakeF32VectorFromArray(SCM_VECTOR4F_ARRAY_SIZE(a)*4, @@ -140,33 +179,33 @@ (define-cproc vector4f-array-set! (a:: i:: x::) - (return "Scm_Vector4fArraySet")) + (call "Scm_Vector4fArraySet")) (define-cproc vector4f-array-ref (a:: i:: &optional fallback) - (return "Scm_Vector4fArrayRef") + (call "Scm_Vector4fArrayRef") (setter vector4f-array-set!)) (define-cproc vector4f-array-ref/shared (a:: i:: &optional fallback) - (return "Scm_Vector4fArrayRefShared")) + (call "Scm_Vector4fArrayRefShared")) ;; point4f ------------------------------------------------------ (define-cproc point4f (x:: y:: z:: &optional (w:: 1.0)) - (return "Scm_MakePoint4f")) + (call "Scm_MakePoint4f")) (define-cproc point4f? (obj) - (return "SCM_POINT4FP")) + (call "SCM_POINT4FP")) (define-cproc make-point4f () "SCM_RETURN(Scm_MakePoint4fv(NULL));") (define-cproc list->point4f (l::) - (return "Scm_ListToPoint4f")) + (call "Scm_ListToPoint4f")) (define-cproc point4f->list (x::) - (return "Scm_Point4fToList")) + (call "Scm_Point4fToList")) (define-cproc f32vector->point4f (v:: &optional (start:: 0)) "int size = SCM_F32VECTOR_SIZE(v); @@ -194,14 +233,14 @@ (setter point4f-set!)) (define-cproc point4f-add (x:: y::) - (return "Scm_Point4fAdd")) + (call "Scm_Point4fAdd")) (define-cproc point4f-add! (x:: y::) "Scm_Vector4fAddv(SCM_POINT4F_D(x), SCM_POINT4F_D(x), SCM_VECTOR4F_D(y)); SCM_RETURN(SCM_OBJ(x));") (define-cproc point4f-sub (x:: y) - (return "Scm_Point4fSub")) + (call "Scm_Point4fSub")) ;point4f-sub! @@ -220,13 +259,13 @@ SCM_RETURN(va);") (define-cproc point4f-array? (obj) - (return "SCM_POINT4F_ARRAY_P")) + (call "SCM_POINT4F_ARRAY_P")) (define-cproc point4f-array-length (v::) - (return "SCM_POINT4F_ARRAY_SIZE")) + (call "SCM_POINT4F_ARRAY_SIZE")) (define-cproc f32vector->point4f-array/shared (v::) - (return "Scm_MakePoint4fArrayV")) + (call "Scm_MakePoint4fArrayV")) (define-cproc point4f-array->f32vector (a::) "SCM_RETURN(Scm_MakeF32VectorFromArray(SCM_POINT4F_ARRAY_SIZE(a)*4, @@ -235,16 +274,16 @@ (define-cproc point4f-array-set! (a:: i:: x::) - (return "Scm_Point4fArraySet")) + (call "Scm_Point4fArraySet")) (define-cproc point4f-array-ref (a:: i:: &optional fallback) - (return "Scm_Point4fArrayRef") + (call "Scm_Point4fArrayRef") (setter point4f-array-set!)) (define-cproc point4f-array-ref/shared (a:: i:: &optional fallback) - (return "Scm_Point4fArrayRefShared")) + (call "Scm_Point4fArrayRefShared")) ;; Matrix4f ------------------------------------------------------- @@ -258,29 +297,41 @@ SCM_RETURN(Scm_MakeMatrix4fv(SCM_F32VECTOR_ELEMENTS(init)));") (define-cproc matrix4f (&rest args) - (return "Scm_ListToMatrix4f")) + (call "Scm_ListToMatrix4f")) (define-cproc matrix4f? (obj) - (return "SCM_MATRIX4FP")) + (call "SCM_MATRIX4FP")) (define-cproc list->matrix4f (l::) - (return "Scm_ListToMatrix4f")) + (call "Scm_ListToMatrix4f")) (define-cproc matrix4f->list (m::) - (return "Scm_Matrix4fToList")) + (call "Scm_Matrix4fToList")) (define-cproc f32vector->matrix4f (v:: &optional (start:: 0)) - "int size = SCM_F32VECTOR_SIZE(v); - if (start < 0 || size-start < 16) - Scm_Error(\"f32vector too small: %S (start=%d)\", v, start); - SCM_RETURN(Scm_MakeMatrix4fv(SCM_F32VECTOR_ELEMENTS(v)+start));") + (body + (let* ((size :: int (SCM_F32VECTOR_SIZE v))) + (when (or (< start 0) (< (- size start) 16)) + (Scm_Error "f32vector too small: %S (start=%d)" v start)) + (result (Scm_MakeMatrix4fv (+ (SCM_F32VECTOR_ELEMENTS v) start)))))) + +(define-cproc f32vector->matrix4f! (m:: + v:: + &optional (start:: 0)) + (body + (let* ((size :: int (SCM_F32VECTOR_SIZE v))) + (when (or (< start 0) (< (- size start) 16)) + (Scm_Error "f32vector too small: %S (start=%d)" v start)) + (Scm_Matrix4fSetv m (+ (SCM_F32VECTOR_ELEMENTS v) start)) + (result (SCM_OBJ m))))) + (define-cproc matrix4f->f32vector (m::) - "SCM_RETURN(Scm_MakeF32VectorFromArray(16, SCM_MATRIX4F_D(m)));") + (expr (Scm_MakeF32VectorFromArray 16 (SCM_MATRIX4F_D m)))) (define-cproc matrix4f-copy (m::) - "SCM_RETURN(Scm_MakeMatrix4fv(SCM_MATRIX4F_D(m)));") + (expr (Scm_MakeMatrix4fv (SCM_MATRIX4F_D m)))) (define-cproc matrix4f-copy! (dst:: src::) - "SCM_RETURN(Scm_Matrix4fSetv(dst, SCM_MATRIX4F_D(src)));") + (expr (Scm_Matrix4fSetv dst (SCM_MATRIX4F_D src)))) (define-cproc matrix4f-mul (p:: q) "if (SCM_MATRIX4FP(q)) SCM_RETURN(Scm_Matrix4fMulMatrix4f(p, SCM_MATRIX4F(q))); @@ -516,12 +567,27 @@ SCM_VECTOR4F_D(S)); SCM_RETURN(SCM_MAKE_BOOL(r));") +(define-cproc matrix4f->translation (m::) + (body + (result (Scm_MakeVector4f (aref (SCM_MATRIX4F_D m) 12) + (aref (SCM_MATRIX4F_D m) 13) + (aref (SCM_MATRIX4F_D m) 14) + 0.0)))) + +(define-cproc matrix4f->translation! (v:: m::) + (body + (set! (SCM_VECTOR4F_REF v 0) (aref (SCM_MATRIX4F_D m) 12)) + (set! (SCM_VECTOR4F_REF v 1) (aref (SCM_MATRIX4F_D m) 13)) + (set! (SCM_VECTOR4F_REF v 2) (aref (SCM_MATRIX4F_D m) 14)) + (set! (SCM_VECTOR4F_REF v 3) 0.0) + (result (SCM_OBJ v)))) + (define-cproc matrix4f->rotation (m::) "float v[4]; float angle = Scm_Matrix4fToRotationv(SCM_MATRIX4F_D(m), v); SCM_RETURN(Scm_Values2(Scm_MakeVector4fv(v), Scm_MakeFlonum((double)angle)));") -(define-cproc matrix4f->rotation! (m:: v::) +(define-cproc matrix4f->rotation! (v:: m::) "float angle = Scm_Matrix4fToRotationv(SCM_MATRIX4F_D(m), SCM_VECTOR4F_D(v)); SCM_RETURN(Scm_Values2(SCM_OBJ(v), Scm_MakeFlonum((double)angle)));") @@ -529,10 +595,10 @@ ;; Quatf ---------------------------------------------------- (define-cproc quatf (x:: y:: z:: w::) - (return "Scm_MakeQuatf")) + (call "Scm_MakeQuatf")) (define-cproc quatf? (obj) - (return "SCM_QUATFP")) + (call "SCM_QUATFP")) (define-cproc make-quatf (&optional vec (angle:: 0)) "if (SCM_UNBOUNDP(vec)) { @@ -547,9 +613,9 @@ }") (define-cproc list->quatf (x) - (return "Scm_ListToQuatf")) + (call "Scm_ListToQuatf")) (define-cproc quatf->list (q::) - (return "Scm_QuatfToList")) + (call "Scm_QuatfToList")) (define-cproc f32vector->quatf (x:: &optional (start:: 0)) "int size = SCM_F32VECTOR_SIZE(x); @@ -576,6 +642,14 @@ SCM_QUATF_D(q)[i] = (float)val; SCM_RETURN(SCM_OBJ(q));") +(define-cproc quatf-set4! (q:: x:: y:: z:: w::) + (body + (set! (aref (SCM_QUATF_D q) 0) x + (aref (SCM_QUATF_D q) 1) y + (aref (SCM_QUATF_D q) 2) z + (aref (SCM_QUATF_D q) 3) w) + (result (SCM_OBJ q)))) + (define-cproc rotation->quatf! (q:: v angle::) "float *qv = SCM_QUATF_D(q), *vv; double sint, cost; @@ -586,14 +660,14 @@ SCM_RETURN(SCM_OBJ(q));") (define-cproc quatf-add (p:: q::) - (return "Scm_QuatfAdd")) + (call "Scm_QuatfAdd")) (define-cproc quatf-add! (p:: q::) "float r[4]; Scm_QuatfAddv(r, SCM_QUATF_D(p), SCM_QUATF_D(q)); SCM_RETURN(Scm_QuatfSetv(p, r));") (define-cproc quatf-sub (p:: q::) - (return "Scm_QuatfSub")) + (call "Scm_QuatfSub")) (define-cproc quatf-sub! (p:: q::) "float r[4]; Scm_QuatfSubv(r, SCM_QUATF_D(p), SCM_QUATF_D(q)); @@ -610,7 +684,7 @@ SCM_RETURN(SCM_OBJ(q));") (define-cproc quatf-mul (p:: q::) - (return "Scm_QuatfMul")) + (call "Scm_QuatfMul")) (define-cproc quatf-mul! (p:: q::) "float r[4]; Scm_QuatfMulv(r, SCM_QUATF_D(p), SCM_QUATF_D(q)); @@ -618,25 +692,35 @@ ;; calculate qpq* (define-cproc quatf-transform (quat:: v) - "float *d, *q, qconj[4], s[4], r[4]; - SCM_MATH3D_X4FP(d, v); - q = SCM_QUATF_D(quat); - qconj[0] = -q[0]; qconj[1] = -q[1]; qconj[2] = -q[2]; qconj[3] = q[3]; - Scm_QuatfMulv(s, q, d); - Scm_QuatfMulv(r, s, qconj); - if (SCM_VECTOR4FP(v)) SCM_RETURN(Scm_MakeVector4fv(r)); - else if (SCM_POINT4FP(v)) SCM_RETURN(Scm_MakePoint4fv(r)); - else SCM_RETURN(Scm_MakeF32VectorFromArray(4, r));") + (body + (let* ((d :: float*) (|r[4]| :: float)) + (SCM_MATH3D_X4FP d v) + (Scm_QuatfTransformv r (SCM_QUATF_D quat) d) + (cond [(SCM_VECTOR4FP v) (result (Scm_MakeVector4fv r))] + [(SCM_POINT4FP v) (result (Scm_MakePoint4fv r))] + [else (result (Scm_MakeF32VectorFromArray 4 r))])))) (define-cproc quatf-conjugate (q::) - "float *d = SCM_QUATF_D(q); - SCM_RETURN(Scm_MakeQuatf(-d[0], -d[1], -d[2], d[3]));") + (body + (let* ((d :: float* (SCM_QUATF_D q))) + (result (Scm_MakeQuatf (- (aref d 0)) (- (aref d 1)) (- (aref d 2)) + (aref d 3)))))) + +(define-cproc quatf-conjugate! (q:: p::) + (body + (let* ((s :: float* (SCM_QUATF_D p)) + (d :: float* (SCM_QUATF_D q))) + (SCM_QUATF_CONJUGATEV d s) + (result (SCM_OBJ q))))) + (define-cproc quatf-norm (q::) - "SCM_RETURN(Scm_MakeFlonum(SCM_QUATF_NORMV(SCM_QUATF_D(q))));") + (expr (Scm_MakeFlonum (SCM_QUATF_NORMV (SCM_QUATF_D q))))) + (define-cproc quatf-normalize (q::) - (return "Scm_QuatfNormalize")) + (call "Scm_QuatfNormalize")) + (define-cproc quatf-normalize! (q::) - (return "Scm_QuatfNormalizeX")) + (call "Scm_QuatfNormalizeX")) (define-cproc quatf->matrix4f (q::) "float m[16]; @@ -647,21 +731,60 @@ SCM_RETURN(SCM_OBJ(m));") (define-cproc matrix4f->quatf (m::) - "float q[4]; - Scm_Matrix4fToQuatfv(q, SCM_MATRIX4F_D(m)); - SCM_RETURN(Scm_MakeQuatfv(q));") + (body + (let* ((|q[4]| :: float)) + (Scm_Matrix4fToQuatfv q (SCM_MATRIX4F_D m)) + (result (Scm_MakeQuatfv q))))) + (define-cproc matrix4f->quatf! (q:: m::) - "Scm_Matrix4fToQuatfv(SCM_QUATF_D(q), SCM_MATRIX4F_D(m)); - SCM_RETURN(SCM_OBJ(q));") + (body + (Scm_Matrix4fToQuatfv (SCM_QUATF_D q) (SCM_MATRIX4F_D m)) + (result (SCM_OBJ q)))) (define-cproc quatf-slerp (p:: q:: t::) - "float r[4]; - Scm_QuatfSlerp(r, SCM_QUATF_D(q), SCM_QUATF_D(p), t); - SCM_RETURN(Scm_MakeQuatfv(r));") + (body + (let* ((|r[4]| :: float)) + (Scm_QuatfSlerp r (SCM_QUATF_D p) (SCM_QUATF_D q) t) + (result (Scm_MakeQuatfv r))))) + (define-cproc quatf-slerp! (r:: p:: q:: t::) - "Scm_QuatfSlerp(SCM_QUATF_D(r), SCM_QUATF_D(p), SCM_QUATF_D(p), t); - SCM_RETURN(SCM_OBJ(r));") + (body + (Scm_QuatfSlerp (SCM_QUATF_D r) (SCM_QUATF_D p) (SCM_QUATF_D q) t) + (result (SCM_OBJ r)))) +(define-cproc vectors->quatf (v:: w::) + (body + (let* ((|r[4]| :: float)) + (Scm_VectorsToQuatfv r (SCM_VECTOR4F_D v) (SCM_VECTOR4F_D w)) + (result (Scm_MakeQuatfv r))))) + +(define-cproc vectors->quatf! (q:: v:: w::) + (body + (Scm_VectorsToQuatfv (SCM_QUATF_D q) + (SCM_VECTOR4F_D v) (SCM_VECTOR4F_D w)) + (result (SCM_OBJ q)))) + +(define-cproc axes->quatf (v1:: + v2:: + w1:: + w2::) + (body + (let* ((|r[4]| :: float)) + (Scm_AxesToQuatfv r (SCM_VECTOR4F_D v1) (SCM_VECTOR4F_D v2) + (SCM_VECTOR4F_D w1) (SCM_VECTOR4F_D w2)) + (result (Scm_MakeQuatfv r))))) + +(define-cproc axes->quatf! (q:: + v1:: + v2:: + w1:: + w2::) + (body + (Scm_AxesToQuatfv (SCM_QUATF_D q) + (SCM_VECTOR4F_D v1) (SCM_VECTOR4F_D v2) + (SCM_VECTOR4F_D w1) (SCM_VECTOR4F_D w2)) + (result (SCM_OBJ q)))) + ;; Local variables: ;; mode: scheme ;; end: =================================================================== --- gauche-gl-0.4.4.orig/src/glext-lib.stub (revision 301) +++ gauche-gl-0.4.4/src/glext-lib.stub (working copy) @@ -1,7 +1,7 @@ ;;; ;;; glext-lib.stub - glue functions for GL extensions ;;; -;;; Copyright(C) 2004-2005 by Shiro Kawai (shiro@acm.org) +;;; Copyright (c) 2004-2008 Shiro Kawai ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, @@ -375,15 +375,25 @@ ;; (define-cproc gl-active-texture-arb (texture::) - "ENSURE(glActiveTextureARB); - glActiveTextureARB(texture); - SCM_RETURN(SCM_UNDEFINED);") + (body + "ENSURE(glActiveTextureARB);" + "glActiveTextureARB(texture);")) +(define-cproc gl-active-texture (texture::) ; GL 1.3 + (body + "ENSURE(glActiveTexture);" + "glActiveTexture(texture);")) + (define-cproc gl-client-active-texture-arb (texture::) - "ENSURE(glClientActiveTextureARB); - glClientActiveTextureARB(texture); - SCM_RETURN(SCM_UNDEFINED);") + (body + "ENSURE(glClientActiveTextureARB);" + "glClientActiveTextureARB(texture);")) +(define-cproc gl-client-active-texture (texture::) ; GL 1.3 + (body + "ENSURE(glClientActiveTexture);" + "glClientActiveTexture(texture);")) + (define-cproc gl-multi-tex-coord-arb (texunit:: v &rest args) "if (SCM_F32VECTORP(v)) { switch (SCM_F32VECTOR_SIZE(v)) { @@ -1781,6 +1791,142 @@ ;; GL_NV_vertex_program3 ;; +;;============================================================= +;; GL_EXT_framebuffer_object +;; + +(define-cproc gl-is-renderbuffer-ext (renderbuffer::) + (body + "ENSURE(glIsRenderbufferEXT);" + "SCM_RESULT = glIsRenderbufferEXT(renderbuffer);")) + +(define-cproc gl-bind-renderbuffer-ext (target:: renderbuffer::) + (body + "ENSURE(glBindRenderbufferEXT);" + "glBindRenderbufferEXT(target, renderbuffer);")) + +(define-cproc gl-gen-renderbuffers-ext (size::) + (body "ScmObj vec;" + "ENSURE(glGenRenderbuffersEXT);" + "if (size <= 0) Scm_Error(\"size must be a positive integer, but got %d\", size);" + "vec = Scm_MakeU32Vector(size, 0);" + "glGenRenderbuffersEXT(size, (GLuint*)SCM_U32VECTOR_ELEMENTS(vec));" + "SCM_RESULT = vec;")) + +(define-cproc gl-renderbuffer-storage-ext (target:: + internalformat:: + width:: height::) + (body + "ENSURE(glRenderbufferStorageEXT);" + "glRenderbufferStorageEXT(target, internalformat, width, height);")) + +(define-cproc gl-get-renderbuffer-parameter-ext (target:: + pname::) + (body "GLint val;" + "ENSURE(glGetRenderbufferParameterivEXT);" + "switch (pname) {" + "case GL_RENDERBUFFER_WIDTH_EXT:" + "case GL_RENDERBUFFER_HEIGHT_EXT:" + "case GL_RENDERBUFFER_INTERNAL_FORMAT_EXT:" + "case GL_RENDERBUFFER_RED_SIZE_EXT:" + "case GL_RENDERBUFFER_GREEN_SIZE_EXT:" + "case GL_RENDERBUFFER_BLUE_SIZE_EXT:" + "case GL_RENDERBUFFER_ALPHA_SIZE_EXT:" + "case GL_RENDERBUFFER_DEPTH_SIZE_EXT:" + "case GL_RENDERBUFFER_STENCIL_SIZE_EXT:" + " glGetRenderbufferParameterivEXT(target, pname, &val);" + " SCM_RESULT = Scm_MakeInteger(val);" + " break;" + "default:" + " Scm_Error(\"unsupported pname for gl-get-renderbuffer-parameter-ext: %S\", pname);" + " SCM_RESULT = SCM_UNDEFINED;" + "}")) + +(define-cproc gl-bind-framebuffer-ext (target:: framebuffer::) + (body + "ENSURE(glBindFramebufferEXT);" + "glBindFramebufferEXT(target, framebuffer);")) + +(define-cproc gl-delete-framebuffers-ext (fbs::) + (body + "ENSURE(glDeleteFramebuffersEXT);" + "glDeleteFramebuffersEXT(SCM_U32VECTOR_SIZE(fbs)," + " (GLuint*)SCM_U32VECTOR_ELEMENTS(fbs));")) + +(define-cproc gl-gen-framebuffers-ext (size::) + (body "ScmObj vec;" + "ENSURE(glGenFramebuffersEXT);" + "if (size <= 0) Scm_Error(\"size must be a positive integer, but got %d\", size);" + "vec = Scm_MakeU32Vector(size, 0);" + "glGenFramebuffersEXT(size, (GLuint*)SCM_U32VECTOR_ELEMENTS(vec));" + "SCM_RESULT = vec;")) + +(define-cproc gl-check-framebuffer-status-ext (target::) + (body + "ENSURE(glCheckFramebufferStatusEXT);" + "SCM_RESULT = glCheckFramebufferStatusEXT(target);")) + +(define-cproc gl-framebuffer-texture-1d-ext (target:: + attachment:: + textarget:: + texture:: + level::) + (body + "ENSURE(glFramebufferTexture1DEXT);" + "glFramebufferTexture1DEXT(target, attachment, textarget, texture, level);")) + +(define-cproc gl-framebuffer-texture-2d-ext (target:: + attachment:: + textarget:: + texture:: + level::) + (body + "ENSURE(glFramebufferTexture2DEXT);" + "glFramebufferTexture2DEXT(target, attachment, textarget, texture, level);")) + +(define-cproc gl-framebuffer-texture-3d-ext (target:: + attachment:: + textarget:: + texture:: + level:: + zoffset::) + (body + "ENSURE(glFramebufferTexture3DEXT);" + "glFramebufferTexture3DEXT(target, attachment, textarget, texture, level, zoffset);")) + +(define-cproc gl-framebuffer-renderbuffer-ext (target:: + attachment:: + renderbuffertarget:: + renderbuffer::) + (body + "ENSURE(glFramebufferRenderbufferEXT);" + "glFramebufferRenderbufferEXT(target, attachment, renderbuffertarget, renderbuffer);")) + +(define-cproc gl-get-framebuffer-attachment-parameter-ext (target:: + attachment:: + pname::) + (body "GLint val;" + "ENSURE(glGetFramebufferAttachmentParameterivEXT);" + "switch (pname) {" + "case GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_EXT:" + "case GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT:" + "case GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_EXT:" + "case GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_EXT:" + "case GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_3D_ZOFFSET_EXT:" + " glGetFramebufferAttachmentParameterivEXT(target, attachment, pname, &val);" + " SCM_RESULT = Scm_MakeInteger(val);" + " break;" + "default:" + " Scm_Error(\"unsupported pname for gl-get-renderbuffer-parameter-ext: %S\", pname);" + " SCM_RESULT = SCM_UNDEFINED;" + "}")) + +(define-cproc gl-generate-mipmap-ext (target::) + (body + "ENSURE(glGenerateMipmapEXT);" + "glGenerateMipmapEXT(target);")) + + ;; Local variables: ;; mode: scheme ;; end: =================================================================== --- gauche-gl-0.4.4.orig/src/glu-lib.stub (revision 301) +++ gauche-gl-0.4.4/src/glu-lib.stub (working copy) @@ -1,7 +1,7 @@ ;;; ;;; glu-lib.stub - glue functions for GLU ;;; -;;; Copyright(C) 2001-2005 by Shiro Kawai (shiro@acm.org) +;;; Copyright (c) 2001-2008 Shiro Kawai ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, @@ -37,15 +37,15 @@ (define-cproc glu-look-at (eyex:: eyey:: eyez:: ctrx:: ctry:: ctrz:: upx:: upy:: upz::) - (return "gluLookAt")) + (call "gluLookAt")) (define-cproc glu-ortho-2d (left:: right:: bottom:: top::) - (return "gluOrtho2D")) + (call "gluOrtho2D")) (define-cproc glu-perspective (fovy:: aspect:: znear:: zfar::) - (return "gluPerspective")) + (call "gluPerspective")) (define-cproc glu-pick-matrix (x:: y:: w:: h:: vp) "if (!SCM_S32VECTORP(vp) || SCM_S32VECTOR_SIZE(vp) != 4) { =================================================================== --- gauche-gl-0.4.4.orig/src/test-math3d.scm (revision 301) +++ gauche-gl-0.4.4/src/test-math3d.scm (working copy) @@ -9,6 +9,7 @@ (use gl.math3d) (use gauche.sequence) (use math.const) +(use srfi-1) (define (nearly=? a b) (let ((sizea (size-of a)) @@ -56,6 +57,12 @@ (test* "vector4f -" #,(vector4f -1.0 -2.0 -3.0 -4.0) (- #,(vector4f 1.0 2.0 3.0 4.0) #,(vector4f 2.0 4.0 6.0 8.0))) +(test* "vector4f *" #,(vector4f 2 4 6 8) + (* #,(vector4f 1 2 3 4) 2.0)) +(test* "vector4f *" #,(vector4f 2 4 6 8) + (* 2.0 #,(vector4f 1 2 3 4))) +(test* "vector4f /" #,(vector4f 0.5 1.0 1.5 2.0) + (/ #,(vector4f 1 2 3 4) 2.0)) (test* "vector4f dot" 40.0 (vector4f-dot #,(vector4f 1.0 2.0 3.0 4.0) #,(vector4f 2.0 3.0 4.0 5.0))) @@ -69,6 +76,7 @@ (vector4f-normalize! v) v)) + ;; sequence access (test* "sequence" '(1.0 2.0 3.0 4.0) @@ -444,6 +452,31 @@ (* -13 pi/180))) nearly=?) +;; rotation check +(let () + (define (rot-test q v) + (let* ((nv (vector4f-normalize v))) + (test* (format "rotation by quaternion ~s ~s" q v) + (* (quatf->matrix4f q) nv) + (quatf-transform q nv) + nearly=?))) + (define (rot-test* q) + (for-each (cute rot-test (quatf-normalize q) <>) + '(#,(vector4f 1 0 0 0) + #,(vector4f 0 1 0 0) + #,(vector4f 0 0 1 0) + #,(vector4f 1 1 0 0) + #,(vector4f 1 -1 0 0) + #,(vector4f -1 0 1 0) + #,(vector4f 1 0 -1 0) + #,(vector4f 0 1 -1 0) + #,(vector4f 0 -1 1 0) + #,(vector4f 3 1 4 0)))) + (for-each rot-test* + '(#,(quatf 1 0 0 0) #,(quatf 0 1 0 0) #,(quatf 0 0 1 0) + #,(quatf 0 0 0 1) #,(quatf 1 1 1 1) #,(quatf 1 -1 1 -1) + #,(quatf 3 1 -4 5)))) + ;; test case for small trace case (test* "matrix->quatf (small trace)" (make-quatf (vector4f 1 0 0) (- pi 0.1)) @@ -458,6 +491,57 @@ (matrix4f->quatf (rotation->matrix4f (vector4f 0 0 1) (- pi 0.1))) nearly=?) +;; two vectors -> quatf +(let () + (define (2vtest v w) + (let ((nv (vector4f-normalize v)) + (nw (vector4f-normalize w))) + (test* (format "2vtest ~s ~s" v w) nw + (quatf-transform (vectors->quatf nv nw) nv) + nearly=?) + (test* (format "2vtest ~s ~s" w v) nv + (quatf-transform (vectors->quatf nw nv) nw) + nearly=?))) + (2vtest #,(vector4f 1 0 0 0) #,(vector4f 0 1 0 0)) + (2vtest #,(vector4f 0 1 0 0) #,(vector4f 0 0 1 0)) + (2vtest #,(vector4f 0 0 1 0) #,(vector4f 1 0 0 0)) + (2vtest #,(vector4f 1 2 3 0) #,(vector4f 4 -5 6 0)) + (2vtest #,(vector4f 1 1 0 0) #,(vector4f 1 1 0 0)) + (2vtest #,(vector4f 1 1 0 0) #,(vector4f 1 1 0.001 0)) + ) + +;; four vectors -> quatf +(let () + (define (4vtest v1 v2 w1 w2) + (let ((nv1 (vector4f-normalize v1)) + (nv2 (vector4f-normalize v2)) + (nw1 (vector4f-normalize w1)) + (nw2 (vector4f-normalize w2))) + (test* (format "4vtest (~s ~s) (~s ~s)" v1 v2 w1 w2) + (list '(1.0) nw1 nw2 (+ nw1 nw2)) + (let1 q (axes->quatf nv1 nv2 nw1 nw2) + (list (list (quatf-norm q)) + (quatf-transform q nv1) + (quatf-transform q nv2) + (quatf-transform q (+ nv1 nv2)))) + (cut every nearly=? <> <>)) + (test* (format "4vtest (~s ~s) (~s ~s)" w1 w2 v1 v2) + (list '(1.0) nv1 nv2 (+ nv1 nv2)) + (let1 q (axes->quatf nw1 nw2 nv1 nv2) + (list (list (quatf-norm q)) + (quatf-transform q nw1) + (quatf-transform q nw2) + (quatf-transform q (+ nw1 nw2)))) + (cut every nearly=? <> <>)))) + + (4vtest #,(vector4f 1 0 0 0) #,(vector4f 0 1 0 0) + #,(vector4f 0 1 0 0) #,(vector4f 0 0 1 0)) + (4vtest #,(vector4f 1 0 0 0) #,(vector4f 0 1 0 0) + #,(vector4f 0 0 -1 0) #,(vector4f 0 1 0 0)) + (4vtest #,(vector4f 1 1 0 0) #,(vector4f 1 -1 0) + #,(vector4f 1 0 0) #,(vector4f 0 0 1 0)) + ) + ;; sequence access (test* "sequence" '(1.0 2.0 3.0 4.0) =================================================================== --- gauche-gl-0.4.4.orig/doc/Makefile.in (revision 301) +++ gauche-gl-0.4.4/doc/Makefile.in (working copy) @@ -63,7 +63,7 @@ gosh ./extract -en -o gauche-gl-refe.texi gauche-gl-ref.texi gauche-gl-refe.info.gz : gauche-gl-refe.texi - if test X$(MAKEINFO) != X -a X$(GZIP_PROGRAM) != X; then \ + if test "X$(MAKEINFO)" != X -a "X$(GZIP_PROGRAM)" != X; then \ $(MAKEINFO) --no-warn gauche-gl-refe.texi; \ rm -rf gauche-gl-refe.info*.gz; \ $(GZIP_PROGRAM) gauche-gl-refe.info; \ @@ -85,7 +85,7 @@ gosh ./extract -jp -o gauche-gl-refj.texi gauche-gl-ref.texi gauche-gl-refj.info.gz : gauche-gl-refj.texi - if test X$(MAKEINFO) != X -a X$(GZIP_PROGRAM) != X; then \ + if test "X$(MAKEINFO)" != X -a "X$(GZIP_PROGRAM)" != X; then \ $(MAKEINFO) --no-warn gauche-gl-refj.texi; \ rm -rf gauche-gl-refj.info*.gz; \ $(GZIP_PROGRAM) gauche-gl-refj.info ; \ =================================================================== --- gauche-gl-0.4.4.orig/doc/gauche-gl-ref.texi (revision 301) +++ gauche-gl-0.4.4/doc/gauche-gl-ref.texi (working copy) @@ -59,7 +59,7 @@ * OpenGL API:: * GLUT API:: * Vectors and matrices:: -* Simple image handling:: +* Simple utilities:: * Indices:: @end menu @@ -84,13 +84,12 @@ The vector and matrix objects here can be directly passed to Gauche-gl functions. The functions are descrbied in @ref{Vectors and matrices}. -@item gl.simple-image -OpenGL doesn't provide any means of reading/writing image data, and -it should be covered by other Gauche extensions. However, -it is sometimes handy to have simple means to handle external -image data, so that you can do some experiment with Gauche-gl alone. -This module provides minimal support for that. -The functions are descrbied in @ref{Simple image handling}. +@item gl.simple.* +These modules provide simple APIs for programmers to +hack up a very simple OpenGL application. They are by no +means intended for general application development, but +would be handy for throwaway script. +See @ref{Simple utilities} for the details. @end table @c ====================================================================== @@ -2918,7 +2917,7 @@ @c ====================================================================== -@node Vectors and matrices, Simple image handling, GLUT API, Top +@node Vectors and matrices, Simple utilities, GLUT API, Top @chapter Vectors and matrices @deftp {Module} gl.math3d @@ -3115,6 +3114,10 @@ (@var{w} element is ignored). @end defun +@defun vector4f-norm v +Returns the norm (length) of the vector @var{v}. +@end defun + @defun vector4f-normalize x @defunx vector4f-normalize! x Returns a normalized vector of vector4f @var{x}. @@ -3339,6 +3342,12 @@ initial values. The f32vector @var{v} must have enough length. @end defun +@defun f32vector->matrix4f! m v &optional (start 0) +Extract 16 flonums in the f32vector @var{v} starting from the +index @var{start}, and fill the matrix4f @var{m} with them. +The f32vector @var{v} must have enough length. +@end defun + @defun matrix4f->f32vector m Returns a new f32vector that has elements from matrix4f @var{m}. @end defun @@ -3468,8 +3477,8 @@ @xref{Quaternions}, for more details about quaternions. @end defun -@defun euler-angle->matrxi4f xangle yangle zangle &optional order -@defunx euler-angle->matrxi4f! m xangle yangle zangle &optional order +@defun euler-angle->matrix4f xangle yangle zangle &optional order +@defunx euler-angle->matrix4f! m xangle yangle zangle &optional order Returns a matrix that represents rotation along x, y and z axis by @var{xangle}, @var{yangle}, and @var{zangle}, respectively. @@ -3526,12 +3535,23 @@ @var{m} is non-singular or not. @end defun +@defun matrix4f->translation m +Extract the translation component from the given TRS matrix @var{m} +and returns it as a @code{}. +@end defun + +@defun matrix4f->translation! v m +Extract the translation component from the given TRS matrix @var{m} +and stores the result into a @code{} @var{v}. +Returns @var{v}. +@end defun + @defun matrix4f->rotation m From given orthogonal matrix @var{m}, extracts and returns and rotation axis and angle, as a vector4f and a real number. @end defun -@defun matrix4f->rotation! m v +@defun matrix4f->rotation! v m Same as above, except the storage of vector4f @var{v} is reused to store the result axis. @end defun @@ -3607,6 +3627,25 @@ a f32vector (only first three component is used). @end defun +@defun vectors->quatf v w +@defunx vectors->quatf! q v w +Given two unit vectors @var{v} and @var{w}, calculates and returns +a quaternion that represents a rotation from @var{v} to @var{w}. +The destructive version @code{vectors->quatf!} modifies @var{q}. +@end defun + +@defun axes->quatf v1 v2 w1 w2 +@defunx axes->quatf! q v1 v2 w1 w2 +The arguments must be all unit vectors, +@var{v1} and @var{v2} must be perpendicular, +and also @var{w1} and @var{w2} must be perpendicular. + +Calculates and returns a quaternion that represents a rotation +which transforms @var{v1} to @var{w1}, and @var{v2} to @var{w2}, +respectively. The destructive version stores the result +into @var{q}. +@end defun + @defun quatf-add p q @defunx quatf-add! p q @defunx quatf-sub p q @@ -3624,11 +3663,13 @@ @defun quatf-mul p q @defunx quatf-mul! p q Multiply two quaternions @var{p} and @var{q}. -The destructive version modifies @var{p}. +The destructive version modifies @var{p} as well. @end defun -@defun quatf-conjugate q -Returns a conjugate of a quaternion @var{q}. +@defun quatf-conjugate p +@defunx quatf-conjugate! q p +Returns a conjugate of a quaternion @var{p}. +The destructive version modifies @var{q} as well. @end defun @defun quatf-transform q p @@ -3660,22 +3701,47 @@ The destructive version modifies @var{m}. @end defun +@defun matrix4f->quatf m +@defunx matrix4f->quatf! q m +Extracts the rotation component of a matrix @var{m} and +returns a quaterion that represents the rotation. +@code{Matrix4f->quatf!} also uses @var{q} as the storage +to store the result. +@end defun + @defun quatf-slerp p q t @defunx quatf-slerp! r p q t Returns a quaternion that interpolates between two unit quaternions @var{p} and @var{q}, by a scalar value @var{t}. -The destructive version modifies @var{t}. +The destructive version modifies @var{r}. @end defun +@c ====================================================================== +@node Simple utilities, Indices, Vectors and matrices, Top +@chapter Simple utilities +This chapter covers @code{gl.simple.*} modules. They are +provided for the convenience of those who wants quick experiment +with Gauche-gl alone, without a hassle to install a bunch of +other modules. Their features are pretty limited, but you +may find them handy when you need to hack up some throwaway +script that need to show some graphics on the screen. +@menu +* Simple image handling:: +* Simple viewer:: +@end menu -@c ====================================================================== -@node Simple image handling, Indices, Vectors and matrices, Top -@chapter Simple image handling +@node Simple image handling, Simple viewer, Simple utilities, Simple utilities +@section Simple image handling -@deftp {Module} gl.simple-image -@mdindex gl.simple-image +@deftp {Module} gl.simple.image +@mdindex gl.simple.image +OpenGL doesn't provide any means of reading/writing image data, and +it should be covered by other Gauche extensions. However, +it is sometimes handy to have simple means to handle external +image data, so that you can do some experiment with Gauche-gl alone. + This module provides a minimal support to handle external image data, so that one can do some experiment in Gauche-gl alone. @@ -3704,10 +3770,140 @@ for the REPL to display the entire result. @end defun +@node Simple viewer, , Simple image handling, Simple utilities +@section Simple viewer +@deftp {Module} gl.simple.viewer +@mdindex gl.simple.viewer +This module packages common operations to allow users to +view 3D objects, controlling the camera by the mouse, +and have some interactions with the keyboard. +A typical way of using the viewer is like the following: + +@example +(use gl) +(use gl.glut) +(use gl.simple.viewer) + +(define (main args) + (glut-init args) + (simple-viewer-display ) + (simple-viewer-set-key! ...) + (simple-viewer-window :title ...) + (simple-viewer-run) ; loop forever. type ESC to exit. + 0) +@end example + +The viewer handles mouse drag (to move the camera), +and also draws reference grid and axes by default for +your convenience. You have to provide a thunk, which +must draw your 3D object. + +For the keyboard events, you can use a convenient API +to associate handler to the key (character for normal keys, +and constants like @code{GL_LEFT_ARROW} for special keys). + +The reshape event is handled implicitly, though you can +override it. + +If you call @code{simple-viewer-run}, it enters the event +loop and never returns. If you wish to keep REPL and/or +other parts of your application run concurrently, +the convenient way is to run @code{simple-viewer-run} +in a separate thread. + +@example +(use gauche.threads) + +(define (run-viewer) + (thread-start! (make-thread simple-viewer-run #f))) +@end example + +See also the code under @file{examples/simple} directory +of the source tree for more examples. +@end deftp + +@defun simple-viewer-window name &key title mode parent width height x y +Creates a new GL window with @var{name}, which must be a symbol +to identify the window later in the simple viewer framework. +The window won't be shown until @code{simple-viewer-run} is called. + +Each window +@end defun + + +@defun simple-viewer-display &optional display-thunk +Gets/sets the display thunk, which is called every time +the GL window is redrawn. You can change the display thunk +any time, even while the viewer thread is running. + +If no argument is given, returns the current display thunk. +It can be @code{#f} if no display thunk is set. + +When the display thunk is called, the matrix mode is +@code{MODELVIEW} and the camera transformation is already applied. +The grid and axes are also drawn, unless you've customized them. + +In the display thunk you can just write your model in the +world coordinate system. It is guaranteed that +the current color is white and line width is 1.0, but +the states of other GL contexts are undefined, +so you have to set them explicitly. +@end defun + +@defun simple-viewer-reshape &optional reshape-proc +Gets/sets the reshape procedure which is called every +time the GL window configuration is changed. (It is +also called when the GL window is shown first time.) +You can change the reshape procedure any time, +even while the viewer thread is running. + +If no argument is given, returns the current reshape proc. + +A reshape procedure is called with two arguments, +the width and the height (in pixels) of the new GL +window configuration. By default, @code{gl.simple.viewer} +sets a procedure that changes viewport and +projection matrix apopropriately; you need to change +it only if you want a different behavior. +@end defun + +@defun simple-viewer-grid &optional grid-proc +@defunx simple-viewer-axis &optional axis-proc +Gets/sets a procedure to draw a grid and axes. +You can change these procedures +any time, even while the viewer thread is running. + +The @var{grid-proc} and @var{axis-proc} are called with no arguments +every time the GL window is redrawn, before the display thunk +is invoked. +The matrix mode is @code{MODELVIEW}, the camera transformation +is already applied, and lighting is disabled. + +The default grid proc draws 10x10 grid +on X-Z plane centered at the origin. The default axis proc +draws a red line from origin to +X, a green line from origin to +Y, +and a blue line from origin to +Z. + +You can pass @code{#f} to disable grid and/or axis display. + +If no argument is given, returns the current grid/axis proc, +respectively. +@end defun + +@defun simple-viewer-set-key! key handler @dots{} +Even number of arguments must be given; the first of +every two specifies the key, and the next one +specifies the action when the key is pressed. +@end defun + + + + + @c ====================================================================== -@node Indices, , Simple image handling, Top +@node Indices, , Simple utilities, Top @appendix Indices @c NODE º÷°ú =================================================================== --- gauche-gl-0.4.4.orig/lib/Makefile.in (revision 301) +++ gauche-gl-0.4.4/lib/Makefile.in (working copy) @@ -14,7 +14,9 @@ SCMFILES = gl.scm \ gl/math3d.scm \ gl/glut.scm \ - gl/simple-image.scm + gl/simple-image.scm \ + gl/simple/viewer.scm \ + gl/simple/image.scm CONFIG_GENERATED = Makefile =================================================================== --- gauche-gl-0.4.4.orig/lib/gl/simple/viewer.scm (revision 0) +++ gauche-gl-0.4.4/lib/gl/simple/viewer.scm (revision 7080) @@ -0,0 +1,335 @@ +;;; +;;; simple/viewer.scm - simple viewer +;;; +;;; Copyright (c) 2008 Shiro Kawai <shiro@acm.org> +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; +;;; 2. 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. +;;; +;;; 3. Neither the name of the authors nor the names of its 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. +;;; + +;; This is a simple viewer skeleton. It is by no means intended for +;; general applications; it's rather a handy tool to quickly hack up +;; a throwaway script to visualize some data. + +(define-module gl.simple.viewer + (use gl) + (use gl.glut) + (use gl.math3d) + (use util.match) + (use util.list) + (use srfi-42) + (export simple-viewer-window + simple-viewer-set-window + simple-viewer-get-window + simple-viewer-display + simple-viewer-reshape + simple-viewer-grid + simple-viewer-axis + simple-viewer-set-key! + simple-viewer-run + ) + ) +(select-module gl.simple.viewer) + +(define *default-key-handlers* (make-hash-table 'eqv?)) +(define *default-display-proc* #f) +(define *default-grid-proc* (lambda () (default-grid))) +(define *default-axis-proc* (lambda () (default-axis))) +(define *default-reshape-proc* (lambda (w h) (default-reshape w h))) + +;;============================================================= +;; Wrapper of GLUT window +;; + +;; We internally maintain <simple-viewer-window> instance to manage +;; GLUT windows created by simple viewer. However, we only expose +;; window names (symbols) to the users. + +(define-class <simple-viewer-window> () + (;; all slots private. use API. + (name :init-keyword :name) ; window name (symbol) + (id :init-keyword :id) ; GLUT window id + (parent :init-keyword :parent) ; parent window, if this is sub + (closure :init-keyword :closure) ; a closure to maintain the + ; internal state. + (name-tab :allocation :class ; name -> window + :init-form (make-hash-table 'eq?)) + (id-tab :allocation :class ; id -> window + :init-form (make-hash-table 'eqv?)) + )) + +(define-method initialize ((win <simple-viewer-window>) args) + (next-method) + (hash-table-put! (ref win'name-tab) (ref win'name) win) + (hash-table-put! (ref win'id-tab) (ref win'id) win)) + +(define (name->window name) + (hash-table-get (class-slot-ref <simple-viewer-window> 'name-tab) name #f)) +(define (id->window id) + (hash-table-get (class-slot-ref <simple-viewer-window> 'id-tab) id #f)) +(define (name->window-id name) + (and-let* [(win (name->window name))] (ref win'id))) +(define (id->window-name id) + (and-let* [(win (id->window id))] (ref win'name))) + +;; Creates a GL window. +(define (simple-viewer-window name . keys) + (let-keywords keys ((parent #f) + (mode (logior GLUT_DOUBLE GLUT_DEPTH GLUT_RGB)) + (title (x->string name)) + (width 300) + (height 300) + (x #f) + (y #f)) + ;; Internal state + (define prev-x -1) + (define prev-y -1) + (define prev-b #f) + (define rotx 20.0) + (define roty -30.0) + (define rotz 0.0) + (define xlatx 0.0) + (define xlaty 0.0) + (define zoom 1.0) + + (define key-handlers (%hash-table-copy *default-key-handlers*)) + (define grid-proc *default-grid-proc*) + (define axis-proc *default-axis-proc*) + (define display-proc *default-display-proc*) + (define reshape-proc *default-reshape-proc*) + + ;; Callback closures + (define (display-fn) + (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT)) + (gl-push-matrix) + (gl-scale zoom zoom zoom) + (gl-translate xlatx xlaty 0.0) + (gl-rotate rotx 1.0 0.0 0.0) + (gl-rotate roty 0.0 1.0 0.0) + (gl-rotate rotz 0.0 0.0 1.0) + + (gl-disable GL_LIGHTING) + (and grid-proc (grid-proc)) + (and axis-proc (axis-proc)) + (gl-color 1.0 1.0 1.0 0.0) + (gl-line-width 1.0) + (and display-proc (display-proc)) + (gl-pop-matrix) + (glut-swap-buffers)) + + (define (reshape-fn w h) + (set! height h) (set! width w) + (and reshape-proc (reshape-proc w h))) + + (define (mouse-fn button state x y) + (cond [(= state GLUT_UP) + (set! prev-x -1) (set! prev-y -1) (set! prev-b #f)] + [else + (set! prev-x x) (set! prev-y y) (set! prev-b button)])) + + (define (motion-fn x y) + (cond [(= prev-b GLUT_LEFT_BUTTON) + (inc! rotx (* (/. (- y prev-y) height) 90.0)) + (inc! roty (* (/. (- x prev-x) width) 90.0))] + [(= prev-b GLUT_MIDDLE_BUTTON) + (inc! xlatx (* (/. (- x prev-x) width (sqrt zoom)) 12.0)) + (inc! xlaty (* (/. (- prev-y y) height (sqrt zoom)) 12.0))] + [(= prev-b GLUT_RIGHT_BUTTON) + (set! zoom (clamp (* (+ 1.0 (* (/. (- prev-y y) height) 2.0)) + zoom) + 0.1 1000.0))]) + (set! prev-x x) (set! prev-y y) + (glut-post-redisplay)) + + (define (keyboard-fn key x y) + (common-keyboard-func key-handlers key x y)) + (define (special-fn key x y) + (common-special-func key-handlers key x y)) + + (define (closure . args) + (match args + [('grid proc) (set! grid-proc proc)] + [('axis proc) (set! axis-proc proc)] + [('display proc) (set! display-proc proc)] + [('reshape proc) (set! reshape-proc proc)] + [('key-handlers) key-handlers] + [_ (error "unrecognized simple-viewer-window message:" args)])) + + (glut-init-display-mode mode) + ;; Register GLUT window id. + (let* ((pwin (and parent (name->window parent))) + (id (cond [pwin + (glut-create-sub-window (ref pwin'id ) + (or x 0) (or y 0) + width height)] + [else + (glut-init-window-size width height) + (when (and x y) + (glut-init-window-position x y)) + (glut-create-window title)]))) + (make <simple-viewer-window> + :name name :id id :parent pwin :closure closure)) + + ;; Set up handlers. + (glut-display-func display-fn) + (glut-reshape-func reshape-fn) + (glut-mouse-func mouse-fn) + (glut-motion-func motion-fn) + (glut-keyboard-func keyboard-fn) + (glut-special-func special-fn) + + ;; Enable some commonly used stuff + ;; TODO: make them customizable + (gl-enable GL_CULL_FACE) + (gl-enable GL_DEPTH_TEST) + (gl-enable GL_NORMALIZE) + + name)) + +(define (simple-viewer-get-window) + (id->window-name (glut-get-window))) + +(define (simple-viewer-set-window name) + (cond [(name->window-id name) => glut-set-window])) + +;; Callback registrar. +(define-syntax define-registrar + (syntax-rules () + [(_ varname key default-var) + (define (varname proc . opts) + (match opts + [() (set! default-var proc)] + [(name) + (cond [(name->window name) => (lambda (win) + (ref win'closure) 'key proc)] + [else + (errorf "~a: no such window with name: ~a" 'varname name)])] + ))])) + +(define-registrar simple-viewer-display display *default-display-proc*) +(define-registrar simple-viewer-reshape reshape *default-reshape-proc*) +(define-registrar simple-viewer-grid grid *default-grid-proc*) +(define-registrar simple-viewer-axis axis *default-axis-proc*) + +(define (simple-viewer-set-key! window . args) + (let1 tab (cond [(not window) *default-key-handlers*] + [(name->window window) => (cut ref <> 'key-handlers)] + [else + (error "simple-viewer-set-key!: no such window:" window)]) + (let loop ((args args)) + (match args + [() '()] + [(key proc . rest) + (if proc + (hash-table-put! tab key proc) + (hash-table-delete! tab key)) + (loop rest)] + [else '()])))) + +(define (simple-viewer-run . keys) + (let-keywords keys ((rescue-errors #t) + ) + (if rescue-errors + (let1 eport (current-error-port) + (let loop () + (guard (e [else (format eport "*** SIMPLE-VIEWER: ~a\n" + (ref e'message))]) + (glut-main-loop)) + (loop))) + (glut-main-loop)) + )) + +;; +;; Default handlers (private) +;; + +(define (default-reshape w h) + (let1 ratio (/ h w) + (gl-viewport 0 0 w h) + (gl-matrix-mode GL_PROJECTION) + (gl-load-identity) + (gl-frustum -1.0 1.0 (- ratio) ratio 5.0 10000.0) + (gl-matrix-mode GL_MODELVIEW) + (gl-load-identity) + (gl-translate 0.0 0.0 -40.0) + )) + +(define (default-grid) + (gl-color 0.5 0.5 0.5 0.0) + (gl-line-width 1.0) + (gl-begin* GL_LINES + (do-ec (: i -5 6) + (begin + (gl-vertex i 0 -5) + (gl-vertex i 0 5) + (gl-vertex -5 0 i) + (gl-vertex 5 0 i))))) + +(define (default-axis) + (define (axis a b c) + (gl-color a b c 0.0) + (gl-begin* GL_LINES + (gl-vertex 0 0 0) + (gl-vertex a b c))) + (gl-line-width 3.0) + (axis 1.0 0.0 0.0) + (axis 0.0 1.0 0.0) + (axis 0.0 0.0 1.0)) + +(define (quit-loop) + (cond-expand + [gauche.sys.pthreads (thread-terminate! (current-thread))] + [else (exit)])) + +;; common key handler +(define (common-keyboard-func table keycode x y) + (cond [(hash-table-get table (integer->char keycode) #f) + => (cut <> x y)]) + (glut-post-redisplay)) + +(define (common-special-func table keycode x y) + (cond [(hash-table-get table keycode #f) => (cut <> x y)]) + (glut-post-redisplay)) + +;; +;; Set up default keymaps +;; + +(simple-viewer-set-key! #f #\escape (lambda _ (quit-loop))) + +;; oops, Gauche 0.8.13 is missing hash-table-copy. This is a workaround. + +(define %hash-table-copy + (global-variable-ref (find-module 'gauche) 'hash-table-copy + (lambda (src) + (rlet1 dst (make-hash-table (hash-table-type src)) + (hash-table-for-each src + (lambda (k v) + (hash-table-put! dst k v))))) + )) + +(provide "gl/simple/viewer") =================================================================== --- gauche-gl-0.4.4.orig/lib/gl/simple/image.scm (revision 0) +++ gauche-gl-0.4.4/lib/gl/simple/image.scm (revision 7080) @@ -0,0 +1,128 @@ +;;; +;;; gl.simple.image - simple image I/O +;;; +;;; Copyright (c) 2005-2008 Shiro Kawai <shiro@acm.org> +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; +;;; 2. 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. +;;; +;;; 3. Neither the name of the authors nor the names of its 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. +;;; +;;; $Id: simple-image.scm,v 1.2 2008-06-04 11:46:27 shirok Exp $ +;;; + +;; For serious image handling, I'd recommend you to use a serious +;; library (Gauche's GD binding sounds nice, though there's no working +;; version yet). This module provides a minimal routines to do +;; some experiment and testing with Gauche-gl alone. + +(define-module gl.simple.image + (export read-sgi-image read-sgi-image-from-port) + (use gauche.uvector) + (use gauche.sequence) + (use util.match) + (use binary.pack) + (use srfi-42) + ) +(select-module gl.simple.image) + +(define (read-sgi-image file) + (call-with-input-file file read-sgi-image-from-port)) + +;; read-sgi-image-from-port :: port -> (width, height, nchannels, data) +(define (read-sgi-image-from-port port) + (match-let1 (magic compr bpp dim x y z min max pad1 name cmap . pad2) + (unpack "nccnnnnNNNA80Nc404" :input port) + (and (= magic 474) + (= bpp 1) ;; we only support 8bit/channel for now. + (= cmap 0) ;; we only support direct pixel values for now. + (if (= compr 1) + (read-sgi-rle port dim x y z) + (read-sgi-raw port dim x y z))))) + +(define (read-sgi-raw port dim x y z) + (case dim + ((1) (let1 v (make-u8vector x) + (read-block! v port) + (list x 1 1 v))) + ((2) (let1 v (make-u8vector (* x y)) + (read-block! v port) + (list x y 1 v))) + ((3) (let ((planes (list-ec (: i z) + (let1 v (make-u8vector (* x y)) + (read-block! v port) + v))) + (vec (make-u8vector (* x y z)))) + (dotimes (i (* x y)) + (for-each-with-index + (lambda (j plane) + (u8vector-set! vec (+ (* i z) j) (u8vector-ref plane i))) + planes)) + (list x y z vec))) + (else #f))) + +(define (read-sgi-rle port dim x y z) + (let ((starts (make-u32vector (* y z))) ; scan line start indexes + (sizes (make-u32vector (* y z))) ; compressed scan line sizes + (compressed #f) + (offset (+ 512 (* 2 4 y z))) ; offset to the compressed data + (vec (make-u8vector (* x y z)))) ; result vector + (read-block! starts port 0 -1 'big-endian) + (read-block! sizes port 0 -1 'big-endian) + (set! compressed + (string->u8vector + (call-with-output-string (cut copy-port port <>)))) + + (dotimes (zz z) + (dotimes (yy y) + (let ((start (- (u32vector-ref starts (+ (* zz y) yy)) offset)) + (size (u32vector-ref sizes (+ (* zz y) yy)))) + (let1 line + (uvector-alias <u8vector> compressed start (+ start size)) + (do ((xx (+ (* x yy z) zz) xx) + (k 0 k)) + ((>= k size)) + (let1 b (u8vector-ref line k) + (inc! k) + (cond + ((= b 0)) + ((< b 128) ;; repeat next byte to b times + (let1 bb (u8vector-ref line k) + (inc! k) + (dotimes (n b) + (u8vector-set! vec xx bb) + (inc! xx z)))) + (else ;; copy (- b 128) bytes + (dotimes (n (- b 128)) + (u8vector-set! vec xx (u8vector-ref line k)) + (inc! k) + (inc! xx z))))) + ))))) + + (list x y z vec))) + + +(provide "gl/simple/image") + =================================================================== --- gauche-gl-0.4.4.orig/lib/gl/math3d.scm (revision 301) +++ gauche-gl-0.4.4/lib/gl/math3d.scm (working copy) @@ -1,7 +1,7 @@ ;;; ;;; gl/math3d.scm - auxiliary vector arithmetics for 3D graphics ;;; -;;; Copyright(C) 2002-2003 by Shiro Kawai (shiro@acm.org) +;;; Copyright (c) 2002-2008 Shiro Kawai <shiro@acm.org> ;;; ;;; Permission to use, copy, modify, distribute this software and ;;; accompanying documentation for any purpose is hereby granted, @@ -274,6 +274,8 @@ (vector4f-add x y)) (define-method object-+ ((x <point4f>) (y <vector4f>)) (point4f-add x y)) +(define-method object-+ ((y <vector4f>) (x <point4f>)) + (point4f-add x y)) (define-method object-+ ((x <quatf>) (y <quatf>)) (quatf-add x y)) @@ -289,6 +291,13 @@ (define-method object-- ((x <vector4f>)) (vector4f-sub #,(vector4f 0 0 0) x)) +(define-method object-* ((v <vector4f>) (f <real>)) + (vector4f-mul v f)) +(define-method object-* ((f <real>) (v <vector4f>)) + (vector4f-mul v f)) +(define-method object-/ ((v <vector4f>) (f <real>)) + (vector4f-div v f)) + (define-method object-* ((m <matrix4f>) (v <vector4f>)) (matrix4f-mul m v)) (define-method object-* ((m <matrix4f>) (v <point4f>)) =================================================================== --- gauche-gl-0.4.4.orig/lib/gl/simple-image.scm (revision 301) +++ gauche-gl-0.4.4/lib/gl/simple-image.scm (working copy) @@ -1,128 +1,9 @@ ;;; ;;; simple-image.scm - simple image I/O ;;; -;;; Copyright (c) 2005 Shiro Kawai, All rights reserved. +;;; This is obsoleted. Use gl.simple.image instead. ;;; -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: -;;; -;;; 1. Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. -;;; -;;; 2. 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. -;;; -;;; 3. Neither the name of the authors nor the names of its 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. -;;; -;;; $Id: simple-image.scm,v 1.1 2005/06/08 12:10:43 shirok Exp $ -;;; -;; For serious image handling, I'd recommend you to use a serious -;; library (Gauche's GD binding sounds nice, though there's no working -;; version yet). This module provides a minimal routines to do -;; some experiment and testing with Gauche-gl alone. - (define-module gl.simple-image - (export read-sgi-image read-sgi-image-from-port) - (use gauche.uvector) - (use gauche.sequence) - (use util.match) - (use binary.pack) - (use srfi-42) - ) -(select-module gl.simple-image) - -(define (read-sgi-image file) - (call-with-input-file file read-sgi-image-from-port)) - -;; read-sgi-image-from-port :: port -> (width, height, nchannels, data) -(define (read-sgi-image-from-port port) - (match-let1 (magic compr bpp dim x y z min max pad1 name cmap . pad2) - (unpack "nccnnnnNNNA80Nc404" :input port) - (and (= magic 474) - (= bpp 1) ;; we only support 8bit/channel for now. - (= cmap 0) ;; we only support direct pixel values for now. - (if (= compr 1) - (read-sgi-rle port dim x y z) - (read-sgi-raw port dim x y z))))) - -(define (read-sgi-raw port dim x y z) - (case dim - ((1) (let1 v (make-u8vector x) - (read-block! v port) - (list x 1 1 v))) - ((2) (let1 v (make-u8vector (* x y)) - (read-block! v port) - (list x y 1 v))) - ((3) (let ((planes (list-ec (: i z) - (let1 v (make-u8vector (* x y)) - (read-block! v port) - v))) - (vec (make-u8vector (* x y z)))) - (dotimes (i (* x y)) - (for-each-with-index - (lambda (j plane) - (u8vector-set! vec (+ (* i z) j) (u8vector-ref plane i))) - planes)) - (list x y z vec))) - (else #f))) - -(define (read-sgi-rle port dim x y z) - (let ((starts (make-u32vector (* y z))) ; scan line start indexes - (sizes (make-u32vector (* y z))) ; compressed scan line sizes - (compressed #f) - (offset (+ 512 (* 2 4 y z))) ; offset to the compressed data - (vec (make-u8vector (* x y z)))) ; result vector - (read-block! starts port 0 -1 'big-endian) - (read-block! sizes port 0 -1 'big-endian) - (set! compressed - (string->u8vector - (call-with-output-string (cut copy-port port <>)))) - - (dotimes (zz z) - (dotimes (yy y) - (let ((start (- (u32vector-ref starts (+ (* zz y) yy)) offset)) - (size (u32vector-ref sizes (+ (* zz y) yy)))) - (let1 line - (uvector-alias <u8vector> compressed start (+ start size)) - (do ((xx (+ (* x yy z) zz) xx) - (k 0 k)) - ((>= k size)) - (let1 b (u8vector-ref line k) - (inc! k) - (cond - ((= b 0)) - ((< b 128) ;; repeat next byte to b times - (let1 bb (u8vector-ref line k) - (inc! k) - (dotimes (n b) - (u8vector-set! vec xx bb) - (inc! xx z)))) - (else ;; copy (- b 128) bytes - (dotimes (n (- b 128)) - (u8vector-set! vec xx (u8vector-ref line k)) - (inc! k) - (inc! xx z))))) - ))))) - - (list x y z vec))) - - + (extend gl.simple.image)) ; for backward compatibility (provide "gl/simple-image") - =================================================================== --- gauche-gl-0.4.4.orig/examples/simple/minimum-viewer.scm (revision 0) +++ gauche-gl-0.4.4/examples/simple/minimum-viewer.scm (revision 7080) @@ -0,0 +1,12 @@ +;; A minimum demo to use gl.simple.viewer + +(use gl) +(use gl.glut) +(use gl.simple.viewer) + +(define (main args) + (glut-init args) + (simple-viewer-display (lambda () (glut-wire-sphere 2.0 10 8))) + (simple-viewer-window 'demo) + (simple-viewer-run) + 0) =================================================================== --- gauche-gl-0.4.4.orig/examples/glbook/example8-6.scm (revision 301) +++ gauche-gl-0.4.4/examples/glbook/example8-6.scm (working copy) @@ -2,7 +2,7 @@ (use gl) (use gl.glut) -(use gl.simple-image) +(use gl.simple.image) (use gauche.uvector) (use util.match) =================================================================== --- gauche-gl-0.4.4.orig/examples/glbook/example8-8.scm (revision 301) +++ gauche-gl-0.4.4/examples/glbook/example8-8.scm (working copy) @@ -2,7 +2,7 @@ (use gl) (use gl.glut) -(use gl.simple-image) +(use gl.simple.image) (use gauche.uvector) (use gauche.sequence) (use util.match) =================================================================== --- gauche-gl-0.4.4.orig/examples/glbook/example13-7.scm (revision 301) +++ gauche-gl-0.4.4/examples/glbook/example13-7.scm (working copy) @@ -46,7 +46,7 @@ (print-3d-color-vertex buffer count) (inc! count 8)) ((= token GL_LINE_TOKEN) (print "GL_LINE_TOKEN") - (aprint-3d-color-vertex buffer count) (inc! count 8) + (print-3d-color-vertex buffer count) (inc! count 8) (print-3d-color-vertex buffer count) (inc! count 8)) ((= token GL_LINE_RESET_TOKEN) (print "GL_LINE_RESET_TOKEN") �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������debian/patches/01_no_path_xtra.patch����������������������������������������������������������������0000644�0000000�0000000�00000005207�12075206767�014644� 0����������������������������������������������������������������������������������������������������ustar ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Description: no PATH_XTRA Don't configure for PATH_XTRA Author: NIIBE Yutaka <gniibe@fsij.org> Reviewed-By: NIIBE Yutaka <gniibe@fsij.org> Last-Update: 2010-03-19 --- a/configure.in +++ b/configure.in @@ -7,7 +7,7 @@ AC_INIT(Gauche-gl, 0.5.1, shiro@acm.org) AC_CANONICAL_SYSTEM -AC_PATH_XTRA +dnl AC_PATH_XTRA case "$target" in *-*-cygwin*) @@ -74,8 +74,8 @@ AC_CHECK_HEADERS(GL/glx.h, [ # OpenGL/X11 # NB: FreeBSD seems to need -lX11 -lXext. We are on X11 system anyway, # so I assume this won't do any harm. - GL_LIBS='-lGLU -lGL -lX11 -lXext' - GLUT_LIB="$GLUT_LIB -lXmu -lXi" + GL_LIBS='-lGLU -lGL' + GLUT_LIB="$GLUT_LIB" ], ,) AC_CHECK_HEADERS(GLUT/glut.h, [ case $target in --- a/cg/Makefile.in +++ b/cg/Makefile.in @@ -17,13 +17,12 @@ # These are set by configure # NB: cc and various flags must match the ones used to compile Gauche, # so the make invocator shouldn't casually override them. -CFLAGS = @DEFS@ @CFLAGS@ @X_CFLAGS@ @GLUT_INCDIR@ -I../src +CFLAGS = @DEFS@ @CFLAGS@ @GLUT_INCDIR@ -I../src LDFLAGS = -I../src @LDFLAGS@ OBJEXT = @OBJEXT@ SOEXT = @SOEXT@ OLIBS = @LIBS@ -LIBS = @CG_LIBS@ @GL_EXTRALIBS@ @GL_LIBS@ @LIBS@ \ - @X_LIBS@ @X_PRE_LIBS@ @X_EXTRA_LIBS@ @X_LIBS@ +LIBS = @CG_LIBS@ @GL_EXTRALIBS@ @GL_LIBS@ @LIBS@ GOSH = "@GOSH@" GAUCHE_CONFIG = "@GAUCHE_CONFIG@" GAUCHE_INSTALL = "@GAUCHE_INSTALL@" @@ -62,7 +61,7 @@ install : all $(GAUCHE_INSTALL) -m 444 -T $(HEADER_INSTALL_DIR) $(HEADERS) $(GAUCHE_INSTALL) -m 444 -T $(SCM_INSTALL_DIR) $(SCMFILES) - $(GAUCHE_INSTALL) -m 555 -T $(ARCH_INSTALL_DIR) $(ARCHFILES) + $(GAUCHE_INSTALL) -m 755 -T $(ARCH_INSTALL_DIR) $(ARCHFILES) uninstall : all $(GAUCHE_INSTALL) -U $(HEADER_INSTALL_DIR) $(HEADERS) --- a/src/Makefile.in +++ b/src/Makefile.in @@ -17,12 +17,12 @@ # These are set by configure # NB: cc and various flags must match the ones used to compile Gauche, # so the make invocator shouldn't casually override them. -CFLAGS = @DEFS@ @X_CFLAGS@ @GLUT_INCDIR@ +CFLAGS = @DEFS@ @GLUT_INCDIR@ LDFLAGS = @LDFLAGS@ OBJEXT = @OBJEXT@ SOEXT = @SOEXT@ OLIBS = @LIBS@ -LIBS = @GL_LIBS@ @LIBS@ @X_LIBS@ @X_PRE_LIBS@ @X_EXTRA_LIBS@ @X_LIBS@ +LIBS = @GL_LIBS@ @LIBS@ GOSH = "@GOSH@" GAUCHE_CONFIG = "@GAUCHE_CONFIG@" @@ -101,7 +101,7 @@ install : all $(GAUCHE_INSTALL) -m 444 -T $(HEADER_INSTALL_DIR) $(HEADERS) $(GAUCHE_INSTALL) -m 444 -T $(SCM_INSTALL_DIR) $(SCMFILES) - $(GAUCHE_INSTALL) -m 555 -T $(ARCH_INSTALL_DIR) $(ARCHFILES) + $(GAUCHE_INSTALL) -m 755 -T $(ARCH_INSTALL_DIR) $(ARCHFILES) uninstall : all $(GAUCHE_INSTALL) -U $(HEADER_INSTALL_DIR) $(HEADERS) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������debian/control��������������������������������������������������������������������������������������0000644�0000000�0000000�00000001324�12075406564�010602� 0����������������������������������������������������������������������������������������������������ustar ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Source: gauche-gl Section: lisp Priority: optional Maintainer: Debian Gauche Maintainers <pkg-gauche-devel@lists.alioth.debian.org> Uploaders: Hatta Shuzo <hattas@debian.org>, YAEGASHI Takeshi <yaegashi@debian.org>, NIIBE Yutaka <gniibe@fsij.org>, Jens Thiele <karme@karme.de> Build-Depends: quilt (>= 0.46-7~), debhelper (>= 9), autotools-dev, freeglut3-dev, pkg-config, gauche-dev (>= 0.9.3.3), autoconf, texinfo Standards-Version: 3.9.3 Homepage: http://practical-scheme.net/gauche/ Package: gauche-gl Architecture: any Depends: ${shlibs:Depends}, ${misc:Depends} Description: Gauche bindings for OpenGL Gauche-gl is an extension module of Gauche Scheme implementation. It provides gl, gl.glut, and gl.math3d modules. ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������debian/rules����������������������������������������������������������������������������������������0000755�0000000�0000000�00000001303�12075206406�010245� 0����������������������������������������������������������������������������������������������������ustar ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/make -f # -*- makefile-gmake -*- # Uncomment this to turn on verbose mode. #export DH_VERBOSE=1 export DH_OPTIONS export GZIP=-9 %: dh $@ --with quilt override_dh_auto_clean: dh_auto_clean rm -f configure config.sub config.guess override_dh_auto_configure: ln -sf /usr/share/misc/config.sub . ln -sf /usr/share/misc/config.guess . autoconf -I /usr/share/gauche/0.9 dh_auto_configure # Not invoking make install at 'doc' directory override_dh_auto_install: (cd src; $(MAKE) DESTDIR=$(CURDIR)/debian/gauche-gl install) (cd lib; $(MAKE) DESTDIR=$(CURDIR)/debian/gauche-gl install) gauche-install -m 444 -T $(CURDIR)/debian/gauche-gl`gauche-config --syslibdir`/.packages Gauche-gl.gpd �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������debian/compat���������������������������������������������������������������������������������������0000644�0000000�0000000�00000000002�12075205630�010364� 0����������������������������������������������������������������������������������������������������ustar ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������9 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������debian/README.source��������������������������������������������������������������������������������0000644�0000000�0000000�00000000650�11371652124�011350� 0����������������������������������������������������������������������������������������������������ustar ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gauche-gl for Debian -------------------- This package uses quilt to manage all modifications to the upstream source. Changes are stored in the source package as diffs in debian/patches and applied during the build. Please see: /usr/share/doc/quilt/README.source for more information on how to apply the patches, modify patches, or remove a patch. -- NIIBE Yutaka <gniibe@fsij.org>, Mon, 10 May 2010 09:33:24 +0900 ����������������������������������������������������������������������������������������debian/copyright������������������������������������������������������������������������������������0000644�0000000�0000000�00000010362�11350560146�011124� 0����������������������������������������������������������������������������������������������������ustar ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������This package was debianized by NIIBE Yutaka <gniibe@fsij.org> on Wed, 11 Aug 2004 10:33:33 +0900. It was downloaded from http://dl.sf.net/gauche/Gauche-gl-0.3.1.tgz Upstream Author: Shiro Kawai <shiro@acm.org> Copyright: Copyright (c) 2001-2002 Shiro Kawai, All rights reserved. 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. examples/slbook/ogl2brick/3Dlabs-License.txt: examples/slbook/ogl2particle/3Dlabs-License.txt /************************************************************************ * * * Copyright (C) 2002-2004 3Dlabs Inc. Ltd. * * * * All rights reserved. * * * * Redistribution and use in source and binary forms, with or without * * modification, are permitted provided that the following conditions * * are met: * * * * Redistributions of source code must retain the above copyright * * notice, this list of conditions and the following disclaimer. * * * * 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. * * * * Neither the name of LightWork Design Ltd. nor the names of its * * 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 HOLDERS 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. * * * ************************************************************************/ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������debian/changelog������������������������������������������������������������������������������������0000644�0000000�0000000�00000011723�12075406726�011055� 0����������������������������������������������������������������������������������������������������ustar ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gauche-gl (0.5.1-1) unstable; urgency=low * New upstream release. * debian/patches/series: Disable 00_new_api_0.9.patch (it's for 0.4.4). * debian/compat: Upgrade to 9. * debian/rules (DH_OPTIONS): Add export. * debian/control (Standards-Version): Now, it follows 3.9.3. (Maintainer): Now, it's team maintained. (Uploaders): New (same as gauche). -- NIIBE Yutaka <gniibe@fsij.org> Tue, 15 Jan 2013 16:54:17 +0900 gauche-gl (0.4.4-5) unstable; urgency=low * debian/rules (override_dh_auto_test): Removed. -- NIIBE Yutaka <gniibe@fsij.org> Mon, 10 May 2010 09:32:34 +0900 gauche-gl (0.4.4-4) unstable; urgency=low * debian/gauche-gl.info: New file. * debian/patches/00_new_api_0.9.patch: New file for new Gauche 0.9. * debian/patches/01_no_path_xtra.patch: New file from diff of 0.4.4-3. * debian/{rules,source,patches,README.source}: Use 3.0 (quilt) format. * debian/compat: Updated. * debian/control (Section): It's now lisp. (Homepage): New field. (Depends): Added ${misc:Depends}. (Build-Depends): This is for new gauche-dev (>= 0.9). Added autoconf and texinfo. -- NIIBE Yutaka <gniibe@fsij.org> Fri, 19 Mar 2010 11:23:06 +0900 gauche-gl (0.4.4-3) unstable; urgency=low * debian/control (Build-Depends): Depends gauche-dev version 0.8.13 and later. (Standards-Version): Now follows to 3.7.3. -- NIIBE Yutaka <gniibe@fsij.org> Fri, 15 Feb 2008 14:03:41 +0900 gauche-gl (0.4.4-2) unstable; urgency=low * debian/control (Build-Depends): Depends gauche-dev version 0.8.12 and later. -- NIIBE Yutaka <gniibe@fsij.org> Thu, 01 Nov 2007 10:15:15 +0900 gauche-gl (0.4.4-1) unstable; urgency=low * New upstream release. * debian/control (Build-Depends): Depends gauche-dev version 0.8.11 and later. -- NIIBE Yutaka <gniibe@fsij.org> Sat, 25 Aug 2007 13:53:10 +0900 gauche-gl (0.4.3-1) unstable; urgency=low * New upstream release (Closes: #404230). * debian/watch: New format (version=3). * debian/compat: New version 5. -- NIIBE Yutaka <gniibe@fsij.org> Thu, 25 Jan 2007 13:39:28 +0900 gauche-gl (0.4.2-2) unstable; urgency=low * Remove unneeded dependencies. * debian/control (Build-Depends): Remove libxt-dev, libxmu-dev, libxi-dev. (Standards-Version): Updated to 3.7.2.2. -- NIIBE Yutaka <gniibe@fsij.org> Mon, 11 Dec 2006 13:59:44 +0900 gauche-gl (0.4.2-1) unstable; urgency=low * New upstream release. * GLX_GLXEXT_PROTOTYPES patch merged (closes: Bug#388577). (Since GL_GLEXT_PROTOTYPES is irrelevant for GL/glx.h, only the part of GLX_GLXEXT_PROTOTYPES has been merged.) The patch for src/gauche-gl.c has been incorporated into upstream. * debian/control (Build-Depends): Depends gauche-dev version 0.8.8 and later. -- NIIBE Yutaka <gniibe@fsij.org> Mon, 4 Dec 2006 11:06:44 +0900 gauche-gl (0.4.1-3) unstable; urgency=low * debian/control (Build-Depends): Added libxi-dev. -- NIIBE Yutaka <gniibe@fsij.org> Mon, 29 May 2006 10:25:02 +0900 gauche-gl (0.4.1-2) unstable; urgency=low * debian/control (Standards-Version): Follow new standard 3.7.2. (Build-Depends): Depends gauche-dev version 0.8.7 and later. * debian/rules: Added binary-indep target. -- NIIBE Yutaka <gniibe@fsij.org> Tue, 23 May 2006 02:01:35 +0900 gauche-gl (0.4.1-1) unstable; urgency=low * New upstream release. * debian/control (Standards-Version): Follow new standard 3.6.2. (Build-Depends): Depends gauche-dev version 0.8.6 and later. -- NIIBE Yutaka <gniibe@fsij.org> Wed, 4 Jan 2006 18:06:34 +0900 gauche-gl (0.3.1-8) unstable; urgency=low * Build with newer gauche. -- NIIBE Yutaka <gniibe@fsij.org> Sat, 4 Jun 2005 03:47:13 +0900 gauche-gl (0.3.1-7) unstable; urgency=low * debian/control: Specify build dependency to newer gauche-dev (>= 0.8.3) suggested by Lars Wirzenius <liw@iki.fi>. Closes: Bug#297080. -- NIIBE Yutaka <gniibe@fsij.org> Mon, 7 Mar 2005 19:03:47 +0900 gauche-gl (0.3.1-6) unstable; urgency=low * Build for new Gauche 0.8.3. -- NIIBE Yutaka <gniibe@fsij.org> Sun, 13 Feb 2005 16:05:40 +0900 gauche-gl (0.3.1-5) unstable; urgency=low * debian/control: Specify only one version dependency to gauche. * debian/README.Debian: Added explanation of gauche ABI of 0.7.4.2. * debian/watch: Fix URL. -- NIIBE Yutaka <gniibe@fsij.org> Sat, 23 Oct 2004 23:15:44 +0900 gauche-gl (0.3.1-4) unstable; urgency=low * debian/control: Add libxt-dev and libxmu-dev to Build-Depends. Closes: Bug#266828. -- NIIBE Yutaka <gniibe@fsij.org> Fri, 20 Aug 2004 16:07:56 +0900 gauche-gl (0.3.1-3) unstable; urgency=low * configure.in: Fix PIC flag handling. -- NIIBE Yutaka <gniibe@fsij.org> Wed, 18 Aug 2004 17:09:17 +0900 gauche-gl (0.3.1-2) unstable; urgency=low * configure.in, src/Makefile.in: Add PIC flag handling. -- NIIBE Yutaka <gniibe@fsij.org> Tue, 17 Aug 2004 19:27:53 +0900 gauche-gl (0.3.1-1) unstable; urgency=low * Initial Release. Closes: Bug#264777. -- NIIBE Yutaka <gniibe@fsij.org> Wed, 11 Aug 2004 10:33:33 +0900 ���������������������������������������������debian/README.Debian��������������������������������������������������������������������������������0000644�0000000�0000000�00000001545�11350554763�011245� 0����������������������������������������������������������������������������������������������������ustar ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gauche-gl for Debian -------------------- 0.3.1-6, 0.3.1-7: In Gauche 0.8, SONAME is defeined in libgauche (as libgauche.so.0). However, Gauche still does not have well-defined modular design for extension modules (such like Perl/Python/Rupy). When newer gauche will be packaged for Debian, we will reexamine the Depends: field of control file. History: 0.3.1-1 to 0.3.1-5: This package was compiled with gauche 0.7.4.2, and it had the dependency to a specific version, 0.7.4.2 (although the condition is weaker, in fact). As of 0.7.4.2, module ABI against libgauche was not well defined, we could not specify the version of gauche depended. In the upstream of 0.8, it has been improved. SONAME of libgauche (0.8) includes interface number, so that module can specify the version of libgauche. -- NIIBE Yutaka <gniibe@fsij.org>, Fri, 19 Mar 2010 10:57:07 +0900 �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������