On 19-Jan-09, at 8:57 PM, Frederick LeMaster wrote:
You could define a 'hook' the way emacs and guile do.
;wrapper.scm (define disp-hook (list (lambda () (void))))
(define (add-hook hook thunk) (set-cdr! hook (cons thunk '())))
(define (run-hook hook) (for-each (lambda (p) (p)) hook))
(c-define (c-disp) () void "f" "" (run-hook disp-hook))
;test.scm (load "graphics")
(define (disp) (glClear GL_COLOR_BUFFER_BIT) (glutWireTeapot 0.5))
(add-hook disp-hook disp)
Nice solution! Another approach, which preserves the GLUT API, is to replace
(define glutDisplayFunc (c-lambda ((function () void)) void "glutDisplayFunc"))
with
(define (glutDisplayFunc func) (real-glutDisplayFunc (scheme-void-function->c-void-function func)))
(define real-glutDisplayFunc (c-lambda ((function () void)) void "glutDisplayFunc"))
(define (scheme-void-function->c-void-function func) (set! scheme-void-function func) c-void-function)
(c-define (c-void-function) () void "c_void_function" "" (scheme-void-function))
(define scheme-void-function #f)
Note that with this approach only one callback can be installed but that's OK because GLUT has a single display callback.
In a more general context you could use the following scheme-void- function->c-void-function procedure definition which allocates C functions from a pool of 5 predefined functions (basically a poor implementation of C closures):
(c-define (f0) () void "f0" "" (f 0)) (c-define (f1) () void "f1" "" (f 1)) (c-define (f2) () void "f2" "" (f 2)) (c-define (f3) () void "f3" "" (f 3)) (c-define (f4) () void "f4" "" (f 4))
(define c-void-functions (vector f0 f1 f2 f3 f4)) (define scheme-void-functions (vector #f #f #f #f #f))
(define (f i) ((vector-ref scheme-void-functions i)))
(define (scheme-void-function->c-void-function func) (let loop ((i 0)) (if (< i (vector-length scheme-void-functions)) (if (vector-ref scheme-void-functions i) (loop (+ i 1)) (begin (vector-set! scheme-void-functions i func) (vector-ref c-void-functions i))) (error "can't convert Scheme function to C function" func))))
The limit of 5 could of course be increased, but some limit will exist unless you are willing to accept a non-portable solution.
Gambit's C-interface actually includes code to convert any Scheme function to a C function by using the technique of dynamic code generation. This feature is disabled by default because it is a non- portable solution (it supports x86, SPARC and PowerPC) and it hasn't been tested thoroughly (check ___make_c_closure in lib/os_dyn.c for details). If you want to try it out you'll have to build Gambit from scratch using this (rather cryptic) invocation of the configure script:
CC="gcc -D___WORD_SIZE=___WORD_WIDTH" ./configure
If you do try it out, please let me know how it works out.
Marc