1;; Example 9-4  Three-Dimensional Texturing
2
3(use gl)
4(use gl.glut)
5(use gauche.uvector)
6
7;; Create checkerboard image
8(define-constant *iwidth* 16)
9(define-constant *iheight* 16)
10(define-constant *idepth* 16)
11(define *image* (make-u8vector (* *iwidth* *iheight* *idepth* 3)))
12(define *texname* 0)
13
14(define (make-image)
15  ;; NB: this must be easier once uniform array is implemented.
16  (dotimes (s 16)
17    (dotimes (t 16)
18      (dotimes (r 16)
19        (let ((rts (* 3 (+ (* r *iwidth* *iheight*)
20                           (* t *iwidth*)
21                           s))))
22          (set! (ref *image* rts)       (* s 17))
23          (set! (ref *image* (+ rts 1)) (* t 17))
24          (set! (ref *image* (+ rts 2)) (* r 17)))))))
25
26(define (init)
27  (gl-clear-color 0 0 0 0)
28  (gl-shade-model GL_FLAT)
29  (gl-enable GL_DEPTH_TEST)
30
31  (make-image)
32  (gl-pixel-store GL_UNPACK_ALIGNMENT 1)
33
34  (let1 texnames (gl-gen-textures 1)
35    (set! *texname* (ref texnames 0))
36    (gl-bind-texture GL_TEXTURE_3D *texname*))
37  (gl-tex-parameter GL_TEXTURE_3D GL_TEXTURE_WRAP_S GL_CLAMP)
38  (gl-tex-parameter GL_TEXTURE_3D GL_TEXTURE_WRAP_T GL_CLAMP)
39  (gl-tex-parameter GL_TEXTURE_3D GL_TEXTURE_WRAP_R GL_CLAMP)
40  (gl-tex-parameter GL_TEXTURE_3D GL_TEXTURE_MAG_FILTER GL_NEAREST)
41  (gl-tex-parameter GL_TEXTURE_3D GL_TEXTURE_MIN_FILTER GL_NEAREST)
42  (gl-tex-image-3d GL_TEXTURE_3D 0 GL_RGB *iwidth* *iheight* *idepth*
43                   0 GL_RGB GL_UNSIGNED_BYTE *image*)
44  (gl-enable GL_TEXTURE_3D)
45  )
46
47(define (disp)
48  (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
49  (gl-begin GL_QUADS)
50  (gl-tex-coord 0.0 0.0 0.0) (gl-vertex -2.25 -1.0 0.0)
51  (gl-tex-coord 0.0 1.0 0.0) (gl-vertex -2.25 1.0 0.0)
52  (gl-tex-coord 1.0 1.0 1.0) (gl-vertex -0.25 1.0 0.0)
53  (gl-tex-coord 1.0 0.0 1.0) (gl-vertex -0.25 -1.0 0.0)
54
55  (gl-tex-coord 0.0 0.0 1.0) (gl-vertex 0.25 -1.0 0.0)
56  (gl-tex-coord 0.0 1.0 1.0) (gl-vertex 0.25 1.0 0.0)
57  (gl-tex-coord 1.0 1.0 0.0) (gl-vertex 2.25 1.0 0.0)
58  (gl-tex-coord 1.0 0.0 0.0) (gl-vertex 2.25 -1.0 0.0)
59  (gl-end)
60  (gl-flush)
61  )
62
63(define (reshape w h)
64  (gl-viewport 0 0 w h)
65  (gl-matrix-mode GL_PROJECTION)
66  (gl-load-identity)
67  (glu-perspective 60.0 (/ w h) 1.0 30.0)
68  (gl-matrix-mode GL_MODELVIEW)
69  (gl-load-identity)
70  (gl-translate 0.0 0.0 -4.0))
71
72(define (keyboard key x y)
73  (cond
74   ((= key 27) (exit 0))
75   ))
76
77(define (main args)
78  (glut-init args)
79  (glut-init-display-mode (logior GLUT_SINGLE GLUT_RGB GLUT_DEPTH))
80  (glut-init-window-size 250 250)
81  (glut-init-window-position 100 100)
82  (glut-create-window (car args))
83  (init)
84  (glut-display-func disp)
85  (glut-reshape-func reshape)
86  (glut-keyboard-func keyboard)
87  (glut-main-loop)
88  0)
89