[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  
		      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- 
	  (foreign-slot-value attributes 'xsetwindowattributes 'background- 
	  (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
		   (logior cwbackpixel cwbackingstore cweventmask)

(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- 
    (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  
                          :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)

(defun destroy-context (context)
   (with-slots (display window pointer
     (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*))
                   (my-create-window *display*  
*root* ,x ,y ,width ,height *visual*
                                  (logior exposuremask buttonpressmask
	  (*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*)
        , at body)
          (;; 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*  
                     (with-foreign-object (xev :long 24)
                       (do ((got-close-signal nil))
                         ;; get next event
                         (xnextevent *display* xev)
                         ;; decipher structure, at least partially
                         (with-foreign-slots ((type window serial) xev  
			  (format t "event ~A window ~A *window* ~A~%" type window *window*)
                           ;; action based on event type
                            ;; expose events
                            ((and (= type 12) (= window *window*))  
                            ;; clientnotify event
                            ((= type 33)
                             (with-foreign-slots ((message-type data0)  
                                ((or (= data0 +destroy-message+)
                                     (and (= window *window*)
                                          (= message-type wm-protocols)
                                          (= data0 (wm-delete-window  
                                 (setf got-close-signal t))
                                ((= data0 +refresh-message+)
                                 (refresh)))))))) ))
                 ;; close down everything
		(dolist (c (reverse *all-contexts*)) (destroy-context c))
		(xclosedisplay *display*)))

(defmacro view (x y width height  &rest body)
   `(let* ((*window*
	   (my-create-window *display* *parent* ,x ,y ,width ,height *visual*
			     (logior exposuremask buttonpressmask
	  (*context* (my-create-context *display* *visual*  
*window* ,width ,height))
	  (*width* ,width) (*height* ,height)
	  (*parent* *window*))
      (push *context* *all-contexts*)
      (xmapwindow *display* *window*)
       , 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)
       ;; draw a white diagonal line
       (move-to width 0)
       (line-to 0 height)
       (set-source-rgb 1 1 1)
       (set-line-width 5)
       ;; draw a green diagonal line
       (move-to 0 0)
       (line-to width height)
       (set-source-rgb 0 1 0)
       (set-line-width 5)

(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)
		     (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


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