figl/glut/low-level.scm

   1 ;;; fgil
   2 ;;; Copyright (C) 2013 Daniel Hartwig <mandyke@gmail.com>
   3 ;;;
   4 ;;; Figl is free software: you can redistribute it and/or modify it
   5 ;;; under the terms of the GNU Lesser General Public License as
   6 ;;; published by the Free Software Foundation, either version 3 of the
   7 ;;; License, or (at your option) any later version.
   8 ;;;
   9 ;;; Figl is distributed in the hope that it will be useful, but WITHOUT
  10 ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  11 ;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
  12 ;;; Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU Lesser General Public
  15 ;;; License along with this program.  If not, see
  16 ;;; <http://www.gnu.org/licenses/>.
  17
  18 ;;; Commentary:
  19 ;;
  20 ;; These bindings are direct mappings to the OpenGL Utility Library
  21 ;; (GLUT) Programming Interface, API Version 3.
  22 ;;
  23 ;; Care should be taken to avoid errors as GLUT implementations may
  24 ;; exit() on error condition.  See section 14.3 of the specification.
  25 ;;
  26 ;;; Code:
  27
  28 (define-module (figl glut low-level)
  29   #:use-module (figl glut runtime)
  30   #:use-module (figl glut types)
  31   #:use-module (figl gl types)
  32   #:use-module ((system foreign) #:renamer (symbol-prefix-proc 'ffi:))
  33   #:use-module (srfi srfi-26) ; cut
  34   #:export (;; 2 Initialization
  35             glutInit
  36             glutInitWindowPosition
  37             glutInitWindowSize
  38             glutInitDisplayMode
  39
  40             ;; 3 Begin Event Processing
  41             glutMainLoop
  42
  43             ;; 4 Window Management
  44             glutCreateWindow
  45             glutCreateSubWindow
  46             glutSetWindow
  47             glutGetWindow
  48             glutDestroyWindow
  49             glutPostRedisplay
  50             glutSwapBuffers
  51             glutPositionWindow
  52             glutReshapeWindow
  53             glutFullScreen
  54             glutPopWindow
  55             glutPushWindow
  56             glutShowWindow
  57             glutHideWindow
  58             glutIconifyWindow
  59             glutSetWindowTitle
  60             glutSetIconTitle
  61             glutSetCursor
  62
  63             ;; 5 Overlay Management
  64             glutEstablishOverlay
  65             glutUseLayer
  66             glutRemoveOverlay
  67             glutPostOverlayRedisplay
  68             glutShowOverlay
  69             glutHideOverlay
  70
  71             ;; 6 Menu Management
  72             glutCreateMenu
  73             glutSetMenu
  74             glutGetMenu
  75             glutDestroyMenu
  76             glutAddMenuEntry
  77             glutAddSubMenu
  78             glutChangeToMenuEntry
  79             glutChangeToSubMenu
  80             glutRemoveMenuItem
  81             glutAttachMenu
  82             glutDetachMenu
  83
  84             ;; 7 Callback Registration
  85             glutDisplayFunc
  86             glutOverlayDisplayFunc
  87             glutReshapeFunc
  88             glutKeyboardFunc
  89             glutMouseFunc
  90             glutMotionFunc
  91             glutPassiveMotionFunc
  92             glutVisibilityFunc
  93             glutEntryFunc
  94             glutSpecialFunc
  95             glutSpaceballMotionFunc
  96             glutSpaceballRotateFunc
  97             glutSpaceballButtonFunc
  98             glutButtonBoxFunc
  99             glutDialsFunc
 100             glutTabletMotionFunc
 101             glutTabletButtonFunc
 102             glutMenuStatusFunc
 103             glutMenuStateFunc
 104             glutIdleFunc
 105             glutTimerFunc
 106
 107             ;; 8 Color Index Colormap Management
 108             glutSetColor
 109             glutGetColor
 110             glutCopyColormap
 111
 112             ;; 9 State Retrieval
 113             glutGet
 114             glutLayerGet
 115             glutDeviceGet
 116             glutGetModifiers
 117             glutExtensionSupported
 118
 119             ;; 10 Font Rendering
 120             glutBitmapCharacter
 121             glutBitmapWidth
 122             glutStrokeCharacter
 123             glutStrokeWidth
 124
 125             ;; 11 Geometric Object Rendering
 126             glutSolidSphere
 127             glutWireSphere
 128             glutSolidCube
 129             glutWireCube
 130             glutSolidCone
 131             glutWireCone
 132             glutSolidTorus
 133             glutWireTorus
 134             glutSolidDodecahedron
 135             glutWireDodecahedron
 136             glutSolidOctahedron
 137             glutWireOctahedron
 138             glutSolidTetrahedron
 139             glutWireTetrahedron
 140             glutSolidIcosahedron
 141             glutWireIcosahedron
 142             glutSolidTeapot
 143             glutWireTeapot
 144             ))
 145
 146 ;;;
 147 ;;; 2 Initialization
 148 ;;;
 149
 150 (define-glut-procedure
 151   (glutInit (argcp int-*) (argv char-**) -> void)
 152   #f)
 153
 154 (define-glut-procedure
 155   (glutInitWindowPosition (x int) (y int) -> void)
 156   #f)
 157
 158 (define-glut-procedure
 159   (glutInitWindowSize (width int) (height int) -> void)
 160   #f)
 161
 162 (define-glut-procedure
 163   (glutInitDisplayMode (mode unsigned-int) -> void)
 164   #f)
 165
 166 ;;;
 167 ;;; 3 Begin Event Processing
 168 ;;;
 169
 170 (define-glut-procedure
 171   (glutMainLoop -> void)
 172   #f)
 173
 174 ;;;
 175 ;;; 4 Window Management
 176 ;;;
 177
 178 (define-glut-procedure
 179   (glutCreateWindow (name char-*) -> int)
 180   #f)
 181
 182 (define-glut-procedure
 183   (glutCreateSubWindow (win int)
 184                        (x int)
 185                        (y int)
 186                        (width int)
 187                        (height int)
 188                        ->
 189                        int)
 190   #f)
 191
 192 (define-glut-procedure
 193   (glutSetWindow (win int) -> void)
 194   #f)
 195
 196 (define-glut-procedure
 197   (glutGetWindow -> int)
 198   #f)
 199
 200 (define-glut-procedure
 201   (glutDestroyWindow (win int) -> void)
 202   #f)
 203
 204 (define-glut-procedure
 205   (glutPostRedisplay -> void)
 206   #f)
 207
 208 (define-glut-procedure
 209   (glutSwapBuffers -> void)
 210   #f)
 211
 212 (define-glut-procedure
 213   (glutPositionWindow (x int) (y int) -> void)
 214   #f)
 215
 216 (define-glut-procedure
 217   (glutReshapeWindow (width int) (height int) -> void)
 218   #f)
 219
 220 (define-glut-procedure
 221   (glutFullScreen -> void)
 222   #f)
 223
 224 (define-glut-procedure
 225   (glutPopWindow -> void)
 226   #f)
 227
 228 (define-glut-procedure
 229   (glutPushWindow -> void)
 230   #f)
 231
 232 (define-glut-procedure
 233   (glutShowWindow -> void)
 234   #f)
 235
 236 (define-glut-procedure
 237   (glutHideWindow -> void)
 238   #f)
 239
 240 (define-glut-procedure
 241   (glutIconifyWindow -> void)
 242   #f)
 243
 244 (define-glut-procedure
 245   (glutSetWindowTitle (name char-*) -> void)
 246   #f)
 247
 248 (define-glut-procedure
 249   (glutSetIconTitle (name char-*) -> void)
 250   #f)
 251
 252 (define-glut-procedure
 253   (glutSetCursor (cursor int) -> void)
 254   #f)
 255
 256 \f
 257 ;;;
 258 ;;; 5 Overlay Management
 259 ;;;
 260
 261 (define-glut-procedure
 262   (glutEstablishOverlay -> void)
 263   #f)
 264
 265 (define-glut-procedure
 266   (glutUseLayer (layer GLenum) -> void)
 267   #f)
 268
 269 (define-glut-procedure
 270   (glutRemoveOverlay -> void)
 271   #f)
 272
 273 (define-glut-procedure
 274   (glutPostOverlayRedisplay -> void)
 275   #f)
 276
 277 (define-glut-procedure
 278   (glutShowOverlay -> void)
 279   #f)
 280
 281 (define-glut-procedure
 282   (glutHideOverlay -> void)
 283   #f)
 284
 285 \f
 286 ;;;
 287 ;;; 6 Menu Management
 288 ;;;
 289
 290 (define-glut-procedure
 291   (glutCreateMenu (func void-*) -> int)
 292   #f)
 293
 294 (define-glut-procedure
 295   (glutSetMenu (menu int) -> void)
 296   #f)
 297
 298 (define-glut-procedure
 299   (glutGetMenu -> int)
 300   #f)
 301
 302 (define-glut-procedure
 303   (glutDestroyMenu (menu int) -> void)
 304   #f)
 305
 306 (define-glut-procedure
 307   (glutAddMenuEntry (name char-*) (value int) -> void)
 308   #f)
 309
 310 (define-glut-procedure
 311   (glutAddSubMenu (name char-*) (menu int) -> void)
 312   #f)
 313
 314 (define-glut-procedure
 315   (glutChangeToMenuEntry (entry int)
 316                          (name char-*)
 317                          (value int)
 318                          ->
 319                          void)
 320   #f)
 321
 322 (define-glut-procedure
 323   (glutChangeToSubMenu (entry int)
 324                        (name char-*)
 325                        (menu int)
 326                        ->
 327                        void)
 328   #f)
 329
 330 (define-glut-procedure
 331   (glutRemoveMenuItem (entry int) -> void)
 332   #f)
 333
 334 (define-glut-procedure
 335   (glutAttachMenu (button int) -> void)
 336   #f)
 337
 338 (define-glut-procedure
 339   (glutDetachMenu (button int) -> void)
 340   #f)
 341
 342 \f
 343 ;;;
 344 ;;; 7 Callback Registration
 345 ;;;
 346
 347 (define-glut-procedure
 348   (glutDisplayFunc (func void-*) -> void)
 349   #f)
 350
 351 (define-glut-procedure
 352   (glutOverlayDisplayFunc (func void-*) -> void)
 353   #f)
 354
 355 (define-glut-procedure
 356   (glutReshapeFunc (func void-*) -> void)
 357   #f)
 358
 359 (define-glut-procedure
 360   (glutKeyboardFunc (func void-*) -> void)
 361   #f)
 362
 363 (define-glut-procedure
 364   (glutMouseFunc (func void-*) -> void)
 365   #f)
 366
 367 (define-glut-procedure
 368   (glutMotionFunc (func void-*) -> void)
 369   #f)
 370
 371 (define-glut-procedure
 372   (glutPassiveMotionFunc (func void-*) -> void)
 373   #f)
 374
 375 (define-glut-procedure
 376   (glutVisibilityFunc (func void-*) -> void)
 377   #f)
 378
 379 (define-glut-procedure
 380   (glutEntryFunc (func void-*) -> void)
 381   #f)
 382
 383 (define-glut-procedure
 384   (glutSpecialFunc (func void-*) -> void)
 385   #f)
 386
 387 (define-glut-procedure
 388   (glutSpaceballMotionFunc (func void-*) -> void)
 389   #f)
 390
 391 (define-glut-procedure
 392   (glutSpaceballRotateFunc (func void-*) -> void)
 393   #f)
 394
 395 (define-glut-procedure
 396   (glutSpaceballButtonFunc (func void-*) -> void)
 397   #f)
 398
 399 (define-glut-procedure
 400   (glutButtonBoxFunc (func void-*) -> void)
 401   #f)
 402
 403 (define-glut-procedure
 404   (glutDialsFunc (func void-*) -> void)
 405   #f)
 406
 407 (define-glut-procedure
 408   (glutTabletMotionFunc (func void-*) -> void)
 409   #f)
 410
 411 (define-glut-procedure
 412   (glutTabletButtonFunc (func void-*) -> void)
 413   #f)
 414
 415 (define-glut-procedure
 416   (glutMenuStatusFunc (func void-*) -> void)
 417   #f)
 418
 419 (define-glut-procedure
 420   (glutIdleFunc (func void-*) -> void)
 421   #f)
 422
 423 (define-glut-procedure
 424   (glutTimerFunc (msecs unsigned-int)
 425                  (func void-*)
 426                  (value int)
 427                  ->
 428                  void)
 429   #f)
 430
 431 \f
 432 ;;;
 433 ;;; 8 Color Index Colormap Management
 434 ;;;
 435
 436 (define-glut-procedure
 437   (glutSetColor (cell int)
 438                 (red GLfloat)
 439                 (green GLfloat)
 440                 (blue GLfloat)
 441                 ->
 442                 void)
 443   #f)
 444
 445 (define-glut-procedure
 446   (glutGetColor (cell int) (component int) -> GLfloat)
 447   #f)
 448
 449 (define-glut-procedure
 450   (glutCopyColormap (win int) -> void)
 451   #f)
 452
 453 ;;;
 454 ;;; 9 State Retrieval
 455 ;;;
 456
 457 (define-glut-procedure
 458   (glutGet (state GLenum) -> int)
 459   #f)
 460
 461 (define-glut-procedure
 462   (glutLayerGet (info GLenum) -> int)
 463   #f)
 464
 465 (define-glut-procedure
 466   (glutDeviceGet (info GLenum) -> int)
 467   #f)
 468
 469 (define-glut-procedure
 470   (glutGetModifiers -> int)
 471   #f)
 472
 473 (define-glut-procedure
 474   (glutExtensionSupported (extension char-*) -> int)
 475   #f)
 476
 477 ;;;
 478 ;;; 10 Font Rendering
 479 ;;;
 480
 481 (define-glut-procedure
 482   (glutBitmapCharacter (font void-*) (character int) -> void)
 483   #f)
 484
 485 (define-glut-procedure
 486   (glutBitmapWidth (font void-*) (character int) -> int)
 487   #f)
 488
 489 (define-glut-procedure
 490   (glutStrokeCharacter (font void-*) (character int) -> void)
 491   #f)
 492
 493 (define-glut-procedure
 494   (glutStrokeWidth (font void-*) (character int) -> void)
 495   #f)
 496
 497 \f
 498 ;;;
 499 ;;; 11 Geometric Object Rendering
 500 ;;;
 501
 502 (define-glut-procedure
 503   (glutSolidSphere (radius GLdouble)
 504                    (slices GLint)
 505                    (stacks GLint)
 506                    ->
 507                    void)
 508   #f)
 509
 510 (define-glut-procedure
 511   (glutWireSphere (radius GLdouble)
 512                   (slices GLint)
 513                   (stacks GLint)
 514                   ->
 515                   void)
 516   #f)
 517
 518 (define-glut-procedure
 519   (glutSolidCube (size GLdouble) -> void)
 520   #f)
 521
 522 (define-glut-procedure
 523   (glutWireCube (size GLdouble) -> void)
 524   #f)
 525
 526 (define-glut-procedure
 527   (glutSolidCone (base GLdouble)
 528                  (height GLdouble)
 529                  (slices GLint)
 530                  (stacks GLint)
 531                  ->
 532                  void)
 533   #f)
 534
 535 (define-glut-procedure
 536   (glutWireCone (base GLdouble)
 537                 (height GLdouble)
 538                 (slices GLint)
 539                 (stacks GLint)
 540                 ->
 541                 void)
 542   #f)
 543
 544 (define-glut-procedure
 545   (glutSolidTorus (inner-radius GLdouble)
 546                   (outer-radius GLdouble)
 547                   (sides GLint)
 548                   (rings GLint)
 549                   ->
 550                   void)
 551   #f)
 552
 553 (define-glut-procedure
 554   (glutWireTorus (inner-radius GLdouble)
 555                  (outer-radius GLdouble)
 556                  (sides GLint)
 557                  (rings GLint)
 558                  ->
 559                  void)
 560   #f)
 561
 562 (define-glut-procedure
 563   (glutSolidDodecahedron -> void)
 564   #f)
 565
 566 (define-glut-procedure
 567   (glutWireDodecahedron -> void)
 568   #f)
 569
 570 (define-glut-procedure
 571   (glutSolidOctahedron -> void)
 572   #f)
 573
 574 (define-glut-procedure
 575   (glutWireOctahedron -> void)
 576   #f)
 577
 578 (define-glut-procedure
 579   (glutSolidTetrahedron -> void)
 580   #f)
 581
 582 (define-glut-procedure
 583   (glutWireTetrahedron -> void)
 584   #f)
 585
 586 (define-glut-procedure
 587   (glutSolidIcosahedron -> void)
 588   #f)
 589
 590 (define-glut-procedure
 591   (glutWireIcosahedron -> void)
 592   #f)
 593
 594 (define-glut-procedure
 595   (glutSolidTeapot (size GLdouble) -> void)
 596   #f)
 597
 598 (define-glut-procedure
 599   (glutWireTeapot (size GLdouble) -> void)
 600   #f)