;;; Ypsilon Scheme System
;;; Copyright (c) 2004-2009 Y.FUJITA / LittleWing Company Limited.
;;; See license.txt for terms and conditions of use.
;;; Ported to Chez Scheme by Ed Cavazos (wayo.cavazos@gmail.com)
(library (glut)
(export GLUT_RGB
GLUT_RGBA
GLUT_INDEX
GLUT_SINGLE
GLUT_DOUBLE
GLUT_ACCUM
GLUT_ALPHA
GLUT_DEPTH
GLUT_STENCIL
GLUT_MULTISAMPLE
GLUT_STEREO
GLUT_LUMINANCE
GLUT_NO_RECOVERY
GLUT_LEFT_BUTTON
GLUT_MIDDLE_BUTTON
GLUT_RIGHT_BUTTON
GLUT_DOWN
GLUT_UP
GLUT_KEY_F1
GLUT_KEY_F2
GLUT_KEY_F3
GLUT_KEY_F4
GLUT_KEY_F5
GLUT_KEY_F6
GLUT_KEY_F7
GLUT_KEY_F8
GLUT_KEY_F9
GLUT_KEY_F10
GLUT_KEY_F11
GLUT_KEY_F12
GLUT_KEY_LEFT
GLUT_KEY_UP
GLUT_KEY_RIGHT
GLUT_KEY_DOWN
GLUT_KEY_PAGE_UP
GLUT_KEY_PAGE_DOWN
GLUT_KEY_HOME
GLUT_KEY_END
GLUT_KEY_INSERT
GLUT_LEFT
GLUT_ENTERED
GLUT_MENU_NOT_IN_USE
GLUT_MENU_IN_USE
GLUT_NOT_VISIBLE
GLUT_VISIBLE
GLUT_HIDDEN
GLUT_FULLY_RETAINED
GLUT_PARTIALLY_RETAINED
GLUT_FULLY_COVERED
GLUT_RED
GLUT_GREEN
GLUT_BLUE
GLUT_NORMAL
GLUT_OVERLAY
glutInit
glutInitDisplayString
glutInitDisplayMode
glutInitWindowPosition
glutInitWindowSize
glutMainLoop
glutCreateWindow
glutCreateSubWindow
glutDestroyWindow
glutPostRedisplay
glutPostWindowRedisplay
glutSwapBuffers
glutGetWindow
glutSetWindow
glutSetWindowTitle
glutSetIconTitle
glutPositionWindow
glutReshapeWindow
glutPopWindow
glutPushWindow
glutIconifyWindow
glutShowWindow
glutHideWindow
glutFullScreen
glutSetCursor
glutWarpPointer
glutEstablishOverlay
glutRemoveOverlay
glutUseLayer
glutPostOverlayRedisplay
glutPostWindowOverlayRedisplay
glutShowOverlay
glutHideOverlay
glutCreateMenu
glutDestroyMenu
glutGetMenu
glutSetMenu
glutAddMenuEntry
glutAddSubMenu
glutChangeToMenuEntry
glutChangeToSubMenu
glutRemoveMenuItem
glutAttachMenu
glutDetachMenu
glutDisplayFunc
glutReshapeFunc
glutKeyboardFunc
glutMouseFunc
glutMotionFunc
glutPassiveMotionFunc
glutEntryFunc
glutVisibilityFunc
glutIdleFunc
glutTimerFunc
glutMenuStateFunc
glutSpecialFunc
glutSpaceballMotionFunc
glutSpaceballRotateFunc
glutSpaceballButtonFunc
glutButtonBoxFunc
glutDialsFunc
glutTabletMotionFunc
glutTabletButtonFunc
glutMenuStatusFunc
glutOverlayDisplayFunc
glutWindowStatusFunc
glutKeyboardUpFunc
glutSpecialUpFunc
glutJoystickFunc
glutSetColor
glutGetColor
glutCopyColormap
glutGet
glutDeviceGet
glutExtensionSupported
glutGetModifiers
glutLayerGet
glutGetProcAddress
glutBitmapCharacter
glutBitmapWidth
glutStrokeCharacter
glutStrokeWidth
glutBitmapLength
glutStrokeLength
glutWireSphere
glutSolidSphere
glutWireCone
glutSolidCone
glutWireCube
glutSolidCube
glutWireTorus
glutSolidTorus
glutWireDodecahedron
glutSolidDodecahedron
glutWireTeapot
glutSolidTeapot
glutWireOctahedron
glutSolidOctahedron
glutWireTetrahedron
glutSolidTetrahedron
glutWireIcosahedron
glutSolidIcosahedron
glutVideoResizeGet
glutSetupVideoResizing
glutStopVideoResizing
glutVideoResize
glutVideoPan
glutReportErrors
glutIgnoreKeyRepeat
glutSetKeyRepeat
glutForceJoystickFunc
glutGameModeString
glutEnterGameMode
glutLeaveGameMode
glutGameModeGet)
(import (chezscheme))
;; (define libGLUT
;; (cond (on-darwin (load-shared-object "GLUT.framework/GLUT"))
;; (on-windows (load-shared-object "glut32.dll"))
;; (on-linux (load-shared-object "libglut.so.3"))
;; (on-freebsd (load-shared-object "libglut.so"))
;; (on-openbsd (begin
;; (load-shared-object "libXmu.so.10.0")
;; (load-shared-object "libGLU.so.7.0")
;; (load-shared-object "libglut.so.3.7")))
;; (else
;; (assertion-violation
;; #f
;; "can not locate GLUT library, unknown operating system"))))
(define no-op (load-shared-object "libglut.so.3"))
;; Display mode bit masks.
(define GLUT_RGB 0)
(define GLUT_RGBA GLUT_RGB)
(define GLUT_INDEX 1)
(define GLUT_SINGLE 0)
(define GLUT_DOUBLE 2)
(define GLUT_ACCUM 4)
(define GLUT_ALPHA 8)
(define GLUT_DEPTH 16)
(define GLUT_STENCIL 32)
(define GLUT_MULTISAMPLE 128)
(define GLUT_STEREO 256)
(define GLUT_LUMINANCE 512)
(define GLUT_NO_RECOVERY 1024)
;; Mouse buttons.
(define GLUT_LEFT_BUTTON 0)
(define GLUT_MIDDLE_BUTTON 1)
(define GLUT_RIGHT_BUTTON 2)
;; Mouse button state.
(define GLUT_DOWN 0)
(define GLUT_UP 1)
;; function keys
(define GLUT_KEY_F1 1)
(define GLUT_KEY_F2 2)
(define GLUT_KEY_F3 3)
(define GLUT_KEY_F4 4)
(define GLUT_KEY_F5 5)
(define GLUT_KEY_F6 6)
(define GLUT_KEY_F7 7)
(define GLUT_KEY_F8 8)
(define GLUT_KEY_F9 9)
(define GLUT_KEY_F10 10)
(define GLUT_KEY_F11 11)
(define GLUT_KEY_F12 12)
;; directional keys
(define GLUT_KEY_LEFT 100)
(define GLUT_KEY_UP 101)
(define GLUT_KEY_RIGHT 102)
(define GLUT_KEY_DOWN 103)
(define GLUT_KEY_PAGE_UP 104)
(define GLUT_KEY_PAGE_DOWN 105)
(define GLUT_KEY_HOME 106)
(define GLUT_KEY_END 107)
(define GLUT_KEY_INSERT 108)
;; Entry/exit state.
(define GLUT_LEFT 0)
(define GLUT_ENTERED 1)
;; Menu usage state.
(define GLUT_MENU_NOT_IN_USE 0)
(define GLUT_MENU_IN_USE 1)
;; Visibility state.
(define GLUT_NOT_VISIBLE 0)
(define GLUT_VISIBLE 1)
;; Window status state.
(define GLUT_HIDDEN 0)
(define GLUT_FULLY_RETAINED 1)
(define GLUT_PARTIALLY_RETAINED 2)
(define GLUT_FULLY_COVERED 3)
;; Color index component selection values.
(define GLUT_RED 0)
(define GLUT_GREEN 1)
(define GLUT_BLUE 2)
;; Layers for use.
(define GLUT_NORMAL 0)
(define GLUT_OVERLAY 1)
;; (define-syntax define-function
;; (syntax-rules ()
;; ((_ ret name args)
;; (define name
;; (c-function libGLUT "GLUT library" ret __stdcall name args)))))
(define-syntax define-function
(syntax-rules ()
((_ ret name args)
(define name
(foreign-procedure (symbol->string 'name) args ret)))))
(define-syntax define-function/single-callback
(syntax-rules (callback)
((_ ret name ((callback c-ret c-params)))
(define name
(let ((f (foreign-procedure (symbol->string 'name) (int) ret)))
(lambda (proc)
(let ((code (foreign-callable proc c-params c-ret)))
(lock-object code)
(f (foreign-callable-entry-point code)))))))))
;; void glutInit(int *argcp, char **argv)
;; (define-function void glutInit ([int] [char*]))
;; (define glutInit
;; (if on-windows
;; (lambda (a1 a2)
;; #;(c-argument 'glutInit 1 [int] a1)
;; #;(c-argument 'glutInit 2 [char*] a2)
;; ((c-function libGLUT "GLUT library" void __stdcall __glutInitWithExit ([int] [char*] [c-callback void (int)]))
;; a1 a2 (lambda (n) (exit n))))
;; (c-function libGLUT "GLUT library" void __stdcall glutInit ([int] [char*]))))
;; (define glutInit
;; (foreign-procedure "glutInit" (u8* u8*) void))
;; This version ignores it's arguments.
(define glutInit
(let ((f (foreign-procedure "glutInit" (u8* u8*) void)))
(lambda (a b)
(f (bytevector 0 0 0 0)
(bytevector 0)))))
;; void glutInitDisplayString(const char *string)
(define-function void glutInitDisplayString (string))
;; void glutInitDisplayMode(unsigned int mode)
(define-function void glutInitDisplayMode (int))
;; void glutInitWindowPosition(int x, int y)
(define-function void glutInitWindowPosition (int int))
;; void glutInitWindowSize(int width, int height)
(define-function void glutInitWindowSize (int int))
;; void glutMainLoop(void)
(define-function void glutMainLoop ())
;; int glutCreateWindow(const char *title)
(define-function int glutCreateWindow (string))
;; int glutCreateSubWindow(int win, int x, int y, int width, int height)
(define-function int glutCreateSubWindow (int int int int int))
;; void glutDestroyWindow(int win)
(define-function void glutDestroyWindow (int))
;; void glutPostRedisplay(void)
(define-function void glutPostRedisplay ())
;; void glutPostWindowRedisplay(int win)
(define-function void glutPostWindowRedisplay (int))
;; void glutSwapBuffers(void)
(define-function void glutSwapBuffers ())
;; int glutGetWindow(void)
(define-function int glutGetWindow ())
;; void glutSetWindow(int win)
(define-function void glutSetWindow (int))
;; void glutSetWindowTitle(const char *title)
(define-function void glutSetWindowTitle (string))
;; void glutSetIconTitle(const char *title)
(define-function void glutSetIconTitle (string))
;; void glutPositionWindow(int x, int y)
(define-function void glutPositionWindow (int int))
;; void glutReshapeWindow(int width, int height)
(define-function void glutReshapeWindow (int int))
;; void glutPopWindow(void)
(define-function void glutPopWindow ())
;; void glutPushWindow(void)
(define-function void glutPushWindow ())
;; void glutIconifyWindow(void)
(define-function void glutIconifyWindow ())
;; void glutShowWindow(void)
(define-function void glutShowWindow ())
;; void glutHideWindow(void)
(define-function void glutHideWindow ())
;; void glutFullScreen(void)
(define-function void glutFullScreen ())
;; void glutSetCursor(int cursor)
(define-function void glutSetCursor (int))
;; void glutWarpPointer(int x, int y)
(define-function void glutWarpPointer (int int))
;; void glutEstablishOverlay(void)
(define-function void glutEstablishOverlay ())
;; void glutRemoveOverlay(void)
(define-function void glutRemoveOverlay ())
;; void glutUseLayer(GLenum layer)
(define-function void glutUseLayer (int))
;; void glutPostOverlayRedisplay(void)
(define-function void glutPostOverlayRedisplay ())
;; void glutPostWindowOverlayRedisplay(int win)
(define-function void glutPostWindowOverlayRedisplay (int))
;; void glutShowOverlay(void)
(define-function void glutShowOverlay ())
;; void glutHideOverlay(void)
(define-function void glutHideOverlay ())
;; int glutCreateMenu(void (*)(int))
;; (define-function void glutCreateMenu ([c-callback void (int)]))
(define-function/single-callback void glutCreateMenu ((callback void (int))))
;; void glutDestroyMenu(int menu)
(define-function void glutDestroyMenu (int))
;; int glutGetMenu(void)
(define-function int glutGetMenu ())
;; void glutSetMenu(int menu)
(define-function void glutSetMenu (int))
;; void glutAddMenuEntry(const char *label, int value)
(define-function void glutAddMenuEntry (string int))
;; void glutAddSubMenu(const char *label, int submenu)
(define-function void glutAddSubMenu (string int))
;; void glutChangeToMenuEntry(int item, const char *label, int value)
(define-function void glutChangeToMenuEntry (int string int))
;; void glutChangeToSubMenu(int item, const char *label, int submenu)
(define-function void glutChangeToSubMenu (int string int))
;; void glutRemoveMenuItem(int item)
(define-function void glutRemoveMenuItem (int))
;; void glutAttachMenu(int button)
(define-function void glutAttachMenu (int))
;; void glutDetachMenu(int button)
(define-function void glutDetachMenu (int))
;; void glutDisplayFunc(void (*func)(void))
;; (define-function void glutDisplayFunc ([c-callback void ()]))
(define-function/single-callback void glutDisplayFunc ((callback void ())))
;; void glutReshapeFunc(void (*func)(int width, int height))
;; (define-function void glutReshapeFunc ([c-callback void (int int)]))
(define-function/single-callback void glutReshapeFunc ([callback void (int int)]))
;; void glutKeyboardFunc(void (*func)(unsigned char key, int x, int y))
(define-function/single-callback void glutKeyboardFunc ([callback void (int int int)]))
;; void glutMouseFunc(void (*func)(int button, int state, int x, int y))
(define-function/single-callback void glutMouseFunc ([callback void (int int int int)]))
;; void glutMotionFunc(void (*func)(int x, int y))
(define-function/single-callback void glutMotionFunc ([callback void (int int)]))
;; void glutPassiveMotionFunc(void (*func)(int x, int y))
(define-function/single-callback void glutPassiveMotionFunc ([callback void (int int)]))
;; void glutEntryFunc(void (*func)(int state))
(define-function/single-callback void glutEntryFunc ([callback void (int)]))
;; void glutVisibilityFunc(void (*func)(int state))
(define-function/single-callback void glutVisibilityFunc ([callback void (int)]))
;; void glutIdleFunc(void (*func)(void))
(define-function/single-callback void glutIdleFunc ([callback void ()]))
;; void glutTimerFunc(unsigned int millis, void (*func)(int value), int value)
;; (define-function void glutTimerFunc (int [c-callback void (int)] int))
(define glutTimerFunc
(let ((f (foreign-procedure "glutTimerFunc" (unsigned-int int int) void)))
(lambda (millis proc value)
(let ((code (foreign-callable proc (int) void)))
(lock-object code)
(f millis
(foreign-callable-entry-point code)
value)))))
;; void glutMenuStateFunc(void (*func)(int state))
(define-function/single-callback void glutMenuStateFunc ([callback void (int)]))
;; void glutSpecialFunc(void (*func)(int key, int x, int y))
(define-function/single-callback void glutSpecialFunc ([callback void (int int int)]))
;; void glutSpaceballMotionFunc(void (*func)(int x, int y, int z))
(define-function/single-callback void glutSpaceballMotionFunc ([callback void (int int int)]))
;; void glutSpaceballRotateFunc(void (*func)(int x, int y, int z))
(define-function/single-callback void glutSpaceballRotateFunc ([callback void (int int int)]))
;; void glutSpaceballButtonFunc(void (*func)(int button, int state))
(define-function/single-callback void glutSpaceballButtonFunc ([callback void (int int)]))
;; void glutButtonBoxFunc(void (*func)(int button, int state))
(define-function/single-callback void glutButtonBoxFunc ([callback void (int int)]))
;; void glutDialsFunc(void (*func)(int dial, int value))
(define-function/single-callback void glutDialsFunc ([callback void (int int)]))
;; void glutTabletMotionFunc(void (*func)(int x, int y))
(define-function/single-callback void glutTabletMotionFunc ([callback void (int int)]))
;; void glutTabletButtonFunc(void (*func)(int button, int state, int x, int y))
(define-function/single-callback void glutTabletButtonFunc ([callback void (int int int int)]))
;; void glutMenuStatusFunc(void (*func)(int status, int x, int y))
(define-function/single-callback void glutMenuStatusFunc ([callback void (int int int)]))
;; void glutOverlayDisplayFunc(void (*func)(void))
(define-function/single-callback void glutOverlayDisplayFunc ([callback void ()]))
;; void glutWindowStatusFunc(void (*func)(int state))
(define-function/single-callback void glutWindowStatusFunc ([callback void (int)]))
;; void glutKeyboardUpFunc(void (*func)(unsigned char key, int x, int y))
(define-function/single-callback void glutKeyboardUpFunc ([callback void (int int int)]))
;; void glutSpecialUpFunc(void (*func)(int key, int x, int y))
(define-function/single-callback void glutSpecialUpFunc ([callback void (int int int)]))
;; void glutJoystickFunc(void (*func)(unsigned int buttonMask, int x, int y, int z), int pollInterval)
;; (define-function void glutJoystickFunc ([c-callback void (int int int int)] int))
(define glutJoystickFunc
(let ((f (foreign-procedure "glutJoystickFunc" (int int) void)))
(lambda (proc poll-interval)
(let ((code (foreign-callable proc (unsigned-int int int int) void)))
(lock-object code)
(f (foreign-callable-entry-point code)
poll-interval)))))
;; void glutSetColor(int, GLfloat red, GLfloat green, GLfloat blue)
(define-function void glutSetColor (int float float float))
;; GLfloat glutGetColor(int ndx, int component)
(define-function double glutGetColor (int int))
;; void glutCopyColormap(int win)
(define-function void glutCopyColormap (int))
;; int glutGet(GLenum type)
(define-function int glutGet (int))
;; int glutDeviceGet(GLenum type)
(define-function int glutDeviceGet (int))
;; int glutExtensionSupported(const char *name)
(define-function int glutExtensionSupported (string))
;; int glutGetModifiers(void)
(define-function int glutGetModifiers ())
;; int glutLayerGet(GLenum type)
(define-function int glutLayerGet (int))
;; void * glutGetProcAddress(const char *procName)
(define-function void* glutGetProcAddress (string))
;; void glutBitmapCharacter(void *font, int character)
(define-function void* glutBitmapCharacter (void* int))
;; int glutBitmapWidth(void *font, int character)
(define-function int glutBitmapWidth (void* int))
;; void glutStrokeCharacter(void *font, int character)
(define-function void glutStrokeCharacter (void* int))
;; int glutStrokeWidth(void *font, int character)
(define-function int glutStrokeWidth (void* int))
;; int glutBitmapLength(void *font, const unsigned char *string)
(define-function int glutBitmapLength (void* string))
;; int glutStrokeLength(void *font, const unsigned char *string)
(define-function int glutStrokeLength (void* string))
;; void glutWireSphere(GLdouble radius, GLint slices, GLint stacks)
(define-function int glutWireSphere (double int int))
;; void glutSolidSphere(GLdouble radius, GLint slices, GLint stacks)
(define-function void glutSolidSphere (double int int))
;; void glutWireCone(GLdouble base, GLdouble height, GLint slices, GLint stacks)
(define-function void glutWireCone (double double int int))
;; void glutSolidCone(GLdouble base, GLdouble height, GLint slices, GLint stacks)
(define-function void glutSolidCone (double double int int))
;; void glutWireCube(GLdouble size)
(define-function void glutWireCube (double))
;; void glutSolidCube(GLdouble size)
(define-function void glutSolidCube (double))
;; void glutWireTorus(GLdouble innerRadius, GLdouble outerRadius, GLint sides, GLint rings)
(define-function void glutWireTorus (double double int int))
;; void glutSolidTorus(GLdouble innerRadius, GLdouble outerRadius, GLint sides, GLint rings)
(define-function void glutSolidTorus (double double int int))
;; void glutWireDodecahedron(void)
(define-function void glutWireDodecahedron ())
;; void glutSolidDodecahedron(void)
(define-function void glutSolidDodecahedron ())
;; void glutWireTeapot(GLdouble size)
(define-function void glutWireTeapot (double))
;; void glutSolidTeapot(GLdouble size)
(define-function void glutSolidTeapot (double))
;; void glutWireOctahedron(void)
(define-function void glutWireOctahedron ())
;; void glutSolidOctahedron(void)
(define-function void glutSolidOctahedron ())
;; void glutWireTetrahedron(void)
(define-function void glutWireTetrahedron ())
;; void glutSolidTetrahedron(void)
(define-function void glutSolidTetrahedron ())
;; void glutWireIcosahedron(void)
(define-function void glutWireIcosahedron ())
;; void glutSolidIcosahedron(void)
(define-function void glutSolidIcosahedron ())
;; int glutVideoResizeGet(GLenum param)
(define-function int glutVideoResizeGet ())
;; void glutSetupVideoResizing(void)
(define-function int glutSetupVideoResizing ())
;; void glutStopVideoResizing(void)
(define-function void glutStopVideoResizing ())
;; void glutVideoResize(int x, int y, int width, int height)
(define-function void glutVideoResize (int int int int))
;; void glutVideoPan(int x, int y, int width, int height)
(define-function void glutVideoPan (int int int int))
;; void glutReportErrors(void)
(define-function void glutReportErrors ())
;; void glutIgnoreKeyRepeat(int ignore)
(define-function void glutIgnoreKeyRepeat (int))
;; void glutSetKeyRepeat(int repeatMode)
(define-function void glutSetKeyRepeat (int))
;; void glutForceJoystickFunc(void)
(define-function void glutForceJoystickFunc ())
;; void glutGameModeString(const char *string)
(define-function void glutGameModeString (string))
;; int glutEnterGameMode(void)
(define-function int glutEnterGameMode ())
;; void glutLeaveGameMode(void)
(define-function void glutLeaveGameMode ())
;; int glutGameModeGet(GLenum mode)
(define-function int glutGameModeGet (int))
)