[cairo] cl-cairo with X11 examples with mouse events handling
Taoufik Dachraoui
taoufik.dachraoui at wanadoo.fr
Mon Oct 12 11:11:51 PDT 2009
I managed to write the following (this is not complete but I know how
to handle xevents)
load the file and do >(cl-cairo2:runit)
then press mouse button on windows
>>>> xclui.lisp
(in-package :cl-cairo2)
(defun my-create-window (display parent x y width height visual
background-pixel
event-mask &optional (backing-store t))
"Create an x11 window with the given attributes."
;; call xcreatewindow with attributes
(with-foreign-object (attributes 'xsetwindowattributes)
(setf (foreign-slot-value attributes 'xsetwindowattributes 'event-
mask)
event-mask
(foreign-slot-value attributes 'xsetwindowattributes 'background-
pixel)
background-pixel
(foreign-slot-value attributes 'xsetwindowattributes 'backing-store)
(if backing-store 1 0))
(xcreatewindow display parent x y width height
0 ; zero border width
0 ; depth - copy from parent
1 ;inputoutput ; class
visual
(logior cwbackpixel cwbackingstore cweventmask)
attributes)))
(defclass my-xlib-context (context)
((display :initarg :display)
(window :initarg :window)
(xlib-context :initarg :xlib-context :accessor xlib-context)
(wm-delete-window :initarg :wm-delete-window :accessor wm-delete-
window)
(width :initarg :width)
(height :initarg :height)))
;create cairo context; link X Window to cairo surface
(defun my-create-context (display visual window width height)
;(xsynchronize display 1)
(let* ((xlib-surface (cairo_xlib_surface_create display window visual
width height))
(xlib-context (cairo_create xlib-surface)))
(cairo_surface_destroy xlib-surface)
(let* ((surface (cairo_image_surface_create :CAIRO_FORMAT_RGB24
width height))
(*context* (make-instance 'my-xlib-context :width
width :height height :pixel-based-p t
:display display :window window :xlib-
context xlib-context
:wm-delete-window (xinternatom display
"WM_DELETE_WINDOW" 1)
:pointer (cairo_create surface))))
(with-foreign-object (prot 'xatom)
(setf (mem-aref prot 'xatom) (wm-delete-window *context*))
(xsetwmprotocols display window prot 1))
(cairo_set_source_surface xlib-context surface 0 0) ; link
window to surface
(cairo_surface_destroy surface)
;(xsynchronize display 0)
*context*)))
(defun destroy-context (context)
(with-slots (display window pointer
xlib-context)
context
(force-output t)
(let ((saved-pointer pointer))
(setf pointer nil) ; invalidate first so it can't be used
(cairo_destroy saved-pointer))
(cairo_destroy xlib-context)
;; !! free xlib-context, surface
(xdestroywindow display window)))
(defmacro application (x y width height window-name &rest body)
`(let* ((*display* (xopendisplay ":0.0"))
(*screen* (xdefaultscreen *display*))
(*root* (xdefaultrootwindow *display*))
(*visual* (xdefaultvisual *display* *screen*))
(*depth* (xdefaultdepth *display* *screen*))
(*whitepixel* (xwhitepixel *display* *screen*))
(*window*
(my-create-window *display*
*root* ,x ,y ,width ,height *visual*
*whitepixel*
(logior exposuremask buttonpressmask
structurenotifymask)
t))
(*parent* *window*)
(*context* (my-create-context *display* *visual*
*window* ,width ,height))
(*width* ,width) (*height* ,height)
(*all-contexts* nil))
(set-window-size-hints *display*
*window* ,width ,width ,height ,height)
(xstorename *display* *window* ,window-name)
(xmapwindow *display* *window*)
(progn
, at body)
(labels
(;; Repaint the xlib context with the image surface
;; (previously set as source during initialization.
(refresh ()
(dolist (c (reverse *all-contexts*)) (cairo_paint
(xlib-context c)))
(cairo_paint (xlib-context *context*)))
;; The main event loop, started as a separate thread
;; when initialization is complete. The main thread is
;; supposed to communicate with this one via X signals
;; using an unmapped InputOnly window (see
;; send-message-to-signal-window).
(event-loop ()
(let ((wm-protocols (xinternatom *display*
"WM_PROTOCOLS" 1)))
(with-foreign-object (xev :long 24)
(do ((got-close-signal nil))
(got-close-signal)
;; get next event
(xnextevent *display* xev)
;; decipher structure, at least partially
(with-foreign-slots ((type window serial) xev
xanyevent)
(format t "event ~A window ~A *window* ~A~%" type window *window*)
;; action based on event type
(cond
;; expose events
((and (= type 12) (= window *window*))
(refresh))
;; clientnotify event
((= type 33)
(with-foreign-slots ((message-type data0)
xev
xclientmessageevent)
(cond
((or (= data0 +destroy-message+)
(and (= window *window*)
(= message-type wm-protocols)
(= data0 (wm-delete-window
*context*))))
(setf got-close-signal t))
((= data0 +refresh-message+)
(refresh)))))))) ))
;; close down everything
(dolist (c (reverse *all-contexts*)) (destroy-context c))
(xclosedisplay *display*)))
(event-loop))))
(defmacro view (x y width height &rest body)
`(let* ((*window*
(my-create-window *display* *parent* ,x ,y ,width ,height *visual*
*whitepixel*
(logior exposuremask buttonpressmask
structurenotifymask)
t))
(*context* (my-create-context *display* *visual*
*window* ,width ,height))
(*width* ,width) (*height* ,height)
(*parent* *window*))
(push *context* *all-contexts*)
(xmapwindow *display* *window*)
(progn
, at body)))
;
;
; view body fires at exposue event; draw
(defun x-on-window (width height)
(rectangle 0 0 width height)
(set-source-rgb 0.2 0.2 0.5)
(fill-path)
;; draw a white diagonal line
(move-to width 0)
(line-to 0 height)
(set-source-rgb 1 1 1)
(set-line-width 5)
(stroke)
;; draw a green diagonal line
(move-to 0 0)
(line-to width height)
(set-source-rgb 0 1 0)
(set-line-width 5)
(stroke))
(defun runit ()
(application 100 100 400 400 "test"
(view 0 0 100 50
(rectangle 0 0 *width* *height*)
(set-source-rgb 0.2 0.2 1.0)
(fill-path)
(move-to 20 20)
(set-source-rgb 1.0 1.0 1.0)
(show-text "test"))
(view 100 100 100 100 (x-on-window *width* *height*))
(view 200 200 150 150 (x-on-window *width* *height*))))
(export 'runit)
>>> end file
Regards
Taoufik
On Oct 12, 2009, at 6:53 PM, Bill Spitzak wrote:
>
> I fully agree that such an example is very much needed. One of the
> big points in favor of Cairo is that it is not tied to a toolkit,
> but all the examples being tied to a toolkit mean that is not really
> true...
>
> As FLTK can draw using Cairo, I think I may be able to extract the
> necessary information and make a program that works that does not
> use GTK (or FLTK). I hope this will be a useful example.
>
> Taoufik Dachraoui wrote:
>> Dear,
>> I am new to cl-cairo2 and would like to know how to write an X11
>> application using CL-CAIRO2
>> I installed cl-cairo2 on openmcl (Clozure CL) and run the tests
>> (e.g tutorial/x11-example.lisp)
>> The X11 tests works fine but I could not figure out how to use and
>> handle mouse events (e.g. button-press, exposure,...)
>> I will appreciate if someone can send me an example of how to
>> create a X11 window and to define lisp functions to handle mouse
>> and keyboard events.
>> I prefer to use X window with cairo and not GTK with cairo.
>> Kind regards
>> Taoufik
>> _______________________________________________
>> cairo mailing list
>> cairo at cairographics.org
>> http://lists.cairographics.org/mailman/listinfo/cairo
>
More information about the cairo
mailing list