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

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

initial commit

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