Sophie

Sophie

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

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

;; Example 2-9  Enabling and Loading Vertex Arrays

(use gl)
(use gl.glut)

(define *setup-method* 'pointer)
(define *deref-method* 'drawarray)

(define (setup-pointers)
  (gl-enable-client-state GL_VERTEX_ARRAY)
  (gl-enable-client-state GL_COLOR_ARRAY)
  (gl-vertex-pointer 2 '#s32(25 25
                             100 325
                             175 25
                             175 325
                             250 25
                             325 325))
  (gl-color-pointer 3 '#f32(1.0 0.2 0.2
                            0.2 0.2 1.0
                            0.8 1.0 0.2
                            0.75 0.75 0.75
                            0.35 0.35 0.35
                            0.5 0.5 0.5))
  )

(define (setup-interleave)
  (gl-interleaved-arrays GL_C3F_V3F
                         '#f32(1.0 0.2 1.0 100.0 100.0 0.0
                               1.0 0.2 0.2 0.0 200.0 0.0
                               1.0 1.0 0.2 100.0 300.0 0.0
                               0.2 1.0 0.2 200.0 300.0 0.0
                               0.2 1.0 1.0 300.0 200.0 0.0
                               0.2 0.2 1.0 200.0 100.0 0.0))
  )

(define (init)
  (gl-clear-color 0.0 0.0 0.0 0.0)
  (gl-shade-model GL_SMOOTH)
  (setup-pointers))

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (case *deref-method*
    ((drawarray)
     (gl-draw-arrays GL_TRIANGLES 0 6))
    ((arrayelement)
     (gl-begin* GL_TRIANGLES
       (gl-array-element 2)
       (gl-array-element 3)
       (gl-array-element 5)
       ))
    ((drawelements)
     (gl-draw-elements GL_POLYGON '#u32(0 1 3 4)))
    )
  (gl-flush))

(define (reshape w h)
  (gl-viewport 0 0 w h)
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-ortho-2d 0.0 w 0.0 h))

(define (mouse button state x y)
  (cond
   ((= button GLUT_LEFT_BUTTON)
    (when (= state GLUT_DOWN)
      (case *setup-method*
        ((pointer) (set! *setup-method* 'interleaved)
                   (setup-interleave))
        ((interleaved) (set! *setup-method* 'pointer)
                       (setup-pointers)))
      (glut-post-redisplay)))
   ((or (= button GLUT_MIDDLE_BUTTON)
        (= button GLUT_RIGHT_BUTTON))
    (when (= state GLUT_DOWN)
      (case *deref-method*
        ((drawarray) (set! *deref-method* 'arrayelement))
        ((arrayelement) (set! *deref-method* 'drawelements))
        ((drawelements) (set! *deref-method* 'drawarray)))
      (glut-post-redisplay)))
   ))

(define (keyboard key x y)
  (when (= key 27) (exit 0)))

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