source: project/glut/glut.scm @ 6960

Last change on this file since 6960 was 6960, checked in by felix winkelmann, 13 years ago

various fixes of the use of _callback [reported by Salmonella]

File size: 19.8 KB
Line 
1;;;; glut.scm
2
3(use easyffi)
4
5#>
6#ifdef C_MACOSX
7#include "GLUT/glut.h"
8#else
9#include "GL/glut.h"
10#endif
11<#
12
13(foreign-parse #<<EOF
14
15___declare(export_constants, yes)
16___declare(substitute, "^(GLUT_|glut);glut:")
17
18typedef int GLint;
19typedef float GLfloat;
20typedef double GLdouble;
21typedef int GLenum;
22
23
24/* Display mode bit masks. */
25#define GLUT_RGB                        0
26#define GLUT_RGBA                       0
27#define GLUT_INDEX                      1
28#define GLUT_SINGLE                     0
29#define GLUT_DOUBLE                     2
30#define GLUT_ACCUM                      4
31#define GLUT_ALPHA                      8
32#define GLUT_DEPTH                      16
33#define GLUT_STENCIL                    32
34#define GLUT_MULTISAMPLE                128
35#define GLUT_STEREO                     256
36#define GLUT_LUMINANCE                  512
37
38/* Mouse buttons. */
39#define GLUT_LEFT_BUTTON                0
40#define GLUT_MIDDLE_BUTTON              1
41#define GLUT_RIGHT_BUTTON               2
42
43/* Mouse button  state. */
44#define GLUT_DOWN                       0
45#define GLUT_UP                         1
46
47/* function keys */
48#define GLUT_KEY_F1                     1
49#define GLUT_KEY_F2                     2
50#define GLUT_KEY_F3                     3
51#define GLUT_KEY_F4                     4
52#define GLUT_KEY_F5                     5
53#define GLUT_KEY_F6                     6
54#define GLUT_KEY_F7                     7
55#define GLUT_KEY_F8                     8
56#define GLUT_KEY_F9                     9
57#define GLUT_KEY_F10                    10
58#define GLUT_KEY_F11                    11
59#define GLUT_KEY_F12                    12
60/* directional keys */
61#define GLUT_KEY_LEFT                   100
62#define GLUT_KEY_UP                     101
63#define GLUT_KEY_RIGHT                  102
64#define GLUT_KEY_DOWN                   103
65#define GLUT_KEY_PAGE_UP                104
66#define GLUT_KEY_PAGE_DOWN              105
67#define GLUT_KEY_HOME                   106
68#define GLUT_KEY_END                    107
69#define GLUT_KEY_INSERT                 108
70
71/* Entry/exit  state. */
72#define GLUT_LEFT                       0
73#define GLUT_ENTERED                    1
74
75/* Menu usage  state. */
76#define GLUT_MENU_NOT_IN_USE            0
77#define GLUT_MENU_IN_USE                1
78
79/* Visibility  state. */
80#define GLUT_NOT_VISIBLE                0
81#define GLUT_VISIBLE                    1
82
83/* Window status  state. */
84#define GLUT_HIDDEN                     0
85#define GLUT_FULLY_RETAINED             1
86#define GLUT_PARTIALLY_RETAINED         2
87#define GLUT_FULLY_COVERED              3
88
89/* Color index component selection values. */
90#define GLUT_RED                        0
91#define GLUT_GREEN                      1
92#define GLUT_BLUE                       2
93
94/* Layers for use. */
95#define GLUT_NORMAL                     0
96#define GLUT_OVERLAY                    1
97
98/* glutGet parameters. */
99#define GLUT_WINDOW_X                   100
100#define GLUT_WINDOW_Y                   101
101#define GLUT_WINDOW_WIDTH               102
102#define GLUT_WINDOW_HEIGHT              103
103#define GLUT_WINDOW_BUFFER_SIZE         104
104#define GLUT_WINDOW_STENCIL_SIZE        105
105#define GLUT_WINDOW_DEPTH_SIZE          106
106#define GLUT_WINDOW_RED_SIZE            107
107#define GLUT_WINDOW_GREEN_SIZE          108
108#define GLUT_WINDOW_BLUE_SIZE           109
109#define GLUT_WINDOW_ALPHA_SIZE          110
110#define GLUT_WINDOW_ACCUM_RED_SIZE      111
111#define GLUT_WINDOW_ACCUM_GREEN_SIZE    112
112#define GLUT_WINDOW_ACCUM_BLUE_SIZE     113
113#define GLUT_WINDOW_ACCUM_ALPHA_SIZE    114
114#define GLUT_WINDOW_DOUBLEBUFFER        115
115#define GLUT_WINDOW_RGBA                116
116#define GLUT_WINDOW_PARENT              117
117#define GLUT_WINDOW_NUM_CHILDREN        118
118#define GLUT_WINDOW_COLORMAP_SIZE       119
119#define GLUT_WINDOW_NUM_SAMPLES         120
120#define GLUT_WINDOW_STEREO              121
121#define GLUT_WINDOW_CURSOR              122
122#define GLUT_SCREEN_WIDTH               200
123#define GLUT_SCREEN_HEIGHT              201
124#define GLUT_SCREEN_WIDTH_MM            202
125#define GLUT_SCREEN_HEIGHT_MM           203
126#define GLUT_MENU_NUM_ITEMS             300
127#define GLUT_DISPLAY_MODE_POSSIBLE      400
128#define GLUT_INIT_WINDOW_X              500
129#define GLUT_INIT_WINDOW_Y              501
130#define GLUT_INIT_WINDOW_WIDTH          502
131#define GLUT_INIT_WINDOW_HEIGHT         503
132#define GLUT_INIT_DISPLAY_MODE          504
133#define GLUT_ELAPSED_TIME               700
134#define GLUT_WINDOW_FORMAT_ID           123
135
136#define GLUT_HAS_KEYBOARD               600
137#define GLUT_HAS_MOUSE                  601
138#define GLUT_HAS_SPACEBALL              602
139#define GLUT_HAS_DIAL_AND_BUTTON_BOX    603
140#define GLUT_HAS_TABLET                 604
141#define GLUT_NUM_MOUSE_BUTTONS          605
142#define GLUT_NUM_SPACEBALL_BUTTONS      606
143#define GLUT_NUM_BUTTON_BOX_BUTTONS     607
144#define GLUT_NUM_DIALS                  608
145#define GLUT_NUM_TABLET_BUTTONS         609
146#define GLUT_DEVICE_IGNORE_KEY_REPEAT   610
147#define GLUT_DEVICE_KEY_REPEAT          611
148#define GLUT_HAS_JOYSTICK               612
149#define GLUT_OWNS_JOYSTICK              613
150#define GLUT_JOYSTICK_BUTTONS           614
151#define GLUT_JOYSTICK_AXES              615
152#define GLUT_JOYSTICK_POLL_RATE         616
153
154#define GLUT_OVERLAY_POSSIBLE           800
155#define GLUT_LAYER_IN_USE               801
156#define GLUT_HAS_OVERLAY                802
157#define GLUT_TRANSPARENT_INDEX          803
158#define GLUT_NORMAL_DAMAGED             804
159#define GLUT_OVERLAY_DAMAGED            805
160
161#define GLUT_VIDEO_RESIZE_POSSIBLE      900
162#define GLUT_VIDEO_RESIZE_IN_USE        901
163#define GLUT_VIDEO_RESIZE_X_DELTA       902
164#define GLUT_VIDEO_RESIZE_Y_DELTA       903
165#define GLUT_VIDEO_RESIZE_WIDTH_DELTA   904
166#define GLUT_VIDEO_RESIZE_HEIGHT_DELTA  905
167#define GLUT_VIDEO_RESIZE_X             906
168#define GLUT_VIDEO_RESIZE_Y             907
169#define GLUT_VIDEO_RESIZE_WIDTH         908
170#define GLUT_VIDEO_RESIZE_HEIGHT        909
171
172/* glutUseLayer parameters. */
173#define GLUT_NORMAL                     0
174#define GLUT_OVERLAY                    1
175
176/* glutGetModifiers return mask. */
177#define GLUT_ACTIVE_SHIFT               1
178#define GLUT_ACTIVE_CTRL                2
179#define GLUT_ACTIVE_ALT                 4
180
181/* glutSetCursor parameters. */
182/* Basic arrows. */
183#define GLUT_CURSOR_RIGHT_ARROW         0
184#define GLUT_CURSOR_LEFT_ARROW          1
185/* Symbolic cursor shapes. */
186#define GLUT_CURSOR_INFO                2
187#define GLUT_CURSOR_DESTROY             3
188#define GLUT_CURSOR_HELP                4
189#define GLUT_CURSOR_CYCLE               5
190#define GLUT_CURSOR_SPRAY               6
191#define GLUT_CURSOR_WAIT                7
192#define GLUT_CURSOR_TEXT                8
193#define GLUT_CURSOR_CROSSHAIR           9
194/* Directional cursors. */
195#define GLUT_CURSOR_UP_DOWN             10
196#define GLUT_CURSOR_LEFT_RIGHT          11
197/* Sizing cursors. */
198#define GLUT_CURSOR_TOP_SIDE            12
199#define GLUT_CURSOR_BOTTOM_SIDE         13
200#define GLUT_CURSOR_LEFT_SIDE           14
201#define GLUT_CURSOR_RIGHT_SIDE          15
202#define GLUT_CURSOR_TOP_LEFT_CORNER     16
203#define GLUT_CURSOR_TOP_RIGHT_CORNER    17
204#define GLUT_CURSOR_BOTTOM_RIGHT_CORNER 18
205#define GLUT_CURSOR_BOTTOM_LEFT_CORNER  19
206/* Inherit from parent window. */
207#define GLUT_CURSOR_INHERIT             100
208/* Blank cursor. */
209#define GLUT_CURSOR_NONE                101
210/* Fullscreen crosshair (if available). */
211#define GLUT_CURSOR_FULL_CROSSHAIR      102
212
213/* GLUT initialization sub-API. */
214void  glutInitDisplayMode(unsigned int mode);
215void  glutInitWindowPosition(int x, int y);
216void  glutInitWindowSize(int width, int height);
217___safe void  glutMainLoop(void);
218
219/* GLUT window sub-API. */
220int  glutCreateWindow(const char *title);
221int  glutCreateSubWindow(int win, int x, int y, int width, int height);
222void  glutDestroyWindow(int win);
223void  glutPostRedisplay(void);
224void  glutSwapBuffers(void);
225int  glutGetWindow(void);
226void  glutSetWindow(int win);
227void  glutSetWindowTitle(const char *title);
228void  glutSetIconTitle(const char *title);
229void  glutPositionWindow(int x, int y);
230void  glutReshapeWindow(int width, int height);
231void  glutPopWindow(void);
232void  glutPushWindow(void);
233void  glutIconifyWindow(void);
234void  glutShowWindow(void);
235void  glutHideWindow(void);
236void glutFullScreen(void);
237void glutSetCursor(int cursor);
238
239/* GLUT menu sub-API. */
240int  glutCreateMenu(void ( *func)(int));
241void  glutDestroyMenu(int menu);
242int  glutGetMenu(void);
243void  glutSetMenu(int menu);
244void  glutAddMenuEntry(const char *label, int value);
245void  glutAddSubMenu(const char *label, int submenu);
246void  glutChangeToMenuEntry(int item, const char *label, int value);
247void  glutChangeToSubMenu(int item, const char *label, int submenu);
248void  glutRemoveMenuItem(int item);
249void  glutAttachMenu(int button);
250void  glutDetachMenu(int button);
251
252/* GLUT window callback sub-API. */
253void  glutDisplayFunc(void ( *func)(void));
254void  glutReshapeFunc(void ( *func)(int width, int height));
255void  glutKeyboardFunc(void ( *func)(unsigned char key, int x, int y));
256void  glutMouseFunc(void ( *func)(int button, int state, int x, int y));
257void  glutMotionFunc(void ( *func)(int x, int y));
258void  glutPassiveMotionFunc(void ( *func)(int x, int y));
259void  glutEntryFunc(void ( *func)(int state));
260void  glutVisibilityFunc(void ( *func)(int state));
261void  glutIdleFunc(void ( *func)(void));
262void  glutTimerFunc(unsigned int millis, void ( *func)(int value), int value);
263void  glutMenuStateFunc(void ( *func)(int state));
264void glutSpecialFunc(void ( *func)(int key, int x, int y));
265void glutSpaceballMotionFunc(void ( *func)(int x, int y, int z));
266void glutSpaceballRotateFunc(void ( *func)(int x, int y, int z));
267void glutSpaceballButtonFunc(void ( *func)(int button, int state));
268void glutButtonBoxFunc(void ( *func)(int button, int state));
269void  glutDialsFunc(void ( *func)(int dial, int value));
270void  glutTabletMotionFunc(void ( *func)(int x, int y));
271void  glutTabletButtonFunc(void ( *func)(int button, int state, int x, int y));
272void  glutMenuStatusFunc(void ( *func)(int status, int x, int y));
273void  glutOverlayDisplayFunc(void ( *func)(void));
274
275/* GLUT color index sub-API. */
276void  glutSetColor(int, GLfloat red, GLfloat green, GLfloat blue);
277GLfloat  glutGetColor(int ndx, int component);
278void  glutCopyColormap(int win);
279
280/* GLUT state retrieval sub-API. */
281int  glutGet(GLenum type);
282int  glutDeviceGet(GLenum type);
283
284int glutExtensionSupported(const char *name);
285int  glutGetModifiers(void);
286 int  glutLayerGet(GLenum type);
287
288/* GLUT font sub-API */
289void  glutBitmapCharacter(void *font, char character);
290int  glutBitmapWidth(void *font, char character);
291void  glutStrokeCharacter(void *font, char character);
292int  glutStrokeWidth(void *font, char character);
293
294/* GLUT pre-built models sub-API */
295void  glutWireSphere(GLdouble radius, GLint slices, GLint stacks);
296void  glutSolidSphere(GLdouble radius, GLint slices, GLint stacks);
297void  glutWireCone(GLdouble base, GLdouble height, GLint slices, GLint stacks);
298void  glutSolidCone(GLdouble base, GLdouble height, GLint slices, GLint stacks);
299void  glutWireCube(GLdouble size);
300void  glutSolidCube(GLdouble size);
301void  glutWireTorus(GLdouble innerRadius, GLdouble outerRadius, GLint sides, GLint rings);
302void  glutSolidTorus(GLdouble innerRadius, GLdouble outerRadius, GLint sides, GLint rings);
303void  glutWireDodecahedron(void);
304void  glutSolidDodecahedron(void);
305void  glutWireTeapot(GLdouble size);
306void  glutSolidTeapot(GLdouble size);
307void  glutWireOctahedron(void);
308void  glutSolidOctahedron(void);
309void  glutWireTetrahedron(void);
310void  glutSolidTetrahedron(void);
311void  glutWireIcosahedron(void);
312void  glutSolidIcosahedron(void);
313
314
315
316/**** Peter Wang contributed these: ****/
317
318/* GLUT initialization sub-API. */
319void  glutInitDisplayString(const char *string);
320
321/* GLUT window sub-API. */
322void  glutPostWindowRedisplay(int win);
323void  glutWarpPointer(int x, int y);
324
325/* GLUT overlay sub-API. */
326void  glutPostWindowOverlayRedisplay(int win);
327
328/* GLUT window callback sub-API. */
329void  glutWindowStatusFunc(void (*func)(int state));
330void  glutKeyboardUpFunc(void (*func)(unsigned char key, int x, int y));
331void  glutSpecialUpFunc(void (*func)(int key, int x, int y));
332void  glutJoystickFunc(void (*func)(unsigned int buttonMask, int x, int y, int z), int pollInterval);
333
334/* GLUT font sub-API */
335int  glutBitmapLength(void *font, char *string);
336int  glutStrokeLength(void *font, char *string);
337
338/* GLUT video resize sub-API. */
339int  glutVideoResizeGet(GLenum param);
340void  glutSetupVideoResizing(void);
341void  glutStopVideoResizing(void);
342void  glutVideoResize(int x, int y, int width, int height);
343void  glutVideoPan(int x, int y, int width, int height);
344
345/* GLUT debugging sub-API. */
346void  glutReportErrors(void);
347
348/* GLUT device control sub-API. */
349/* glutSetKeyRepeat modes. */
350#define GLUT_KEY_REPEAT_OFF             0
351#define GLUT_KEY_REPEAT_ON              1
352#define GLUT_KEY_REPEAT_DEFAULT         2
353
354/* Joystick button masks. */
355#define GLUT_JOYSTICK_BUTTON_A          1
356#define GLUT_JOYSTICK_BUTTON_B          2
357#define GLUT_JOYSTICK_BUTTON_C          4
358#define GLUT_JOYSTICK_BUTTON_D          8
359
360void  glutIgnoreKeyRepeat(___bool ignore);
361void  glutSetKeyRepeat(int repeatMode);
362void  glutForceJoystickFunc(void);
363
364/* GLUT game mode sub-API. */
365/* glutGameModeGet. */
366#define GLUT_GAME_MODE_ACTIVE           0
367#define GLUT_GAME_MODE_POSSIBLE         1
368#define GLUT_GAME_MODE_WIDTH            2
369#define GLUT_GAME_MODE_HEIGHT           3
370#define GLUT_GAME_MODE_PIXEL_DEPTH      4
371#define GLUT_GAME_MODE_REFRESH_RATE     5
372#define GLUT_GAME_MODE_DISPLAY_CHANGED  6
373
374void  glutGameModeString(const char *string);
375int  glutEnterGameMode(void);
376void  glutLeaveGameMode(void);
377int  glutGameModeGet(GLenum mode);
378
379EOF
380)
381
382(declare
383  (hide callbacks set-callback find-callback
384        create_menu_cb display_cb reshape_cb keyboard_cb mouse_cb motion_cb passive_motion_cb entry_cb visibility_cb idle_cb timer_cb
385        menu_state_cb special_cb spaceball_motion_cb spaceball_rotate_cb spaceball_button_cb button_box_cb dials_cb tablet_motion_cb
386        tablet_button_cb menu_status_cb overlay_display_cb window_status_cb keyboard_up_cb special_up_cb joystick_cb
387        glut:Init) )
388
389(define callbacks '())
390
391(define (set-callback type proc)
392  (let* ([w (glut:GetWindow)]
393         [a (assq w callbacks)] )
394    (if a
395        (let ([b (assq type (cdr a))])
396          (if b
397              (set-cdr! b proc)
398              (set-cdr! a (cons (cons type proc) (cdr a))) ) )
399        (set! callbacks (cons (cons w (list (cons type proc))) callbacks)) ) ) )
400
401(define (find-callback type k)
402  (and-let* ([a (assq (glut:GetWindow) callbacks)]
403             [b (assq type (cdr a))] 
404             [c (cdr b)] )
405    (k c) ) )
406
407(define-external (create_menu_cb (int i)) void (find-callback 'create-menu (cut <> i)))
408(define-external (display_cb) void (find-callback 'display (cut <>)))
409(define-external (reshape_cb (int w) (int h)) void (find-callback 'reshape (cut <> w h)))
410(define-external (keyboard_cb (char k) (int x) (int y)) void (find-callback 'keyboard (cut <> k x y)))
411(define-external (mouse_cb (int button) (int state) (int x) (int y)) void (find-callback 'mouse (cut <> button state x y)))
412(define-external (motion_cb (int x) (int y)) void (find-callback 'motion (cut <> x y)))
413(define-external (passive_motion_cb (int x) (int y)) void (find-callback 'passive-motion (cut <> x y)))
414(define-external (entry_cb (int state)) void (find-callback 'entry (cut <> state)))
415(define-external (visibility_cb (int state)) void (find-callback 'visibility (cut <> state)))
416(define-external (idle_cb) void (find-callback 'idle (cut <>)))
417(define-external (timer_cb (int i)) void (find-callback 'timer (cut <> i)))
418(define-external (menu_state_cb (int state)) void (find-callback 'menu-state (cut <> state)))
419(define-external (special_cb (int key) (int x) (int y)) void (find-callback 'special (cut <> key x y)))
420(define-external (spaceball_motion_cb (int key) (int x) (int y)) void (find-callback 'spaceball-motion (cut <> key x y)))
421(define-external (spaceball_rotate_cb (int key) (int x) (int y)) void (find-callback 'spaceball-rotate (cut <> key x y)))
422(define-external (spaceball_button_cb (int key) (int x)) void (find-callback 'spaceball-button (cut <> key x)))
423(define-external (button_box_cb (int key) (int x)) void (find-callback 'button-box (cut <> key x)))
424(define-external (dials_cb (int key) (int x)) void (find-callback 'dials (cut <> key x)))
425(define-external (tablet_motion_cb (int key) (int x)) void (find-callback 'tablet-motion (cut <> key x)))
426(define-external (tablet_button_cb (int key) (int state) (int x) (int y)) void (find-callback 'tablet-button (cut <> key state x y)))
427(define-external (menu_status_cb (int status) (int x) (int y)) void (find-callback 'menu-status (cut <> status x y)))
428(define-external (overlay_display_cb) void (find-callback 'overlay-display (cut <>)))
429(define-external (window_status_cb (int s)) void (find-callback 'window-status (cut <> s)))
430(define-external (keyboard_up_cb (unsigned-char k) (int x) (int y)) void (find-callback 'keyboard-up (cut <> k x y)))
431(define-external (special_up_cb (int k) (int x) (int y)) void (find-callback 'special-up (cut <> k x y)))
432(define-external (joystick_cb (unsigned-int b) (int x) (int y) (int z)) void (find-callback 'joystick (cut <> b x y z)))
433
434(define glut:CreateMenu (let ([old glut:CreateMenu]) (lambda (proc) (old (location create_menu_cb)) (set-callback 'create-menu proc))))
435(define glut:DisplayFunc (let ([old glut:DisplayFunc]) (lambda (proc) (old (location display_cb)) (set-callback 'display proc))))
436(define glut:ReshapeFunc (let ([old glut:ReshapeFunc]) (lambda (proc) (old (location reshape_cb)) (set-callback 'reshape proc))))
437(define glut:KeyboardFunc (let ([old glut:KeyboardFunc]) (lambda (proc) (old (location keyboard_cb)) (set-callback 'keyboard proc))))
438(define glut:MouseFunc (let ([old glut:MouseFunc]) (lambda (proc) (old (location mouse_cb)) (set-callback 'mouse proc))))
439(define glut:MotionFunc (let ([old glut:MotionFunc]) (lambda (proc) (old (location motion_cb)) (set-callback 'motion proc))))
440(define glut:PassiveMotionFunc (let ([old glut:PassiveMotionFunc]) (lambda (proc) (old (location passive_motion_cb)) (set-callback 'passive-motion proc))))
441(define glut:EntryFunc (let ([old glut:EntryFunc]) (lambda (proc) (old (location entry_cb)) (set-callback 'entry proc))))
442(define glut:VisibilityFunc (let ([old glut:VisibilityFunc]) (lambda (proc) (old (location visibility_cb)) (set-callback 'visibility proc))))
443(define glut:IdleFunc (let ([old glut:IdleFunc]) (lambda (proc) (old (location idle_cb)) (set-callback 'idle proc))))
444(define glut:TimerFunc (let ([old glut:TimerFunc]) (lambda (ms proc val) (old ms (location timer_cb) val) (set-callback 'timer proc))))
445(define glut:MenuStateFunc (let ([old glut:MenuStateFunc]) (lambda (proc) (old (location menu_state_cb)) (set-callback 'menu-state proc))))
446(define glut:SpecialFunc (let ([old glut:SpecialFunc]) (lambda (proc) (old (location special_cb)) (set-callback 'special proc))))
447(define glut:SpaceballMotionFunc 
448  (let ([old glut:SpaceballMotionFunc]) (lambda (proc) (old (location spaceball_motion_cb)) (set-callback 'spaceball-motion proc))))
449(define glut:SpaceballRotateFunc 
450  (let ([old glut:SpaceballRotateFunc]) (lambda (proc) (old (location spaceball_rotate_cb)) (set-callback 'spaceball-rotate proc))))
451(define glut:SpaceballButtonFunc 
452  (let ([old glut:SpaceballButtonFunc]) (lambda (proc) (old (location spaceball_button_cb)) (set-callback 'spaceball-button proc))))
453(define glut:ButtonBoxFunc (let ([old glut:ButtonBoxFunc]) (lambda (proc) (old (location button_box_cb)) (set-callback 'button-box proc))))
454(define glut:DialsFunc (let ([old glut:DialsFunc]) (lambda (proc) (old (location dials_cb)) (set-callback 'dials proc))))
455(define glut:TabletMotionFunc (let ([old glut:TabletMotionFunc]) (lambda (proc) (old (location tablet_motion_cb)) (set-callback 'tablet-motion proc))))
456(define glut:TabletButtonFunc (let ([old glut:TabletButtonFunc]) (lambda (proc) (old (location tablet_button_cb)) (set-callback 'tablet-button proc))))
457(define glut:MenuStatusFunc (let ([old glut:MenuStatusFunc]) (lambda (proc) (old (location menu_status_cb)) (set-callback 'menu-status proc))))
458(define glut:OverlayDisplayFunc
459  (let ([old glut:OverlayDisplayFunc]) (lambda (proc) (old (location overlay_display_cb)) (set-callback 'overlay-display proc))))
460
461(define glut:WindowStatusFunc (let ([old glut:WindowStatusFunc]) (lambda (proc) (old (location window_status_cb)) (set-callback 'window-status proc))))
462(define glut:KeyboardUpFunc (let ([old glut:KeyboardUpFunc]) (lambda (proc) (old (location keyboard_up_cb)) (set-callback 'keyboard-up proc))))
463(define glut:SpecialUpFunc (let ([old glut:SpecialUpFunc]) (lambda (proc) (old (location special_up_cb)) (set-callback 'special-up proc))))
464(define glut:JoystickFunc (let ([old glut:JoystickFunc]) (lambda (proc interval) (old (location joystick_cb) interval) (set-callback 'joystick proc))))
465
466(define-foreign-variable GLUT_STROKE_ROMAN c-pointer)
467(define-foreign-variable GLUT_STROKE_MONO_ROMAN c-pointer)
468(define-foreign-variable GLUT_BITMAP_9_BY_15 c-pointer)
469(define-foreign-variable GLUT_BITMAP_8_BY_13 c-pointer)
470(define-foreign-variable GLUT_BITMAP_TIMES_ROMAN_10 c-pointer)
471(define-foreign-variable GLUT_BITMAP_TIMES_ROMAN_24 c-pointer)
472(define-foreign-variable GLUT_BITMAP_HELVETICA_10 c-pointer)
473(define-foreign-variable GLUT_BITMAP_HELVETICA_12 c-pointer)
474(define-foreign-variable GLUT_BITMAP_HELVETICA_18 c-pointer)
475(define glut:STROKE_ROMAN GLUT_STROKE_ROMAN)
476(define glut:STROKE_MONO_ROMAN GLUT_STROKE_MONO_ROMAN)
477(define glut:BITMAP_9_BY_15 GLUT_BITMAP_9_BY_15)
478(define glut:BITMAP_8_BY_13 GLUT_BITMAP_8_BY_13)
479(define glut:BITMAP_TIMES_ROMAN_10 GLUT_BITMAP_TIMES_ROMAN_10)
480(define glut:BITMAP_TIMES_ROMAN_24 GLUT_BITMAP_TIMES_ROMAN_24)
481(define glut:BITMAP_HELVETICA_10 GLUT_BITMAP_HELVETICA_10)
482(define glut:BITMAP_HELVETICA_12 GLUT_BITMAP_HELVETICA_12)
483(define glut:BITMAP_HELVETICA_18 GLUT_BITMAP_HELVETICA_18)
484
485 (foreign-code "glutInit(&C_main_argc, C_main_argv);")
Note: See TracBrowser for help on using the repository browser.