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

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

initial commit

File size: 2.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; TODO merge the two following procedure.
54
55; Draw a unit square on the x/y plane.
56(define (unit-square-xy)
57  (emit-quads
58    (vertex -0.5 -0.5)
59    (vertex  0.5 -0.5)
60    (vertex  0.5  0.5)
61    (vertex -0.5  0.5)))
62
63; Draw a square on the x/y plane. Size is given in argument.
64(define (square-xy size)
65  (let ((-s (/ (- size) 2))
66        (s (/ size 2)))
67    (emit-quads
68      (vertex -s -s)
69      (vertex  s -s)
70      (vertex  s  s)
71      (vertex -s  s))))
72
73; Draw a grid.
74; n is the number segments.
75; s is the size of a segment.
76(define (grid n s)
77  (let ((w/2 (* s (/ n 2.0)))
78        )
79    (emit-lines
80      (let loop ((i (- w/2)))
81        (when (<= i w/2)
82          (vertex i (- w/2)) ; vertical line
83          (vertex i w/2)
84          (vertex (- w/2) i)
85          (vertex w/2 i)
86          (loop (+ i s)))))))
87
88
89(define (clear)
90  (gl:Clear (+ gl:COLOR_BUFFER_BIT gl:DEPTH_BUFFER_BIT)))
91
92(define (clear-color r g b . a)
93  (gl:ClearColor r g b (:optional a 0)))
94
95(define (background . args)
96  (case (length args)
97    ((1) (let ((a (/ (car args) 255)))
98           (clear-color a a a)))
99    ((3) (let ((r (/ (car args) 255))
100               (g (/ (cadr args) 255))
101               (b (/ (caddr args) 255)))
102           (clear-color r g b)))))
103
104(define (map_ f lst)
105  (when (not (null? lst))
106    (f (car lst))
107    (map_ f (cdr lst))))
108
109(define (map_2 f lst)
110  (when (not (null? lst))
111    (f (car lst) (cadr lst))
112    (map_2 f (cddr lst))))
113
114(define (map_3 f lst)
115  (when (not (null? lst))
116    (f (car lst) (cadr lst) (caddr lst))
117    (map_3 f (cdddr lst))))
118
119;
120
121(define (vertex x y . z)
122    (gl:Vertex3f x y (:optional z 0)))
123
124(define (points_3 pts)
125  (emit-points (map_3 vertex pts)))
126
127(define (points_2 pts)
128  (emit-points (map_2 vertex pts)))
129
Note: See TracBrowser for help on using the repository browser.