/support/gambit/glut/glut.scm

  1
  2(include "glut-header.scm")
  3
  4(c-declare #<<declare-end
  5#include <GL/gl.h>
  6#include <GL/glu.h>
  7#include <GL/glut.h>
  8declare-end
  9)
 10
 11
 12
 13; os dependent macros:
 14
 15(define GLUT_STROKE_ROMAN ((c-lambda () void* "___result_voidstar = GLUT_STROKE_ROMAN;")))
 16(define GLUT_STROKE_MONO_ROMAN ((c-lambda () void* "___result_voidstar = GLUT_STROKE_MONO_ROMAN;")))
 17(define GLUT_BITMAP_9_BY_15 ((c-lambda () void* "___result_voidstar = GLUT_BITMAP_9_BY_15;")))
 18(define GLUT_BITMAP_8_BY_13 ((c-lambda () void* "___result_voidstar = GLUT_BITMAP_8_BY_13;")))
 19(define GLUT_BITMAP_TIMES_ROMAN_10 ((c-lambda () void* "___result_voidstar = GLUT_BITMAP_TIMES_ROMAN_10;")))
 20(define GLUT_BITMAP_TIMES_ROMAN_24 ((c-lambda () void* "___result_voidstar = GLUT_BITMAP_TIMES_ROMAN_24;")))
 21(define GLUT_BITMAP_HELVETICA_10 ((c-lambda () void* "___result_voidstar = GLUT_BITMAP_HELVETICA_10;")))
 22(define GLUT_BITMAP_HELVETICA_12 ((c-lambda () void* "___result_voidstar = GLUT_BITMAP_HELVETICA_12;")))
 23(define GLUT_BITMAP_HELVETICA_18 ((c-lambda () void* "___result_voidstar = GLUT_BITMAP_HELVETICA_18;")))
 24
 25;; /*
 26;;  * Initialization see fglut_init.c
 27;;  */
 28
 29;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 30
 31;; (define basic-glut-init
 32;;   (c-lambda () void
 33
 34;; "
 35;; int argc = 0 ;
 36
 37;; glutInit( &argc , NULL ) ; "))
 38
 39;; (define glutInit (c-lambda ( int*  nonnull-char-string-list ) void "glutInit"))
 40
 41;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 42
 43;; (define (glutInit argc argv)
 44;;   ((c-lambda () void "int argc = 0 ; glutInit ( &argc , NULL ) ;")))
 45
 46(c-declare " int argc = 0 ; ")
 47
 48(define (glutInit a b)
 49
 50  (let ((argc ((c-lambda () (pointer int) " ___result_voidstar = &argc ; "))))
 51
 52    (let ((proc (c-lambda ( int*  nonnull-char-string-list ) void "glutInit")))
 53
 54      (proc argc '()))))
 55
 56;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 57
 58(define glutInitWindowPosition (c-lambda ( int int ) void "glutInitWindowPosition"))
 59(define glutInitWindowSize (c-lambda ( int int ) void "glutInitWindowSize"))
 60(define glutInitDisplayMode (c-lambda ( unsigned-int ) void "glutInitDisplayMode"))
 61(define glutInitDisplayString (c-lambda ( char-string ) void "glutInitDisplayString"))
 62
 63;; /*
 64;;  * Process loop see freeglut_main.c
 65;;  */
 66(define glutMainLoop (c-lambda ( ) void "glutMainLoop"))
 67
 68;; /*
 69;;  * Window management see freeglut_window.c
 70;;  */
 71(define glutCreateWindow (c-lambda ( char-string ) int "glutCreateWindow"))
 72(define glutCreateSubWindow (c-lambda ( int int int int int ) int "glutCreateSubWindow"))
 73(define glutDestroyWindow (c-lambda ( int ) void "glutDestroyWindow"))
 74(define glutSetWindow (c-lambda ( int ) void "glutSetWindow"))
 75(define glutGetWindow (c-lambda ( ) int "glutGetWindow"))
 76(define glutSetWindowTitle (c-lambda ( char-string ) void "glutSetWindowTitle"))
 77(define glutSetIconTitle (c-lambda ( char-string ) void "glutSetIconTitle"))
 78(define glutReshapeWindow (c-lambda ( int int ) void "glutReshapeWindow"))
 79(define glutPositionWindow (c-lambda ( int int ) void "glutPositionWindow"))
 80(define glutShowWindow (c-lambda ( ) void "glutShowWindow"))
 81(define glutHideWindow (c-lambda ( ) void "glutHideWindow"))
 82(define glutIconifyWindow (c-lambda ( ) void "glutIconifyWindow"))
 83(define glutPushWindow (c-lambda ( ) void "glutPushWindow"))
 84(define glutPopWindow (c-lambda ( ) void "glutPopWindow"))
 85(define glutFullScreen (c-lambda ( ) void "glutFullScreen"))
 86
 87;; /*
 88;;  * Display-connected see freeglut_display.c
 89;;  */
 90(define glutPostWindowRedisplay (c-lambda ( int ) void "glutPostWindowRedisplay"))
 91(define glutPostRedisplay (c-lambda ( ) void "glutPostRedisplay"))
 92(define glutSwapBuffers (c-lambda ( ) void "glutSwapBuffers"))
 93
 94;; /*
 95;;  * Mouse cursor see freeglut_cursor.c
 96;;  */
 97(define glutWarpPointer (c-lambda ( int int ) void "glutWarpPointer"))
 98(define glutSetCursor (c-lambda ( int ) void "glutSetCursor"))
 99
100;; /*
101;;  * Overlay see freeglut_overlay.c
102;;  */
103(define glutEstablishOverlay (c-lambda ( ) void "glutEstablishOverlay"))
104(define glutRemoveOverlay (c-lambda ( ) void "glutRemoveOverlay"))
105(define glutUseLayer (c-lambda ( GLenum ) void "glutUseLayer"))
106(define glutPostOverlayRedisplay (c-lambda ( ) void "glutPostOverlayRedisplay"))
107(define glutPostWindowOverlayRedisplay (c-lambda ( int ) void "glutPostWindowOverlayRedisplay"))
108(define glutShowOverlay (c-lambda ( ) void "glutShowOverlay"))
109(define glutHideOverlay (c-lambda ( ) void "glutHideOverlay"))
110
111;; /*
112;;  * Menu see freeglut_menu.c
113;;  */
114
115;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
116
117;; (define glutCreateMenu (c-lambda ( (function (int) void) ) int "glutCreateMenu"))
118
119(define *glut-create-menu-func* #f)
120
121(c-define (basic-create-menu-func a)
122          (int)
123          void
124          "basicCreateMenuFunc"
125          ""
126          (*glut-create-menu-func* a))
127
128(define (glutCreateMenu proc)
129  (set! *glut-create-menu-func* proc)
130  ((c-lambda () void " glutCreateMenu ( basicCreateMenuFunc ) ; ")))
131
132;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
133
134(define glutDestroyMenu (c-lambda ( int ) void "glutDestroyMenu"))
135(define glutGetMenu (c-lambda ( ) int "glutGetMenu"))
136(define glutSetMenu (c-lambda ( int ) void "glutSetMenu"))
137(define glutAddMenuEntry (c-lambda ( char-string int ) void "glutAddMenuEntry"))
138(define glutAddSubMenu (c-lambda ( char-string int ) void "glutAddSubMenu"))
139(define glutChangeToMenuEntry (c-lambda ( int char-string int ) void "glutChangeToMenuEntry"))
140(define glutChangeToSubMenu (c-lambda ( int char-string int ) void "glutChangeToSubMenu"))
141(define glutRemoveMenuItem (c-lambda ( int ) void "glutRemoveMenuItem"))
142(define glutAttachMenu (c-lambda ( int ) void "glutAttachMenu"))
143(define glutDetachMenu (c-lambda ( int ) void "glutDetachMenu"))
144
145;; /*
146;;  * Global callback see freeglut_callbacks.c
147;;  */
148
149(define glutTimerFunc (c-lambda ( unsigned-int (function (int) void) int ) void "glutTimerFunc"))
150
151;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
152
153;; (define glutIdleFunc (c-lambda ( (function () void) ) void "glutIdleFunc"))
154
155(define *glut-idle-func* #f)
156
157(c-define (basic-idle-func)
158          ()
159          void
160          "basicIdleFunc"
161          ""
162          (*glut-idle-func*))
163
164(define (glutIdleFunc proc)
165  (set! *glut-idle-func* proc)
166  ((c-lambda () void " glutIdleFunc ( basicIdleFunc ) ; ")))
167
168;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
169
170;; /*
171;;  * Window-specific callback see freeglut_callbacks.c
172;;  */
173
174;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
175
176;; (define glutKeyboardFunc (c-lambda ( (function (unsigned-char int int) void) ) void "glutKeyboardFunc"))
177
178(define *glut-keyboard-func* #f)
179
180(c-define (basic-keyboard-func a b c)
181          (unsigned-char int int)
182          void
183          "basicKeyboardFunc"
184          ""
185          (*glut-keyboard-func* a b c))
186
187(define (glutKeyboardFunc proc)
188  (set! *glut-keyboard-func* proc)
189  ((c-lambda () void " glutKeyboardFunc ( basicKeyboardFunc ) ; ")))
190
191;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
192
193;; (define glutSpecialFunc (c-lambda ( (function (int int int) void) ) void "glutSpecialFunc"))
194
195(define *glut-special-func* #f)
196
197(c-define (basic-special-func a b c)
198          (int int int)
199          void
200          "basicSpecialFunc"
201          ""
202          (*glut-special-func* a b c))
203
204(define (glutSpecialFunc proc)
205  (set! *glut-special-func* proc)
206  ((c-lambda () void " glutSpecialFunc ( basicSpecialFunc ) ; ")))
207
208;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
209
210;; (define glut-reshape-func #f)
211
212;; (c-define (basic-reshape-func width height)
213;;           (int int)
214;;           void
215;;           "basicReshapeFunc"
216;;           ""
217;;           (glut-reshape-func width height))
218
219;; (define glutReshapeFunc
220;;   (c-lambda (scheme-object) void "glutReshapeFunc( basicReshapeFunc ) ;"))
221
222;; (define (glutReshapeFunc proc)
223;;   (set! glut-reshape-func proc)
224;;   ((c-lambda () void "glutReshapeFunc( basicReshapeFunc ) ;")))
225
226;; (define glutReshapeFunc (c-lambda ( (function (int int) void) ) void "glutReshapeFunc"))
227
228;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
229
230(define *glut-reshape-func* #f)
231
232(c-define (basic-reshape-func width height)
233          (int int)
234          void
235          "basicReshapeFunc"
236          ""
237          (*glut-reshape-func* width height))
238
239(define (glutReshapeFunc proc)
240  (set! *glut-reshape-func* proc)
241  ((c-lambda () void " glutReshapeFunc ( basicReshapeFunc ) ; ")))
242
243;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
244
245(define glutVisibilityFunc (c-lambda ( (function (int) void) ) void "glutVisibilityFunc"))
246
247;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
248
249;; (define glutDisplayFunc (c-lambda ( (function () void) ) void "glutDisplayFunc"))
250
251;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
252
253(define *glut-display-func* #f)
254
255(c-define (basid-display-func)
256          ()
257          void
258          "basicDisplayFunc"
259          ""
260          (*glut-display-func*))
261
262(define (glutDisplayFunc proc)
263  (set! *glut-display-func* proc)
264  ((c-lambda () void " glutDisplayFunc ( basicDisplayFunc ) ; ")))
265
266;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
267
268;; (define glutMouseFunc (c-lambda ( (function (int int int int) void) ) void "glutMouseFunc"))
269
270(define *glut-mouse-func* #f)
271
272(c-define (basic-mouse-func a b c d)
273          (int int int int)
274          void
275          "basicMouseFunc"
276          ""
277          (*glut-mouse-func* a b c d))
278
279(define (glutMouseFunc proc)
280  (set! *glut-mouse-func* proc)
281  ((c-lambda () void " glutMouseFunc ( basicMouseFunc ) ; ")))
282
283;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
284
285(define glutMotionFunc (c-lambda ( (function (int int) void ) ) void "glutMotionFunc"))
286
287;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
288
289;; (define glutPassiveMotionFunc (c-lambda ( (function (int int) void) ) void "glutPassiveMotionFunc"))
290
291(define *glut-passive-motion-func* #f)
292
293(c-define (basic-passive-motion-func a b)
294          (int int)
295          void
296          "basicPassiveMotionFunc"
297          ""
298          (*glut-passive-motion-func* a b))
299
300(define (glutPassiveMotionFunc proc)
301  (set! *glut-passive-motion-func* proc)
302  ((c-lambda () void " glutPassiveMotionFunc ( basicPassiveMotionFunc ) ; ")))
303
304;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
305
306(define glutEntryFunc (c-lambda ( (function (int) void) ) void "glutEntryFunc"))
307
308(define glutKeyboardUpFunc (c-lambda ( (function (unsigned-char int int) void) ) void "glutKeyboardUpFunc"))
309(define glutSpecialUpFunc (c-lambda ( (function (int int int) void) ) void "glutSpecialUpFunc"))
310(define glutJoystickFunc (c-lambda ( (function (unsigned-int int int int) void) int ) void "glutJoystickFunc"))
311(define glutMenuStateFunc (c-lambda ( (function (int) void) ) void "glutMenuStateFunc"))
312(define glutMenuStatusFunc (c-lambda ( (function (int int int) void) ) void "glutMenuStatusFunc"))
313(define glutOverlayDisplayFunc (c-lambda ( (function () void) ) void "glutOverlayDisplayFunc"))
314(define glutWindowStatusFunc (c-lambda ( (function (int) void) ) void "glutWindowStatusFunc"))
315
316(define glutSpaceballMotionFunc (c-lambda ( (function (int int int) void) ) void "glutSpaceballMotionFunc"))
317(define glutSpaceballRotateFunc (c-lambda ( (function (int int int) void) ) void "glutSpaceballRotateFunc"))
318(define glutSpaceballButtonFunc (c-lambda ( (function (int int) void) ) void "glutSpaceballButtonFunc"))
319(define glutButtonBoxFunc (c-lambda ( (function (int int) void) ) void "glutButtonBoxFunc"))
320(define glutDialsFunc (c-lambda ( (function (int int) void) ) void "glutDialsFunc"))
321(define glutTabletMotionFunc (c-lambda ( (function (int int) void) ) void "glutTabletMotionFunc"))
322(define glutTabletButtonFunc (c-lambda ( (function (int int int int) void) ) void "glutTabletButtonFunc"))
323
324;; /*
325;;  * State setting and retrieval see freeglut_state.c
326;;  */
327(define glutGet (c-lambda ( GLenum ) int "glutGet"))
328(define glutDeviceGet (c-lambda ( GLenum ) int "glutDeviceGet"))
329(define glutGetModifiers (c-lambda ( ) int "glutGetModifiers"))
330(define glutLayerGet (c-lambda ( GLenum ) int "glutLayerGet"))
331
332;; /*
333;;  * Font see freeglut_font.c
334;;  */
335(define glutBitmapCharacter (c-lambda ( void* int ) void "glutBitmapCharacter"))
336(define glutBitmapWidth (c-lambda ( void* int ) int "glutBitmapWidth"))
337(define glutStrokeCharacter (c-lambda ( void* int ) void "glutStrokeCharacter"))
338(define glutStrokeWidth (c-lambda ( void* int ) int "glutStrokeWidth"))
339(define glutBitmapLength (c-lambda ( void* (pointer unsigned-char) ) int "glutBitmapLength"))
340(define glutStrokeLength (c-lambda ( void* (pointer unsigned-char) ) int "glutStrokeLength"))
341
342;; /*
343;;  * Geometry see freeglut_geometry.c
344;;  */
345(define glutWireCube (c-lambda ( GLdouble ) void "glutWireCube"))
346(define glutSolidCube (c-lambda ( GLdouble ) void "glutSolidCube"))
347(define glutWireSphere (c-lambda ( GLdouble GLint GLint ) void "glutWireSphere"))
348(define glutSolidSphere (c-lambda ( GLdouble GLint GLint ) void "glutSolidSphere"))
349(define glutWireCone (c-lambda ( GLdouble GLdouble GLint GLint ) void "glutWireCone"))
350(define glutSolidCone (c-lambda ( GLdouble GLdouble GLint GLint ) void "glutSolidCone"))
351
352(define glutWireTorus (c-lambda ( GLdouble GLdouble GLint GLint ) void "glutWireTorus"))
353(define glutSolidTorus (c-lambda ( GLdouble GLdouble GLint GLint ) void "glutSolidTorus"))
354(define glutWireDodecahedron (c-lambda ( ) void "glutWireDodecahedron"))
355(define glutSolidDodecahedron (c-lambda ( ) void "glutSolidDodecahedron"))
356(define glutWireOctahedron (c-lambda ( ) void "glutWireOctahedron"))
357(define glutSolidOctahedron (c-lambda ( ) void "glutSolidOctahedron"))
358(define glutWireTetrahedron (c-lambda ( ) void "glutWireTetrahedron"))
359(define glutSolidTetrahedron (c-lambda ( ) void "glutSolidTetrahedron"))
360(define glutWireIcosahedron (c-lambda ( ) void "glutWireIcosahedron"))
361(define glutSolidIcosahedron (c-lambda ( ) void "glutSolidIcosahedron"))
362
363;; /*
364;;  * Teapot rendering found in freeglut_teapot.c
365;;  */
366(define glutWireTeapot (c-lambda ( GLdouble ) void "glutWireTeapot"))
367(define glutSolidTeapot (c-lambda ( GLdouble ) void "glutSolidTeapot"))
368
369;; /*
370;;  * Game mode see freeglut_gamemode.c
371;;  */
372(define glutGameModeString (c-lambda ( char-string ) void "glutGameModeString"))
373(define glutEnterGameMode (c-lambda ( ) int "glutEnterGameMode"))
374(define glutLeaveGameMode (c-lambda ( ) void "glutLeaveGameMode"))
375(define glutGameModeGet (c-lambda ( GLenum ) int "glutGameModeGet"))
376
377;; /*
378;;  * Video resize see freeglut_videoresize.c
379;;  */
380(define glutVideoResizeGet (c-lambda ( GLenum ) int "glutVideoResizeGet"))
381(define glutSetupVideoResizing (c-lambda ( ) void "glutSetupVideoResizing"))
382(define glutStopVideoResizing (c-lambda ( ) void "glutStopVideoResizing"))
383(define glutVideoResize (c-lambda ( int int int int ) void "glutVideoResize"))
384(define glutVideoPan (c-lambda ( int int int int ) void "glutVideoPan"))
385
386;; /*
387;;  * Colormap see freeglut_misc.c
388;;  */
389(define glutSetColor (c-lambda ( int GLfloat GLfloat GLfloat ) void "glutSetColor"))
390(define glutGetColor (c-lambda ( int int ) GLfloat "glutGetColor"))
391(define glutCopyColormap (c-lambda ( int ) void "glutCopyColormap"))
392
393;; /*
394;;  * Misc keyboard and joystick see freeglut_misc.c
395;;  */
396(define glutIgnoreKeyRepeat (c-lambda ( int ) void "glutIgnoreKeyRepeat"))
397(define glutSetKeyRepeat (c-lambda ( int ) void "glutSetKeyRepeat"))
398(define glutForceJoystickFunc (c-lambda ( ) void "glutForceJoystickFunc"))
399
400;; /*
401;;  * Misc see freeglut_misc.c
402;;  */
403(define glutExtensionSupported (c-lambda ( char-string ) int "glutExtensionSupported"))
404(define glutReportErrors (c-lambda ( ) void "glutReportErrors"))