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

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

added autorepeat enabling/disabling

File size: 3.9 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;
37; One usefull event processing abstraction is related to
38; the way some people have an array[255] of key to know
39; the current state of key. If it the state changes and
40; the query on the state are not synchronized, state
41; change could be lost. A remedy would be to have for
42; each event a list of its occurences (with time-stamp).
43;
44; Then a test on the state of a key can remove the event
45; or not.
46;
47
48; Enable backface culling.
49; Default is (glCullFace gl:BACK).
50(define (enable-backface-culling)
51  (gl:Enable gl:CULL_FACE))
52
53; Draw a square on the x/y plane. Size is given in argument.
54(define (square-xy size)
55  (let ((-s (/ (- size) 2))
56        (s (/ size 2)))
57    (emit-quads
58      (vertex -s -s)
59      (vertex  s -s)
60      (vertex  s  s)
61      (vertex -s  s))))
62
63; Draw a cube.
64(define (gl-util:cube size)
65  (let ((-s (/ (- size) 2))
66        (s (/ size 2)))
67    (emit-quads
68      (gl:Color3f 1 0.7 0)
69      (vertex -s -s  s) ; front
70      (vertex  s -s  s)
71      (vertex  s  s  s)
72      (vertex -s  s  s)
73     
74      (gl:Color3f 0.9 0.6 0)
75      (vertex  s -s  s) ; right (its left)
76      (vertex  s -s -s)
77      (vertex  s  s -s)
78      (vertex  s  s  s)
79     
80      (gl:Color3f 0.9 0.5 0.1)
81      (vertex  s -s -s) ; back
82      (vertex -s -s -s)
83      (vertex -s  s -s)
84      (vertex  s  s -s)
85     
86      (gl:Color3f 1.0 0.6 0.1)
87      (vertex -s -s -s) ; left
88      (vertex -s -s  s)
89      (vertex -s  s  s)
90      (vertex -s  s -s)
91     
92      (gl:Color3f 0.8 0.6 0.2)
93      (vertex -s -s -s) ; bottom
94      (vertex  s -s -s)
95      (vertex  s -s  s)
96      (vertex -s -s  s)
97     
98      (gl:Color3f 1.0 0.5 0.2)
99      (vertex -s  s  s) ; top
100      (vertex  s  s  s)
101      (vertex  s  s -s)
102      (vertex -s  s -s)
103      )))
104
105(define (gl-util:axis size)
106  (emit-lines
107    (gl:Color3f 1 0 0) ; x
108    (vertex 0 0 0)
109    (vertex size 0 0)
110
111    (gl:Color3f 0 0 1) ; y
112    (vertex 0 0 0)
113    (vertex 0 size 0)
114
115    (gl:Color3f 0 1 0) ; z
116    (vertex 0 0 0)
117    (vertex 0 0 size)))
118
119; Draw a grid.
120; n is the number segments.
121; s is the size of a segment.
122(define (grid n s)
123  (let ((w/2 (* s (/ n 2.0)))
124        )
125    (emit-lines
126      (let loop ((i (- w/2)))
127        (when (<= i w/2)
128          (vertex i (- w/2)) ; vertical line
129          (vertex i w/2)
130          (vertex (- w/2) i)
131          (vertex w/2 i)
132          (loop (+ i s)))))))
133
134
135(define (clear)
136  (gl:Clear (+ gl:COLOR_BUFFER_BIT gl:DEPTH_BUFFER_BIT)))
137
138(define (clear-color r g b . a)
139  (gl:ClearColor r g b (:optional a 0)))
140
141(define (background . args)
142  (case (length args)
143    ((1) (let ((a (/ (car args) 255)))
144           (clear-color a a a)))
145    ((3) (let ((r (/ (car args) 255))
146               (g (/ (cadr args) 255))
147               (b (/ (caddr args) 255)))
148           (clear-color r g b)))))
149
150(define (map_ f lst)
151  (when (not (null? lst))
152    (f (car lst))
153    (map_ f (cdr lst))))
154
155(define (map_2 f lst)
156  (when (not (null? lst))
157    (f (car lst) (cadr lst))
158    (map_2 f (cddr lst))))
159
160(define (map_3 f lst)
161  (when (not (null? lst))
162    (f (car lst) (cadr lst) (caddr lst))
163    (map_3 f (cdddr lst))))
164
165;
166
167(define (vertex x y . z)
168    (gl:Vertex3f x y (:optional z 0)))
169
170(define (points_3 pts)
171  (emit-points (map_3 vertex pts)))
172
173(define (points_2 pts)
174  (emit-points (map_2 vertex pts)))
175
Note: See TracBrowser for help on using the repository browser.