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

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

added autorepeat enabling/disabling

File size: 5.4 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-time
29    gl-display:event-key
30    gl-display:width
31    gl-display:height
32    gl-display:screen-width
33    gl-display:screen-height
34    gl-display:enable-autorepeat
35    gl-display:disable-autorepeat
36    )
37  )
38
39(require-extension gl)
40
41; xlib events
42
43#>
44#include "glx_display.h"
45#include <X.h>
46#include <keysym.h>
47<#
48
49; don't export this
50
51
52(define KEY-PRESSED     (foreign-value "KeyPress"      int))
53(define KEY-RELEASED    (foreign-value "KeyRelease"    int))
54(define BUTTON-PRESSED  (foreign-value "ButtonPress"   int))
55(define BUTTON-RELEASED (foreign-value "ButtonRelease" int))
56(define MOUSE-MOVED     (foreign-value "MotionNotify"  int))
57(define LAST-EVENT      (foreign-value "LASTEvent"     int))
58
59; FIXME is it safe ? Can other apps register new event numbers ?
60(define NO-EVENT        (+ LAST-EVENT 1))
61
62(define ESCAPE-KEY    (foreign-value "XK_Escape" int))
63(define RETURN-KEY    (foreign-value "XK_Return" int))
64(define BACKSPACE-KEY (foreign-value "XK_BackSpace" int))
65
66(define UP-KEY     (foreign-value "XK_Up"     int))
67(define DOWN-KEY   (foreign-value "XK_Down"   int))
68(define LEFT-KEY   (foreign-value "XK_Left"   int))
69(define RIGHT-KEY  (foreign-value "XK_Right"  int))
70
71(define LEFT-MOUSE-BUTTON  (foreign-value "Button1"    int))
72(define RIGHT-MOUSE-BUTTON (foreign-value "Button3"    int))
73
74;
75
76(define x-event-type
77  (foreign-lambda int "event_type" c-pointer))
78(define x-event-x
79  (foreign-lambda int "event_x" c-pointer))
80(define x-event-y
81  (foreign-lambda int "event_y" c-pointer))
82(define (x-event-key event)
83  (define event-keycode
84    (foreign-lambda int "event_keycode" c-pointer))
85  (let ((k (event-keycode event)))
86    (cond ((eq? k ESCAPE-KEY) #\esc)
87          ((eq? k RETURN-KEY) #\return)
88          ((eq? k BACKSPACE-KEY) #\backspace)
89          ((eq? k UP-KEY)     'UP-KEY)
90          ((eq? k DOWN-KEY)   'DOWN-KEY)
91          ((eq? k LEFT-KEY)   'LEFT-KEY)
92          ((eq? k RIGHT-KEY)  'RIGHT-KEY)
93          (else (integer->char k)))))
94
95(define (x-event-button event)
96  (define event-button
97    (foreign-lambda int "event_button" c-pointer))
98  (let ((b (event-button event)))
99    (cond ((eq? b LEFT-MOUSE-BUTTON) 'LMB)
100          ((eq? b RIGHT-MOUSE-BUTTON) 'RMB)
101          (else 'MMB))))
102
103; returns an event from xlib
104(define (gl-display:receive-event window)
105  (define receive
106    (foreign-lambda c-pointer "receive_event" c-pointer))
107  (let* ((e (receive window))
108         (type (x-event-type e))
109         (time (gl-display:time)))
110    (cond ((eq? type KEY-PRESSED)     (list 'KEY-PRESSED time (x-event-key e)))
111          ((eq? type KEY-RELEASED)    (list 'KEY-RELEASED time (x-event-key e)))
112          ((eq? type BUTTON-PRESSED)  (list 'BUTTON-PRESSED time (x-event-button e) (x-event-x e) (x-event-y e)))
113          ((eq? type BUTTON-RELEASED) (list 'BUTTON-RELEASED time (x-event-button e) (x-event-x e) (x-event-y e)))
114          ((eq? type MOUSE-MOVED)     (list 'MOUSE-MOVED time 'dummy (x-event-x e) (x-event-y e))) ; TODO add delta
115          ((eq? type NO-EVENT)        (list 'NO-EVENT))
116          (else                       (gl-display:receive-event window))))) ; pump and discard all other events
117
118(define (gl-display:event-type event)
119  (car event))
120
121(define (gl-display:event-x event)
122  (fourth event))
123(define (gl-display:event-y event)
124  (fifth event))
125
126(define (gl-display:event-time event)
127  (cadr event))
128
129(define (gl-display:event-key event)
130  (caddr event))
131
132
133;
134
135; puts the back-buffer content into the front-buffer.
136(define gl-display:swap
137  (foreign-lambda void "swap_buffers" c-pointer))
138
139(define gl-display:width
140  (foreign-lambda unsigned-int "get_width" c-pointer))
141(define gl-display:height
142  (foreign-lambda unsigned-int "get_height" c-pointer))
143(define gl-display:screen-width
144  (foreign-lambda unsigned-int "get_screen_width" c-pointer))
145(define gl-display:screen-height
146  (foreign-lambda unsigned-int "get_screen_height" c-pointer))
147
148(define gl-display:enable-autorepeat
149  (foreign-lambda void "enable_autorepeat" c-pointer))
150(define gl-display:disable-autorepeat
151  (foreign-lambda void "disable_autorepeat" c-pointer))
152
153; An optional list of properties can be provided.
154; The supported properties are:
155; - single-buffered
156; - centered
157; - full-screen
158; - no-border
159; - shaped
160; FIXME it crashes when no arg is given after a 'width...
161; is it ok ?
162(define (gl-display:create . properties)
163  (define create-display
164    (foreign-lambda c-pointer "create_gl_window" unsigned-int unsigned-int int int int int))
165 
166  (define (on? prop a b)
167    (if (memv prop properties) a b))
168 
169  (define (on-next? prop default)
170    (let ((rest (memv prop properties)))
171      (if (or (null? rest) (not rest))
172        default
173        (cadr rest))))
174 
175  (create-display
176    (on-next? 'width 100)
177    (on-next? 'height 100)
178    (on? 'single-buffered 0 1)
179    (on? 'full-screen 1 0)
180    (on? 'no-border 1 0)
181    (on? 'shape 1 0)
182    ))
183
184(define gl-display:destroy
185  (foreign-lambda void "destroy_gl_window" c-pointer))
186
187(define gl-display:time
188  (foreign-lambda int "time_milliseconds"))
189
Note: See TracBrowser for help on using the repository browser.