source: project/gl-display-glx/gl-display-glx.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: 8.5 KB
Line 
1;;; gl-display-glx.scm
2;;
3;; 07.01.2007 - 08.02.2007
4;; 
5;; Ce fichier peut etre compile en .so avec
6;; csc -s gl-display-glx.scm glx_display.c -I/usr/include/X11 -L/usr/X11R6/lib -L/usr/lib -lGL -lm
7;; Ensuite, le .so peut etre charger avec
8;; (require-extension gl-dislpay-glx).
9;;
10
11;; TODO color-args : prend un ou trois argument et les transforme en trois argument selon RGB, HSV,...
12;; dans un autre fichier...
13
14;
15
16;(require-for-syntax 'srfi-13)
17
18(declare
19  (export
20    gl-display:create
21    gl-display:destroy
22    gl-display:swap
23    gl-display:time
24    gl-display:receive-event
25    gl-display:event-type
26    gl-display:event-x
27    gl-display:event-y
28    gl-display:event-dx
29    gl-display:event-dy
30    gl-display:event-time
31    gl-display:event-keycode
32    gl-display:event-keysym
33    gl-display:width
34    gl-display:height
35    gl-display:screen-width
36    gl-display:screen-height
37    gl-display:enable-autorepeat
38    gl-display:disable-autorepeat
39    gl-display:disable-cursor
40    gl-display:enable-centered-cursor
41    gl-display:disable-centered-cursor
42    gl-display:enable-cycling-cursor
43    gl-display:disable-cycling-cursor
44    )
45  )
46
47(require-extension gl)
48
49; xlib events
50
51#>
52#include "glx_display.h"
53#include <X.h>
54#include <keysym.h>
55<#
56
57
58(define-foreign-enum (keycode_t (enum "keycode_t"))
59  K_BACKSPACE
60  K_TAB
61  K_ENTER
62  K_ESCAPE
63
64  K_SPACE
65  K_EXCLAM
66  K_DOUBLE_QUOTE
67  K_NUMBER_SIGNE
68  K_DOLLAR
69  K_PERCENT
70  K_AMPERSAND
71  K_APOSTROPHE
72  K_LEFT_PAREN
73  K_RIGHT_PAREN
74  K_ASTERISK
75  K_PLUS
76  K_COMMA
77  K_MINUS
78  K_PERIOD
79  K_SLASH
80  K_0
81  K_1
82  K_2
83  K_3
84  K_4
85  K_5
86  K_6
87  K_7
88  K_8
89  K_9
90  K_COLON
91  K_SEMICOLON
92  K_LESS
93  K_EQUAL
94  K_GREATER
95  K_QUESTION
96  K_AT
97  K_A
98  K_B
99  K_C
100  K_D
101  K_E
102  K_F
103  K_G
104  K_H
105  K_I
106  K_J
107  K_K
108  K_L
109  K_M
110  K_N
111  K_O
112  K_P
113  K_Q
114  K_R
115  K_S
116  K_T
117  K_U
118  K_V
119  K_W
120  K_X
121  K_Y
122  K_Z
123  K_LEFT_BRACKET
124  K_BACKSLASH
125  K_RIGHT_BRACKET
126  K_ASCII_CIRCUM
127  K_UNDERSCORE
128  K_GRAVE
129  K_a
130  K_b
131  K_c
132  K_d
133  K_e
134  K_f
135  K_g
136  K_h
137  K_i
138  K_j
139  K_k
140  K_l
141  K_m
142  K_n
143  K_o
144  K_p
145  K_q
146  K_r
147  K_s
148  K_t
149  K_u
150  K_v
151  K_w
152  K_x
153  K_y
154  K_z
155  K_LEFT_BRACE
156  K_BAR
157  K_RIGHT_BRACE
158  K_ASCII_TILDE
159
160  K_COMMAND
161  K_CAPSLOCK
162  K_POWER
163  K_PAUSE
164
165  K_UP_ARROW
166  K_DOWN_ARROW
167  K_LEFT_ARROW
168  K_RIGHT_ARROW
169
170  K_LEFT_ALT
171  K_RIGHT_ALT
172  K_LEFT_CONTROL
173  K_RIGHT_CONTROL
174  K_LEFT_SHIFT
175  K_RIGHT_SHIFT
176  K_INSERT
177  K_DELETE
178  K_PAGE_DOWN
179  K_PAGE_UP
180  K_HOME
181  K_END
182
183  K_F1
184  K_F2
185  K_F3
186  K_F4
187  K_F5
188  K_F6
189  K_F7
190  K_F8
191  K_F9
192  K_F10
193  K_F11
194  K_F12
195  K_F13
196  K_F14
197  K_F15
198
199  K_KP_HOME
200  K_KP_UP_ARROW
201  K_KP_PAGE_UP
202  K_KP_LEFT_ARROW
203  K_KP_5
204  K_KP_RIGHT_ARROW
205  K_KP_END
206  K_KP_DOWN_ARROW
207  K_KP_PAGE_DOWN
208  K_KP_ENTER
209  K_KP_INSERT
210  K_KP_DELETE
211  K_KP_SLASH
212  K_KP_MINUS
213  K_KP_PLUS
214  K_KP_NUMLOCK
215  K_KP_STAR
216  K_KP_EQUALS
217
218  K_MOUSE1
219  K_MOUSE2
220  K_MOUSE3
221  K_MOUSE4
222  K_MOUSE5
223
224  K_WHEEL_DOWN
225  K_WHEEL_UP
226
227  K_LAST_KEY
228)
229
230; don't export this
231
232
233(define KEY-PRESSED     (foreign-value "KeyPress"      int))
234(define KEY-RELEASED    (foreign-value "KeyRelease"    int))
235(define BUTTON-PRESSED  (foreign-value "ButtonPress"   int))
236(define BUTTON-RELEASED (foreign-value "ButtonRelease" int))
237(define MOUSE-MOVED     (foreign-value "MotionNotify"  int))
238(define LAST-EVENT      (foreign-value "LASTEvent"     int))
239
240; FIXME is it safe ? Can other apps register new event numbers ?
241(define NO-EVENT        (+ LAST-EVENT 1))
242
243;(define ESCAPE-KEY    (foreign-value "XK_Escape" int))
244;(define RETURN-KEY    (foreign-value "XK_Return" int))
245;(define BACKSPACE-KEY (foreign-value "XK_BackSpace" int))
246
247;(define UP-KEY     (foreign-value "XK_Up"     int))
248;(define DOWN-KEY   (foreign-value "XK_Down"   int))
249;(define LEFT-KEY   (foreign-value "XK_Left"   int))
250;(define RIGHT-KEY  (foreign-value "XK_Right"  int))
251
252(define LEFT-MOUSE-BUTTON  (foreign-value "Button1"    int))
253(define RIGHT-MOUSE-BUTTON (foreign-value "Button3"    int))
254
255;
256
257(define x-event-type
258  (foreign-lambda int "event_type" c-pointer))
259(define x-event-x
260  (foreign-lambda int "event_x" c-pointer))
261(define x-event-y
262  (foreign-lambda int "event_y" c-pointer))
263(define x-event-dx
264  (foreign-lambda int "event_dx" c-pointer))
265(define x-event-dy
266  (foreign-lambda int "event_dy" c-pointer))
267
268(define x-event-keycode
269  (foreign-lambda keycode_t "event_keycode" c-pointer))
270(define x-event-keysym
271  (foreign-lambda unsigned-int "event_keysym" c-pointer))
272
273;(define (x-event-key event)
274;  (define event-xkeycode
275;    (foreign-lambda int "event_xkeycode" c-pointer))
276;  (let ((k (event-xkeycode event)))
277;    (cond ((eq? k ESCAPE-KEY) #\esc)
278;         ((eq? k RETURN-KEY) #\return)
279;         ((eq? k BACKSPACE-KEY) #\backspace)
280;         ((eq? k UP-KEY)     'UP-KEY)
281;         ((eq? k DOWN-KEY)   'DOWN-KEY)
282;         ((eq? k LEFT-KEY)   'LEFT-KEY)
283;         ((eq? k RIGHT-KEY)  'RIGHT-KEY)
284;         (else (integer->char k)))))
285
286; TODO x-event-char for unicode character instead of keycode.
287
288(define (x-event-button event)
289  (define event-button
290    (foreign-lambda int "event_button" c-pointer))
291  (let ((b (event-button event)))
292    (cond ((eq? b LEFT-MOUSE-BUTTON) 'LMB)
293          ((eq? b RIGHT-MOUSE-BUTTON) 'RMB)
294          (else 'MMB))))
295
296(define (keysym->char i)
297  (integer->char i))
298
299; returns an event from xlib
300(define (gl-display:receive-event window)
301  (define receive
302    (foreign-lambda c-pointer "receive_event" c-pointer))
303  (let* ((e (receive window))
304         (type (x-event-type e))
305         (time (gl-display:time)))
306    (cond ((eq? type KEY-PRESSED)     (list 'KEY-PRESSED time (x-event-keycode e) (keysym->char (x-event-keysym e))))
307          ((eq? type KEY-RELEASED)    (list 'KEY-RELEASED time (x-event-keycode e) (keysym->char (x-event-keysym e))))
308          ((eq? type BUTTON-PRESSED)  (list 'BUTTON-PRESSED time (x-event-button e) (x-event-x e) (x-event-y e)))
309          ((eq? type BUTTON-RELEASED) (list 'BUTTON-RELEASED time (x-event-button e) (x-event-x e) (x-event-y e)))
310          ((eq? type MOUSE-MOVED)     (list 'MOUSE-MOVED time 'dummy
311                                            (x-event-x e) (x-event-y e) (x-event-dx window) (x-event-dy window)))
312          ((eq? type NO-EVENT)        (list 'NO-EVENT))
313          (else                       (gl-display:receive-event window))))) ; pump and discard all other events
314
315(define (gl-display:event-type event)
316  (car event))
317
318(define (gl-display:event-x event)
319  (fourth event))
320(define (gl-display:event-y event)
321  (fifth event))
322(define (gl-display:event-dx event)
323  (sixth event))
324(define (gl-display:event-dy event)
325  (seventh event))
326
327(define (gl-display:event-time event)
328  (cadr event))
329
330(define (gl-display:event-keycode event)
331  (caddr event))
332
333(define (gl-display:event-keysym event)
334  (cadddr event))
335
336;
337(define gl-display:disable-cursor
338  (foreign-lambda void "disable_cursor" c-pointer))
339
340; puts the back-buffer content into the front-buffer.
341(define gl-display:swap
342  (foreign-lambda void "swap_buffers" c-pointer))
343
344(define gl-display:width
345  (foreign-lambda unsigned-int "get_width" c-pointer))
346(define gl-display:height
347  (foreign-lambda unsigned-int "get_height" c-pointer))
348(define gl-display:screen-width
349  (foreign-lambda unsigned-int "get_screen_width" c-pointer))
350(define gl-display:screen-height
351  (foreign-lambda unsigned-int "get_screen_height" c-pointer))
352
353(define gl-display:enable-autorepeat
354  (foreign-lambda void "enable_autorepeat" c-pointer))
355(define gl-display:disable-autorepeat
356  (foreign-lambda void "disable_autorepeat" c-pointer))
357(define gl-display:enable-centered-cursor
358  (foreign-lambda void "enable_centered_cursor" c-pointer))
359(define gl-display:disable-centered-cursor
360  (foreign-lambda void "disable_centered_cursor" c-pointer))
361(define gl-display:enable-cycling-cursor
362  (foreign-lambda void "enable_cycling_cursor" c-pointer))
363(define gl-display:disable-cycling-cursor
364  (foreign-lambda void "disable_cycling_cursor" c-pointer))
365
366; An optional list of properties can be provided.
367; The supported properties are:
368; - single-buffered
369; - centered
370; - full-screen
371; - no-border
372; - shaped
373; FIXME it crashes when no arg is given after a 'width...
374; is it ok ?
375(define (gl-display:create . properties)
376  (define create-display
377    (foreign-lambda c-pointer "create_gl_window" unsigned-int unsigned-int int int int int))
378 
379  (define (on? prop a b)
380    (if (memv prop properties) a b))
381 
382  (define (on-next? prop default)
383    (let ((rest (memv prop properties)))
384      (if (or (null? rest) (not rest))
385        default
386        (cadr rest))))
387 
388  (create-display
389    (on-next? 'width 100)
390    (on-next? 'height 100)
391    (on? 'single-buffered 0 1)
392    (on? 'full-screen 1 0)
393    (on? 'no-border 1 0)
394    (on? 'shape 1 0)
395    ))
396
397(define gl-display:destroy
398  (foreign-lambda void "destroy_gl_window" c-pointer))
399
400(define gl-display:time
401  (foreign-lambda int "time_milliseconds"))
402
Note: See TracBrowser for help on using the repository browser.