112ac1d3 |
1 | ;; Common Lisp bindings for GTK+ v2.x |
90c5d56b |
2 | ;; Copyright 2000-2006 Espen S. Johnsen <espen@users.sf.net> |
560af5c5 |
3 | ;; |
112ac1d3 |
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: |
560af5c5 |
11 | ;; |
112ac1d3 |
12 | ;; The above copyright notice and this permission notice shall be |
13 | ;; included in all copies or substantial portions of the Software. |
560af5c5 |
14 | ;; |
112ac1d3 |
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 | |
358bbd90 |
23 | ;; $Id: gdk.lisp,v 1.30 2006-06-07 13:17:24 espen Exp $ |
560af5c5 |
24 | |
25 | |
26 | (in-package "GDK") |
27 | |
13b24566 |
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)) |
560af5c5 |
34 | |
560af5c5 |
35 | |
13b24566 |
36 | |
a02fc41f |
37 | ;;; Display |
13b24566 |
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 | |
a02fc41f |
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 | |
13b24566 |
89 | (defbinding (display-connection-number "clg_gdk_connection_number") |
90 | (&optional (display (display-get-default))) int |
91 | (display display)) |
92 | |
93 | |
a02fc41f |
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 | |
13b24566 |
108 | ;;; Events |
560af5c5 |
109 | |
8bb8ead0 |
110 | (defbinding (events-pending-p "gdk_events_pending") () boolean) |
560af5c5 |
111 | |
8bb8ead0 |
112 | (defbinding event-get () event) |
560af5c5 |
113 | |
8bb8ead0 |
114 | (defbinding event-peek () event) |
560af5c5 |
115 | |
8bb8ead0 |
116 | (defbinding event-get-graphics-expose () event |
560af5c5 |
117 | (window window)) |
118 | |
8bb8ead0 |
119 | (defbinding event-put () event |
560af5c5 |
120 | (event event)) |
121 | |
8bb8ead0 |
122 | ;(defbinding event-handler-set () ...) |
560af5c5 |
123 | |
8bb8ead0 |
124 | (defbinding set-show-events () nil |
560af5c5 |
125 | (show-events boolean)) |
126 | |
8bb8ead0 |
127 | (defbinding get-show-events () boolean) |
560af5c5 |
128 | |
560af5c5 |
129 | |
a02fc41f |
130 | ;;; Miscellaneous functions |
560af5c5 |
131 | |
a02fc41f |
132 | (defbinding screen-width () int) |
133 | (defbinding screen-height () int) |
560af5c5 |
134 | |
a02fc41f |
135 | (defbinding screen-width-mm () int) |
136 | (defbinding screen-height-mm () int) |
560af5c5 |
137 | |
a02fc41f |
138 | (defbinding pointer-grab |
139 | (window &key owner-events events confine-to cursor time) grab-status |
560af5c5 |
140 | (window window) |
141 | (owner-events boolean) |
a02fc41f |
142 | (events event-mask) |
560af5c5 |
143 | (confine-to (or null window)) |
144 | (cursor (or null cursor)) |
580820d8 |
145 | ((or time 0) (unsigned 32))) |
560af5c5 |
146 | |
a02fc41f |
147 | (defbinding (pointer-ungrab "gdk_display_pointer_ungrab") |
580820d8 |
148 | (&optional time (display (display-get-default))) nil |
a02fc41f |
149 | (display display) |
580820d8 |
150 | ((or time 0) (unsigned 32))) |
560af5c5 |
151 | |
a02fc41f |
152 | (defbinding (pointer-is-grabbed-p "gdk_display_pointer_is_grabbed") |
90c5d56b |
153 | (&optional (display (display-get-default))) boolean |
154 | (display display)) |
a02fc41f |
155 | |
156 | (defbinding keyboard-grab (window &key owner-events time) grab-status |
560af5c5 |
157 | (window window) |
158 | (owner-events boolean) |
580820d8 |
159 | ((or time 0) (unsigned 32))) |
560af5c5 |
160 | |
a02fc41f |
161 | (defbinding (keyboard-ungrab "gdk_display_keyboard_ungrab") |
580820d8 |
162 | (&optional time (display (display-get-default))) nil |
a02fc41f |
163 | (display display) |
580820d8 |
164 | ((or time 0) (unsigned 32))) |
560af5c5 |
165 | |
560af5c5 |
166 | |
560af5c5 |
167 | |
628fd576 |
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 | |
560af5c5 |
175 | |
176 | |
177 | ;;; Visuals |
178 | |
8bb8ead0 |
179 | (defbinding visual-get-best-depth () int) |
560af5c5 |
180 | |
8bb8ead0 |
181 | (defbinding visual-get-best-type () visual-type) |
560af5c5 |
182 | |
8bb8ead0 |
183 | (defbinding visual-get-system () visual) |
560af5c5 |
184 | |
185 | |
8bb8ead0 |
186 | (defbinding (%visual-get-best-with-nothing "gdk_visual_get_best") () visual) |
560af5c5 |
187 | |
8bb8ead0 |
188 | (defbinding %visual-get-best-with-depth () visual |
560af5c5 |
189 | (depth int)) |
190 | |
8bb8ead0 |
191 | (defbinding %visual-get-best-with-type () visual |
560af5c5 |
192 | (type visual-type)) |
193 | |
8bb8ead0 |
194 | (defbinding %visual-get-best-with-both () visual |
560af5c5 |
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 | |
8bb8ead0 |
205 | ;(defbinding query-depths ..) |
560af5c5 |
206 | |
8bb8ead0 |
207 | ;(defbinding query-visual-types ..) |
560af5c5 |
208 | |
8bb8ead0 |
209 | (defbinding list-visuals () (glist visual)) |
560af5c5 |
210 | |
211 | |
212 | ;;; Windows |
213 | |
8bb8ead0 |
214 | (defbinding window-destroy () nil |
560af5c5 |
215 | (window window)) |
216 | |
217 | |
8f30d7da |
218 | (defbinding window-at-pointer () window |
219 | (x int :out) |
220 | (y int :out)) |
560af5c5 |
221 | |
8bb8ead0 |
222 | (defbinding window-show () nil |
560af5c5 |
223 | (window window)) |
224 | |
8f30d7da |
225 | (defbinding window-show-unraised () nil |
226 | (window window)) |
227 | |
8bb8ead0 |
228 | (defbinding window-hide () nil |
560af5c5 |
229 | (window window)) |
230 | |
8f30d7da |
231 | (defbinding window-is-visible-p () boolean |
232 | (window window)) |
233 | |
234 | (defbinding window-is-viewable-p () boolean |
235 | (window window)) |
236 | |
8bb8ead0 |
237 | (defbinding window-withdraw () nil |
560af5c5 |
238 | (window window)) |
239 | |
8f30d7da |
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 | |
8bb8ead0 |
272 | (defbinding window-move () nil |
560af5c5 |
273 | (window window) |
274 | (x int) |
275 | (y int)) |
276 | |
8bb8ead0 |
277 | (defbinding window-resize () nil |
560af5c5 |
278 | (window window) |
279 | (width int) |
280 | (height int)) |
281 | |
8bb8ead0 |
282 | (defbinding window-move-resize () nil |
560af5c5 |
283 | (window window) |
284 | (x int) |
285 | (y int) |
286 | (width int) |
287 | (height int)) |
288 | |
8f30d7da |
289 | (defbinding window-scroll () nil |
290 | (window window) |
291 | (dx int) |
292 | (dy int)) |
293 | |
8bb8ead0 |
294 | (defbinding window-reparent () nil |
560af5c5 |
295 | (window window) |
296 | (new-parent window) |
297 | (x int) |
298 | (y int)) |
299 | |
8bb8ead0 |
300 | (defbinding window-clear () nil |
560af5c5 |
301 | (window window)) |
302 | |
8f30d7da |
303 | (defbinding %window-clear-area () nil |
560af5c5 |
304 | (window window) |
305 | (x int) (y int) (width int) (height int)) |
306 | |
8f30d7da |
307 | (defbinding %window-clear-area-e () nil |
560af5c5 |
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 |
8f30d7da |
313 | (%window-clear-area-e window x y width height) |
314 | (%window-clear-area window x y width height))) |
560af5c5 |
315 | |
8bb8ead0 |
316 | (defbinding window-raise () nil |
560af5c5 |
317 | (window window)) |
318 | |
8bb8ead0 |
319 | (defbinding window-lower () nil |
560af5c5 |
320 | (window window)) |
321 | |
8f30d7da |
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 | |
90c5d56b |
344 | ;; |
8f30d7da |
345 | |
346 | (defbinding window-set-user-data () nil |
347 | (window window) |
348 | (user-data pointer)) |
560af5c5 |
349 | |
8bb8ead0 |
350 | (defbinding window-set-override-redirect () nil |
560af5c5 |
351 | (window window) |
352 | (override-redirect boolean)) |
353 | |
8bb8ead0 |
354 | ; (defbinding window-add-filter () nil |
560af5c5 |
355 | |
8bb8ead0 |
356 | ; (defbinding window-remove-filter () nil |
560af5c5 |
357 | |
8bb8ead0 |
358 | (defbinding window-shape-combine-mask () nil |
560af5c5 |
359 | (window window) |
360 | (shape-mask bitmap) |
361 | (offset-x int) |
362 | (offset-y int)) |
363 | |
8bb8ead0 |
364 | (defbinding window-set-child-shapes () nil |
560af5c5 |
365 | (window window)) |
366 | |
8bb8ead0 |
367 | (defbinding window-merge-child-shapes () nil |
560af5c5 |
368 | (window window)) |
369 | |
560af5c5 |
370 | |
8bb8ead0 |
371 | (defbinding window-set-static-gravities () boolean |
560af5c5 |
372 | (window window) |
373 | (use-static boolean)) |
374 | |
8bb8ead0 |
375 | ; (defbinding add-client-message-filter ... |
560af5c5 |
376 | |
8bb8ead0 |
377 | (defbinding window-set-cursor () nil |
560af5c5 |
378 | (window window) |
8f30d7da |
379 | (cursor (or null cursor))) |
560af5c5 |
380 | |
8bb8ead0 |
381 | (defbinding window-get-pointer () window |
560af5c5 |
382 | (window window) |
383 | (x int :out) |
384 | (y int :out) |
385 | (mask modifier-type :out)) |
386 | |
8f30d7da |
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 | |
bc9997e8 |
394 | (defbinding %get-default-root-window () window) |
560af5c5 |
395 | |
3d5e4e39 |
396 | (defun get-root-window (&optional display) |
bc9997e8 |
397 | (if display |
398 | (error "Not implemented") |
399 | (%get-default-root-window))) |
560af5c5 |
400 | |
401 | |
8f30d7da |
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 | |
560af5c5 |
417 | ;; |
418 | |
8bb8ead0 |
419 | (defbinding rgb-init () nil) |
560af5c5 |
420 | |
421 | |
422 | |
423 | |
424 | ;;; Cursor |
425 | |
25d755bb |
426 | (defmethod allocate-foreign ((cursor cursor) &key source mask fg bg |
8bc1cf79 |
427 | (x 0) (y 0) (display (display-get-default))) |
25d755bb |
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 |
bc21ee32 |
439 | (apply #'make-instance 'cursor :source cursor args))) |
8f30d7da |
440 | |
441 | (defbinding %cursor-new-for-display () pointer |
442 | (display display) |
560af5c5 |
443 | (cursor-type cursor-type)) |
444 | |
8f30d7da |
445 | (defbinding %cursor-new-from-pixmap () pointer |
560af5c5 |
446 | (source pixmap) |
447 | (mask bitmap) |
448 | (foreground color) |
449 | (background color) |
450 | (x int) (y int)) |
451 | |
8f30d7da |
452 | (defbinding %cursor-new-from-pixbuf () pointer |
453 | (display display) |
454 | (pixbuf pixbuf) |
455 | (x int) (y int)) |
456 | |
8bb8ead0 |
457 | (defbinding %cursor-ref () pointer |
9adccb27 |
458 | (location pointer)) |
560af5c5 |
459 | |
8bb8ead0 |
460 | (defbinding %cursor-unref () nil |
9adccb27 |
461 | (location pointer)) |
462 | |
560af5c5 |
463 | |
560af5c5 |
464 | ;;; Pixmaps |
bc9997e8 |
465 | |
358bbd90 |
466 | (defbinding %pixmap-new () pointer |
467 | (window (or null window)) |
560af5c5 |
468 | (width int) |
469 | (height int) |
358bbd90 |
470 | (depth int)) |
471 | |
472 | (defmethod allocate-foreign ((pximap pixmap) &key width height depth window) |
473 | (%pixmap-new window width height depth)) |
474 | |
475 | (defun pixmap-new (width height depth &key window) |
476 | (warn "PIXMAP-NEW is deprecated, use (make-instance 'pixmap ...) instead") |
477 | (make-instance 'pixmap :width width :height height :depth depth :window window)) |
478 | |
8bb8ead0 |
479 | (defbinding %pixmap-colormap-create-from-xpm () pixmap |
560af5c5 |
480 | (window (or null window)) |
481 | (colormap (or null colormap)) |
482 | (mask bitmap :out) |
483 | (color (or null color)) |
90c5d56b |
484 | (filename pathname)) |
560af5c5 |
485 | |
8bb8ead0 |
486 | (defbinding %pixmap-colormap-create-from-xpm-d () pixmap |
560af5c5 |
487 | (window (or null window)) |
488 | (colormap (or null colormap)) |
489 | (mask bitmap :out) |
490 | (color (or null color)) |
2a189a9e |
491 | (data (vector string))) |
560af5c5 |
492 | |
358bbd90 |
493 | ;; Deprecated, use pixbufs instead |
bb110f5f |
494 | (defun pixmap-create (source &key color window colormap) |
495 | (let ((window |
496 | (if (not (or window colormap)) |
497 | (get-root-window) |
498 | window))) |
499 | (multiple-value-bind (pixmap mask) |
2a189a9e |
500 | (etypecase source |
bb110f5f |
501 | ((or string pathname) |
90c5d56b |
502 | (%pixmap-colormap-create-from-xpm window colormap color source)) |
2a189a9e |
503 | ((vector string) |
504 | (%pixmap-colormap-create-from-xpm-d window colormap color source))) |
bb110f5f |
505 | (values pixmap mask)))) |
bc9997e8 |
506 | |
560af5c5 |
507 | |
560af5c5 |
508 | ;;; Color |
509 | |
358bbd90 |
510 | (defbinding colormap-get-system () colormap) |
511 | |
5e12e92b |
512 | (defbinding %color-copy () pointer |
513 | (location pointer)) |
514 | |
515 | (defmethod allocate-foreign ((color color) &rest initargs) |
516 | (declare (ignore color initargs)) |
517 | ;; Color structs are allocated as memory chunks by gdk, and since |
518 | ;; there is no gdk_color_new we have to use this hack to get a new |
519 | ;; color chunk |
90c5d56b |
520 | (with-memory (location #.(foreign-size (find-class 'color))) |
5e12e92b |
521 | (%color-copy location))) |
522 | |
560af5c5 |
523 | (defun %scale-value (value) |
524 | (etypecase value |
525 | (integer value) |
526 | (float (truncate (* value 65535))))) |
527 | |
90c5d56b |
528 | (defmethod initialize-instance ((color color) &key (red 0.0) (green 0.0) (blue 0.0)) |
560af5c5 |
529 | (call-next-method) |
530 | (with-slots ((%red red) (%green green) (%blue blue)) color |
531 | (setf |
1ebfd3a6 |
532 | %red (%scale-value red) |
533 | %green (%scale-value green) |
534 | %blue (%scale-value blue)))) |
560af5c5 |
535 | |
e7f1852f |
536 | (defbinding %color-parse () boolean |
5e12e92b |
537 | (spec string) |
90c5d56b |
538 | (color color :in/return)) |
5e12e92b |
539 | |
e7f1852f |
540 | (defun color-parse (spec &optional (color (make-instance 'color))) |
541 | (multiple-value-bind (succeeded-p color) (%color-parse spec color) |
542 | (if succeeded-p |
543 | color |
544 | (error "Parsing color specification ~S failed." spec)))) |
545 | |
560af5c5 |
546 | (defun ensure-color (color) |
547 | (etypecase color |
548 | (null nil) |
549 | (color color) |
e7f1852f |
550 | (string (color-parse color)) |
1ebfd3a6 |
551 | (vector |
5e12e92b |
552 | (make-instance 'color |
e7f1852f |
553 | :red (svref color 0) :green (svref color 1) :blue (svref color 2))))) |
554 | |
560af5c5 |
555 | |
556 | |
358bbd90 |
557 | ;;; Drawable -- all the draw- functions are deprecated and will be |
90c5d56b |
558 | ;;; removed, use cairo for drawing instead. |
8f30d7da |
559 | |
560 | (defbinding drawable-get-size () nil |
561 | (drawable drawable) |
562 | (width int :out) |
563 | (height int :out)) |
564 | |
565 | (defbinding (drawable-width "gdk_drawable_get_size") () nil |
566 | (drawable drawable) |
567 | (width int :out) |
568 | (nil null)) |
569 | |
570 | (defbinding (drawable-height "gdk_drawable_get_size") () nil |
571 | (drawable drawable) |
572 | (nil null) |
573 | (height int :out)) |
574 | |
575 | ;; (defbinding drawable-get-clip-region () region |
576 | ;; (drawable drawable)) |
577 | |
578 | ;; (defbinding drawable-get-visible-region () region |
579 | ;; (drawable drawable)) |
580 | |
581 | (defbinding draw-point () nil |
582 | (drawable drawable) (gc gc) |
583 | (x int) (y int)) |
584 | |
585 | (defbinding %draw-points () nil |
586 | (drawable drawable) (gc gc) |
587 | (points pointer) |
588 | (n-points int)) |
589 | |
8f30d7da |
590 | (defbinding draw-line () nil |
591 | (drawable drawable) (gc gc) |
592 | (x1 int) (y1 int) |
593 | (x2 int) (y2 int)) |
594 | |
8f30d7da |
595 | (defbinding draw-pixbuf |
596 | (drawable gc pixbuf src-x src-y dest-x dest-y &optional |
597 | width height (dither :none) (x-dither 0) (y-dither 0)) nil |
598 | (drawable drawable) (gc (or null gc)) |
599 | (pixbuf pixbuf) |
600 | (src-x int) (src-y int) |
601 | (dest-x int) (dest-y int) |
602 | ((or width -1) int) ((or height -1) int) |
603 | (dither rgb-dither) |
604 | (x-dither int) (y-dither int)) |
605 | |
8bb8ead0 |
606 | (defbinding draw-rectangle () nil |
8f30d7da |
607 | (drawable drawable) (gc gc) |
608 | (filled boolean) |
609 | (x int) (y int) |
610 | (width int) (height int)) |
611 | |
612 | (defbinding draw-arc () nil |
613 | (drawable drawable) (gc gc) |
614 | (filled boolean) |
615 | (x int) (y int) |
616 | (width int) (height int) |
617 | (angle1 int) (angle2 int)) |
618 | |
8f30d7da |
619 | (defbinding %draw-layout () nil |
620 | (drawable drawable) (gc gc) |
621 | (font pango:font) |
622 | (x int) (y int) |
623 | (layout pango:layout)) |
624 | |
625 | (defbinding %draw-layout-with-colors () nil |
626 | (drawable drawable) (gc gc) |
627 | (font pango:font) |
628 | (x int) (y int) |
629 | (layout pango:layout) |
630 | (foreground (or null color)) |
631 | (background (or null color))) |
632 | |
633 | (defun draw-layout (drawable gc font x y layout &optional foreground background) |
634 | (if (or foreground background) |
635 | (%draw-layout-with-colors drawable gc font x y layout foreground background) |
636 | (%draw-layout drawable gc font x y layout))) |
637 | |
638 | (defbinding draw-drawable |
639 | (drawable gc src src-x src-y dest-x dest-y &optional width height) nil |
640 | (drawable drawable) (gc gc) |
641 | (src drawable) |
642 | (src-x int) (src-y int) |
643 | (dest-x int) (dest-y int) |
644 | ((or width -1) int) ((or height -1) int)) |
645 | |
646 | (defbinding draw-image |
647 | (drawable gc image src-x src-y dest-x dest-y &optional width height) nil |
648 | (drawable drawable) (gc gc) |
649 | (image image) |
650 | (src-x int) (src-y int) |
651 | (dest-x int) (dest-y int) |
652 | ((or width -1) int) ((or height -1) int)) |
653 | |
654 | (defbinding drawable-get-image () image |
655 | (drawable drawable) |
656 | (x int) (y int) |
657 | (width int) (height int)) |
658 | |
659 | (defbinding drawable-copy-to-image |
660 | (drawable src-x src-y width height &optional image dest-x dest-y) image |
661 | (drawable drawable) |
662 | (image (or null image)) |
663 | (src-x int) (src-y int) |
664 | ((if image dest-x 0) int) |
665 | ((if image dest-y 0) int) |
666 | (width int) (height int)) |
560af5c5 |
667 | |
668 | |
669 | ;;; Key values |
670 | |
8bb8ead0 |
671 | (defbinding keyval-name () string |
560af5c5 |
672 | (keyval unsigned-int)) |
673 | |
e4251a29 |
674 | (defbinding %keyval-from-name () unsigned-int |
560af5c5 |
675 | (name string)) |
676 | |
e4251a29 |
677 | (defun keyval-from-name (name) |
678 | "Returns the keysym value for the given key name or NIL if it is not a valid name." |
679 | (let ((keyval (%keyval-from-name name))) |
680 | (unless (zerop keyval) |
681 | keyval))) |
682 | |
8bb8ead0 |
683 | (defbinding keyval-to-upper () unsigned-int |
560af5c5 |
684 | (keyval unsigned-int)) |
685 | |
628fd576 |
686 | (defbinding keyval-to-lower () unsigned-int |
560af5c5 |
687 | (keyval unsigned-int)) |
688 | |
8bb8ead0 |
689 | (defbinding (keyval-is-upper-p "gdk_keyval_is_upper") () boolean |
560af5c5 |
690 | (keyval unsigned-int)) |
691 | |
8bb8ead0 |
692 | (defbinding (keyval-is-lower-p "gdk_keyval_is_lower") () boolean |
560af5c5 |
693 | (keyval unsigned-int)) |
694 | |
7be9fc0c |
695 | ;;; Cairo interaction |
696 | |
90c5d56b |
697 | #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") |
7be9fc0c |
698 | (progn |
699 | (defbinding cairo-create () cairo:context |
700 | (drawable drawable)) |
701 | |
5fba7ba0 |
702 | (defmacro with-cairo-context ((cr drawable) &body body) |
703 | `(let ((,cr (cairo-create ,drawable))) |
704 | (unwind-protect |
705 | (progn ,@body) |
90c5d56b |
706 | (invalidate-instance ,cr t)))) |
5fba7ba0 |
707 | |
7be9fc0c |
708 | (defbinding cairo-set-source-color () nil |
709 | (cr cairo:context) |
710 | (color color)) |
711 | |
712 | (defbinding cairo-set-source-pixbuf () nil |
713 | (cr cairo:context) |
714 | (pixbuf pixbuf) |
715 | (x double-float) |
716 | (y double-float)) |
717 | |
718 | (defbinding cairo-rectangle () nil |
719 | (cr cairo:context) |
720 | (rectangle rectangle)) |
721 | |
722 | ;; (defbinding cairo-region () nil |
723 | ;; (cr cairo:context) |
724 | ;; (region region)) |
725 | ) |
18b84c80 |
726 | |
727 | |
90c5d56b |
728 | |
18b84c80 |
729 | ;;; Multi-threading support |
730 | |
731 | #+sbcl |
732 | (progn |
733 | (defvar *global-lock* (sb-thread:make-mutex :name "global GDK lock")) |
734 | (let ((recursive-level 0)) |
735 | (defun threads-enter () |
736 | (if (eq (sb-thread:mutex-value *global-lock*) sb-thread:*current-thread*) |
737 | (incf recursive-level) |
738 | (sb-thread:get-mutex *global-lock*))) |
739 | |
740 | (defun threads-leave (&optional flush-p) |
741 | (cond |
742 | ((zerop recursive-level) |
743 | (when flush-p |
744 | (display-flush)) |
745 | (sb-thread:release-mutex *global-lock*)) |
746 | (t (decf recursive-level))))) |
747 | |
748 | (define-callback %enter-fn nil () |
749 | (threads-enter)) |
750 | |
751 | (define-callback %leave-fn nil () |
752 | (threads-leave)) |
753 | |
754 | (defbinding threads-set-lock-functions (&optional) nil |
755 | (%enter-fn callback) |
756 | (%leave-fn callback)) |
757 | |
758 | (defmacro with-global-lock (&body body) |
759 | `(progn |
760 | (threads-enter) |
761 | (unwind-protect |
90c5d56b |
762 | ,@body |
18b84c80 |
763 | (threads-leave t))))) |