Sophie

Sophie

distrib > Fedora > 15 > i386 > by-pkgid > 732693838133900f9b7cdf5a0a2e5f55 > files > 52

gauche-gl-0.5-1.fc15.i686.rpm

;; Example 6-7  Polygon Offset to Eliminate Visual Artifacts

(use gl)
(use gl.glut)

(define *list* 0)
(define *spinx* 0)
(define *spiny* 0)
(define *tdist* 0.0)
(define *polyfactor* 1.0)
(define *polyunits* 1.0)

(define (disp)
  (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
  (gl-push-matrix)
  (gl-translate 0.0 0.0 *tdist*)
  (gl-rotate *spinx* 1.0 0.0 0.0)
  (gl-rotate *spiny* 0.0 1.0 0.0)

  (gl-material GL_FRONT GL_AMBIENT_AND_DIFFUSE '#f32(0.8 0.8 0.8 1.0))
  (gl-material GL_FRONT GL_SPECULAR '#f32(0.0 0.0 0.0 1.0))
  (gl-material GL_FRONT GL_SHININESS 0.0)
  (gl-enable GL_LIGHTING)
  (gl-enable GL_LIGHT0)
  (gl-enable GL_POLYGON_OFFSET_FILL)
  (gl-polygon-offset *polyfactor* *polyunits*)
  (gl-call-list *list*)
  (gl-disable GL_POLYGON_OFFSET_FILL)

  (gl-disable GL_LIGHTING)
  (gl-disable GL_LIGHT0)
  (gl-color 1.0 1.0 1.0)
  (gl-polygon-mode GL_FRONT_AND_BACK GL_LINE)
  (gl-call-list *list*)
  (gl-polygon-mode GL_FRONT_AND_BACK GL_FILL)
  
  (gl-pop-matrix)
  (gl-flush)
  )

(define (init)
  (gl-clear-color 0.0 0.0 0.0 1.0)
  (set! *list* (gl-gen-lists 1))
  (gl-new-list *list* GL_COMPILE)
  (glut-solid-sphere 1.0 20 12)
  (gl-end-list)

  (gl-enable GL_DEPTH_TEST)

  (gl-light GL_LIGHT0 GL_AMBIENT '#f32(0.0 0.0 0.0 1.0))
  (gl-light GL_LIGHT0 GL_DIFFUSE '#f32(1.0 1.0 1.0 1.0))
  (gl-light GL_LIGHT0 GL_SPECULAR '#f32(1.0 1.0 1.0 1.0))
  (gl-light GL_LIGHT0 GL_POSITION '#f32(1.0 1.0 1.0 0.0))
  (gl-light-model GL_LIGHT_MODEL_AMBIENT '#f32(0.2 0.2 0.2 1.0))
  )

(define (reshape w h)
  (gl-viewport 0 0 w h)
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 45.0 (/ w h) 1.0 10.0)
  (gl-matrix-mode GL_MODELVIEW)
  (gl-load-identity)
  (glu-look-at 0.0 0.0 5.0 0.0 0.0 0.0 0.0 1.0 0.0)
  )

(define (mouse button state x y)
  (cond
   ((= button GLUT_LEFT_BUTTON)
    (when (= state GLUT_DOWN)
      (set! *spinx* (modulo (+ *spinx* 5) 360))
      (glut-post-redisplay)))
   ((= button GLUT_MIDDLE_BUTTON)
    (when (= state GLUT_DOWN)
      (set! *spiny* (modulo (+ *spiny* 5) 360))
      (glut-post-redisplay)))
   ((= button GLUT_RIGHT_BUTTON)
    (when (= state GLUT_UP)
      (exit 0)))
   ))

(define (keyboard key x y)
  (cond
   ((= key (char->integer #\t))
    (when (< *tdist* 4.0)
      (inc! *tdist* 0.5)
      (glut-post-redisplay)))
   ((= key (char->integer #\T))
    (when (> *tdist* -5.0)
      (dec! *tdist* 0.5)
      (glut-post-redisplay)))
   ((= key (char->integer #\F))
    (inc! *polyfactor* 0.1)
    (print #`"polyfactor is ,|*polyfactor*|")
    (glut-post-redisplay))
   ((= key (char->integer #\f))
    (dec! *polyfactor* 0.1)
    (print #`"polyfactor is ,|*polyfactor*|")
    (glut-post-redisplay))
   ((= key (char->integer #\U))
    (inc! *polyunits* 1.0)
    (print #`"polyunits is ,|*polyunits*|")
    (glut-post-redisplay))
   ((= key (char->integer #\u))
    (dec! *polyunits* 1.0)
    (print #`"polyunits is ,|*polyunits*|")
    (glut-post-redisplay))
   ((= key 27)                          ;ESC
    (exit 0)))
  )

(define (main args)
  (glut-init args)
  (glut-init-display-mode (logior GLUT_SINGLE GLUT_RGB GLUT_DEPTH))
  (glut-init-window-size 500 500)
  (glut-create-window (car args))
  (glut-reshape-func reshape)
  (glut-display-func disp)
  (glut-mouse-func mouse)
  (glut-keyboard-func keyboard)
  (init)
  (glut-main-loop)
  0)