the opengl demos now work unmodified under both ikarus and ypsilon.

lab/ypsilon-ffi/glut-demo.scm

@@ -9,20 +9,20 @@
 ;;   Linux:   libGL.so.1 libglut.so.3    
 
 
-(import (gl) (glut) 
+(import 
+  (gl) (glut) 
   (ypsilon-compat)
-        (rename (except (rnrs) angle display) 
-                (reverse rnrs:reverse))
+  (rename (except (rnrs) angle display) (reverse rnrs:reverse))
   (rnrs programs))
-(begin
 
 
-  (define object glutSolidIcosahedron)
-  (define reverse #t)
-  (define angle 0.0)
-  (define last-update 0)
 
-  (define display
+(define object glutSolidIcosahedron)
+(define reverse #t)
+(define angle 0.0)
+(define last-update 0)
+
+(define display
   (lambda ()
     (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
     (do ((y 2.0 (+ y 3.0)))
@@ -42,7 +42,7 @@
                         (/ (+ x y) 20.0 100.0)))))
     (glutSwapBuffers)))
 
-  (define rotate
+(define rotate
   (lambda ()
     (cond ((< (+ last-update 16000) (microsecond))
            (if (= (glutGetWindow) 0) (exit 0))
@@ -58,18 +58,18 @@
            (set! last-update (microsecond))
            (glutPostRedisplay)))))
 
-  (define mouse
+(define mouse
   (lambda (button state x y)
     (and (= state 0) (set! reverse (not reverse)))
     (format #t "mouse callback ~s ~s ~s ~s ~%" button state x y)))
 
-  (define show-dodecahedron (lambda () (glScalef 0.6 0.6 0.6) (glutSolidDodecahedron)))
-  (define show-sphere       (lambda () (glutSolidSphere 1.0 32 16)))
-  (define show-cone         (lambda () (glutSolidCone 1.0 2.0 32 1)))
-  (define show-cube         (lambda () (glutSolidCube 1.5)))
-  (define show-torus        (lambda () (glutSolidTorus 0.5 1.0 16 32)))
+(define show-dodecahedron (lambda () (glScalef 0.6 0.6 0.6) (glutSolidDodecahedron)))
+(define show-sphere       (lambda () (glutSolidSphere 1.0 32 16)))
+(define show-cone         (lambda () (glutSolidCone 1.0 2.0 32 1)))
+(define show-cube         (lambda () (glutSolidCube 1.5)))
+(define show-torus        (lambda () (glutSolidTorus 0.5 1.0 16 32)))
 
-  (define menu
+(define menu
   (lambda (m)
     (format #t "menu callback ~s ~%" m)
     (case m
@@ -85,7 +85,7 @@
       ((10) (glShadeModel GL_FLAT))
       ((11) (exit)))))
 
-  (define reshape
+(define reshape
   (lambda (w h)
     (format #t "reshape callback ~s ~s ~%" w h)
     (and (> w 0)
@@ -99,11 +99,11 @@
                (glOrtho 0.0 (/ (* 16.0 w) h) 0.0 16.0 -10.0 10.0))
            (glMatrixMode GL_MODELVIEW)))))
 
-  (define visibility
+(define visibility
   (lambda (state)
     (format #t "visibility callback ~s ~%" state)))
 
-  (define f32vector
+(define f32vector
   (lambda lst
     (define-syntax f32set!
       (syntax-rules ()
@@ -116,7 +116,7 @@
                (f32set! bv i (car lst))
                (loop (+ i 1) (cdr lst))))))))
 
-  (define render-one
+(define render-one
   (lambda (x y ambr ambg ambb difr difg difb specr specg specb shine)
     (glPushMatrix)
     (glTranslatef x y 0.0)
@@ -136,7 +136,7 @@
 #;(trace render-one)
 #;(collect-notify #t)
 
-  (define run
+(define run
   (lambda ()
     (glutInitDisplayMode (+ GLUT_DOUBLE GLUT_RGBA GLUT_DEPTH))
     (glutInitWindowPosition 100 100)
@@ -176,4 +176,4 @@
     (glutAttachMenu GLUT_RIGHT_BUTTON)
     (glutMainLoop)))
 
-  (run))
+(run)

lab/ypsilon-ffi/ypsilon-compat.ypsilon.ss

@@ -0,0 +1,6 @@
+
+(library (ypsilon-compat)
+  (export on-windows on-darwin on-linux on-freebsd on-posix
+          load-shared-object c-argument c-function 
+          microsecond usleep format)
+  (import (core) (ffi)))