Context Navigation

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
18	typedef int GLint;
19	typedef float GLfloat;
20	typedef double GLdouble;
21	typedef 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. */
214	void glutInitDisplayMode(unsigned int mode);
215	void glutInitWindowPosition(int x, int y);
216	void glutInitWindowSize(int width, int height);
217	___safe void glutMainLoop(void);
218
219	/* GLUT window sub-API. */
220	int glutCreateWindow(const char *title);
221	int glutCreateSubWindow(int win, int x, int y, int width, int height);
222	void glutDestroyWindow(int win);
223	void glutPostRedisplay(void);
224	void glutSwapBuffers(void);
225	int glutGetWindow(void);
226	void glutSetWindow(int win);
227	void glutSetWindowTitle(const char *title);
228	void glutSetIconTitle(const char *title);
229	void glutPositionWindow(int x, int y);
230	void glutReshapeWindow(int width, int height);
231	void glutPopWindow(void);
232	void glutPushWindow(void);
233	void glutIconifyWindow(void);
234	void glutShowWindow(void);
235	void glutHideWindow(void);
236	void glutFullScreen(void);
237	void glutSetCursor(int cursor);
238
239	/* GLUT menu sub-API. */
240	int glutCreateMenu(void ( *func)(int));
241	void glutDestroyMenu(int menu);
242	int glutGetMenu(void);
243	void glutSetMenu(int menu);
244	void glutAddMenuEntry(const char *label, int value);
245	void glutAddSubMenu(const char *label, int submenu);
246	void glutChangeToMenuEntry(int item, const char *label, int value);
247	void glutChangeToSubMenu(int item, const char *label, int submenu);
248	void glutRemoveMenuItem(int item);
249	void glutAttachMenu(int button);
250	void glutDetachMenu(int button);
251
252	/* GLUT window callback sub-API. */
253	void glutDisplayFunc(void ( *func)(void));
254	void glutReshapeFunc(void ( *func)(int width, int height));
255	void glutKeyboardFunc(void ( *func)(unsigned char key, int x, int y));
256	void glutMouseFunc(void ( *func)(int button, int state, int x, int y));
257	void glutMotionFunc(void ( *func)(int x, int y));
258	void glutPassiveMotionFunc(void ( *func)(int x, int y));
259	void glutEntryFunc(void ( *func)(int state));
260	void glutVisibilityFunc(void ( *func)(int state));
261	void glutIdleFunc(void ( *func)(void));
262	void glutTimerFunc(unsigned int millis, void ( *func)(int value), int value);
263	void glutMenuStateFunc(void ( *func)(int state));
264	void glutSpecialFunc(void ( *func)(int key, int x, int y));
265	void glutSpaceballMotionFunc(void ( *func)(int x, int y, int z));
266	void glutSpaceballRotateFunc(void ( *func)(int x, int y, int z));
267	void glutSpaceballButtonFunc(void ( *func)(int button, int state));
268	void glutButtonBoxFunc(void ( *func)(int button, int state));
269	void glutDialsFunc(void ( *func)(int dial, int value));
270	void glutTabletMotionFunc(void ( *func)(int x, int y));
271	void glutTabletButtonFunc(void ( *func)(int button, int state, int x, int y));
272	void glutMenuStatusFunc(void ( *func)(int status, int x, int y));
273	void glutOverlayDisplayFunc(void ( *func)(void));
274
275	/* GLUT color index sub-API. */
276	void glutSetColor(int, GLfloat red, GLfloat green, GLfloat blue);
277	GLfloat glutGetColor(int ndx, int component);
278	void glutCopyColormap(int win);
279
280	/* GLUT state retrieval sub-API. */
281	int glutGet(GLenum type);
282	int glutDeviceGet(GLenum type);
283
284	int glutExtensionSupported(const char *name);
285	int glutGetModifiers(void);
286	int glutLayerGet(GLenum type);
287
288	/* GLUT font sub-API */
289	void glutBitmapCharacter(void *font, char character);
290	int glutBitmapWidth(void *font, char character);
291	void glutStrokeCharacter(void *font, char character);
292	int glutStrokeWidth(void *font, char character);
293
294	/* GLUT pre-built models sub-API */
295	void glutWireSphere(GLdouble radius, GLint slices, GLint stacks);
296	void glutSolidSphere(GLdouble radius, GLint slices, GLint stacks);
297	void glutWireCone(GLdouble base, GLdouble height, GLint slices, GLint stacks);
298	void glutSolidCone(GLdouble base, GLdouble height, GLint slices, GLint stacks);
299	void glutWireCube(GLdouble size);
300	void glutSolidCube(GLdouble size);
301	void glutWireTorus(GLdouble innerRadius, GLdouble outerRadius, GLint sides, GLint rings);
302	void glutSolidTorus(GLdouble innerRadius, GLdouble outerRadius, GLint sides, GLint rings);
303	void glutWireDodecahedron(void);
304	void glutSolidDodecahedron(void);
305	void glutWireTeapot(GLdouble size);
306	void glutSolidTeapot(GLdouble size);
307	void glutWireOctahedron(void);
308	void glutSolidOctahedron(void);
309	void glutWireTetrahedron(void);
310	void glutSolidTetrahedron(void);
311	void glutWireIcosahedron(void);
312	void glutSolidIcosahedron(void);
313
314
315
316	/** Peter Wang contributed these: **/
317
318	/* GLUT initialization sub-API. */
319	void glutInitDisplayString(const char *string);
320
321	/* GLUT window sub-API. */
322	void glutPostWindowRedisplay(int win);
323	void glutWarpPointer(int x, int y);
324
325	/* GLUT overlay sub-API. */
326	void glutPostWindowOverlayRedisplay(int win);
327
328	/* GLUT window callback sub-API. */
329	void glutWindowStatusFunc(void (*func)(int state));
330	void glutKeyboardUpFunc(void (*func)(unsigned char key, int x, int y));
331	void glutSpecialUpFunc(void (*func)(int key, int x, int y));
332	void glutJoystickFunc(void (*func)(unsigned int buttonMask, int x, int y, int z), int pollInterval);
333
334	/* GLUT font sub-API */
335	int glutBitmapLength(void font, char string);
336	int glutStrokeLength(void font, char string);
337
338	/* GLUT video resize sub-API. */
339	int glutVideoResizeGet(GLenum param);
340	void glutSetupVideoResizing(void);
341	void glutStopVideoResizing(void);
342	void glutVideoResize(int x, int y, int width, int height);
343	void glutVideoPan(int x, int y, int width, int height);
344
345	/* GLUT debugging sub-API. */
346	void 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
360	void glutIgnoreKeyRepeat(___bool ignore);
361	void glutSetKeyRepeat(int repeatMode);
362	void 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
374	void glutGameModeString(const char *string);
375	int glutEnterGameMode(void);
376	void glutLeaveGameMode(void);
377	int glutGameModeGet(GLenum mode);
378
379	EOF
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.

Context Navigation

source: project/glut/glut.scm @ 6960

Download in other formats: