55212af1 |
1 | ;; Common Lisp bindings for GTK+ v2.x |
1b7d3a82 |
2 | ;; Copyright 2000-2006 Espen S. Johnsen <espen@users.sf.net> |
0d07716f |
3 | ;; |
55212af1 |
4 | ;; Permission is hereby granted, free of charge, to any person obtaining |
5 | ;; a copy of this software and associated documentation files (the |
6 | ;; "Software"), to deal in the Software without restriction, including |
7 | ;; without limitation the rights to use, copy, modify, merge, publish, |
8 | ;; distribute, sublicense, and/or sell copies of the Software, and to |
9 | ;; permit persons to whom the Software is furnished to do so, subject to |
10 | ;; the following conditions: |
0d07716f |
11 | ;; |
55212af1 |
12 | ;; The above copyright notice and this permission notice shall be |
13 | ;; included in all copies or substantial portions of the Software. |
0d07716f |
14 | ;; |
55212af1 |
15 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, |
16 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF |
17 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. |
18 | ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY |
19 | ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, |
20 | ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE |
21 | ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. |
22 | |
48acc6ae |
23 | ;; $Id: gdk.lisp,v 1.29 2006/04/26 15:01:05 espen Exp $ |
0d07716f |
24 | |
25 | |
26 | (in-package "GDK") |
27 | |
e295d6df |
28 | ;;; Initialization |
29 | |
30 | (defbinding (gdk-init "gdk_parse_args") () nil |
31 | "Initializes the library without opening the display." |
32 | (nil null) |
33 | (nil null)) |
0d07716f |
34 | |
0d07716f |
35 | |
e295d6df |
36 | |
a05a0e59 |
37 | ;;; Display |
e295d6df |
38 | |
39 | (defbinding %display-open () display |
40 | (display-name (or null string))) |
41 | |
42 | (defun display-open (&optional display-name) |
43 | (let ((display (%display-open display-name))) |
44 | (unless (display-get-default) |
45 | (display-set-default display)) |
46 | display)) |
47 | |
a05a0e59 |
48 | (defbinding %display-get-n-screens () int |
49 | (display display)) |
50 | |
51 | (defbinding %display-get-screen () screen |
52 | (display display) |
53 | (screen-num int)) |
54 | |
55 | (defun display-screens (&optional (display (display-get-default))) |
56 | (loop |
57 | for i from 0 below (%display-get-n-screens display) |
58 | collect (%display-get-screen display i))) |
59 | |
60 | (defbinding display-get-default-screen |
61 | (&optional (display (display-get-default))) screen |
62 | (display display)) |
63 | |
64 | (defbinding display-beep (&optional (display (display-get-default))) nil |
65 | (display display)) |
66 | |
67 | (defbinding display-sync (&optional (display (display-get-default))) nil |
68 | (display display)) |
69 | |
70 | (defbinding display-flush (&optional (display (display-get-default))) nil |
71 | (display display)) |
72 | |
73 | (defbinding display-close (&optional (display (display-get-default))) nil |
74 | (display display)) |
75 | |
76 | (defbinding display-get-event |
77 | (&optional (display (display-get-default))) event |
78 | (display display)) |
79 | |
80 | (defbinding display-peek-event |
81 | (&optional (display (display-get-default))) event |
82 | (display display)) |
83 | |
84 | (defbinding display-put-event |
85 | (event &optional (display (display-get-default))) event |
86 | (display display) |
87 | (event event)) |
88 | |
e295d6df |
89 | (defbinding (display-connection-number "clg_gdk_connection_number") |
90 | (&optional (display (display-get-default))) int |
91 | (display display)) |
92 | |
93 | |
a05a0e59 |
94 | |
95 | ;;; Display manager |
96 | |
97 | (defbinding display-get-default () display) |
98 | |
99 | (defbinding (display-manager "gdk_display_manager_get") () display-manager) |
100 | |
101 | (defbinding (display-set-default "gdk_display_manager_set_default_display") |
102 | (display) nil |
103 | ((display-manager) display-manager) |
104 | (display display)) |
105 | |
106 | |
107 | |
e295d6df |
108 | ;;; Events |
0d07716f |
109 | |
5515cd18 |
110 | (defbinding (events-pending-p "gdk_events_pending") () boolean) |
0d07716f |
111 | |
5515cd18 |
112 | (defbinding event-get () event) |
0d07716f |
113 | |
5515cd18 |
114 | (defbinding event-peek () event) |
0d07716f |
115 | |
5515cd18 |
116 | (defbinding event-get-graphics-expose () event |
0d07716f |
117 | (window window)) |
118 | |
5515cd18 |
119 | (defbinding event-put () event |
0d07716f |
120 | (event event)) |
121 | |
5515cd18 |
122 | ;(defbinding event-handler-set () ...) |
0d07716f |
123 | |
5515cd18 |
124 | (defbinding set-show-events () nil |
0d07716f |
125 | (show-events boolean)) |
126 | |
5515cd18 |
127 | (defbinding get-show-events () boolean) |
0d07716f |
128 | |
0d07716f |
129 | |
a05a0e59 |
130 | ;;; Miscellaneous functions |
0d07716f |
131 | |
a05a0e59 |
132 | (defbinding screen-width () int) |
133 | (defbinding screen-height () int) |
0d07716f |
134 | |
a05a0e59 |
135 | (defbinding screen-width-mm () int) |
136 | (defbinding screen-height-mm () int) |
0d07716f |
137 | |
a05a0e59 |
138 | (defbinding pointer-grab |
139 | (window &key owner-events events confine-to cursor time) grab-status |
0d07716f |
140 | (window window) |
141 | (owner-events boolean) |
a05a0e59 |
142 | (events event-mask) |
0d07716f |
143 | (confine-to (or null window)) |
144 | (cursor (or null cursor)) |
4a098e36 |
145 | ((or time 0) (unsigned 32))) |
0d07716f |
146 | |
a05a0e59 |
147 | (defbinding (pointer-ungrab "gdk_display_pointer_ungrab") |
4a098e36 |
148 | (&optional time (display (display-get-default))) nil |
a05a0e59 |
149 | (display display) |
4a098e36 |
150 | ((or time 0) (unsigned 32))) |
0d07716f |
151 | |
a05a0e59 |
152 | (defbinding (pointer-is-grabbed-p "gdk_display_pointer_is_grabbed") |
1b7d3a82 |
153 | (&optional (display (display-get-default))) boolean |
154 | (display display)) |
a05a0e59 |
155 | |
156 | (defbinding keyboard-grab (window &key owner-events time) grab-status |
0d07716f |
157 | (window window) |
158 | (owner-events boolean) |
4a098e36 |
159 | ((or time 0) (unsigned 32))) |
0d07716f |
160 | |
a05a0e59 |
161 | (defbinding (keyboard-ungrab "gdk_display_keyboard_ungrab") |
4a098e36 |
162 | (&optional time (display (display-get-default))) nil |
a05a0e59 |
163 | (display display) |
4a098e36 |
164 | ((or time 0) (unsigned 32))) |
0d07716f |
165 | |
0d07716f |
166 | |
0d07716f |
167 | |
596c3078 |
168 | (defbinding atom-intern (atom-name &optional only-if-exists) atom |
169 | ((string atom-name) string) |
170 | (only-if-exists boolean)) |
171 | |
172 | (defbinding atom-name () string |
173 | (atom atom)) |
174 | |
0d07716f |
175 | |
176 | |
177 | ;;; Visuals |
178 | |
5515cd18 |
179 | (defbinding visual-get-best-depth () int) |
0d07716f |
180 | |
5515cd18 |
181 | (defbinding visual-get-best-type () visual-type) |
0d07716f |
182 | |
5515cd18 |
183 | (defbinding visual-get-system () visual) |
0d07716f |
184 | |
185 | |
5515cd18 |
186 | (defbinding (%visual-get-best-with-nothing "gdk_visual_get_best") () visual) |
0d07716f |
187 | |
5515cd18 |
188 | (defbinding %visual-get-best-with-depth () visual |
0d07716f |
189 | (depth int)) |
190 | |
5515cd18 |
191 | (defbinding %visual-get-best-with-type () visual |
0d07716f |
192 | (type visual-type)) |
193 | |
5515cd18 |
194 | (defbinding %visual-get-best-with-both () visual |
0d07716f |
195 | (depth int) |
196 | (type visual-type)) |
197 | |
198 | (defun visual-get-best (&key depth type) |
199 | (cond |
200 | ((and depth type) (%visual-get-best-with-both depth type)) |
201 | (depth (%visual-get-best-with-depth depth)) |
202 | (type (%visual-get-best-with-type type)) |
203 | (t (%visual-get-best-with-nothing)))) |
204 | |
5515cd18 |
205 | ;(defbinding query-depths ..) |
0d07716f |
206 | |
5515cd18 |
207 | ;(defbinding query-visual-types ..) |
0d07716f |
208 | |
5515cd18 |
209 | (defbinding list-visuals () (glist visual)) |
0d07716f |
210 | |
211 | |
212 | ;;; Windows |
213 | |
5515cd18 |
214 | (defbinding window-destroy () nil |
0d07716f |
215 | (window window)) |
216 | |
217 | |
64780167 |
218 | (defbinding window-at-pointer () window |
219 | (x int :out) |
220 | (y int :out)) |
0d07716f |
221 | |
5515cd18 |
222 | (defbinding window-show () nil |
0d07716f |
223 | (window window)) |
224 | |
64780167 |
225 | (defbinding window-show-unraised () nil |
226 | (window window)) |
227 | |
5515cd18 |
228 | (defbinding window-hide () nil |
0d07716f |
229 | (window window)) |
230 | |
64780167 |
231 | (defbinding window-is-visible-p () boolean |
232 | (window window)) |
233 | |
234 | (defbinding window-is-viewable-p () boolean |
235 | (window window)) |
236 | |
5515cd18 |
237 | (defbinding window-withdraw () nil |
0d07716f |
238 | (window window)) |
239 | |
64780167 |
240 | (defbinding window-iconify () nil |
241 | (window window)) |
242 | |
243 | (defbinding window-deiconify () nil |
244 | (window window)) |
245 | |
246 | (defbinding window-stick () nil |
247 | (window window)) |
248 | |
249 | (defbinding window-unstick () nil |
250 | (window window)) |
251 | |
252 | (defbinding window-maximize () nil |
253 | (window window)) |
254 | |
255 | (defbinding window-unmaximize () nil |
256 | (window window)) |
257 | |
258 | (defbinding window-fullscreen () nil |
259 | (window window)) |
260 | |
261 | (defbinding window-unfullscreen () nil |
262 | (window window)) |
263 | |
264 | (defbinding window-set-keep-above () nil |
265 | (window window) |
266 | (setting boolean)) |
267 | |
268 | (defbinding window-set-keep-below () nil |
269 | (window window) |
270 | (setting boolean)) |
271 | |
5515cd18 |
272 | (defbinding window-move () nil |
0d07716f |
273 | (window window) |
274 | (x int) |
275 | (y int)) |
276 | |
5515cd18 |
277 | (defbinding window-resize () nil |
0d07716f |
278 | (window window) |
279 | (width int) |
280 | (height int)) |
281 | |
5515cd18 |
282 | (defbinding window-move-resize () nil |
0d07716f |
283 | (window window) |
284 | (x int) |
285 | (y int) |
286 | (width int) |
287 | (height int)) |
288 | |
64780167 |
289 | (defbinding window-scroll () nil |
290 | (window window) |
291 | (dx int) |
292 | (dy int)) |
293 | |
5515cd18 |
294 | (defbinding window-reparent () nil |
0d07716f |
295 | (window window) |
296 | (new-parent window) |
297 | (x int) |
298 | (y int)) |
299 | |
5515cd18 |
300 | (defbinding window-clear () nil |
0d07716f |
301 | (window window)) |
302 | |
64780167 |
303 | (defbinding %window-clear-area () nil |
0d07716f |
304 | (window window) |
305 | (x int) (y int) (width int) (height int)) |
306 | |
64780167 |
307 | (defbinding %window-clear-area-e () nil |
0d07716f |
308 | (window window) |
309 | (x int) (y int) (width int) (height int)) |
310 | |
311 | (defun window-clear-area (window x y width height &optional expose) |
312 | (if expose |
64780167 |
313 | (%window-clear-area-e window x y width height) |
314 | (%window-clear-area window x y width height))) |
0d07716f |
315 | |
5515cd18 |
316 | (defbinding window-raise () nil |
0d07716f |
317 | (window window)) |
318 | |
5515cd18 |
319 | (defbinding window-lower () nil |
0d07716f |
320 | (window window)) |
321 | |
64780167 |
322 | (defbinding window-focus () nil |
323 | (window window) |
324 | (timestamp unsigned-int)) |
325 | |
326 | (defbinding window-register-dnd () nil |
327 | (window window)) |
328 | |
329 | (defbinding window-begin-resize-drag () nil |
330 | (window window) |
331 | (edge window-edge) |
332 | (button int) |
333 | (root-x int) |
334 | (root-y int) |
335 | (timestamp unsigned-int)) |
336 | |
337 | (defbinding window-begin-move-drag () nil |
338 | (window window) |
339 | (button int) |
340 | (root-x int) |
341 | (root-y int) |
342 | (timestamp unsigned-int)) |
343 | |
1b7d3a82 |
344 | ;; |
64780167 |
345 | |
346 | (defbinding window-set-user-data () nil |
347 | (window window) |
348 | (user-data pointer)) |
0d07716f |
349 | |
5515cd18 |
350 | (defbinding window-set-override-redirect () nil |
0d07716f |
351 | (window window) |
352 | (override-redirect boolean)) |
353 | |
5515cd18 |
354 | ; (defbinding window-add-filter () nil |
0d07716f |
355 | |
5515cd18 |
356 | ; (defbinding window-remove-filter () nil |
0d07716f |
357 | |
5515cd18 |
358 | (defbinding window-shape-combine-mask () nil |
0d07716f |
359 | (window window) |
360 | (shape-mask bitmap) |
361 | (offset-x int) |
362 | (offset-y int)) |
363 | |
5515cd18 |
364 | (defbinding window-set-child-shapes () nil |
0d07716f |
365 | (window window)) |
366 | |
5515cd18 |
367 | (defbinding window-merge-child-shapes () nil |
0d07716f |
368 | (window window)) |
369 | |
0d07716f |
370 | |
5515cd18 |
371 | (defbinding window-set-static-gravities () boolean |
0d07716f |
372 | (window window) |
373 | (use-static boolean)) |
374 | |
5515cd18 |
375 | ; (defbinding add-client-message-filter ... |
0d07716f |
376 | |
5515cd18 |
377 | (defbinding window-set-cursor () nil |
0d07716f |
378 | (window window) |
64780167 |
379 | (cursor (or null cursor))) |
0d07716f |
380 | |
5515cd18 |
381 | (defbinding window-get-pointer () window |
0d07716f |
382 | (window window) |
383 | (x int :out) |
384 | (y int :out) |
385 | (mask modifier-type :out)) |
386 | |
64780167 |
387 | (defbinding %window-get-toplevels () (glist window)) |
388 | |
389 | (defun window-get-toplevels (&optional screen) |
390 | (if screen |
391 | (error "Not implemented") |
392 | (%window-get-toplevels))) |
393 | |
402183fc |
394 | (defbinding %get-default-root-window () window) |
0d07716f |
395 | |
67824820 |
396 | (defun get-root-window (&optional display) |
402183fc |
397 | (if display |
398 | (error "Not implemented") |
399 | (%get-default-root-window))) |
0d07716f |
400 | |
401 | |
64780167 |
402 | |
403 | ;;; Drag and Drop |
404 | |
405 | ;; Destination side |
406 | |
407 | (defbinding drag-status () nil |
408 | (context drag-context) |
409 | (action drag-action) |
410 | (time (unsigned 32))) |
411 | |
412 | |
413 | |
414 | |
415 | |
416 | |
0d07716f |
417 | ;; |
418 | |
5515cd18 |
419 | (defbinding rgb-init () nil) |
0d07716f |
420 | |
421 | |
422 | |
423 | |
424 | ;;; Cursor |
425 | |
6091b3e8 |
426 | (defmethod allocate-foreign ((cursor cursor) &key source mask fg bg |
adc20f66 |
427 | (x 0) (y 0) (display (display-get-default))) |
6091b3e8 |
428 | (etypecase source |
429 | (keyword (%cursor-new-for-display display source)) |
430 | (pixbuf (%cursor-new-from-pixbuf display source x y)) |
431 | (pixmap (%cursor-new-from-pixmap source mask |
432 | (or fg (ensure-color #(0.0 0.0 0.0))) |
433 | (or bg (ensure-color #(1.0 1.0 1.0))) x y)) |
434 | (pathname (%cursor-new-from-pixbuf display (pixbuf-load source) x y)))) |
435 | |
436 | (defun ensure-cursor (cursor &rest args) |
437 | (if (typep cursor 'cursor) |
438 | cursor |
48acc6ae |
439 | (apply #'make-instance 'cursor :source cursor args))) |
64780167 |
440 | |
441 | (defbinding %cursor-new-for-display () pointer |
442 | (display display) |
0d07716f |
443 | (cursor-type cursor-type)) |
444 | |
64780167 |
445 | (defbinding %cursor-new-from-pixmap () pointer |
0d07716f |
446 | (source pixmap) |
447 | (mask bitmap) |
448 | (foreground color) |
449 | (background color) |
450 | (x int) (y int)) |
451 | |
64780167 |
452 | (defbinding %cursor-new-from-pixbuf () pointer |
453 | (display display) |
454 | (pixbuf pixbuf) |
455 | (x int) (y int)) |
456 | |
5515cd18 |
457 | (defbinding %cursor-ref () pointer |
6baf860c |
458 | (location pointer)) |
0d07716f |
459 | |
5515cd18 |
460 | (defbinding %cursor-unref () nil |
6baf860c |
461 | (location pointer)) |
462 | |
0d07716f |
463 | |
0d07716f |
464 | ;;; Pixmaps |
402183fc |
465 | |
5515cd18 |
466 | (defbinding pixmap-new (width height depth &key window) pixmap |
0d07716f |
467 | (width int) |
468 | (height int) |
469 | (depth int) |
470 | (window (or null window))) |
471 | |
5515cd18 |
472 | (defbinding %pixmap-colormap-create-from-xpm () pixmap |
0d07716f |
473 | (window (or null window)) |
474 | (colormap (or null colormap)) |
475 | (mask bitmap :out) |
476 | (color (or null color)) |
1b7d3a82 |
477 | (filename pathname)) |
0d07716f |
478 | |
5515cd18 |
479 | (defbinding %pixmap-colormap-create-from-xpm-d () pixmap |
0d07716f |
480 | (window (or null window)) |
481 | (colormap (or null colormap)) |
482 | (mask bitmap :out) |
483 | (color (or null color)) |
b53669e6 |
484 | (data (vector string))) |
0d07716f |
485 | |
5a66b42b |
486 | (defun pixmap-create (source &key color window colormap) |
487 | (let ((window |
488 | (if (not (or window colormap)) |
489 | (get-root-window) |
490 | window))) |
491 | (multiple-value-bind (pixmap mask) |
b53669e6 |
492 | (etypecase source |
5a66b42b |
493 | ((or string pathname) |
1b7d3a82 |
494 | (%pixmap-colormap-create-from-xpm window colormap color source)) |
b53669e6 |
495 | ((vector string) |
496 | (%pixmap-colormap-create-from-xpm-d window colormap color source))) |
5a66b42b |
497 | (values pixmap mask)))) |
402183fc |
498 | |
0d07716f |
499 | |
500 | |
501 | ;;; Color |
502 | |
2e10ba8b |
503 | (defbinding %color-copy () pointer |
504 | (location pointer)) |
505 | |
506 | (defmethod allocate-foreign ((color color) &rest initargs) |
507 | (declare (ignore color initargs)) |
508 | ;; Color structs are allocated as memory chunks by gdk, and since |
509 | ;; there is no gdk_color_new we have to use this hack to get a new |
510 | ;; color chunk |
1b7d3a82 |
511 | (with-memory (location #.(foreign-size (find-class 'color))) |
2e10ba8b |
512 | (%color-copy location))) |
513 | |
0d07716f |
514 | (defun %scale-value (value) |
515 | (etypecase value |
516 | (integer value) |
517 | (float (truncate (* value 65535))))) |
518 | |
1b7d3a82 |
519 | (defmethod initialize-instance ((color color) &key (red 0.0) (green 0.0) (blue 0.0)) |
0d07716f |
520 | (call-next-method) |
521 | (with-slots ((%red red) (%green green) (%blue blue)) color |
522 | (setf |
216bc8c3 |
523 | %red (%scale-value red) |
524 | %green (%scale-value green) |
525 | %blue (%scale-value blue)))) |
0d07716f |
526 | |
f3f8586a |
527 | (defbinding %color-parse () boolean |
2e10ba8b |
528 | (spec string) |
1b7d3a82 |
529 | (color color :in/return)) |
2e10ba8b |
530 | |
f3f8586a |
531 | (defun color-parse (spec &optional (color (make-instance 'color))) |
532 | (multiple-value-bind (succeeded-p color) (%color-parse spec color) |
533 | (if succeeded-p |
534 | color |
535 | (error "Parsing color specification ~S failed." spec)))) |
536 | |
0d07716f |
537 | (defun ensure-color (color) |
538 | (etypecase color |
539 | (null nil) |
540 | (color color) |
f3f8586a |
541 | (string (color-parse color)) |
216bc8c3 |
542 | (vector |
2e10ba8b |
543 | (make-instance 'color |
f3f8586a |
544 | :red (svref color 0) :green (svref color 1) :blue (svref color 2))))) |
545 | |
0d07716f |
546 | |
547 | |
1b7d3a82 |
548 | ;;; Drawable -- all the draw- functions are dprecated and will be |
549 | ;;; removed, use cairo for drawing instead. |
64780167 |
550 | |
551 | (defbinding drawable-get-size () nil |
552 | (drawable drawable) |
553 | (width int :out) |
554 | (height int :out)) |
555 | |
556 | (defbinding (drawable-width "gdk_drawable_get_size") () nil |
557 | (drawable drawable) |
558 | (width int :out) |
559 | (nil null)) |
560 | |
561 | (defbinding (drawable-height "gdk_drawable_get_size") () nil |
562 | (drawable drawable) |
563 | (nil null) |
564 | (height int :out)) |
565 | |
566 | ;; (defbinding drawable-get-clip-region () region |
567 | ;; (drawable drawable)) |
568 | |
569 | ;; (defbinding drawable-get-visible-region () region |
570 | ;; (drawable drawable)) |
571 | |
572 | (defbinding draw-point () nil |
573 | (drawable drawable) (gc gc) |
574 | (x int) (y int)) |
575 | |
576 | (defbinding %draw-points () nil |
577 | (drawable drawable) (gc gc) |
578 | (points pointer) |
579 | (n-points int)) |
580 | |
64780167 |
581 | (defbinding draw-line () nil |
582 | (drawable drawable) (gc gc) |
583 | (x1 int) (y1 int) |
584 | (x2 int) (y2 int)) |
585 | |
64780167 |
586 | (defbinding draw-pixbuf |
587 | (drawable gc pixbuf src-x src-y dest-x dest-y &optional |
588 | width height (dither :none) (x-dither 0) (y-dither 0)) nil |
589 | (drawable drawable) (gc (or null gc)) |
590 | (pixbuf pixbuf) |
591 | (src-x int) (src-y int) |
592 | (dest-x int) (dest-y int) |
593 | ((or width -1) int) ((or height -1) int) |
594 | (dither rgb-dither) |
595 | (x-dither int) (y-dither int)) |
596 | |
5515cd18 |
597 | (defbinding draw-rectangle () nil |
64780167 |
598 | (drawable drawable) (gc gc) |
599 | (filled boolean) |
600 | (x int) (y int) |
601 | (width int) (height int)) |
602 | |
603 | (defbinding draw-arc () nil |
604 | (drawable drawable) (gc gc) |
605 | (filled boolean) |
606 | (x int) (y int) |
607 | (width int) (height int) |
608 | (angle1 int) (angle2 int)) |
609 | |
64780167 |
610 | (defbinding %draw-layout () nil |
611 | (drawable drawable) (gc gc) |
612 | (font pango:font) |
613 | (x int) (y int) |
614 | (layout pango:layout)) |
615 | |
616 | (defbinding %draw-layout-with-colors () nil |
617 | (drawable drawable) (gc gc) |
618 | (font pango:font) |
619 | (x int) (y int) |
620 | (layout pango:layout) |
621 | (foreground (or null color)) |
622 | (background (or null color))) |
623 | |
624 | (defun draw-layout (drawable gc font x y layout &optional foreground background) |
625 | (if (or foreground background) |
626 | (%draw-layout-with-colors drawable gc font x y layout foreground background) |
627 | (%draw-layout drawable gc font x y layout))) |
628 | |
629 | (defbinding draw-drawable |
630 | (drawable gc src src-x src-y dest-x dest-y &optional width height) nil |
631 | (drawable drawable) (gc gc) |
632 | (src drawable) |
633 | (src-x int) (src-y int) |
634 | (dest-x int) (dest-y int) |
635 | ((or width -1) int) ((or height -1) int)) |
636 | |
637 | (defbinding draw-image |
638 | (drawable gc image src-x src-y dest-x dest-y &optional width height) nil |
639 | (drawable drawable) (gc gc) |
640 | (image image) |
641 | (src-x int) (src-y int) |
642 | (dest-x int) (dest-y int) |
643 | ((or width -1) int) ((or height -1) int)) |
644 | |
645 | (defbinding drawable-get-image () image |
646 | (drawable drawable) |
647 | (x int) (y int) |
648 | (width int) (height int)) |
649 | |
650 | (defbinding drawable-copy-to-image |
651 | (drawable src-x src-y width height &optional image dest-x dest-y) image |
652 | (drawable drawable) |
653 | (image (or null image)) |
654 | (src-x int) (src-y int) |
655 | ((if image dest-x 0) int) |
656 | ((if image dest-y 0) int) |
657 | (width int) (height int)) |
0d07716f |
658 | |
659 | |
660 | ;;; Key values |
661 | |
5515cd18 |
662 | (defbinding keyval-name () string |
0d07716f |
663 | (keyval unsigned-int)) |
664 | |
56b0eab3 |
665 | (defbinding %keyval-from-name () unsigned-int |
0d07716f |
666 | (name string)) |
667 | |
56b0eab3 |
668 | (defun keyval-from-name (name) |
669 | "Returns the keysym value for the given key name or NIL if it is not a valid name." |
670 | (let ((keyval (%keyval-from-name name))) |
671 | (unless (zerop keyval) |
672 | keyval))) |
673 | |
5515cd18 |
674 | (defbinding keyval-to-upper () unsigned-int |
0d07716f |
675 | (keyval unsigned-int)) |
676 | |
596c3078 |
677 | (defbinding keyval-to-lower () unsigned-int |
0d07716f |
678 | (keyval unsigned-int)) |
679 | |
5515cd18 |
680 | (defbinding (keyval-is-upper-p "gdk_keyval_is_upper") () boolean |
0d07716f |
681 | (keyval unsigned-int)) |
682 | |
5515cd18 |
683 | (defbinding (keyval-is-lower-p "gdk_keyval_is_lower") () boolean |
0d07716f |
684 | (keyval unsigned-int)) |
685 | |
78dc8487 |
686 | ;;; Cairo interaction |
687 | |
1b7d3a82 |
688 | #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") |
78dc8487 |
689 | (progn |
690 | (defbinding cairo-create () cairo:context |
691 | (drawable drawable)) |
692 | |
10ec8e36 |
693 | (defmacro with-cairo-context ((cr drawable) &body body) |
694 | `(let ((,cr (cairo-create ,drawable))) |
695 | (unwind-protect |
696 | (progn ,@body) |
1b7d3a82 |
697 | (invalidate-instance ,cr t)))) |
10ec8e36 |
698 | |
78dc8487 |
699 | (defbinding cairo-set-source-color () nil |
700 | (cr cairo:context) |
701 | (color color)) |
702 | |
703 | (defbinding cairo-set-source-pixbuf () nil |
704 | (cr cairo:context) |
705 | (pixbuf pixbuf) |
706 | (x double-float) |
707 | (y double-float)) |
708 | |
709 | (defbinding cairo-rectangle () nil |
710 | (cr cairo:context) |
711 | (rectangle rectangle)) |
712 | |
713 | ;; (defbinding cairo-region () nil |
714 | ;; (cr cairo:context) |
715 | ;; (region region)) |
716 | ) |
00a8d921 |
717 | |
718 | |
1b7d3a82 |
719 | |
00a8d921 |
720 | ;;; Multi-threading support |
721 | |
722 | #+sbcl |
723 | (progn |
724 | (defvar *global-lock* (sb-thread:make-mutex :name "global GDK lock")) |
725 | (let ((recursive-level 0)) |
726 | (defun threads-enter () |
727 | (if (eq (sb-thread:mutex-value *global-lock*) sb-thread:*current-thread*) |
728 | (incf recursive-level) |
729 | (sb-thread:get-mutex *global-lock*))) |
730 | |
731 | (defun threads-leave (&optional flush-p) |
732 | (cond |
733 | ((zerop recursive-level) |
734 | (when flush-p |
735 | (display-flush)) |
736 | (sb-thread:release-mutex *global-lock*)) |
737 | (t (decf recursive-level))))) |
738 | |
739 | (define-callback %enter-fn nil () |
740 | (threads-enter)) |
741 | |
742 | (define-callback %leave-fn nil () |
743 | (threads-leave)) |
744 | |
745 | (defbinding threads-set-lock-functions (&optional) nil |
746 | (%enter-fn callback) |
747 | (%leave-fn callback)) |
748 | |
749 | (defmacro with-global-lock (&body body) |
750 | `(progn |
751 | (threads-enter) |
752 | (unwind-protect |
1b7d3a82 |
753 | ,@body |
00a8d921 |
754 | (threads-leave t))))) |