/support/gambit/glut/glut.scm
Scheme | 404 lines | 206 code | 97 blank | 101 comment | 0 complexity | 7af93727dd4e0d965fc12274a4576185 MD5 | raw file
Possible License(s): BSD-3-Clause
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"))