1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
;; Example 6-2 Three-Dimensional Blending
(use gl)
(use gl.glut)
(define MAXZ 8.0)
(define MINZ -8.0)
(define ZINC 0.4)
(define *solid-z* MAXZ)
(define *transparent-z* MINZ)
(define *sphere-list* #f)
(define *cube-list* #f)
(define (init)
(gl-material GL_FRONT GL_SPECULAR '#f32(1.0 1.0 1.0 0.15))
(gl-material GL_FRONT GL_SHININESS 100.0)
(gl-light GL_LIGHT0 GL_POSITION '#f32(0.5 0.5 1.0 0.0))
(gl-enable GL_LIGHTING)
(gl-enable GL_LIGHT0)
(gl-enable GL_DEPTH_TEST)
(set! *sphere-list* (gl-gen-lists 1))
(gl-new-list *sphere-list* GL_COMPILE)
(glut-solid-sphere 0.4 16 16)
(gl-end-list)
(set! *cube-list* (gl-gen-lists 1))
(gl-new-list *cube-list* GL_COMPILE)
(glut-solid-cube 0.6)
(gl-end-list)
)
(define (disp)
(gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
(gl-push-matrix)
(gl-translate -0.15 -0.15 *solid-z*)
(gl-material GL_FRONT GL_EMISSION '#f32(0.0 0.0 0.0 1.0))
(gl-material GL_FRONT GL_DIFFUSE '#f32(0.75 0.75 0.0 1.0))
(gl-call-list *sphere-list*)
(gl-pop-matrix)
(gl-push-matrix)
(gl-translate 0.15 0.15 *transparent-z*)
(gl-rotate 15.0 1.0 1.0 0.0)
(gl-rotate 30.0 0.0 1.0 0.0)
(gl-material GL_FRONT GL_EMISSION '#f32(0.0 0.3 0.3 0.6))
(gl-material GL_FRONT GL_DIFFUSE '#f32(0.0 0.8 0.8 0.6))
(gl-enable GL_BLEND)
(gl-depth-mask #f)
(gl-blend-func GL_SRC_ALPHA GL_ONE)
(gl-call-list *cube-list*)
(gl-depth-mask #t)
(gl-disable GL_BLEND)
(gl-pop-matrix)
(glut-swap-buffers)
)
(define (reshape w h)
(gl-viewport 0 0 w h)
(gl-matrix-mode GL_PROJECTION)
(gl-load-identity)
(if (<= w h)
(gl-ortho -1.5 1.5 (* -1.5 (/ h w)) (* 1.5 (/ h w)) -10.0 10.0)
(gl-ortho (* -1.5 (/ w h)) (* 1.5 (/ w h)) -1.5 1.5 -10.0 10.0))
(gl-matrix-mode GL_MODELVIEW)
(gl-load-identity)
)
(define (animate)
(if (or (<= *solid-z* MINZ) (>= *transparent-z* MAXZ))
(glut-idle-func #f)
(begin
(dec! *solid-z* ZINC)
(inc! *transparent-z* ZINC)
(glut-post-redisplay)))
)
(define (keyboard key x y)
(cond
((or (= key (char->integer #\a))
(= key (char->integer #\A)))
(set! *solid-z* MAXZ)
(set! *transparent-z* MINZ)
(glut-idle-func animate))
((or (= key (char->integer #\r))
(= key (char->integer #\R)))
(set! *solid-z* MAXZ)
(set! *transparent-z* MINZ)
(glut-post-redisplay))
((= key 27) (exit 0)))
)
(define (main args)
(glut-init args)
(glut-init-display-mode (logior GLUT_DOUBLE GLUT_RGB GLUT_DEPTH))
(glut-init-window-size 500 500)
(glut-create-window *program-name*)
(init)
(glut-reshape-func reshape)
(glut-keyboard-func keyboard)
(glut-display-func disp)
(glut-main-loop)
0)
|
