Sophie

Sophie

distrib > Fedora > 13 > i386 > media > os > by-pkgid > fb4fdf9f3ff51801a8baad42b1da0d6a > files > 37

gauche-gl-0.4.4-6.fc12.i686.rpm

;; Example 3-7  Robot Arm

(use gl)
(use gl.glut)

(define *shoulder* 0)
(define *elbow* 0)

(define (init)
  (gl-clear-color 0.0 0.0 0.0 0.0)
  (gl-shade-model GL_FLAT)
  )

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-push-matrix)
  (gl-translate -1.0 0.0 0.0)
  (gl-rotate *shoulder* 0.0 0.0 1.0)
  (gl-translate 1.0 0.0 0.0)
  (gl-push-matrix)
  (gl-scale 2.0 0.4 1.0)
  (glut-wire-cube 1.0)
  (gl-pop-matrix)

  (gl-translate 1.0 0.0 0.0)
  (gl-rotate *elbow* 0.0 0.0 1.0)
  (gl-translate 1.0 0.0 0.0)
  (gl-push-matrix)
  (gl-scale 2.0 0.4 1.0)
  (glut-wire-cube 1.0)
  (gl-pop-matrix)

  (gl-pop-matrix)
  (glut-swap-buffers)
  )

(define (reshape w h)
  (gl-viewport 0 0 w h)
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 60.0 (/ w h) 1.0 20.0)
  (gl-matrix-mode GL_MODELVIEW)
  (gl-load-identity)
  (gl-translate 0 0 -5.0)
  )

(define (keyboard key x y)
  (cond ((= key (char->integer #\s))
         (set! *shoulder* (modulo (+ *shoulder* 5) 360))
         (glut-post-redisplay))
        ((= key (char->integer #\S))
         (set! *shoulder* (modulo (- *shoulder* 5) 360))
         (glut-post-redisplay))
        ((= key (char->integer #\e))
         (set! *elbow* (modulo (+ *elbow* 5) 360))
         (glut-post-redisplay))
        ((= key (char->integer #\E))
         (set! *elbow* (modulo (- *elbow* 5) 360))
         (glut-post-redisplay))
        ((= key 27) (exit 0))
        ))

(define (main args)
  (glut-init args)
  (glut-init-display-mode (logior GLUT_DOUBLE GLUT_RGB))
  (glut-init-window-size 500 500)
  (glut-init-window-position 100 100)
  (glut-create-window *program-name*)
  (init)
  (glut-display-func disp)
  (glut-reshape-func reshape)
  (glut-keyboard-func keyboard)
  (glut-main-loop)
  0)