- cl-cairo2-cvs@common-lisp.net - mailman3.common-lisp.net

[cl-cairo2-cvs] r11 - cffi tutorial
by tpapp＠common-lisp.net 13 Aug '07

13 Aug '07

Author: tpapp Date: Mon Aug 13 10:30:44 2007 New Revision: 11 Added: tutorial/x11-example.lisp x11-context.lisp xlib.lisp Removed: README.xlib-context cffi/ tutorial/xlib-example.lisp xlib-context.lisp Modified: cl-cairo2-swig.lisp cl-cairo2.asd cl-cairo2.i context.lisp package.lisp path.lisp surface.lisp transformations.lisp tutorial/tutorial.tex Log: minor bugfixes, complete reworking of x11 support, support for cl-colors Modified: cl-cairo2-swig.lisp ============================================================================== --- cl-cairo2-swig.lisp (original) +++ cl-cairo2-swig.lisp Mon Aug 13 10:30:44 2007 @@ -1279,50 +1279,4 @@ (cffi:defcfun ("cairo_svg_version_to_string" cairo_svg_version_to_string) :string (version cairo_svg_version_t)) -(cffi:defcfun ("cairo_xlib_surface_create" cairo_xlib_surface_create) :pointer - (dpy :pointer) - (drawable :pointer) - (visual :pointer) - (width :int) - (height :int)) - -(cffi:defcfun ("cairo_xlib_surface_create_for_bitmap" cairo_xlib_surface_create_for_bitmap) :pointer - (dpy :pointer) - (bitmap :pointer) - (screen :pointer) - (width :int) - (height :int)) - -(cffi:defcfun ("cairo_xlib_surface_set_size" cairo_xlib_surface_set_size) :void - (surface :pointer) - (width :int) - (height :int)) - -(cffi:defcfun ("cairo_xlib_surface_set_drawable" cairo_xlib_surface_set_drawable) :void - (surface :pointer) - (drawable :pointer) - (width :int) - (height :int)) - -(cffi:defcfun ("cairo_xlib_surface_get_display" cairo_xlib_surface_get_display) :pointer - (surface :pointer)) - -(cffi:defcfun ("cairo_xlib_surface_get_drawable" cairo_xlib_surface_get_drawable) :pointer - (surface :pointer)) - -(cffi:defcfun ("cairo_xlib_surface_get_screen" cairo_xlib_surface_get_screen) :pointer - (surface :pointer)) - -(cffi:defcfun ("cairo_xlib_surface_get_visual" cairo_xlib_surface_get_visual) :pointer - (surface :pointer)) - -(cffi:defcfun ("cairo_xlib_surface_get_depth" cairo_xlib_surface_get_depth) :int - (surface :pointer)) - -(cffi:defcfun ("cairo_xlib_surface_get_width" cairo_xlib_surface_get_width) :int - (surface :pointer)) - -(cffi:defcfun ("cairo_xlib_surface_get_height" cairo_xlib_surface_get_height) :int - (surface :pointer)) - Modified: cl-cairo2.asd ============================================================================== --- cl-cairo2.asd (original) +++ cl-cairo2.asd Mon Aug 13 10:30:44 2007 @@ -1,6 +1,6 @@ (defsystem cl-cairo2 :description "Cairo 1.4 bindings" - :version "0.2.3" + :version "0.3" :author "Tamas K Papp" :license "GPL" :components ((:file "package") @@ -12,7 +12,10 @@ (:file "path" :depends-on ("context")) (:file "text" :depends-on ("context")) (:file "transformations" :depends-on ("context")) - (:file "xlib-context" :depends-on ("context") - :in-order-to ((load-op (feature :unix)) - (compile-op (feature :unix))))) - :depends-on (:cffi :cl-colors)) + (:file "xlib" :depends-on ("context") + :in-order-to ((load-op (feature :unix)) + (compile-op (feature :unix)))) + (:file "x11-context" :depends-on ("xlib") + :in-order-to ((load-op (feature :unix)) + (compile-op (feature :unix))))) + :depends-on (:cffi :cl-colors :cl-utilities)) Modified: cl-cairo2.i ============================================================================== --- cl-cairo2.i (original) +++ cl-cairo2.i Mon Aug 13 10:30:44 2007 @@ -44,6 +44,5 @@ %include /usr/include/cairo/cairo-xlib-xrender.h %include /usr/include/cairo/cairo-pdf.h %include /usr/include/cairo/cairo-svg.h -%include /usr/include/cairo/cairo-xlib.h Modified: context.lisp ============================================================================== --- context.lisp (original) +++ context.lisp Mon Aug 13 10:30:44 2007 @@ -30,10 +30,10 @@ (let ((context (make-instance 'context))) (setf (slot-value context 'pointer) (cairo_create pointer)) ;; register finalizer - (let ((context-pointer (slot-value context 'pointer))) - (finalize context - #'(lambda () - (cairo_destroy context-pointer)))) +;; (let ((context-pointer (slot-value context 'pointer))) +;; (finalize context +;; #'(lambda () +;; (cairo_destroy context-pointer)))) ;; return context context)))) @@ -97,7 +97,7 @@ (with-context (context ,pointer) ,@body)))) -(defmacro define-many-with-default-context (&rest args) +(defmacro define-many-with-default-context (&body args) "Apply define-with-default context to a list. Each item is itself a list, first element gives the function name, the rest the arguments." @@ -131,8 +131,8 @@ ;;;; (define-many-with-default-context - (save) - (restore) + (save) + (restore) (push-group) (pop-group) (pop-group-to-source) @@ -151,28 +151,27 @@ (define-with-default-context-sync stroke-preserve) ;;;; -;;;; set colors using the color library +;;;; set colors using the cl-colors library ;;;; + (defgeneric set-source-color (color &optional context)) (defmethod set-source-color - ((color rgb-color) &optional (context *context*)) - (set-source-rgb - (rgb-color-red color) - (rgb-color-green color) - (rgb-color-blue color) - context)) + ((color rgb) &optional (context *context*)) + (with-slots (red green blue) color + (set-source-rgb red green blue context))) (defmethod set-source-color - ((color rgba-color) &optional (context *context*)) - (set-source-rgba - (rgba-color-red color) - (rgba-color-green color) - (rgba-color-blue color) - (rgba-color-alpha color) - context)) - + ((color rgba) &optional (context *context*)) + (with-slots (red green blue alpha) color + (set-source-rgb red green blue alpha context))) + +(defmethod set-source-color + ((color hsv) &optional (context *context*)) + (with-slots (red green blue) (hsv->rgb color) + (set-source-rgb red green blue context))) + ;;;; ;;;; functions that get/set a property without any conversion ;;;; Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Mon Aug 13 10:30:44 2007 @@ -1,5 +1,5 @@ (defpackage :cl-cairo2 - (:use :common-lisp :cffi :cl-colors) + (:use :common-lisp :cffi :cl-colors :cl-utilities) (:export ; !!! when the interface ; stabilizes, remove export's ; from all other places and @@ -10,4 +10,6 @@ *context* set-source-color ;; transformations make-trans-matrix trans-matrix-xx trans-matrix-yx trans-matrix-xy - trans-matrix-yy trans-matrix-x0 trans-matrix-y0 trans-matrix-p)) + trans-matrix-yy trans-matrix-x0 trans-matrix-y0 trans-matrix-p + ;; x11-context + x11-context x11-display open-x11-display create-x11-context)) Modified: path.lisp ============================================================================== --- path.lisp (original) +++ path.lisp Mon Aug 13 10:30:44 2007 @@ -1,8 +1,8 @@ (in-package :cl-cairo2) (define-many-with-default-context - (new-path) - (new-sub-path) + (new-path) + (new-sub-path) (close-path) (arc xc yc radius angle1 angle2) (arc-negative xc yc radius angle1 angle2) Modified: surface.lisp ============================================================================== --- surface.lisp (original) +++ surface.lisp Mon Aug 13 10:30:44 2007 @@ -45,7 +45,7 @@ (check-surface-pointer-status pointer (setf (slot-value surface 'pointer) pointer) ;; register finalizer - (finalize surface #'(lambda () (cairo_surface_destroy pointer))) +;; (finalize surface #'(lambda () (cairo_surface_destroy pointer))) ;; return surface surface))) Modified: transformations.lisp ============================================================================== --- transformations.lisp (original) +++ transformations.lisp Mon Aug 13 10:30:44 2007 @@ -18,8 +18,8 @@ ;;;; (define-many-with-default-context - (translate tx ty) - (scale sx sy) + (translate tx ty) + (scale sx sy) (rotate angle)) (define-flexible (reset-matrix pointer) @@ -82,8 +82,8 @@ and copies x and y in/out before/after (respectively) the execution of body." `(with-foreign-objects ((xp :double) (yp :double)) - (setf (mem-ref xp :double) x - (mem-ref yp :double) y) + (setf (mem-ref xp :double) (coerce x 'double-float) + (mem-ref yp :double) (coerce y 'double-float)) ,@body (values (mem-ref xp :double) (mem-ref yp :double)))) @@ -92,7 +92,7 @@ returns the latter two." `(define-flexible (,name pointer x y) (with-x-y - (,(prepend-intern "cairo_" name) pointer xp yp)))) + (,(prepend-intern "cairo_" name) pointer xp yp)))) ;;;; ;;;; transformation and conversion functions Modified: tutorial/tutorial.tex ============================================================================== --- tutorial/tutorial.tex (original) +++ tutorial/tutorial.tex Mon Aug 13 10:30:44 2007 @@ -229,7 +229,7 @@ written to PNG files) are supported. Drawing in X11 windows is implemented using the -\lstinline!xlib-context! class --- see Section~\ref{sec:xlib-context} +\lstinline!x11-context! class --- see Section~\ref{sec:x11-context} for more information. \subsection{Contexts} @@ -331,32 +331,42 @@ with \lstinline!trans-matrix-!, and other a few other functions have been renamed to avoid conflicts with linear algebra packages. -\subsection{Xlib Contexts} -\label{sec:xlib-context} +\subsection{X11 Contexts} +\label{sec:x11-context} -The xlib context is not part of cairo -- it is a bit of glue code that +The x11 context is not part of cairo -- it is a bit of glue code that uses cairo's X11 surface on a pixmap, and displays this pixmap when needed (when X11 asks for the window contents to be redrawn or when -cairo draws on the pixmap). For the latter, it uses the XDamage -extension. +cairo draws on the pixmap). -The X11 event loop runs in a separate thread, so you need a Lisp -implementation that supports threads. The surface is not exposed to -the user, who is only allowed to see the context. This makes memory -management and proper cleanup easier. - -\textbf{Important:} before proceeding, make sure that you read -\verb!README.xlib-context! on how to install the shared library with -the necessary code. +In order to open an \lstinline!x11-context!, first you need to open an +\lstinline!x11-display!, for example, +\begin{lstlisting} +(defparameter *display* (open-x11-display ":0")) +\end{lstlisting} +opens a display on the local host. Each display runs an event loop in +a separate thread, and you can open several display and several +windows on each simultaneously. The X11 event loop runs in a separate +thread, so you need a Lisp implementation that supports threads. You +can close displays with \lstinline!destroy!, all open windows will be +closed and the contexts mapping into these windows will be destroyed +(drawing on them will be an invalid operation). + +For cl-cairo2, each window maps to a context. The surface is not +exposed to the user, who is only allowed to see the context. This +makes memory management and proper cleanup easier. You can create Xlib contexts with \begin{lstlisting} - (create-xlib-context width height) + (create-x11-context width height display) \end{lstlisting} When \lstinline!destroy!ed, the window is closed. This works the other way too: when the window is closed, the context is destroyed. +The windows are double-buffered using a pixmap on the X11 server, +therefore redrawing exposed windows is fast. However, this +implementation precludes the resizing of the window. -Example code can be found in \verb!tutorial/xlib-example.lisp!. The +Example code can be found in \verb!tutorial/x11-example.lisp!. The current implementation is not optimized for speed (the whole window is redrawn all the time) but it is fast enough for me. If you need speed improvements desperately, please contact the author. Added: tutorial/x11-example.lisp ============================================================================== --- (empty file) +++ tutorial/x11-example.lisp Mon Aug 13 10:30:44 2007 @@ -0,0 +1,60 @@ +(asdf:operate 'asdf:load-op :cl-cairo2) + +;;;; Make a test package +(defpackage :cairo-xlib-example + (:use :common-lisp :cl-cairo2)) + +(in-package :cairo-xlib-example) + +;; open display +(defparameter *display* (open-x11-display ":0")) + +(let ((width 400) + (height 300)) + (setf *context* (create-x11-context width height *display*)) + ;; clear the whole canvas with blue + (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)) +;; need to close window manually + + +(defun random-square (alpha) + "Draw a blue rectangle with fixed size and the given transparency alpha." + (move-to 1 1) + (line-to -1 1) + (line-to -1 -1) + (line-to 1 -1) + (close-path) + (set-source-rgba 0 0 1 alpha) + (fill-path)) + +(defparameter width 800) +(defparameter height 600) +(defparameter max-angle 90d0) +(setf *context* (create-x11-context width height *display*)) +;; fill with white +(rectangle 0 0 width height) +(set-source-rgb 1 1 1) +(fill-path) +;; draw the rectangles +(dotimes (i 500) + (let ((scaling (+ 5d0 (random 40d0)))) + (reset-matrix) ; reset matrix + (translate (random width) (random height)) ; move the origin + (scale scaling scaling) ; scale + (rotate (deg-to-rad (random max-angle))) ; rotate + (random-square (+ 0.1 (random 0.4))))) +;; need to close window manually Added: x11-context.lisp ============================================================================== --- (empty file) +++ x11-context.lisp Mon Aug 13 10:30:44 2007 @@ -0,0 +1,272 @@ +(in-package :cl-cairo2) + + +(defconstant x11-display-destroy-message-type 29653) +(defconstant x11-display-destroy-data0 17875817) + +(defvar *x11-context-count* 0 "window counter for autogenerating names") + +(defun next-x11-context-name () + "Return an autogenerated window name using *x11-context-count*." + (format nil "cl-cairo2 ~a" (incf *x11-context-count*))) + +;; x11-display + +(defclass x11-context (context) + ((width :initarg :width) + (height :initarg :height) + (window :initarg :window :accessor window) + (pixmap :initarg :pixmap) + (graphics-context :initarg :graphics-context) + (x11-display + :initarg :x11-display + :documentation "refers back to the context's X11 display"))) + +(defclass x11-display () + ((display + :initform nil + :documentation "pointer to an xlib display, if nil, the display is +closed and all other fields should be ignored") + (screen + :documentation "screen number") + (root) + (visual) + (depth) + (whitepixel) + (wm-delete-window + :documentation "atom for the WM_DELETE_WINDOW event") + (signal-window + :documentation "window used for sending signals to the event loop, unmapped") + (thread + :documentation "the thread id") + (x11-contexts + :initform nil + :documentation "a list of X11 contexts on this display"))) + + +;; code to make threads, please extend with your own Lisp if needed +;; testing is welcome, I only tested cmucl and sbcl +(defun start-thread (function name) + #+allegro (mp:process-run-function name function) + #+armedbear (ext:make-thread function :name name) + #+cmu (mp:make-process function :name name) + #+lispworks (mp:process-run-function name nil function) + #+openmcl (ccl:process-run-function name function) + #+sbcl (sb-thread:make-thread function :name name)) + +;; we create this definition manually, SWIG just messes things up +(defcfun ("cairo_xlib_surface_create" cairo_xlib_surface_create) cairo_surface_t + (display display) + (drawable drawable) + (visual visual) + (width :int) + (height :int)) + +;;;; +;;;; The important code starts here. The event model is the +;;;; following: we open an x11-display, which is attached to an Xlib +;;;; display, and has a list of x11-contexts, which is initially +;;;; empty. An event loop is started in a separate thread: each time +;;;; an event arrives, it is matched to one of the windows and is +;;;; acted upon. +;;;; +;;;; Each x11-context has a window where its contents appear. +;;;; +;;;; The window signal-window serves a special purpose. It remains +;;;; unmapped, but allows us to send events (eg requests to terminate) +;;;; to the event loop even if there are no x11-contexts. + +(defun refresh-x11-context (display x11-context) + "Copy the contents of the pixmap to the window." + (with-slots (width height window pixmap graphics-context) x11-context + (xcopyarea display pixmap window graphics-context + 0 0 width height 0 0) + (xsync display 1))) + + +(defun open-x11-display (display-name) + "Open an X11 display, get the constants and start an event loop." + (let ((x11-display (make-instance 'x11-display))) + (with-slots (display screen root visual depth whitepixel wm-delete-window + signal-window thread x11-contexts) x11-display + ;; open display + (setf display (xopendisplay display-name)) + (when (null-pointer-p display) + (error "couldn't open display ~a" display-name)) + ;; get defaults + (setf screen (xdefaultscreen display) + root (xdefaultrootwindow display)) + (setf visual (xdefaultvisual display screen) + depth (xdefaultdepth display screen) + whitepixel (xwhitepixel display screen)) + ;; get WM_DELETE_WINDOW atom + (setf wm-delete-window + (xinternatom display "WM_DELETE_WINDOW" 1)) + ;; create signal-window + (setf signal-window + ;; window is given strictly positive size + (xcreatesimplewindow display root 0 0 1 1 0 + whitepixel whitepixel)) + (xselectinput display signal-window 0) + ;; start threads + (setf thread + (start-thread + (lambda () + (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) xev xanyevent) + (let ((x11-context (find window x11-contexts :key #'window))) + ;; action based on event type + (cond + ;; expose event + ((and (= type 12) x11-context) + (refresh-x11-context display x11-context)) + ; clientnotify event + ((= type 33) + (with-foreign-slots ((message-type data0) xev + xclientmessageevent) + ;; WM_DELETE_WINDOW + (when (and x11-context + (= message-type wm-protocols) + (= data0 wm-delete-window)) + (destroy x11-context)) + ;; signal to the x11-display + (when (= window signal-window) + (xclosedisplay display) + (setf display nil) + (setf got-close-signal t))))))))))) + (format nil "thread for display ~a" display-name))) + ;; return x11-display + x11-display))) + + +(defun close-x11-context (x11-context) + "Close related window and do some cleanup, except removal from + x11-contexts of the x11-display. This function is meant to be used + internally and is not exported." + (with-slots (x11-display window pixmap pointer) x11-context + (with-slots (x11-contexts display) x11-display + ;; we will sync all operations during destruction of the window + (xsynchronize display 1) + ;; destroy cairo context + (let ((saved-pointer pointer)) + (setf pointer nil) ; invalidate first so it can't be used + (cairo_destroy saved-pointer)) + ;; free pixmap + (xfreepixmap display pixmap) + (setf pixmap nil) + ;; destroy window + (xdestroywindow display window) + (setf window nil) + ;; set x11-display of context to nil + (setf x11-display nil)))) + + +(defmethod destroy ((object x11-context)) + (with-slots (x11-contexts) (slot-value object 'x11-display) + ;; close + (close-x11-context object) + ;; remove from the list of windows + (setf x11-contexts (remove object x11-contexts)))) + + +(defun create-x11-context (width height x11-display + &optional (x11-context-name (next-x11-context-name))) + "Create an x11-context (a window with a context that belongs to it) +with given dimensions and optional name. If the name is not given, it +will be autogenerated." + (assert (typep x11-display 'x11-display)) + (let ((x11-context (make-instance 'x11-context + :width width + :height height + :x11-display x11-display))) + (with-slots (pointer width height window pixmap graphics-context) x11-context + (with-slots (display screen root visual depth whitepixel wm-delete-window + x11-contexts) x11-display + ;; add window to list + (push x11-context x11-contexts) + ;; we will sync all operations during setup of the window + (xsynchronize display 1) + ;; create window and pixmap + (setf window + (xcreatesimplewindow display root 0 0 width height + 0 whitepixel whitepixel)) + (setf pixmap + (xcreatepixmap display window width height depth)) + ;; create graphics context + (setf graphics-context + (xcreategc display pixmap 0 (null-pointer))) + ;; window name + (xstorename display window x11-context-name) + ;; size hints (most window managers will respect this) + (let ((hints (xallocsizehints))) + (with-foreign-slots ((flags x y min-width min-height + max-width max-height) + hints + xsizehints) + ;; we only set the first four values because old WM's might + ;; get confused if we don't, they should be ignored + (setf flags (logior pminsize pmaxsize) + x 0 + y 0 + (foreign-slot-value hints 'xsizehints 'width) width + (foreign-slot-value hints 'xsizehints 'height) height + min-width width + max-width width + min-height height + max-height height) + (xsetwmnormalhints display window hints))) + ;; select input + (xselectinput display window (logior exposuremask structurenotifymask)) + ;; handle window closing + (with-foreign-object (prot 'atom) + (setf (mem-aref prot 'atom) wm-delete-window) + (xsetwmprotocols display window prot 1)) + ;; map window + (xmapwindow display window) + ;; create xlib surface and context, destroy surface (not needed any more) + (let ((surface (cairo_xlib_surface_create display pixmap visual + width height))) + (setf pointer (cairo_create surface)) + ;; !!! error checking + (cairo_surface_destroy surface)) + ;; turn of synchronization + (xsynchronize display 0) + ;; return x11-context + x11-context)))) + + +(defmethod sync ((object x11-context)) + (with-slots (x11-display) object + (with-slots (display) x11-display + (refresh-x11-context display object)))) + + +(defmethod destroy ((object x11-display)) + "Close X11 display, destroying all the contexts if necessary." + (with-slots ((display-pointer display) signal-window x11-contexts) + object + (unless display-pointer + (error "This display is not open.")) + (when x11-contexts + (dolist (x11-context x11-contexts) + (close-x11-context x11-context) + (setf x11-contexts nil))) + (with-foreign-object (xev :long 24) + (with-foreign-slots + ((type display window message-type format data0) + xev xclientmessageevent) + (setf type 33) ; clientnotify + (setf display display-pointer) + (setf window signal-window) + (setf message-type 0) + (setf format 32) + (setf data0 0) + (xsendevent display signal-window 0 0 xev)) + (xflush display-pointer)))) + Added: xlib.lisp ============================================================================== --- (empty file) +++ xlib.lisp Mon Aug 13 10:30:44 2007 @@ -0,0 +1,319 @@ +(in-package :cl-cairo2) + +;;;; +;;;; a limited interface to certain Xlib functions +;;;; + +(load-foreign-library "libX11.so") + +;;;; types + +(defctype display :pointer) +(defctype xid :unsigned-long) ; X Id type +(defctype drawable xid) +(defctype window xid) +(defctype pixmap xid) +(defctype graphics-context xid) +(defctype visual :pointer) +(defctype atom :unsigned-long) +(defctype bool :int) + +;; constants + +(defmacro define-bitmask-constants (&body name-power-pairs) + "Define a list of constants from name-value pairs, raising 2 to +the power value." + (labels ((dbc (pairs) + (case (length pairs) + (0 nil) + (1 (error "no power after ~a" (car name-power-pairs))) + (t (destructuring-bind (name power &rest rest) pairs + `((defconstant ,name (expt 2 ,power)) + ,@(dbc rest))))))) + `(progn + ,@(dbc name-power-pairs)))) + +(defconstant noeventmask 0) +(define-bitmask-constants + keypressmask 0 + keyreleasemask 1 + buttonpressmask 2 + buttonreleasemask 3 + enterwindowmask 4 + leavewindowmask 5 + pointermotionmask 6 + pointermotionhintmask 7 + button1motionmask 8 + button2motionmask 9 + button3motionmask 10 + button4motionmask 11 + button5motionmask 12 + buttonmotionmask 13 + keymapstatemask 14 + exposuremask 15 + visibilitychangemask 16 + structurenotifymask 17 + resizeredirectmask 18 + substructurenotifymask 19 + substructureredirectmask 20 + focuschangemask 21 + propertychangemask 23 + colormapchangemask 23 + ownergrabbuttonmask 24) + + + +;;;; error code handling +(defmacro check-status (call) + "Check the return calue of call, if nonzero, display an error message." + (with-unique-names (status) + `(let ((,status ,call)) + (if (zerop ,status) + (values) + (error "operations ~a returned status (error) ~a" ',call ,status))))) + +;;;; display operations + +(defcfun ("XOpenDisplay" xopendisplay) display + (display-name :string)) + +(defcfun ("XCloseDisplay" xclosedisplay) :int + (display display)) + + +;;;; defaults for the X11 display & screen + +(defcfun ("XDefaultDepth" xdefaultdepth) :int + (display display) + (screen-number :int)) + +(defcfun ("XDefaultRootWindow" xdefaultrootwindow) window + (display display)) + +(defcfun ("XDefaultScreen" xdefaultscreen) :int + (display display)) + +(defcfun ("XDefaultVisual" xdefaultvisual) visual + (display display) + (screen-number :int)) + +(defcfun ("XBlackPixel" xblackpixel) :unsigned-long + (display display) + (screen-number :int)) + +(defcfun ("XWhitePixel" xwhitepixel) :unsigned-long + (display display) + (screen-number :int)) + + +;;;; graphics contexts + +(defcfun ("XDefaultGC" xdefaultgc) graphics-context + (display display) + (screen-number :int)) + +(defcfun ("XCreateGC" xcreategc) graphics-context + (display display) + (drawable drawable) + (valuemask :unsigned-long) + (xgcvalues :pointer)) + +(defcfun ("XFreeGC" xfreegc) :int + (display display) + (graphics-context graphics-context)) + +;;;; window and pixmap management + +(defcfun ("XMapWindow" xmapwindow) :int + (display display) + (window window)) + +(defcfun ("XCreateSimpleWindow" xcreatesimplewindow) window + (display display) + (parent window) + (x :int) + (y :int) + (width :unsigned-int) + (height :unsigned-int) + (border-width :unsigned-int) + (border :unsigned-long) + (background :unsigned-long)) + +(defcfun ("XDestroyWindow" xdestroywindow) :int + (display display) + (window window)) + +(defcfun ("XCreatePixmap" xcreatepixmap) pixmap + (display display) + (drawable drawable) + (width :unsigned-int) + (height :unsigned-int) + (depth :unsigned-int)) + +(defcfun ("XFreePixmap" xfreepixmap) :int + (display display) + (pixmap pixmap)) + +(defcfun ("XSelectInput" xselectinput) :int + (display display) + (window window) + (event-mask :long)) + +(defcfun ("XCopyArea" xcopyarea) :int + (display display) + (source drawable) + (destination drawable) + (graphics-context graphics-context) + (source-x :int) + (source-y :int) + (width :unsigned-int) + (height :unsigned-int) + (destination-x :int) + (destination-y :int)) + + +;; synchronization & threads + +(defcfun ("XInitThreads" xinitthreads) :int) + +(defcfun ("XSynchronize" xsynchronize) :int + (display display) + (onoff :int)) + +(defcfun ("XFlush" xflush) :int + (display display)) + +(defcfun ("XSync" xsync) :int + (display display) + (discard :int)) + +;; atoms & protocols + +(defcfun ("XInternAtom" xinternatom) atom + (display display) + (atom-name :string) + (only-if-exists :int)) + +(defcfun ("XSetWMProtocols" xsetwmprotocols) :int + (display display) + (window window) + (protocols :pointer) + (count :int)) + + +;; events + +(defcstruct xanyevent + (type :int) + (serial :unsigned-long) + (send-event bool) + (display display) + (window window)) + +(defcstruct xexposeevent + (type :int) + (serial :unsigned-long) + (send-event bool) + (display display) + (drawable drawable) + (x :int) + (y :int) + (width :int) + (height :int) + (count :int) + (major-code :int) + (minor-code :int)) + +(defcstruct xdestroywindowevent + (type :int) + (serial :unsigned-long) + (send-event bool) + (display display) + (event window) + (window window)) + +(defcstruct xclientmessageevent + (type :int) + (serial :unsigned-long) + (send-event bool) + (display display) + (window window) + (message-type atom) + (format :int) + ;; we only use first field, union of message data is not included + (data0 :unsigned-long)) + +(defcfun ("XNextEvent" xnextevent) :int + (display display) + (event-return :pointer)) + +(defcfun ("XSendEvent" xsendevent) :int + (display display) + (window window) + (propagate bool) + (event-mask :long) + (xevent :pointer)) + +;; hints & misc + +(defcstruct xsizehints + (flags :long) ; marks which fields in this structure are defined + (x :int) ; Obsolete + (y :int) ; Obsolete + (width :int) ; Obsolete + (height :int) ; Obsolete + (min-width :int) + (min-height :int) + (max-width :int) + (max-height :int) + (min-aspect-x :int) ; numerator + (min-aspect-y :int) ; denominator + (max-aspect-x :int) ; numerator + (max-aspect-y :int) ; denominator + (base-width :int) + (base_height :int) + (win_gravity :int)) + +(define-bitmask-constants + USPosition 0 + USSize 1 + PPosition 2 + PSize 3 + PMinSize 4 + PMaxSize 5 + PResizeInc 6 + PAspect 7 + PBaseSize 8 + PWinGravity 9) + +(defcfun ("XAllocSizeHints" xallocsizehints) :pointer) + +(defcfun ("XSetWMNormalHints" xsetwmnormalhints) :void + (display display) + (window window) + (hints :pointer)) + +(defcfun ("XStoreName" xstorename) :int + (display display) + (window window) + (window-name :string)) + +(defcfun ("XFree" xfree) :int + (data :pointer)) + + +;; extensions + +(defcfun ("XAddExtension" xaddextension) :pointer + (display display)) + +(defcstruct xextcodes + (extensions :int) + (major-opcode :int) + (first-event :int) + (first-error :int)) + + +;; call xinitthreads + +(xinitthreads)

1 0

[cl-cairo2-cvs] r10 - tutorial
by tpapp＠common-lisp.net 26 Jul '07

26 Jul '07

Author: tpapp Date: Thu Jul 26 10:52:20 2007 New Revision: 10 Modified: cl-cairo2-swig.lisp cl-cairo2.asd cl-cairo2.i context.lisp package.lisp tutorial/tutorial.tex Log: interface using cl-colors added Modified: cl-cairo2-swig.lisp ============================================================================== --- cl-cairo2-swig.lisp (original) +++ cl-cairo2-swig.lisp Thu Jul 26 10:52:20 2007 @@ -2,10 +2,10 @@ (in-package :cl-cairo2) (defctype my-double :double) -(defmethod cffi:expand-to-foreign (value (type (eql 'my-double))) - `(coerce ,value 'double-float)) -;; (defmethod translate-to-foreign (value (type my-double)) -;; (coerce value 'double-float)) +;; (defmethod cffi:expand-to-foreign (value (type (eql 'my-double))) +;; `(coerce ,value 'double-float)) +(defmethod translate-to-foreign (value (type (eql 'my-double))) + (coerce value 'double-float)) ;; typedefs: we don't want to create all of them automatically, ;; because typedefs for structures confuse with-foreign-slots Modified: cl-cairo2.asd ============================================================================== --- cl-cairo2.asd (original) +++ cl-cairo2.asd Thu Jul 26 10:52:20 2007 @@ -1,6 +1,6 @@ (defsystem cl-cairo2 :description "Cairo 1.4 bindings" - :version "0.2.2" + :version "0.2.3" :author "Tamas K Papp" :license "GPL" :components ((:file "package") @@ -15,4 +15,4 @@ (:file "xlib-context" :depends-on ("context") :in-order-to ((load-op (feature :unix)) (compile-op (feature :unix))))) - :depends-on (:cffi)) + :depends-on (:cffi :cl-colors)) Modified: cl-cairo2.i ============================================================================== --- cl-cairo2.i (original) +++ cl-cairo2.i Thu Jul 26 10:52:20 2007 @@ -10,10 +10,10 @@ (in-package :cl-cairo2) (defctype my-double :double) -(defmethod cffi:expand-to-foreign (value (type (eql 'my-double))) - `(coerce ,value 'double-float)) -;; (defmethod translate-to-foreign (value (type my-double)) -;; (coerce value 'double-float)) +;; (defmethod cffi:expand-to-foreign (value (type (eql 'my-double))) +;; `(coerce ,value 'double-float)) +(defmethod translate-to-foreign (value (type (eql 'my-double))) + (coerce value 'double-float)) ;; typedefs: we don't want to create all of them automatically, ;; because typedefs for structures confuse with-foreign-slots Modified: context.lisp ============================================================================== --- context.lisp (original) +++ context.lisp Thu Jul 26 10:52:20 2007 @@ -150,6 +150,29 @@ (define-with-default-context-sync stroke) (define-with-default-context-sync stroke-preserve) +;;;; +;;;; set colors using the color library +;;;; +(defgeneric set-source-color (color &optional context)) + +(defmethod set-source-color + ((color rgb-color) &optional (context *context*)) + (set-source-rgb + (rgb-color-red color) + (rgb-color-green color) + (rgb-color-blue color) + context)) + +(defmethod set-source-color + ((color rgba-color) &optional (context *context*)) + (set-source-rgba + (rgba-color-red color) + (rgba-color-green color) + (rgba-color-blue color) + (rgba-color-alpha color) + context)) + + ;;;; ;;;; functions that get/set a property without any conversion ;;;; Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Thu Jul 26 10:52:20 2007 @@ -1,5 +1,5 @@ (defpackage :cl-cairo2 - (:use :common-lisp :cffi) + (:use :common-lisp :cffi :cl-colors) (:export ; !!! when the interface ; stabilizes, remove export's ; from all other places and @@ -7,7 +7,7 @@ ;; utility functions deg-to-rad ;; context - *context* + *context* set-source-color ;; transformations make-trans-matrix trans-matrix-xx trans-matrix-yx trans-matrix-xy trans-matrix-yy trans-matrix-x0 trans-matrix-y0 trans-matrix-p)) Modified: tutorial/tutorial.tex ============================================================================== --- tutorial/tutorial.tex (original) +++ tutorial/tutorial.tex Thu Jul 26 10:52:20 2007 @@ -261,6 +261,14 @@ I doubt that Lisp users need \lstinline!get/set-user-data! or \lstinline!get-reference-count!. Let me know if you do. +Since version 0.2.3, you can use colors from +\href{http://www.cliki.net/cl-colors}{cl-colors} with the generic +function \lstinline!set-source-color!, for example, +\begin{lstlisting} + (set-source-color +darkolivegreen+) +\end{lstlisting} + + \subsection{Paths} \label{sec:paths}

1 0

[cl-cairo2-cvs] r9 -
by tpapp＠common-lisp.net 21 Jul '07

21 Jul '07

Author: tpapp Date: Sat Jul 21 09:44:55 2007 New Revision: 9 Modified: cl-cairo2.asd Log: version number changed Modified: cl-cairo2.asd ============================================================================== --- cl-cairo2.asd (original) +++ cl-cairo2.asd Sat Jul 21 09:44:55 2007 @@ -1,6 +1,6 @@ (defsystem cl-cairo2 :description "Cairo 1.4 bindings" - :version "0.2.1" + :version "0.2.2" :author "Tamas K Papp" :license "GPL" :components ((:file "package")

1 0

[cl-cairo2-cvs] r8 - tutorial
by tpapp＠common-lisp.net 21 Jul '07

21 Jul '07

Author: tpapp Date: Sat Jul 21 09:41:55 2007 New Revision: 8 Modified: context.lisp surface.lisp tables.lisp tutorial/example.lisp tutorial/tutorial.tex Log: changed to longer property names to avoid name clashes Modified: context.lisp ============================================================================== --- context.lisp (original) +++ context.lisp Sat Jul 21 09:41:55 2007 @@ -66,7 +66,7 @@ (multiple-value-prog1 (progn ,@body) (let ((,status (lookup-cairo-enum (cairo_status ,pointer-name) table-status))) - (unless (eq ,status 'success) + (unless (eq ,status 'status-success) (warn "function returned with status ~a." ,status)))) (warn "context is not alive"))))) Modified: surface.lisp ============================================================================== --- surface.lisp (original) +++ surface.lisp Sat Jul 21 09:41:55 2007 @@ -30,7 +30,7 @@ `(multiple-value-prog1 (progn ,@body) (let ((,status (lookup-cairo-enum (cairo_surface_status ,pointer) table-status))) - (unless (eq ,status 'success) + (unless (eq ,status 'status-success) (warn "function returned with status ~a." ,status)))))) (defmacro with-surface ((surface pointer) &body body) Modified: tables.lisp ============================================================================== --- tables.lisp (original) +++ tables.lisp Sat Jul 21 09:41:55 2007 @@ -9,99 +9,99 @@ (export (cdr i))))) (exporting-table table-format - '((:CAIRO_FORMAT_ARGB32 . argb32) - (:CAIRO_FORMAT_RGB24 . rgb24) - (:CAIRO_FORMAT_A8 . a8) - (:CAIRO_FORMAT_A1 . a1))) + '((:CAIRO_FORMAT_ARGB32 . format-argb32) + (:CAIRO_FORMAT_RGB24 . format-rgb24) + (:CAIRO_FORMAT_A8 . format-a8) + (:CAIRO_FORMAT_A1 . format-a1))) (exporting-table table-antialias - '((:CAIRO_ANTIALIAS_DEFAULT . default) - (:CAIRO_ANTIALIAS_NONE . none) - (:CAIRO_ANTIALIAS_GRAY . gray) - (:CAIRO_ANTIALIAS_SUBPIXEL . subpixel))) + '((:CAIRO_ANTIALIAS_DEFAULT . antialias-default) + (:CAIRO_ANTIALIAS_NONE . antialias-none) + (:CAIRO_ANTIALIAS_GRAY . antialias-gray) + (:CAIRO_ANTIALIAS_SUBPIXEL . antialias-subpixel))) (exporting-table table-fill-rule - '((:CAIRO_FILL_RULE_WINDING . winding) - (:CAIRO_FILL_RULE_EVEN_ODD . odd))) + '((:CAIRO_FILL_RULE_WINDING . fill-rule-winding) + (:CAIRO_FILL_RULE_EVEN_ODD . fill-rule-odd))) (exporting-table table-line-cap - '((:CAIRO_LINE_CAP_BUTT . butt) - (:CAIRO_LINE_CAP_ROUND . round) - (:CAIRO_LINE_CAP_SQUARE . square))) + '((:CAIRO_LINE_CAP_BUTT . line-cap-butt) + (:CAIRO_LINE_CAP_ROUND . line-cap-round) + (:CAIRO_LINE_CAP_SQUARE . line-cap-square))) (exporting-table table-line-join - '((:CAIRO_LINE_JOIN_MITER . miter) - (:CAIRO_LINE_JOIN_ROUND . round) - (:CAIRO_LINE_JOIN_BEVEL . bevel))) + '((:CAIRO_LINE_JOIN_MITER . line-join-miter) + (:CAIRO_LINE_JOIN_ROUND . line-join-round) + (:CAIRO_LINE_JOIN_BEVEL . line-join-bevel))) (exporting-table table-operator - '((:CAIRO_OPERATOR_CLEAR . clear) - (:CAIRO_OPERATOR_SOURCE . source) - (:CAIRO_OPERATOR_OVER . over) - (:CAIRO_OPERATOR_IN . in) - (:CAIRO_OPERATOR_OUT . out) - (:CAIRO_OPERATOR_ATOP . atop) - (:CAIRO_OPERATOR_DEST . dest) - (:CAIRO_OPERATOR_DEST_OVER . dest-over) - (:CAIRO_OPERATOR_DEST_IN . dest-in) - (:CAIRO_OPERATOR_DEST_OUT . dest-out) - (:CAIRO_OPERATOR_DEST_ATOP . dest-atop) - (:CAIRO_OPERATOR_XOR . xor) - (:CAIRO_OPERATOR_ADD . add) - (:CAIRO_OPERATOR_SATURATE . saturate))) + '((:CAIRO_OPERATOR_CLEAR . operator-clear) + (:CAIRO_OPERATOR_SOURCE . operator-source) + (:CAIRO_OPERATOR_OVER . operator-over) + (:CAIRO_OPERATOR_IN . operator-in) + (:CAIRO_OPERATOR_OUT . operator-out) + (:CAIRO_OPERATOR_ATOP . operator-atop) + (:CAIRO_OPERATOR_DEST . operator-dest) + (:CAIRO_OPERATOR_DEST_OVER . operator-dest-over) + (:CAIRO_OPERATOR_DEST_IN . operator-dest-in) + (:CAIRO_OPERATOR_DEST_OUT . operator-dest-out) + (:CAIRO_OPERATOR_DEST_ATOP . operator-dest-atop) + (:CAIRO_OPERATOR_XOR . operator-xor) + (:CAIRO_OPERATOR_ADD . operator-add) + (:CAIRO_OPERATOR_SATURATE . operator-saturate))) (exporting-table table-font-slant - '((:CAIRO_FONT_SLANT_NORMAL . normal) - (:CAIRO_FONT_SLANT_ITALIC . italic) - (:CAIRO_FONT_SLANT_OBLIQUE . oblique))) + '((:CAIRO_FONT_SLANT_NORMAL . font-slant-normal) + (:CAIRO_FONT_SLANT_ITALIC . font-slant-italic) + (:CAIRO_FONT_SLANT_OBLIQUE . font-slant-oblique))) (exporting-table table-font-weight - '((:CAIRO_FONT_WEIGHT_NORMAL . normal) - (:CAIRO_FONT_WEIGHT_BOLD . bold))) + '((:CAIRO_FONT_WEIGHT_NORMAL . font-weight-normal) + (:CAIRO_FONT_WEIGHT_BOLD . font-weight-bold))) (exporting-table table-subpixel-order - '((:CAIRO_SUBPIXEL_ORDER_DEFAULT . default) - (:CAIRO_SUBPIXEL_ORDER_RGB . rgb) - (:CAIRO_SUBPIXEL_ORDER_BGR .bgr) - (:CAIRO_SUBPIXEL_ORDER_VRGB . vrgb) - (:CAIRO_SUBPIXEL_ORDER_VBGR . vbgr))) + '((:CAIRO_SUBPIXEL_ORDER_DEFAULT . subpixel-order-default) + (:CAIRO_SUBPIXEL_ORDER_RGB . subpixel-order-rgb) + (:CAIRO_SUBPIXEL_ORDER_BGR . subpixel-order-bgr) + (:CAIRO_SUBPIXEL_ORDER_VRGB . subpixel-order-vrgb) + (:CAIRO_SUBPIXEL_ORDER_VBGR . subpixel-order-vbgr))) (exporting-table table-hint-style - '((:CAIRO_HINT_STYLE_DEFAULT . default) - (:CAIRO_HINT_STYLE_NONE . none) - (:CAIRO_HINT_STYLE_SLIGHT . slight) - (:CAIRO_HINT_STYLE_MEDIUM . medium) - (:CAIRO_HINT_STYLE_FULL . full))) + '((:CAIRO_HINT_STYLE_DEFAULT . hint-style-default) + (:CAIRO_HINT_STYLE_NONE . hint-style-none) + (:CAIRO_HINT_STYLE_SLIGHT . hint-style-slight) + (:CAIRO_HINT_STYLE_MEDIUM . hint-style-medium) + (:CAIRO_HINT_STYLE_FULL . hint-style-full))) (exporting-table table-hint-metrics - '((:CAIRO_HINT_METRICS_DEFAULT . default) - (:CAIRO_HINT_METRICS_OFF . off) - (:CAIRO_HINT_METRICS_ON . on))) + '((:CAIRO_HINT_METRICS_DEFAULT . hint-metrics-default) + (:CAIRO_HINT_METRICS_OFF . hint-metrics-off) + (:CAIRO_HINT_METRICS_ON . hint-metrics-on))) (exporting-table table-status - '((:CAIRO_STATUS_SUCCESS . success) - (:CAIRO_STATUS_NO_MEMORY . no-memory) - (:CAIRO_STATUS_INVALID_RESTORE . invalid-restore) - (:CAIRO_STATUS_INVALID_POP_GROUP . invalid-pop-group) - (:CAIRO_STATUS_NO_CURRENT_POINT . no-current-point) - (:CAIRO_STATUS_INVALID_MATRIX . invalid-matrix) - (:CAIRO_STATUS_INVALID_STATUS . invalid-status) - (:CAIRO_STATUS_NULL_POINTER . null-pointer) - (:CAIRO_STATUS_INVALID_STRING . invalid-string) - (:CAIRO_STATUS_INVALID_PATH_DATA . invalid-path-data) - (:CAIRO_STATUS_READ_ERROR . read-error) - (:CAIRO_STATUS_WRITE_ERROR . write-error) - (:CAIRO_STATUS_SURFACE_FINISHED . surface-finished) - (:CAIRO_STATUS_SURFACE_TYPE_MISMATCH . surface-type-mismatch) - (:CAIRO_STATUS_PATTERN_TYPE_MISMATCH . pattern-type-mismatch) - (:CAIRO_STATUS_INVALID_CONTENT . invalid-content) - (:CAIRO_STATUS_INVALID_FORMAT . invalid-format) - (:CAIRO_STATUS_INVALID_VISUAL . invalid-visual) - (:CAIRO_STATUS_FILE_NOT_FOUND . file-not-found) - (:CAIRO_STATUS_INVALID_DASH . invalid-dash) - (:CAIRO_STATUS_INVALID_DSC_COMMENT . invalid-dsc-comment) - (:CAIRO_STATUS_INVALID_INDEX . invalid-index) - (:CAIRO_STATUS_CLIP_NOT_REPRESENTABLE . clip-not-representable))) + '((:CAIRO_STATUS_SUCCESS . status-success) + (:CAIRO_STATUS_NO_MEMORY . status-no-memory) + (:CAIRO_STATUS_INVALID_RESTORE . status-invalid-restore) + (:CAIRO_STATUS_INVALID_POP_GROUP . status-invalid-pop-group) + (:CAIRO_STATUS_NO_CURRENT_POINT . status-no-current-point) + (:CAIRO_STATUS_INVALID_MATRIX . status-invalid-matrix) + (:CAIRO_STATUS_INVALID_STATUS . status-invalid-status) + (:CAIRO_STATUS_NULL_POINTER . status-null-pointer) + (:CAIRO_STATUS_INVALID_STRING . status-invalid-string) + (:CAIRO_STATUS_INVALID_PATH_DATA . status-invalid-path-data) + (:CAIRO_STATUS_READ_ERROR . status-read-error) + (:CAIRO_STATUS_WRITE_ERROR . status-write-error) + (:CAIRO_STATUS_SURFACE_FINISHED . status-surface-finished) + (:CAIRO_STATUS_SURFACE_TYPE_MISMATCH . status-surface-type-mismatch) + (:CAIRO_STATUS_PATTERN_TYPE_MISMATCH . status-pattern-type-mismatch) + (:CAIRO_STATUS_INVALID_CONTENT . status-invalid-content) + (:CAIRO_STATUS_INVALID_FORMAT . status-invalid-format) + (:CAIRO_STATUS_INVALID_VISUAL . status-invalid-visual) + (:CAIRO_STATUS_FILE_NOT_FOUND . status-file-not-found) + (:CAIRO_STATUS_INVALID_DASH . status-invalid-dash) + (:CAIRO_STATUS_INVALID_DSC_COMMENT . status-invalid-dsc-comment) + (:CAIRO_STATUS_INVALID_INDEX . status-invalid-index) + (:CAIRO_STATUS_CLIP_NOT_REPRESENTABLE . status-clip-not-representable))) (defun lookup-cairo-enum (cairo-enum table) (let ((enum (cdr (assoc cairo-enum table)))) Modified: tutorial/example.lisp ============================================================================== --- tutorial/example.lisp (original) +++ tutorial/example.lisp Sat Jul 21 09:41:55 2007 @@ -75,7 +75,7 @@ (set-source-rgb 1 1 1) (fill-path) ;; setup font -(select-font-face "Arial" 'normal 'normal) +(select-font-face "Arial" 'font-slant-normal 'font-weight-normal) (set-font-size size) ;; starting point (mark-at x y 2 1 0 0) ; red @@ -129,7 +129,7 @@ (set-source-rgb 0 0 1) (stroke) ;; "cl-cairo2" in Arial bold to the center -(select-font-face "Arial" 'normal 'bold) +(select-font-face "Arial" 'font-slant-normal 'font-weight-bold) (set-font-size 100) (set-source-rgba 1 0.75 0 0.5) ; orange (show-text-aligned "cl-cairo2" (/ size 2) (/ size 2)) @@ -159,7 +159,7 @@ (defparameter width 1024) (defparameter height 768) (defparameter max-angle 40d0) -(with-png-file ("hearts.png" 'rgb24 width height) +(with-png-file ("hearts.png" 'format-rgb24 width height) ;; fill with white (rectangle 0 0 width height) (set-source-rgb 1 1 1) Modified: tutorial/tutorial.tex ============================================================================== --- tutorial/tutorial.tex (original) +++ tutorial/tutorial.tex Sat Jul 21 09:41:55 2007 @@ -54,10 +54,10 @@ \href{http://cairographics.org/}{Cairo} is a 2D graphics library with support for multiple output devices. The \lstinline!cl-cairo2! -package provides Common Lisp bindings for the Cairo API. Alternatives +package provides Common Lisp bindings for the Cairo API.\footnote{Alternatives are \href{http://www.cliki.net/cl-cairo}{cl-cairo}, written by Lars -Nostdal and others (which appears to be dormant), and Christian -Haselbach's \href{http://www.cliki.net/cffi-cairo}{cffi-cairo}. +Nostdal and others (this project appears to be dormant), and Christian +Haselbach's \href{http://www.cliki.net/cffi-cairo}{cffi-cairo}.} \lstinline!cl-cairo2! is written with the following principles in mind: @@ -159,7 +159,7 @@ write this to the bitmap file when you are done. The macro \lstinline!with-png-file! will take care of these details: use it like \begin{lstlisting} -(with-png-file ("example.png" 'rgb24 200 100) +(with-png-file ("example.png" 'format-rgb24 200 100) ;; drawing commands ...) \end{lstlisting} @@ -171,10 +171,10 @@ lookup tables (assoc lists) for this purpose, which are defined in \verb!tables.lisp!. Cairo constants \texttt{CAIRO\_\textsl{PROPERTY}\_\textsl{SOMETHING}} usually map to -the Lisp symbol \lstinline!something!, and can only be used in setting -or querying \texttt{PROPERTY}. For example, \verb!CAIRO_FORMAT_RGB24! -is mapped to \lstinline!rgb24!, and using it for some other property -will create an error. +the Lisp symbol \lstinline!property-something!, and can only be used +in setting or querying \texttt{PROPERTY}. For example, +\verb!CAIRO_FORMAT_RGB24! is mapped to \lstinline!format-rgb24!, and +using it for some other property will create an error. Likewise, names of the Lisp function are easy to deduce from the name of the C function in the Cairo API: just drop the \verb!cairo_! prefix @@ -290,7 +290,7 @@ \verb!text.lisp! for an enumeration of what is missing). You can select font face and size using commands like \begin{lstlisting} - (select-font-face "Arial" 'italic 'bold) + (select-font-face "Arial" 'font-slant-italic 'font-weight-bold) (select-font-size 12) \end{lstlisting} and use \lstinline!(show-text "hello world")! to draw it. You can

1 0

[cl-cairo2-cvs] r7 - tutorial
by tpapp＠common-lisp.net 12 Jul '07

12 Jul '07

Author: tpapp Date: Thu Jul 12 10:01:08 2007 New Revision: 7 Added: tutorial/test-finalizer.lisp Modified: Makefile cairo.lisp cl-cairo2-swig.lisp cl-cairo2.asd cl-cairo2.i context.lisp package.lisp path.lisp surface.lisp tables.lisp transformations.lisp tutorial/tutorial.tex xlib-context.lisp Log: Code cleanup, also added finalizers Modified: Makefile ============================================================================== --- Makefile (original) +++ Makefile Thu Jul 12 10:01:08 2007 @@ -1,4 +1,7 @@ -cl-cairo2-swig.lisp: cl-cairo2.i +CAIRO_INCLUDE_DIR=/usr/include/cairo +CAIRO_INCLUDE_FILES=$(wildcard $(CAIRO_INCLUDE_DIR)/*.h) + +cl-cairo2-swig.lisp: cl-cairo2.i $(CAIRO_INCLUDE_FILES) swig -cffi cl-cairo2.i test-swig.lisp: test.i Modified: cairo.lisp ============================================================================== --- cairo.lisp (original) +++ cairo.lisp Thu Jul 12 10:01:08 2007 @@ -1,10 +1,12 @@ (in-package :cl-cairo2) -(define-foreign-library libcairo - (:unix (:or "libcairo.so.2" "libcairo.so")) - (t (:default "libcairo"))) +;; (define-foreign-library libcairo +;; (:unix (:or "libcairo.so.2" "libcairo.so")) +;; (t (:default "libcairo"))) -(use-foreign-library libcairo) +;; (use-foreign-library libcairo) + +(load-foreign-library '(:default "libcairo")) (defun deg-to-rad (deg) "Convert degrees to radians." Modified: cl-cairo2-swig.lisp ============================================================================== --- cl-cairo2-swig.lisp (original) +++ cl-cairo2-swig.lisp Thu Jul 12 10:01:08 2007 @@ -2,10 +2,10 @@ (in-package :cl-cairo2) (defctype my-double :double) -;; (defmethod expand-to-foreign (value (type (eql 'my-double))) -;; `(coerce ,value 'double-float)) -(defmethod translate-to-foreign (value (type (eql 'my-double))) - (coerce value 'double-float)) +(defmethod cffi:expand-to-foreign (value (type (eql 'my-double))) + `(coerce ,value 'double-float)) +;; (defmethod translate-to-foreign (value (type my-double)) +;; (coerce value 'double-float)) ;; typedefs: we don't want to create all of them automatically, ;; because typedefs for structures confuse with-foreign-slots @@ -81,9 +81,7 @@ (cl:defconstant CAIRO_VERSION_MINOR 4) -(cl:defconstant CAIRO_VERSION_MICRO 6) - -(cl:defconstant CAIRO_VERSION_STRING "1.4.6") +(cl:defconstant CAIRO_VERSION_MICRO 10) (cl:defconstant CAIRO_HAS_SVG_SURFACE 1) Modified: cl-cairo2.asd ============================================================================== --- cl-cairo2.asd (original) +++ cl-cairo2.asd Thu Jul 12 10:01:08 2007 @@ -1,6 +1,6 @@ (defsystem cl-cairo2 :description "Cairo 1.4 bindings" - :version "0.2" + :version "0.2.1" :author "Tamas K Papp" :license "GPL" :components ((:file "package") @@ -8,10 +8,10 @@ (:file "cl-cairo2-swig" :depends-on ("cairo")) (:file "tables" :depends-on ("cl-cairo2-swig")) (:file "surface" :depends-on ("cairo" "tables" "cl-cairo2-swig")) - (:file "context" :depends-on ("surface" "cl-cairo2-swig")) - (:file "path" :depends-on ("context")) ; "cl-cairo2-swig")) - (:file "text" :depends-on ("context")) ; "cl-cairo2-swig")) - (:file "transformations" :depends-on ("context")) ; "cl-cairo2-swig"))) + (:file "context" :depends-on ("surface" "tables" "cl-cairo2-swig")) + (:file "path" :depends-on ("context")) + (:file "text" :depends-on ("context")) + (:file "transformations" :depends-on ("context")) (:file "xlib-context" :depends-on ("context") :in-order-to ((load-op (feature :unix)) (compile-op (feature :unix))))) Modified: cl-cairo2.i ============================================================================== --- cl-cairo2.i (original) +++ cl-cairo2.i Thu Jul 12 10:01:08 2007 @@ -1,6 +1,7 @@ %module "cl-cairo2-swig" %ignore CAIRO_VERSION; +%ignore CAIRO_VERSION_STRING; %typemap(cin) double "my-double"; /* %typemap(cin) int ":my-int"; */ @@ -9,10 +10,10 @@ (in-package :cl-cairo2) (defctype my-double :double) -;; (defmethod expand-to-foreign (value (type (eql 'my-double))) -;; `(coerce ,value 'double-float)) -(defmethod translate-to-foreign (value (type (eql 'my-double))) - (coerce value 'double-float)) +(defmethod cffi:expand-to-foreign (value (type (eql 'my-double))) + `(coerce ,value 'double-float)) +;; (defmethod translate-to-foreign (value (type my-double)) +;; (coerce value 'double-float)) ;; typedefs: we don't want to create all of them automatically, ;; because typedefs for structures confuse with-foreign-slots Modified: context.lisp ============================================================================== --- context.lisp (original) +++ context.lisp Thu Jul 12 10:01:08 2007 @@ -29,14 +29,23 @@ (with-surface (surface pointer) (let ((context (make-instance 'context))) (setf (slot-value context 'pointer) (cairo_create pointer)) - ;; !!! error checking + ;; register finalizer + (let ((context-pointer (slot-value context 'pointer))) + (finalize context + #'(lambda () + (cairo_destroy context-pointer)))) + ;; return context context)))) (defmethod destroy ((object context)) (with-slots (pointer) object (when pointer (cairo_destroy pointer) - (setf pointer nil)))) + (setf pointer nil))) + ;; deregister finalizer + (cancel-finalization object)) + +(defgeneric sync (object)) (defmethod sync ((object context)) ;; most contexts don't need syncing @@ -46,7 +55,7 @@ ;;;; default context and convenience macros ;;;; -(export (defvar *context* nil "default cairo context")) +(defvar *context* nil "default cairo context") (defmacro with-context ((context pointer) &body body) "Execute body with pointer pointing to context, and check status." @@ -121,7 +130,6 @@ ;;;; simple functions using context ;;;; -(define-with-default-context save) (define-many-with-default-context (save) (restore) Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Thu Jul 12 10:01:08 2007 @@ -1,5 +1,13 @@ (defpackage :cl-cairo2 (:use :common-lisp :cffi) - (:export deg-to-rad - make-trans-matrix trans-matrix-xx trans-matrix-yx trans-matrix-xy - trans-matrix-yy trans-matrix-x0 trans-matrix-y0 trans-matrix-p)) + (:export ; !!! when the interface + ; stabilizes, remove export's + ; from all other places and + ; list them here + ;; utility functions + deg-to-rad + ;; context + *context* + ;; transformations + make-trans-matrix trans-matrix-xx trans-matrix-yx trans-matrix-xy + trans-matrix-yy trans-matrix-x0 trans-matrix-y0 trans-matrix-p)) Modified: path.lisp ============================================================================== --- path.lisp (original) +++ path.lisp Thu Jul 12 10:01:08 2007 @@ -10,7 +10,6 @@ (line-to x y) (move-to x y) (rectangle x y width height) - (rel-curve-to dx1 dy1 dx2 dy2 dx3 dy3) (rel-move-to dx dy) (rel-curve-to dx1 dy1 dx2 dy2 dx3 dy3) (rel-line-to dx dy) Modified: surface.lisp ============================================================================== --- surface.lisp (original) +++ surface.lisp Thu Jul 12 10:01:08 2007 @@ -44,12 +44,17 @@ (let ((surface (make-instance 'surface))) (check-surface-pointer-status pointer (setf (slot-value surface 'pointer) pointer) + ;; register finalizer + (finalize surface #'(lambda () (cairo_surface_destroy pointer))) + ;; return surface surface))) (defmethod destroy ((object surface)) (with-alive-surface (object pointer) (cairo_surface_destroy pointer) - (setf pointer nil))) + (setf pointer nil)) + ;; deregister finalizer + (cancel-finalization object)) ;;;; ;;;; Macros to create surfaces (that are written into files) and Modified: tables.lisp ============================================================================== --- tables.lisp (original) +++ tables.lisp Thu Jul 12 10:01:08 2007 @@ -2,7 +2,8 @@ (defmacro exporting-table (name definition) `(progn - (export (defparameter ,name ,definition)) + (defparameter ,name ,definition) + (export ',name) (dolist (i ,name) ; (export (car i)) (export (cdr i))))) Modified: transformations.lisp ============================================================================== --- transformations.lisp (original) +++ transformations.lisp Thu Jul 12 10:01:08 2007 @@ -138,7 +138,7 @@ "Define a matrix transformation function with matrix and args, which returns the new matrix." `(export - (defun ,(prepend-intern "trans-matrix-init-" name :replace-dash nil) (matrix ,@args) + (defun ,(prepend-intern "trans-matrix-" name :replace-dash nil) (matrix ,@args) (with-trans-matrix-in-out matrix matrix-pointer (,(prepend-intern "cairo_matrix_" name) matrix-pointer @@ -169,6 +169,3 @@ (with-trans-matrix-in matrix matrix-pointer (with-x-y (cairo_matrix_transform_point matrix-pointer xp yp))))) - - - Added: tutorial/test-finalizer.lisp ============================================================================== --- (empty file) +++ tutorial/test-finalizer.lisp Thu Jul 12 10:01:08 2007 @@ -0,0 +1,13 @@ +(in-package :cl-cairo2) + +(setf *context* (create-pdf-context "/tmp/foo.pdf" 100 100)) +(move-to 0 0) +(line-to 100 100) +(set-source-rgb 0 0 1) +(stroke) + +;; destroy object, after this, it will be ready to be GC'd +(setf *context* nil) + +;; call GC +#+sbcl (sb-ext:gc) Modified: tutorial/tutorial.tex ============================================================================== --- tutorial/tutorial.tex (original) +++ tutorial/tutorial.tex Thu Jul 12 10:01:08 2007 @@ -131,9 +131,11 @@ When the context is created from a surface, the reference count of the latter is incremented. You can immediately destroy the surface: it will not be destroyed (ie the file will not be closed) until you -destroy the context. The following code draws a white diagonal line -on a blue background, using a Postscript file -- the result is shown -in Figure~\ref{fig:example}. +destroy the context.\footnote{The file will also be closed if the + wrapper object is garbage collected. However, you should not rely + on this, as calling the garbage collector is not portable.} The +following code draws a white diagonal line on a blue background, using +a Postscript file -- the result is shown in Figure~\ref{fig:example}. \lstinputlisting[firstline=13,lastline=27]{example.lisp} Modified: xlib-context.lisp ============================================================================== --- xlib-context.lisp (original) +++ xlib-context.lisp Thu Jul 12 10:01:08 2007 @@ -69,12 +69,19 @@ (setf (slot-value xlc 'pointer) (mem-ref context-pointer :pointer)) (foreign-free xc-pointer) (foreign-free context-pointer) + ;; register finalizer + (let ((xc (slot-value xlc 'xc))) + (finalize xlc + #'(lambda () + (close_xlib_context xc)))) + ;; return object xlc)) (export 'create-xlib-context) (defmethod destroy ((object xlib-context)) - (close_xlib_context (slot-value object 'xc))) + (close_xlib_context (slot-value object 'xc)) + (cancel-finalization object)) (defmethod sync ((object xlib-context)) (sync_xlib (slot-value object 'xc)))

1 0

[cl-cairo2-cvs] r6 - cffi tutorial
by tpapp＠common-lisp.net 21 Jun '07

21 Jun '07

Author: tpapp Date: Thu Jun 21 05:07:42 2007 New Revision: 6 Added: README.xlib-context cffi/ cffi/Makefile cffi/xlib-context.c tutorial/xlib-example.lisp xlib-context.lisp Modified: Makefile cairo.lisp cl-cairo2.asd context.lisp surface.lisp text.lisp transformations.lisp tutorial/example.lisp tutorial/tutorial.tex Log: added svg and xlib support Modified: Makefile ============================================================================== --- Makefile (original) +++ Makefile Thu Jun 21 05:07:42 2007 @@ -9,4 +9,4 @@ mkdir /tmp/cl-cairo2-latest cp * -R /tmp/cl-cairo2-latest tar -cvzf /tmp/cl-cairo2-latest.tar.gz -C /tmp cl-cairo2-latest - gpg -b -a /tmp/cl-cairo2-latest.tar.gz \ No newline at end of file + gpg -b -a /tmp/cl-cairo2-latest.tar.gz Added: README.xlib-context ============================================================================== --- (empty file) +++ README.xlib-context Thu Jun 21 05:07:42 2007 @@ -0,0 +1,14 @@ +The xlib context is not part of cairo -- it is a bit of glue code that +uses cairo's X11 surface on a pixmap, and displays this pixmap when +needed (when X11 asks for the window contents to be redrawn or when +cairo draws on the pixmap). For the latter, it uses the XDamage +extension. + +The shared library that contains the glue code has to be compiled and +installed manually in /usr/local/lib/. Running + +make install + +as root from the cffi subdirectory should take care of this. You need +to have the XDamage library and header files (eg package +libxdamage-dev on Debian) installed. Modified: cairo.lisp ============================================================================== --- cairo.lisp (original) +++ cairo.lisp Thu Jun 21 05:07:42 2007 @@ -18,13 +18,15 @@ ;;;; commonly used macros/functions ;;;; -(defun prepend-intern (prefix name &optional (replace-dash t)) +(defun prepend-intern (prefix name &key (replace-dash t) (suffix "")) "Create and intern symbol PREFIXNAME from NAME, optionally - replacing dashes in name. PREFIX is converted to upper case." + replacing dashes in name. PREFIX is converted to upper case. + If given, suffix is appended at the end." (let ((name-as-string (symbol-name name))) (when replace-dash (setf name-as-string (substitute #\_ #\- name-as-string))) - (intern (concatenate 'string (string-upcase prefix) name-as-string)))) + (intern (concatenate 'string (string-upcase prefix) + name-as-string (string-upcase suffix))))) (defun copy-double-vector-to-pointer (vector pointer) "Copies vector of double-floats to a memory location." Added: cffi/Makefile ============================================================================== --- (empty file) +++ cffi/Makefile Thu Jun 21 05:07:42 2007 @@ -0,0 +1,10 @@ +INSTALL=/usr/local/lib + +install: xlib-context.so + cp xlib-context.so $(INSTALL) + +xlib-context.so: xlib-context.o + gcc -shared -o xlib-context.so xlib-context.o -lXdamage + +xlib-context.o: xlib-context.c + gcc -c -fPIC xlib-context.c -I /usr/include/cairo Added: cffi/xlib-context.c ============================================================================== --- (empty file) +++ cffi/xlib-context.c Thu Jun 21 05:07:42 2007 @@ -0,0 +1,210 @@ +#include <stdlib.h> +#include <stdio.h> +#include <X11/Xlib.h> +#include <X11/Xatom.h> +#include <X11/Xutil.h> +#include <X11/extensions/Xdamage.h> +#include <cairo-xlib.h> + +#define TRUE 1 +#define FALSE 0 + +/* #define DEBUG */ + +/* error codes */ +#define ERROR_OUTOFMEMORY 1 +#define ERROR_OPENDISPLAY 2 +#define ERROR_XDAMAGEMISSING 3 + +#define RETURN_ERROR(err) { free(xc); return (err); } + +/* structur */ +typedef struct { + unsigned int width; + unsigned int height; + Display *display; + int screen; + Window window; + Pixmap pixmap; + GC gc; +} xlib_context_data; + +/************************************************************************ + * create_xlib_context -- create an X11 window that acts as a context * + * * + * Parameters * + * display_name -- name of the X11 display, eg ":0" * + * window_name -- name of the X11 window * + * width, height -- width and height in pixels * + * xc_pointer -- see below * + * context_pointer -- points to the location which contains a pointer * + * to a cairo_t structure * + * * + * Notes * + * This function is meant to be called in a separate thread. If * + * successful, it allocates an xlib_context_data structure and puts * + * the pointer in *xc_pointer, and also initializes its contents with * + * the relevant data. A cairo_t context is created and assigned to * + * *context_pointer. * + * * + * The window has fixed size (width x height). The context is * + * attached to an X11 pixmap, which is copied onto the screen when * + * 1) X asks for the window contents to be redrawn, 2) the pixmap is * + * changed by cairo. The latter is handled via the X Damage * + * extension, which needs to be available. * + * * + * * + * * + ************************************************************************/ +int +create_xlib_context(char *display_name, + char *window_name, + unsigned int width, + unsigned int height, + xlib_context_data **xc_pointer, + cairo_t **context_pointer) +{ + Window root; /* root window */ + Visual *visual; /* visual */ + int depth; /* depth */ + XEvent ev; /* event */ + cairo_surface_t *surface; /* surface */ + Atom prots[1]; + int damage_event, damage_error; /* for querying extension */ + Damage damage; /* damage notification handler */ + XDamageNotifyEvent *dev; + cairo_t *context; + XSizeHints *hints; + + xlib_context_data *xc = (void *)NULL; + /* initialize pointer with NULL */ + *xc_pointer = NULL; + /* allocate xlib_context */ + xc = malloc( sizeof(xlib_context_data) ); + if (!xc) + RETURN_ERROR(ERROR_OUTOFMEMORY); + /* open display, get screen, root, visual, and depth */ + xc->display = XOpenDisplay(display_name); + if (!xc->display) + RETURN_ERROR( ERROR_OPENDISPLAY ); + xc->screen = DefaultScreen(xc->display); + root = RootWindow(xc->display, xc->screen); + visual = DefaultVisual(xc->display, xc->screen); + depth = DefaultDepth(xc->display, xc->screen); + /* check X damage extension */ + if (!XDamageQueryExtension( xc->display, &damage_event, &damage_error )) + RETURN_ERROR( ERROR_XDAMAGEMISSING ); + /* create window and pixmap */ + xc->window = XCreateSimpleWindow(xc->display, root, 0, 0, width, height, 0, 0, + WhitePixel (xc->display, xc->screen)); + xc->pixmap = XCreatePixmap(xc->display, xc->window, width, height, depth); + /* size hints */ + hints = XAllocSizeHints(); + hints->min_width = width; + hints->min_height = height; + hints->max_width = width; + hints->max_height = height; + hints->flags = PMinSize | PMaxSize; + XSetWMNormalHints(xc->display, xc->window, hints); + XFree(hints); + /* window name */ + XStoreName(xc->display,xc->window,window_name); + /* graphics context */ + xc->gc = XCreateGC(xc->display, xc->pixmap, 0, 0); + /* setup damage notification */ + damage = XDamageCreate( xc->display, xc->pixmap, XDamageReportNonEmpty ); + /* select events, map window */ + XSelectInput( xc->display, xc->window, + ExposureMask | StructureNotifyMask | KeyPressMask | KeyReleaseMask | + SubstructureNotifyMask ); + /* handle window closing */ + prots[0] = XInternAtom(xc->display, "WM_DELETE_WINDOW", FALSE); + XSetWMProtocols(xc->display, xc->window, prots, 1); + /* map window */ + XMapWindow(xc->display, xc->window); + /* allocate structure, create cairo surface */ + surface = cairo_xlib_surface_create( xc->display, xc->pixmap, visual, + width, height ); + context = cairo_create(surface); + cairo_surface_destroy(surface); + /* set pointers before we start loop */ +#ifdef DEBUG + FILE *debug = fopen("/tmp/debug","w"); + fprintf(debug, "before setting: xc_pointer=%p *xc_pointer=%p context_pointer=%p *context_pointer=%p\n", xc_pointer, *xc_pointer, context_pointer, *context_pointer); +#endif /* DEBUG */ + *xc_pointer = xc; + *context_pointer = context; +#ifdef DEBUG + fprintf(debug, "xc=%p=%p context=%p=%p\n", xc, *xc_pointer, + context, *context_pointer); + fprintf(debug, "damage_event=%d, XDamageNotify=%d\n", damage_event, XDamageNotify); + fflush(debug); +#endif /* DEBUG */ + /* main loop */ + for (;;) { + XNextEvent(xc->display, &ev); +#ifdef DEBUG + fprintf(debug, "event of type %d\n", ev.type); + fflush(debug); +#endif /* DEBUG */ + if (ev.type == (damage_event + XDamageNotify)) { + dev = (XDamageNotifyEvent *) &ev; +#ifdef DEBUG + fprintf(debug, "damage event received\n"); + fflush(debug); +#endif /* DEBUG */ + /* !!!! should only update the rectangle */ + XCopyArea(xc->display, xc->pixmap, xc->window, xc->gc, 0, 0, + width, height, 0, 0); + XDamageSubtract( xc->display, dev->damage, None, None ); + } else { + switch (ev.type) { + case Expose: +#ifdef DEBUG + fprintf(debug, "expose event received\n"); + fflush(debug); +#endif /* DEBUG */ + if (ev.xexpose.count > 0) + break; + /* !!!! should only update the rectangle */ + XCopyArea(xc->display, xc->pixmap, xc->window, xc->gc, 0, 0, + width, height, 0, 0); + break; + case DestroyNotify: + case ClientMessage: + /* cleanup & close */ + XDamageDestroy( xc->display, damage ); + XDestroyWindow( xc->display, xc->window ); + XCloseDisplay( xc->display ); +#ifdef DEBUG + fprintf(debug,"cleaning up\n"); + fclose(debug); +#endif /* DEBUG */ + free(xc); + return(0); + default: + break; + } + } + } +} + +/************************************************************************ + * close_xlib_context -- send a destroy even to the window * + * * + * Note * + * We just send the event, all the cleanup will be done by the * + * event handler loop. * + ************************************************************************/ +void close_xlib_context(xlib_context_data *xc) +{ + XEvent ev; + ev.type = DestroyNotify; + XSendEvent(xc->display, xc->window, FALSE, 0, &ev); + XFlush(xc->display); +} + +void sync_xlib(xlib_context_data *xc) +{ + XFlush(xc->display); +} Modified: cl-cairo2.asd ============================================================================== --- cl-cairo2.asd (original) +++ cl-cairo2.asd Thu Jun 21 05:07:42 2007 @@ -1,6 +1,6 @@ (defsystem cl-cairo2 :description "Cairo 1.4 bindings" - :version "0.1" + :version "0.2" :author "Tamas K Papp" :license "GPL" :components ((:file "package") @@ -11,5 +11,8 @@ (:file "context" :depends-on ("surface" "cl-cairo2-swig")) (:file "path" :depends-on ("context")) ; "cl-cairo2-swig")) (:file "text" :depends-on ("context")) ; "cl-cairo2-swig")) - (:file "transformations" :depends-on ("context"))) ; "cl-cairo2-swig"))) + (:file "transformations" :depends-on ("context")) ; "cl-cairo2-swig"))) + (:file "xlib-context" :depends-on ("context") + :in-order-to ((load-op (feature :unix)) + (compile-op (feature :unix))))) :depends-on (:cffi)) Modified: context.lisp ============================================================================== --- context.lisp (original) +++ context.lisp Thu Jun 21 05:07:42 2007 @@ -38,6 +38,10 @@ (cairo_destroy pointer) (setf pointer nil)))) +(defmethod sync ((object context)) + ;; most contexts don't need syncing + ) + ;;;; ;;;; default context and convenience macros ;;;; @@ -66,6 +70,16 @@ (with-context (context pointer) (,(prepend-intern "cairo_" name) pointer ,@args))))) +(defmacro define-with-default-context-sync (name &rest args) + "Define cairo function with *context* as its first argument and + args as the rest, automatically mapping name to the appropriate + cairo function. sync will be called after the operation." + `(export + (defun ,name (,@args &optional (context *context*)) + (with-context (context pointer) + (,(prepend-intern "cairo_" name) pointer ,@args)) + (sync context)))) + (defmacro define-flexible ((name pointer &rest args) &body body) "Like define-with-default context, but with arbitrary body, pointer will point to the context." @@ -85,20 +99,23 @@ (defmacro define-get-set (property) "Define set-property and get-property functions." `(progn - (define-with-default-context ,(prepend-intern "get-" property nil)) - (define-with-default-context ,(prepend-intern "set-" property nil) ,property))) + (define-with-default-context ,(prepend-intern "get-" property :replace-dash nil)) + (define-with-default-context ,(prepend-intern "set-" property :replace-dash nil) + ,property))) (defmacro define-get-set-using-table (property) "Define set-property and get-property functions, where property is looked up in table-property for conversion into Cairo's enum constants." `(progn - (define-flexible (,(prepend-intern "get-" property nil) pointer) - (lookup-cairo-enum (,(prepend-intern "cairo_get_" property) pointer) - ,(prepend-intern "table-" property nil))) - (define-flexible (,(prepend-intern "set-" property nil) pointer ,property) - (,(prepend-intern "cairo_set_" property) pointer - (lookup-enum ,property ,(prepend-intern "table-" property nil)))))) + (define-flexible (,(prepend-intern "get-" property :replace-dash nil) pointer) + (lookup-cairo-enum (,(prepend-intern "cairo_get_" property) pointer) + ,(prepend-intern "table-" property :replace-dash nil))) + (define-flexible (,(prepend-intern "set-" property :replace-dash nil) + pointer ,property) + (,(prepend-intern "cairo_set_" property) pointer + (lookup-enum ,property ,(prepend-intern "table-" + property :replace-dash nil)))))) ;;;; ;;;; simple functions using context @@ -116,14 +133,15 @@ (clip) (clip-preserve) (reset-clip) - (fill-preserve) - (paint) - (paint-with-alpha alpha) - (stroke) - (stroke-preserve) (copy-page) (show-page)) +(define-with-default-context-sync fill-preserve) +(define-with-default-context-sync paint) +(define-with-default-context-sync paint-with-alpha alpha) +(define-with-default-context-sync stroke) +(define-with-default-context-sync stroke-preserve) + ;;;; ;;;; functions that get/set a property without any conversion ;;;; @@ -142,11 +160,11 @@ (define-get-set-using-table line-join) (define-get-set-using-table operator) - ;; fill-path: it should simply be fill, but it is renamed so it does ;; not clash with cl-user:fill (define-flexible (fill-path pointer) - (cairo_fill pointer)) + (cairo_fill pointer) + (sync context)) (define-flexible (set-dash pointer offset dashes) (let ((num-dashes (length dashes))) Modified: surface.lisp ============================================================================== --- surface.lisp (original) +++ surface.lisp Thu Jun 21 05:07:42 2007 @@ -13,7 +13,7 @@ ;;;; class surface ;;;; -(defclass surface () ((pointer :initform nil))) +(defclass surface () ((pointer :initarg :pointer :initform nil))) (defmacro with-alive-surface ((surface pointer) &body body) "Execute body with pointer pointing to cairo surface, if nil, @@ -52,46 +52,54 @@ (setf pointer nil))) ;;;; -;;;; PDF surface +;;;; Macros to create surfaces (that are written into files) and +;;;; direct creation of contexts for these surfaces. ;;;; -(export - (defun create-pdf-surface (filename width-in-points height-in-points) - (new-surface-with-check - (cairo_pdf_surface_create filename - width-in-points - height-in-points)))) +(defmacro define-create-surface (type) + `(export + (defun ,(prepend-intern "create-" type :replace-dash nil :suffix "-surface") + (filename width-in-points height-in-points) + (new-surface-with-check + (,(prepend-intern "cairo_" type :replace-dash nil + :suffix "_surface_create") + filename width-in-points height-in-points))))) + +(defmacro define-create-context (type) + `(export + (defun ,(prepend-intern "create-" type :replace-dash nil :suffix "-context") + (filename width-in-points height-in-points) + "Create a surface, then a context for a file, then +destroy (dereference) the surface. The user only needs to +destroy the context when done." + (let* ((surface (,(prepend-intern "create-" + type :replace-dash nil :suffix "-surface") + filename width-in-points height-in-points)) + (context (create-context surface))) + (destroy surface) + context)))) -(export - (defun create-pdf-context (filename width-in-points height-in-points) - "Create a surface, then a context for a pdf file, then - destroy (dereference) the surface. The user only needs to - destroy the context when done." - (let* ((surface (create-pdf-surface filename width-in-points height-in-points)) - (context (create-context surface))) - (destroy surface) - context))) + +;;;; +;;;; PDF surface +;;;; + +(define-create-surface pdf) +(define-create-context pdf) ;;;; ;;;; PostScript surface ;;;; -(export - (defun create-ps-surface (filename width-in-points height-in-points) - (new-surface-with-check - (cairo_ps_surface_create filename - width-in-points - height-in-points)))) +(define-create-surface ps) +(define-create-context ps) -(export - (defun create-ps-context (filename width-in-points height-in-points) - "Create a surface, then a context for a postscript file, then - destroy (dereference) the surface. The user only needs to - destroy the context when done." - (let* ((surface (create-ps-surface filename width-in-points height-in-points)) - (context (create-context surface))) - (destroy surface) - context))) +;;;; +;;;; SVG surface +;;;; + +(define-create-surface svg) +(define-create-context svg) ;;;; ;;;; image surface Modified: text.lisp ============================================================================== --- text.lisp (original) +++ text.lisp Thu Jun 21 05:07:42 2007 @@ -37,4 +37,4 @@ extents-pointer cairo_text_extents_t) (values x_bearing y_bearing width height x_advance y_advance)))) -(define-with-default-context show-text text) +(define-with-default-context-sync show-text text) Modified: transformations.lisp ============================================================================== --- transformations.lisp (original) +++ transformations.lisp Thu Jun 21 05:07:42 2007 @@ -123,7 +123,7 @@ "Define a matrix initializer function with args, which returns the new matrix." `(export - (defun ,(prepend-intern "trans-matrix-init-" name nil) ,args + (defun ,(prepend-intern "trans-matrix-init-" name :replace-dash nil) ,args (with-trans-matrix-out matrix-pointer (,(prepend-intern "cairo_matrix_init_" name) matrix-pointer @@ -138,7 +138,7 @@ "Define a matrix transformation function with matrix and args, which returns the new matrix." `(export - (defun ,(prepend-intern "trans-matrix-init-" name nil) (matrix ,@args) + (defun ,(prepend-intern "trans-matrix-init-" name :replace-dash nil) (matrix ,@args) (with-trans-matrix-in-out matrix matrix-pointer (,(prepend-intern "cairo_matrix_" name) matrix-pointer Modified: tutorial/example.lisp ============================================================================== --- tutorial/example.lisp (original) +++ tutorial/example.lisp Thu Jun 21 05:07:42 2007 @@ -6,7 +6,29 @@ (in-package :cairo-example) +;;;; +;;;; short example for the tutorial +;;;; + +(defparameter *surface* (create-ps-surface "example.ps" 200 100)) +(setf *context* (create-context *surface*)) +(destroy *surface*) +;; clear the whole canvas with blue +(rectangle 0 0 200 100) +(set-source-rgb 0.2 0.2 1) +(fill-path) +;; draw a white diagonal line +(move-to 200 0) +(line-to 0 100) +(set-source-rgb 1 1 1) +(set-line-width 5) +(stroke) +;; destroy context, this also destroys the surface and closes the file +(destroy *context*) + +;;;; ;;;; helper functions +;;;; (defun show-text-aligned (text x y &optional (x-align 0.5) (y-align 0.5) (context *context*)) @@ -150,25 +172,3 @@ (scale scaling scaling) ; scale (rotate (deg-to-rad (- (random (* 2 max-angle)) max-angle 180))) ; rotate (heart (+ 0.1 (random 0.7)))))) - - -;;;; -;;;; short example for the tutorial -;;;; - -(defparameter *surface* (create-ps-surface "example.ps" 200 100)) -(setf *context* (create-context *surface*)) -(destroy *surface*) -;; clear the whole canvas with blue -(rectangle 0 0 200 100) -(set-source-rgb 0.2 0.2 1) -(fill-path) -;; draw a white diagonal line -(move-to 0 0) -(line-to 200 100) -(set-source-rgb 1 1 1) -(set-line-width 5) -(stroke) -;; destroy context, this also destroys the surface and closes the file -(destroy *context*) - Modified: tutorial/tutorial.tex ============================================================================== --- tutorial/tutorial.tex (original) +++ tutorial/tutorial.tex Thu Jun 21 05:07:42 2007 @@ -135,7 +135,7 @@ on a blue background, using a Postscript file -- the result is shown in Figure~\ref{fig:example}. -\lstinputlisting[firstline=159,lastline=173]{example.lisp} +\lstinputlisting[firstline=13,lastline=27]{example.lisp} \begin{figure}[htbp] \centering @@ -223,9 +223,12 @@ \lstinline!new-surface-with-check! makes a new surface object from a pointer, checking its status first. -Currently, only Postscript, PDF and image surfaces (which can be +Currently, only Postscript, PDF, SVG and image surfaces (which can be written to PNG files) are supported. +Drawing in X11 windows is implemented using the +\lstinline!xlib-context! class --- see Section~\ref{sec:xlib-context} +for more information. \subsection{Contexts} \label{sec:contexts} @@ -318,6 +321,35 @@ with \lstinline!trans-matrix-!, and other a few other functions have been renamed to avoid conflicts with linear algebra packages. +\subsection{Xlib Contexts} +\label{sec:xlib-context} + +The xlib context is not part of cairo -- it is a bit of glue code that +uses cairo's X11 surface on a pixmap, and displays this pixmap when +needed (when X11 asks for the window contents to be redrawn or when +cairo draws on the pixmap). For the latter, it uses the XDamage +extension. + +The X11 event loop runs in a separate thread, so you need a Lisp +implementation that supports threads. The surface is not exposed to +the user, who is only allowed to see the context. This makes memory +management and proper cleanup easier. + +\textbf{Important:} before proceeding, make sure that you read +\verb!README.xlib-context! on how to install the shared library with +the necessary code. + +You can create Xlib contexts with +\begin{lstlisting} + (create-xlib-context width height) +\end{lstlisting} +When \lstinline!destroy!ed, the window is closed. This works the +other way too: when the window is closed, the context is destroyed. + +Example code can be found in \verb!tutorial/xlib-example.lisp!. The +current implementation is not optimized for speed (the whole window is +redrawn all the time) but it is fast enough for me. If you need speed +improvements desperately, please contact the author. \subsection{To Do} \label{sec:todo} @@ -325,9 +357,7 @@ The list below reflects my priorities. If you need something, please let me know. \begin{itemize} -\item X-Window surface \item patterns (should be easy) -\item SVG surfaces (should be quick \& easy) \item Win32 surfaces (I can't do it, I don't use Windows) \item CLOS integration for fonts (as suggested \href{http://www.cairographics.org/manual/bindings-fonts.html}{here}) @@ -370,18 +400,6 @@ \label{fig:hearts} \end{figure} - - - - - - - - - -% \bibliographystyle{apalike} -% \bibliography{/home/tpapp/doc/general.bib} - \end{document} %%% Local Variables: Added: tutorial/xlib-example.lisp ============================================================================== --- (empty file) +++ tutorial/xlib-example.lisp Thu Jun 21 05:07:42 2007 @@ -0,0 +1,57 @@ +(asdf:operate 'asdf:load-op :cl-cairo2) + +;;;; Make a test package +(defpackage :cairo-xlib-example + (:use :common-lisp :cl-cairo2)) + +(in-package :cairo-xlib-example) + +(let ((width 400) + (height 300)) + (setf *context* (create-xlib-context width height)) + ;; clear the whole canvas with blue + (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)) +;; need to close window manually + + +(defun random-square (alpha) + "Draw a blue rectangle with fixed size and the given transparency alpha." + (move-to 1 1) + (line-to -1 1) + (line-to -1 -1) + (line-to 1 -1) + (close-path) + (set-source-rgba 0 0 1 alpha) + (fill-path)) + +(defparameter width 800) +(defparameter height 600) +(defparameter max-angle 90d0) +(setf *context* (create-xlib-context width height)) +;; fill with white +(rectangle 0 0 width height) +(set-source-rgb 1 1 1) +(fill-path) +;; draw the rectangles +(dotimes (i 500) + (let ((scaling (+ 5d0 (random 40d0)))) + (reset-matrix) ; reset matrix + (translate (random width) (random height)) ; move the origin + (scale scaling scaling) ; scale + (rotate (deg-to-rad (random max-angle))) ; rotate + (random-square (+ 0.1 (random 0.4))))) +;; need to close window manually Added: xlib-context.lisp ============================================================================== --- (empty file) +++ xlib-context.lisp Thu Jun 21 05:07:42 2007 @@ -0,0 +1,80 @@ +(in-package :cl-cairo2) + +;;;; +;;;; a little glue code loaded as a shared library +;;;; + +;; modify path if needed +(load-foreign-library "/usr/local/lib/xlib-context.so") + +;; code to make threads, please extend with your own Lisp if needed +;; testing is welcome, I only tested cmucl and sbcl +(defun start-thread (function name) + #+allegro (mp:process-run-function name function) + #+armedbear (ext:make-thread function :name name) + #+cmu (mp:make-process function :name name) + #+lispworks (mp:process-run-function name nil function) + #+openmcl (ccl:process-run-function name function) + #+sbcl (sb-thread:make-thread function :name name)) + +;;;; +;;;; CFFI interface +;;;; + +(cffi:defcfun ("create_xlib_context" create_xlib_context) :int + (display_name :string) + (window_name :string) + (width :unsigned-int) + (height :unsigned-int) + (xc-pointer :pointer) + (context-pointer :pointer)) + +(cffi:defcfun ("close_xlib_context" close_xlib_context) :void + (xc-pointer :pointer)) + +(cffi:defcfun ("sync_xlib" sync_xlib) :void + (xc-pointer :pointer)) + + +;;;; xlib-context class + +(defclass xlib-context (context) (xc thread)) + +(defun create-xlib-context (width height &key (display-name ":0") + (window-name "cl-cairo2")) + "Create a cairo context that draws to an X11 window of specified size." + (let ((xlc (make-instance 'xlib-context)) + (xc-pointer (foreign-alloc :pointer)) + (context-pointer (foreign-alloc :pointer))) + ;; we will detect changes with null-pointer-p + (setf (mem-ref xc-pointer :pointer) (null-pointer)) + (setf (mem-ref context-pointer :pointer) (null-pointer)) + ;; start and save thread + (setf (slot-value xlc 'thread) + (start-thread + (lambda () + (let ((err (create_xlib_context display-name window-name width height + xc-pointer context-pointer))) + (unless (zerop err) + (error "Error ~a when creating xlib-context." err))) + ;; set slots to nil when done + (with-slots (xc pointer) xlc + (setf xc nil) + (setf pointer nil))) + "cl-cairo2")) + ;; extract slots + (do () ; wait for thread to fill pointers + ((not (null-pointer-p (mem-ref context-pointer :pointer))))) + (setf (slot-value xlc 'xc) (mem-ref xc-pointer :pointer)) + (setf (slot-value xlc 'pointer) (mem-ref context-pointer :pointer)) + (foreign-free xc-pointer) + (foreign-free context-pointer) + xlc)) + +(export 'create-xlib-context) + +(defmethod destroy ((object xlib-context)) + (close_xlib_context (slot-value object 'xc))) + +(defmethod sync ((object xlib-context)) + (sync_xlib (slot-value object 'xc)))

1 0

[cl-cairo2-cvs] r5 - tutorial
by tpapp＠common-lisp.net 04 Jun '07

04 Jun '07

Author: tpapp Date: Mon Jun 4 03:13:31 2007 New Revision: 5 Modified: tutorial/Makefile tutorial/tutorial.tex Log: Tutorial now uses eps files. Modified: tutorial/Makefile ============================================================================== --- tutorial/Makefile (original) +++ tutorial/Makefile Mon Jun 4 03:13:31 2007 @@ -1,5 +1,8 @@ tutorial.pdf: tutorial.dvi dvipdfm tutorial -tutorial.dvi: tutorial.tex hearts.png lissajous.ps text.ps example.ps +tutorial.dvi: tutorial.tex hearts.png lissajous.epsi text.epsi example.epsi latex tutorial.tex + +%.epsi: %.ps + ps2epsi $< $@ Modified: tutorial/tutorial.tex ============================================================================== --- tutorial/tutorial.tex (original) +++ tutorial/tutorial.tex Mon Jun 4 03:13:31 2007 @@ -139,7 +139,7 @@ \begin{figure}[htbp] \centering - \includegraphics{example.ps} + \includegraphics{example.epsi} \caption{white diagonal line on a blue background} \label{fig:example} \end{figure} @@ -351,14 +351,14 @@ \begin{figure}[htbp] \centering - \includegraphics[height=8cm]{text.ps} + \includegraphics[height=8cm]{text.epsi} \caption{text.pdf} \label{fig:text} \end{figure} \begin{figure}[htbp] \centering - \includegraphics[height=8cm]{lissajous.ps} + \includegraphics[height=8cm]{lissajous.epsi} \caption{lissajous.pdf} \label{fig:lissajous} \end{figure}

1 0

[cl-cairo2-cvs] r4 - tutorial
by tpapp＠common-lisp.net 30 May '07

30 May '07

Author: tpapp Date: Tue May 29 22:35:50 2007 New Revision: 4 Removed: tutorial/.tex Log: Deleted cruft

1 0

[cl-cairo2-cvs] r3 - tutorial
by tpapp＠common-lisp.net 30 May '07

30 May '07

Author: tpapp Date: Tue May 29 22:23:32 2007 New Revision: 3 Removed: tutorial/tutorial.lisp Modified: Makefile README tutorial/Makefile tutorial/example.lisp tutorial/tutorial.tex Log: Cleaned up examples Modified: Makefile ============================================================================== --- Makefile (original) +++ Makefile Tue May 29 22:23:32 2007 @@ -3,3 +3,10 @@ test-swig.lisp: test.i swig -cffi -generate-typedef test.i + +asdf: + rm -Rf /tmp/cl-cairo2-latest + mkdir /tmp/cl-cairo2-latest + cp * -R /tmp/cl-cairo2-latest + tar -cvzf /tmp/cl-cairo2-latest.tar.gz -C /tmp cl-cairo2-latest + gpg -b -a /tmp/cl-cairo2-latest.tar.gz \ No newline at end of file Modified: README ============================================================================== --- README (original) +++ README Tue May 29 22:23:32 2007 @@ -1,6 +1,6 @@ Please read the tutorial to get started. To compile the tutorial from source, you will need a reasonably complete LaTeX installation with -dvipdfm, and the pdftops utility. +dvipdfm. The project webpage is at http://common-lisp.net/project/cl-cairo2, where you will find the repository, mailing lists, contact information Modified: tutorial/Makefile ============================================================================== --- tutorial/Makefile (original) +++ tutorial/Makefile Tue May 29 22:23:32 2007 @@ -1,12 +1,5 @@ tutorial.pdf: tutorial.dvi dvipdfm tutorial -tutorial.dvi: tutorial.tex hearts.png lissajous.eps text.eps +tutorial.dvi: tutorial.tex hearts.png lissajous.ps text.ps example.ps latex tutorial.tex - -lissajous.eps: lissajous.pdf - pdftops -eps lissajous.pdf lissajous.eps - -text.eps: ../text.pdf - pdftops -eps text.pdf text.eps - Modified: tutorial/example.lisp ============================================================================== --- tutorial/example.lisp (original) +++ tutorial/example.lisp Tue May 29 22:23:32 2007 @@ -47,7 +47,7 @@ (defparameter size 50) (defparameter x 20) (defparameter y 50) -(setf *context* (create-pdf-context "text.pdf" width height)) +(setf *context* (create-ps-context "text.ps" width height)) ;; white background (rectangle 0 0 width height) (set-source-rgb 1 1 1) @@ -89,7 +89,7 @@ (defparameter b 8) (defparameter delta (/ pi 2)) (defparameter density 2000) -(setf *context* (create-pdf-context "lissajous.pdf" size size)) +(setf *context* (create-ps-context "lissajous.ps" size size)) ;; pastel blue background (rectangle 0 0 width height) (set-source-rgb 0.9 0.9 1) @@ -150,3 +150,25 @@ (scale scaling scaling) ; scale (rotate (deg-to-rad (- (random (* 2 max-angle)) max-angle 180))) ; rotate (heart (+ 0.1 (random 0.7)))))) + + +;;;; +;;;; short example for the tutorial +;;;; + +(defparameter *surface* (create-ps-surface "example.ps" 200 100)) +(setf *context* (create-context *surface*)) +(destroy *surface*) +;; clear the whole canvas with blue +(rectangle 0 0 200 100) +(set-source-rgb 0.2 0.2 1) +(fill-path) +;; draw a white diagonal line +(move-to 0 0) +(line-to 200 100) +(set-source-rgb 1 1 1) +(set-line-width 5) +(stroke) +;; destroy context, this also destroys the surface and closes the file +(destroy *context*) + Modified: tutorial/tutorial.tex ============================================================================== --- tutorial/tutorial.tex (original) +++ tutorial/tutorial.tex Tue May 29 22:23:32 2007 @@ -39,6 +39,7 @@ breaklines=true, % frame=single, columns=fullflexible, + literate={-}{}{0\discretionary{-}{}{-}}, } \begin{document} @@ -134,7 +135,7 @@ on a blue background, using a Postscript file -- the result is shown in Figure~\ref{fig:example}. -\lstinputlisting[firstline=3,lastline=17]{tutorial.lisp} +\lstinputlisting[firstline=159,lastline=173]{example.lisp} \begin{figure}[htbp] \centering @@ -346,18 +347,18 @@ \texttt{example.lisp}. Figures~\ref{fig:text}--\ref{fig:hearts} show the results. -\lstinputlisting{../example.lisp} +\lstinputlisting{example.lisp} \begin{figure}[htbp] \centering - \includegraphics[height=8cm]{text.eps} + \includegraphics[height=8cm]{text.ps} \caption{text.pdf} \label{fig:text} \end{figure} \begin{figure}[htbp] \centering - \includegraphics[height=8cm]{lissajous.eps} + \includegraphics[height=8cm]{lissajous.ps} \caption{lissajous.pdf} \label{fig:lissajous} \end{figure}

1 0

[cl-cairo2-cvs] r2 - .git
by tpapp＠common-lisp.net 28 May '07

28 May '07

Author: tpapp Date: Mon May 28 15:38:28 2007 New Revision: 2 Removed: .git/ svn-commit.2.tmp svn-commit.tmp Log: deleted leftover cruft

1 0