source: project/gl-display-glx/gl-util.scm @ 3547

Last change on this file since 3547 was 3547, checked in by thu, 14 years ago

commit before removal of non gl-display files

File size: 9.1 KB
Line 
1;;; gl-util.scm
2;;; 2007-02-06 - 2007-02-08
3;;;
4;;; The intent of this file is to provide small practical
5;;; things : grid, axis, null-cube, ...
6
7(define M_PI 3.14159265358979323846) ; from math.h
8
9(define (load-identity)
10  (gl:LoadIdentity))
11
12(define (gl-util:initialize)
13  (gl:ShadeModel gl:SMOOTH)
14  (gl:ClearColor 1.0 1.0 1.0 0.0)
15  (gl:ClearDepth 1.0)
16  (gl:Enable     gl:DEPTH_TEST)
17  (gl:DepthFunc  gl:LEQUAL)
18  (gl:Hint       gl:PERSPECTIVE_CORRECTION_HINT gl:NICEST)
19  (gl:Flush))
20
21(define-macro in-mode
22              (lambda (mode . rest)
23                `(begin (gl:Begin ,mode)
24                        ,@rest
25                        (gl:End))))
26
27(define-macro emit-points
28              (lambda rest
29                `(in-mode gl:POINTS ,@rest)))
30(define-macro emit-quads
31              (lambda rest
32                `(in-mode gl:QUADS ,@rest)))
33(define-macro emit-lines
34              (lambda rest
35                `(in-mode gl:LINES ,@rest)))
36(define-macro emit-line-loop
37              (lambda rest
38                `(in-mode gl:LINE_LOOP ,@rest)))
39(define-macro emit-triangle-fan
40              (lambda rest
41                `(in-mode gl:TRIANGLE_FAN ,@rest)))
42;
43; One usefull event processing abstraction is related to
44; the way some people have an array[255] of key to know
45; the current state of key. If it the state changes and
46; the query on the state are not synchronized, state
47; change could be lost. A remedy would be to have for
48; each event a list of its occurences (with time-stamp).
49;
50; Then a test on the state of a key can remove the event
51; or not.
52;
53
54; Enable backface culling.
55; Default is (glCullFace gl:BACK).
56(define (enable-backface-culling)
57  (gl:Enable gl:CULL_FACE))
58
59; Draw a square on the x/y plane. Size is given in argument.
60(define (square-xy size)
61  (let ((-s (/ (- size) 2))
62        (s (/ size 2)))
63    (emit-quads
64      (vertex -s -s)
65      (vertex  s -s)
66      (vertex  s  s)
67      (vertex -s  s))))
68
69; Draw a cube.
70(define (gl-util:cube size)
71  (let ((-s (/ (- size) 2))
72        (s (/ size 2)))
73    (emit-quads
74      (gl:Color3f 1 0.7 0)
75      (vertex -s -s  s) ; front
76      (vertex  s -s  s)
77      (vertex  s  s  s)
78      (vertex -s  s  s)
79     
80      (gl:Color3f 0.9 0.6 0)
81      (vertex  s -s  s) ; right (its left)
82      (vertex  s -s -s)
83      (vertex  s  s -s)
84      (vertex  s  s  s)
85     
86      (gl:Color3f 0.9 0.5 0.1)
87      (vertex  s -s -s) ; back
88      (vertex -s -s -s)
89      (vertex -s  s -s)
90      (vertex  s  s -s)
91     
92      (gl:Color3f 1.0 0.6 0.1)
93      (vertex -s -s -s) ; left
94      (vertex -s -s  s)
95      (vertex -s  s  s)
96      (vertex -s  s -s)
97     
98      (gl:Color3f 0.8 0.6 0.2)
99      (vertex -s -s -s) ; bottom
100      (vertex  s -s -s)
101      (vertex  s -s  s)
102      (vertex -s -s  s)
103     
104      (gl:Color3f 1.0 0.5 0.2)
105      (vertex -s  s  s) ; top
106      (vertex  s  s  s)
107      (vertex  s  s -s)
108      (vertex -s  s -s)
109      )))
110
111(define (gl-util:axis size)
112  (emit-lines
113    (gl:Color3f 1 0 0) ; x
114    (vertex 0 0 0)
115    (vertex size 0 0)
116
117    (gl:Color3f 0 1 0) ; y
118    (vertex 0 0 0)
119    (vertex 0 size 0)
120
121    (gl:Color3f 0 0 1) ; z
122    (vertex 0 0 0)
123    (vertex 0 0 size))
124
125  (gl:Color3f 1 0 0)
126  (gl-util:8-sides-cone-x (/ size 10) (/ size 2) size)
127  (gl:Color3f 0 1 0)
128  (gl-util:8-sides-cone-y (/ size 10) (/ size 2) size)
129  (gl:Color3f 0 0 1)
130  (gl-util:8-sides-cone-z (/ size 10) (/ size 2) size)
131  )
132
133(define (gl-util:cursor-3d size x y z)
134  (emit-lines
135    (gl:Color3f 0.2 0.1 1)
136   
137    (vertex x y z)
138    (vertex (- x size) y z)
139
140    (vertex x y z)
141    (vertex x (- y size) z)
142
143    (vertex x y z)
144    (vertex x y (- z size))))
145
146(define (gl-util:8-sides-cone-x radius len offset)
147  (emit-triangle-fan
148    (gl:Vertex2f offset 0)
149    (gl:Vertex3f offset (* (cos 0.000000) radius) (* (sin 0.000000) radius))
150    (gl:Vertex3f offset (* (cos 0.785398) radius) (* (sin 0.785398) radius))
151    (gl:Vertex3f offset (* (cos 1.570796) radius) (* (sin 1.570796) radius))
152    (gl:Vertex3f offset (* (cos 2.356194) radius) (* (sin 2.356194) radius))
153    (gl:Vertex3f offset (* (cos 3.141593) radius) (* (sin 3.141593) radius))
154    (gl:Vertex3f offset (* (cos 3.926991) radius) (* (sin 3.926991) radius))
155    (gl:Vertex3f offset (* (cos 4.712389) radius) (* (sin 4.712389) radius))
156    (gl:Vertex3f offset (* (cos 5.497787) radius) (* (sin 5.497787) radius))
157    (gl:Vertex3f offset (* (cos 0.000000) radius) (* (sin 0.000000) radius)))
158  (emit-triangle-fan
159    (gl:Vertex3f (+ offset len) 0 0)
160    (gl:Vertex3f offset (* (cos 0.000000) radius) (* (sin 0.000000) radius))
161    (gl:Vertex3f offset (* (cos 5.497787) radius) (* (sin 5.497787) radius))
162    (gl:Vertex3f offset (* (cos 4.712389) radius) (* (sin 4.712389) radius))
163    (gl:Vertex3f offset (* (cos 3.926991) radius) (* (sin 3.926991) radius))
164    (gl:Vertex3f offset (* (cos 3.141593) radius) (* (sin 3.141593) radius))
165    (gl:Vertex3f offset (* (cos 2.356194) radius) (* (sin 2.356194) radius))
166    (gl:Vertex3f offset (* (cos 1.570796) radius) (* (sin 1.570796) radius))
167    (gl:Vertex3f offset (* (cos 0.785398) radius) (* (sin 0.785398) radius))
168    (gl:Vertex3f offset (* (cos 0.000000) radius) (* (sin 0.000000) radius))))
169(define (gl-util:8-sides-cone-y radius len offset)
170  (emit-triangle-fan
171    (gl:Vertex2f 0 offset)
172    (gl:Vertex3f (* (cos 0.000000) radius) offset (* (sin 0.000000) radius))
173    (gl:Vertex3f (* (cos 0.785398) radius) offset (* (sin 0.785398) radius))
174    (gl:Vertex3f (* (cos 1.570796) radius) offset (* (sin 1.570796) radius))
175    (gl:Vertex3f (* (cos 2.356194) radius) offset (* (sin 2.356194) radius))
176    (gl:Vertex3f (* (cos 3.141593) radius) offset (* (sin 3.141593) radius))
177    (gl:Vertex3f (* (cos 3.926991) radius) offset (* (sin 3.926991) radius))
178    (gl:Vertex3f (* (cos 4.712389) radius) offset (* (sin 4.712389) radius))
179    (gl:Vertex3f (* (cos 5.497787) radius) offset (* (sin 5.497787) radius))
180    (gl:Vertex3f (* (cos 0.000000) radius) offset (* (sin 0.000000) radius)))
181  (emit-triangle-fan
182    (gl:Vertex3f 0 (+ offset len) 0)
183    (gl:Vertex3f (* (cos 0.000000) radius) offset (* (sin 0.000000) radius))
184    (gl:Vertex3f (* (cos 5.497787) radius) offset (* (sin 5.497787) radius))
185    (gl:Vertex3f (* (cos 4.712389) radius) offset (* (sin 4.712389) radius))
186    (gl:Vertex3f (* (cos 3.926991) radius) offset (* (sin 3.926991) radius))
187    (gl:Vertex3f (* (cos 3.141593) radius) offset (* (sin 3.141593) radius))
188    (gl:Vertex3f (* (cos 2.356194) radius) offset (* (sin 2.356194) radius))
189    (gl:Vertex3f (* (cos 1.570796) radius) offset (* (sin 1.570796) radius))
190    (gl:Vertex3f (* (cos 0.785398) radius) offset (* (sin 0.785398) radius))
191    (gl:Vertex3f (* (cos 0.000000) radius) offset (* (sin 0.000000) radius))))
192(define (gl-util:8-sides-cone-z radius len offset)
193  (emit-triangle-fan
194    (gl:Vertex3f 0 0 offset)
195    (gl:Vertex3f (* (cos 0.000000) radius) (* (sin 0.000000) radius) offset)
196    (gl:Vertex3f (* (cos 0.785398) radius) (* (sin 0.785398) radius) offset)
197    (gl:Vertex3f (* (cos 1.570796) radius) (* (sin 1.570796) radius) offset)
198    (gl:Vertex3f (* (cos 2.356194) radius) (* (sin 2.356194) radius) offset)
199    (gl:Vertex3f (* (cos 3.141593) radius) (* (sin 3.141593) radius) offset)
200    (gl:Vertex3f (* (cos 3.926991) radius) (* (sin 3.926991) radius) offset)
201    (gl:Vertex3f (* (cos 4.712389) radius) (* (sin 4.712389) radius) offset)
202    (gl:Vertex3f (* (cos 5.497787) radius) (* (sin 5.497787) radius) offset)
203    (gl:Vertex3f (* (cos 0.000000) radius) (* (sin 0.000000) radius) offset))
204  (emit-triangle-fan
205    (gl:Vertex3f 0 0 (+ offset len))
206    (gl:Vertex3f (* (cos 0.000000) radius) (* (sin 0.000000) radius) offset)
207    (gl:Vertex3f (* (cos 5.497787) radius) (* (sin 5.497787) radius) offset)
208    (gl:Vertex3f (* (cos 4.712389) radius) (* (sin 4.712389) radius) offset)
209    (gl:Vertex3f (* (cos 3.926991) radius) (* (sin 3.926991) radius) offset)
210    (gl:Vertex3f (* (cos 3.141593) radius) (* (sin 3.141593) radius) offset)
211    (gl:Vertex3f (* (cos 2.356194) radius) (* (sin 2.356194) radius) offset)
212    (gl:Vertex3f (* (cos 1.570796) radius) (* (sin 1.570796) radius) offset)
213    (gl:Vertex3f (* (cos 0.785398) radius) (* (sin 0.785398) radius) offset)
214    (gl:Vertex3f (* (cos 0.000000) radius) (* (sin 0.000000) radius) offset)))
215
216; Draw a grid.
217; n is the number segments.
218; s is the size of a segment.
219(define (grid n s)
220  (let ((w/2 (* s (/ n 2.0)))
221        )
222    (emit-lines
223      (let loop ((i (- w/2)))
224        (when (<= i w/2)
225          (vertex i (- w/2)) ; vertical line
226          (vertex i w/2)
227          (vertex (- w/2) i)
228          (vertex w/2 i)
229          (loop (+ i s)))))))
230
231
232(define (clear)
233  (gl:Clear (+ gl:COLOR_BUFFER_BIT gl:DEPTH_BUFFER_BIT)))
234
235(define (clear-color r g b . a)
236  (gl:ClearColor r g b (:optional a 0)))
237
238(define (background . args)
239  (case (length args)
240    ((1) (let ((a (/ (car args) 255)))
241           (clear-color a a a)))
242    ((3) (let ((r (/ (car args) 255))
243               (g (/ (cadr args) 255))
244               (b (/ (caddr args) 255)))
245           (clear-color r g b)))))
246
247(define (map_ f lst)
248  (when (not (null? lst))
249    (f (car lst))
250    (map_ f (cdr lst))))
251
252(define (map_2 f lst)
253  (when (not (null? lst))
254    (f (car lst) (cadr lst))
255    (map_2 f (cddr lst))))
256
257(define (map_3 f lst)
258  (when (not (null? lst))
259    (f (car lst) (cadr lst) (caddr lst))
260    (map_3 f (cdddr lst))))
261
262;
263
264(define (vertex x y . z)
265    (gl:Vertex3f x y (:optional z 0)))
266
267(define (points_3 pts)
268  (emit-points (map_3 vertex pts)))
269
270(define (points_2 pts)
271  (emit-points (map_2 vertex pts)))
272
Note: See TracBrowser for help on using the repository browser.