Sophie

Sophie

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

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

;; Example 13-6  Picking with Depth Values

(use gl)
(use gl.glut)
(use gauche.uvector)
(use gauche.array)

(define (init)
  (gl-clear-color 0.0 0.0 0.0 0.0)
  (gl-enable GL_DEPTH_TEST)
  (gl-shade-model GL_FLAT)
  (gl-depth-range 0.0 1.0))

(define (draw-rects mode)
  (when (= mode GL_SELECT) (gl-load-name 1))
  (gl-begin* GL_QUADS
    (gl-color 1.0 1.0 0.0)
    (gl-vertex 2 0 0) (gl-vertex 2 6 0) (gl-vertex 6 6 0) (gl-vertex 6 0 0)
    )
  (when (= mode GL_SELECT) (gl-load-name 2))
  (gl-begin* GL_QUADS
    (gl-color 0.0 1.0 1.0)
    (gl-vertex 3 2 -1) (gl-vertex 3 8 -1) (gl-vertex 8 8 -1) (gl-vertex 8 2 -1)
    )
  (when (= mode GL_SELECT) (gl-load-name 3))
  (gl-begin* GL_QUADS
    (gl-color 1.0 0.0 1.0)
    (gl-vertex 0 2 -2) (gl-vertex 0 7 -2) (gl-vertex 5 7 -2) (gl-vertex 5 2 -2)
    )
  (gl-flush)
  )

(define (process-hits hits vec)
  (print #`"hits = ,hits")
  (let ((ptr 0)
        (ii 0)
        (jj 0))
    (dotimes (i hits)
      (let1 names (ref vec ptr)
        (print #`" number of names for hit = ,names")
        (inc! ptr)
        (print #`"  z1 is ,(/ (ref vec ptr) #x7fffffff);"
               #`" z2 is ,(/ (ref vec (+ ptr 1)) #x7fffffff)")
        (inc! ptr 2)
        (display "   the name is ")
        (dotimes (j names)
          (display #`",(ref vec ptr) ")
          (inc! ptr))
        (print)
        ))))

(define-constant BUFSIZE 512)

(define (pick-rects button state x y)
  (let1 select-buf (make-u32vector BUFSIZE 0)
    (when (and (= button GLUT_LEFT_BUTTON) (= state GLUT_DOWN))
      (let1 viewport (gl-get-integer GL_VIEWPORT)
        (gl-select-buffer select-buf)
        (gl-render-mode GL_SELECT)
        (gl-init-names)
        (gl-push-name 0)

        (gl-matrix-mode GL_PROJECTION)
        (gl-push-matrix)
        (gl-load-identity)
        (glu-pick-matrix x (- (ref viewport 3) y) 5.0 5.0 viewport)
        (gl-ortho 0.0 8.0 0.0 8.0 -0.5 2.5)
        (draw-rects GL_SELECT)
        (gl-pop-matrix)
        (gl-flush)

        (process-hits (gl-render-mode GL_RENDER) select-buf)
        ))))

(define (disp)
  (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
  (draw-rects GL_RENDER)
  (gl-flush))

(define (reshape w h)
  (gl-viewport 0 0 w h)
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (gl-ortho 0.0 8.0 0.0 8.0 -0.5 2.5)
  (gl-matrix-mode GL_MODELVIEW)
  (gl-load-identity))

(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 200 200)
  (glut-init-window-position 100 100)
  (glut-create-window (car args))
  (init)
  (glut-reshape-func reshape)
  (glut-display-func disp)
  (glut-mouse-func pick-rects)
  (glut-keyboard-func keyboard)
  (glut-main-loop)
  0)