[cl-cairo2-cvs] r6 - cffi tutorial
tpapp at common-lisp.net
tpapp at common-lisp.net
Thu Jun 21 09:07:47 UTC 2007
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 , at 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 (, at args &optional (context *context*))
+ (with-context (context pointer)
+ (,(prepend-intern "cairo_" name) pointer , at 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 , at args)
+ (defun ,(prepend-intern "trans-matrix-init-" name :replace-dash nil) (matrix , at 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)))
More information about the Cl-cairo2-cvs
mailing list