cl-cairo2-cvs

Download

cl-cairo2-cvs@common-lisp.net

June 2007

1 participants
2 discussions

[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