From tpapp at common-lisp.net Thu Jul 12 14:01:10 2007 From: tpapp at common-lisp.net (tpapp at common-lisp.net) Date: Thu, 12 Jul 2007 10:01:10 -0400 (EDT) Subject: [cl-cairo2-cvs] r7 - tutorial Message-ID: <20070712140110.36A3F1B01D@common-lisp.net> 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 , at args) + (defun ,(prepend-intern "trans-matrix-" name :replace-dash nil) (matrix , at 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))) From tpapp at common-lisp.net Sat Jul 21 13:41:55 2007 From: tpapp at common-lisp.net (tpapp at common-lisp.net) Date: Sat, 21 Jul 2007 09:41:55 -0400 (EDT) Subject: [cl-cairo2-cvs] r8 - tutorial Message-ID: <20070721134155.7F2305629F@common-lisp.net> 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 , at 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 , at 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 From tpapp at common-lisp.net Sat Jul 21 13:44:56 2007 From: tpapp at common-lisp.net (tpapp at common-lisp.net) Date: Sat, 21 Jul 2007 09:44:56 -0400 (EDT) Subject: [cl-cairo2-cvs] r9 - Message-ID: <20070721134456.965BC83049@common-lisp.net> 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") From tpapp at common-lisp.net Thu Jul 26 14:52:20 2007 From: tpapp at common-lisp.net (tpapp at common-lisp.net) Date: Thu, 26 Jul 2007 10:52:20 -0400 (EDT) Subject: [cl-cairo2-cvs] r10 - tutorial Message-ID: <20070726145220.E9ACC21051@common-lisp.net> 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}