[cl-cairo2-cvs] r7 - tutorial

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