;; 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) ) ) (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)