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
|
;; Example 2-9 Enabling and Loading Vertex Arrays
(use gl)
(use gl.glut)
(define *setup-method* 'pointer)
(define *deref-method* 'drawarray)
(define (setup-pointers)
(gl-enable-client-state GL_VERTEX_ARRAY)
(gl-enable-client-state GL_COLOR_ARRAY)
(gl-vertex-pointer 2 '#s32(25 25
100 325
175 25
175 325
250 25
325 325))
(gl-color-pointer 3 '#f32(1.0 0.2 0.2
0.2 0.2 1.0
0.8 1.0 0.2
0.75 0.75 0.75
0.35 0.35 0.35
0.5 0.5 0.5))
)
(define (setup-interleave)
(gl-interleaved-arrays GL_C3F_V3F
'#f32(1.0 0.2 1.0 100.0 100.0 0.0
1.0 0.2 0.2 0.0 200.0 0.0
1.0 1.0 0.2 100.0 300.0 0.0
0.2 1.0 0.2 200.0 300.0 0.0
0.2 1.0 1.0 300.0 200.0 0.0
0.2 0.2 1.0 200.0 100.0 0.0))
)
(define (init)
(gl-clear-color 0.0 0.0 0.0 0.0)
(gl-shade-model GL_SMOOTH)
(setup-pointers))
(define (disp)
(gl-clear GL_COLOR_BUFFER_BIT)
(case *deref-method*
((drawarray)
(gl-draw-arrays GL_TRIANGLES 0 6))
((arrayelement)
(gl-begin* GL_TRIANGLES
(gl-array-element 2)
(gl-array-element 3)
(gl-array-element 5)
))
((drawelements)
(gl-draw-elements GL_POLYGON '#u32(0 1 3 4)))
)
(gl-flush))
(define (reshape w h)
(gl-viewport 0 0 w h)
(gl-matrix-mode GL_PROJECTION)
(gl-load-identity)
(glu-ortho-2d 0.0 w 0.0 h))
(define (mouse button state x y)
(cond
((= button GLUT_LEFT_BUTTON)
(when (= state GLUT_DOWN)
(case *setup-method*
((pointer) (set! *setup-method* 'interleaved)
(setup-interleave))
((interleaved) (set! *setup-method* 'pointer)
(setup-pointers)))
(glut-post-redisplay)))
((or (= button GLUT_MIDDLE_BUTTON)
(= button GLUT_RIGHT_BUTTON))
(when (= state GLUT_DOWN)
(case *deref-method*
((drawarray) (set! *deref-method* 'arrayelement))
((arrayelement) (set! *deref-method* 'drawelements))
((drawelements) (set! *deref-method* 'drawarray)))
(glut-post-redisplay)))
))
(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 350 350)
(glut-init-window-position 100 100)
(glut-create-window *program-name*)
(init)
(glut-display-func disp)
(glut-reshape-func reshape)
(glut-mouse-func mouse)
(glut-keyboard-func keyboard)
(glut-main-loop)
0)
|
