;; Example 9-8 Automatic Texture-Coordinate Generation (use gl) (use gl.glut) (use gauche.uvector) ;; Create checkerboard image (define-constant *stripe-image-width* 32) (define *stripe-image* (make-u8vector (* *stripe-image-width* 4))) (define *texname* #f) (define (make-stripe-image) (dotimes (j *stripe-image-width*) (set! (ref *stripe-image* (* 4 j)) (if (<= j 4) 255 0)) (set! (ref *stripe-image* (+ (* 4 j) 1)) (if (> j 4) 255 0)) (set! (ref *stripe-image* (+ (* 4 j) 2)) 0) (set! (ref *stripe-image* (+ (* 4 j) 3)) 255))) ;; planes for texture coordinate generation (define x=0plane '#f32(1.0 0.0 0.0 0.0)) (define slanted '#f32(1.0 1.0 1.0 0.0)) (define *current-coeff* x=0plane) (define *current-plane* 0) (define *current-gen-mode* 0) (define (init) (gl-clear-color 0 0 0 0) (gl-enable GL_DEPTH_TEST) (gl-shade-model GL_SMOOTH) (make-stripe-image) (gl-pixel-store GL_UNPACK_ALIGNMENT 1) (set! *texname* (ref (gl-gen-textures 1) 0)) (gl-bind-texture GL_TEXTURE_1D *texname*) (gl-tex-parameter GL_TEXTURE_1D GL_TEXTURE_WRAP_S GL_REPEAT) (gl-tex-parameter GL_TEXTURE_1D GL_TEXTURE_MAG_FILTER GL_LINEAR) (gl-tex-parameter GL_TEXTURE_1D GL_TEXTURE_MIN_FILTER GL_LINEAR) (gl-tex-image-1d GL_TEXTURE_1D 0 GL_RGBA *stripe-image-width* 0 GL_RGBA GL_UNSIGNED_BYTE *stripe-image*) (gl-tex-env GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE GL_MODULATE) (set! *current-coeff* x=0plane) (set! *current-gen-mode* GL_OBJECT_LINEAR) (set! *current-plane* GL_OBJECT_PLANE) (gl-tex-gen GL_S GL_TEXTURE_GEN_MODE *current-gen-mode*) (gl-tex-gen GL_S *current-plane* *current-coeff*) (gl-enable GL_TEXTURE_GEN_S) (gl-enable GL_TEXTURE_1D) (gl-enable GL_CULL_FACE) (gl-enable GL_LIGHTING) (gl-enable GL_LIGHT0) (gl-enable GL_AUTO_NORMAL) (gl-enable GL_NORMALIZE) (gl-front-face GL_CW) (gl-cull-face GL_BACK) (gl-material GL_FRONT GL_SHININESS 64.0) ) (define (disp) (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT)) (gl-push-matrix) (gl-rotate 45.0 0.0 0.0 1.0) (gl-bind-texture GL_TEXTURE_1D *texname*) (glut-solid-teapot 2.0) (gl-pop-matrix) (gl-flush)) (define (reshape w h) (gl-viewport 0 0 w h) (gl-matrix-mode GL_PROJECTION) (gl-load-identity) (if (<= w h) (gl-ortho -3.5 3.5 (* -3.5 (/ h w)) (* 3.5 (/ h w)) -3.5 3.5) (gl-ortho (* -3.5 (/ w h)) (* 3.5 (/ w h)) -3.5 3.5 -3.5 3.5)) (gl-matrix-mode GL_MODELVIEW) (gl-load-identity) ) (define (keyboard key x y) (cond ((or (= key (char->integer #\e)) (= key (char->integer #\E))) (set! *current-gen-mode* GL_EYE_LINEAR) (set! *current-plane* GL_EYE_PLANE) (gl-tex-gen GL_S GL_TEXTURE_GEN_MODE *current-gen-mode*) (gl-tex-gen GL_S *current-plane* *current-coeff*) (glut-post-redisplay)) ((or (= key (char->integer #\o)) (= key (char->integer #\O))) (set! *current-gen-mode* GL_OBJECT_LINEAR) (set! *current-plane* GL_OBJECT_PLANE) (gl-tex-gen GL_S GL_TEXTURE_GEN_MODE *current-gen-mode*) (gl-tex-gen GL_S *current-plane* *current-coeff*) (glut-post-redisplay)) ((or (= key (char->integer #\s)) (= key (char->integer #\S))) (set! *current-coeff* slanted) (gl-tex-gen GL_S *current-plane* *current-coeff*) (glut-post-redisplay)) ((or (= key (char->integer #\x)) (= key (char->integer #\X))) (set! *current-coeff* x=0plane) (gl-tex-gen GL_S *current-plane* *current-coeff*) (glut-post-redisplay)) ((= 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 256 256) (glut-init-window-position 100 100) (glut-create-window (car args)) (init) (glut-display-func disp) (glut-reshape-func reshape) (glut-keyboard-func keyboard) (glut-main-loop) 0)