[cl-cairo2-cvs] r20 - tutorial
tpapp at common-lisp.net
tpapp at common-lisp.net
Wed May 28 01:34:02 UTC 2008
Author: tpapp
Date: Tue May 27 21:34:00 2008
New Revision: 20
Modified:
cl-cairo2-swig.lisp
package.lisp
surface.lisp
tables.lisp
tutorial/example.lisp
tutorial/hearts.png
Log:
added image-surface-get-data and minor fixes by Johann Korndoerfer
Modified: cl-cairo2-swig.lisp
==============================================================================
--- cl-cairo2-swig.lisp (original)
+++ cl-cairo2-swig.lisp Tue May 27 21:34:00 2008
@@ -83,9 +83,9 @@
(cl:defconstant CAIRO_VERSION_MAJOR 1)
-(cl:defconstant CAIRO_VERSION_MINOR 4)
+(cl:defconstant CAIRO_VERSION_MINOR 6)
-(cl:defconstant CAIRO_VERSION_MICRO 14)
+(cl:defconstant CAIRO_VERSION_MICRO 4)
(cl:defconstant CAIRO_HAS_SVG_SURFACE 1)
@@ -141,7 +141,9 @@
:CAIRO_STATUS_INVALID_DASH
:CAIRO_STATUS_INVALID_DSC_COMMENT
:CAIRO_STATUS_INVALID_INDEX
- :CAIRO_STATUS_CLIP_NOT_REPRESENTABLE)
+ :CAIRO_STATUS_CLIP_NOT_REPRESENTABLE
+ :CAIRO_STATUS_TEMP_FILE_ERROR
+ :CAIRO_STATUS_INVALID_STRIDE)
(cffi:defcenum cairo_content_t
(:CAIRO_CONTENT_COLOR #x1000)
@@ -401,6 +403,13 @@
(cffi:defcfun ("cairo_close_path" cairo_close_path) :void
(cr :pointer))
+(cffi:defcfun ("cairo_path_extents" cairo_path_extents) :void
+ (cr :pointer)
+ (x1 :pointer)
+ (y1 :pointer)
+ (x2 :pointer)
+ (y2 :pointer))
+
(cffi:defcfun ("cairo_paint" cairo_paint) :void
(cr :pointer))
@@ -680,7 +689,7 @@
:CAIRO_FONT_TYPE_TOY
:CAIRO_FONT_TYPE_FT
:CAIRO_FONT_TYPE_WIN32
- :CAIRO_FONT_TYPE_ATSUI)
+ :CAIRO_FONT_TYPE_QUARTZ)
(cffi:defcfun ("cairo_font_face_get_type" cairo_font_face_get_type) cairo_font_type_t
(font_face :pointer))
@@ -768,6 +777,9 @@
(cffi:defcfun ("cairo_get_antialias" cairo_get_antialias) cairo_antialias_t
(cr :pointer))
+(cffi:defcfun ("cairo_has_current_point" cairo_has_current_point) :int
+ (cr :pointer))
+
(cffi:defcfun ("cairo_get_current_point" cairo_get_current_point) :void
(cr :pointer)
(x :pointer)
@@ -881,7 +893,9 @@
:CAIRO_SURFACE_TYPE_BEOS
:CAIRO_SURFACE_TYPE_DIRECTFB
:CAIRO_SURFACE_TYPE_SVG
- :CAIRO_SURFACE_TYPE_OS2)
+ :CAIRO_SURFACE_TYPE_OS2
+ :CAIRO_SURFACE_TYPE_WIN32_PRINTING
+ :CAIRO_SURFACE_TYPE_QUARTZ_IMAGE)
(cffi:defcfun ("cairo_surface_get_type" cairo_surface_get_type) cairo_surface_type_t
(surface :pointer))
@@ -940,6 +954,12 @@
(x_pixels_per_inch my-double)
(y_pixels_per_inch my-double))
+(cffi:defcfun ("cairo_surface_copy_page" cairo_surface_copy_page) :void
+ (surface :pointer))
+
+(cffi:defcfun ("cairo_surface_show_page" cairo_surface_show_page) :void
+ (surface :pointer))
+
(cffi:defcenum cairo_format_t
:CAIRO_FORMAT_ARGB32
:CAIRO_FORMAT_RGB24
@@ -951,6 +971,10 @@
(width :int)
(height :int))
+(cffi:defcfun ("cairo_format_stride_for_width" cairo_format_stride_for_width) :int
+ (format cairo_format_t)
+ (width :int))
+
(cffi:defcfun ("cairo_image_surface_create_for_data" cairo_image_surface_create_for_data) :pointer
(data :pointer)
(format cairo_format_t)
@@ -1207,6 +1231,10 @@
(cffi:defcfun ("cairo_ft_scaled_font_unlock_face" cairo_ft_scaled_font_unlock_face) :void
(scaled_font :pointer))
+(cffi:defcenum cairo_ps_level_t
+ :CAIRO_PS_LEVEL_2
+ :CAIRO_PS_LEVEL_3)
+
(cffi:defcfun ("cairo_ps_surface_create" cairo_ps_surface_create) :pointer
(filename :string)
(width_in_points my-double)
@@ -1218,6 +1246,24 @@
(width_in_points my-double)
(height_in_points my-double))
+(cffi:defcfun ("cairo_ps_surface_restrict_to_level" cairo_ps_surface_restrict_to_level) :void
+ (surface :pointer)
+ (level cairo_ps_level_t))
+
+(cffi:defcfun ("cairo_ps_get_levels" cairo_ps_get_levels) :void
+ (levels :pointer)
+ (num_levels :pointer))
+
+(cffi:defcfun ("cairo_ps_level_to_string" cairo_ps_level_to_string) :string
+ (level cairo_ps_level_t))
+
+(cffi:defcfun ("cairo_ps_surface_set_eps" cairo_ps_surface_set_eps) :void
+ (surface :pointer)
+ (eps :int))
+
+(cffi:defcfun ("cairo_ps_surface_get_eps" cairo_ps_surface_get_eps) :int
+ (surface :pointer))
+
(cffi:defcfun ("cairo_ps_surface_set_size" cairo_ps_surface_set_size) :void
(surface :pointer)
(width_in_points my-double)
@@ -1241,6 +1287,9 @@
(width :int)
(height :int))
+(cffi:defcfun ("cairo_xlib_surface_get_xrender_format" cairo_xlib_surface_get_xrender_format) :pointer
+ (surface :pointer))
+
(cffi:defcfun ("cairo_pdf_surface_create" cairo_pdf_surface_create) :pointer
(filename :string)
(width_in_points my-double)
Modified: package.lisp
==============================================================================
--- package.lisp (original)
+++ package.lisp Tue May 27 21:34:00 2008
@@ -14,6 +14,7 @@
destroy create-ps-surface create-pdf-surface create-svg-surface
create-image-surface image-surface-get-format
image-surface-get-width image-surface-get-height
+ image-surface-get-data
image-surface-create-from-png surface-write-to-png
;; context
Modified: surface.lisp
==============================================================================
--- surface.lisp (original)
+++ surface.lisp Tue May 27 21:34:00 2008
@@ -113,6 +113,25 @@
width height)
width height t))
+(defun get-bytes-per-pixel (format)
+ (case format
+ (format-argb32 4)
+ (format-rgb24 3)
+ (format-a8 1)
+ (otherwise (error (format nil "unknown format: ~a" format))))) ;todo: how does format-a1 fit in here?
+
+(defun image-surface-get-data (surface)
+ (with-surface (surface pointer)
+ (let* ((width (image-surface-get-width surface))
+ (height (image-surface-get-height surface))
+ (bytes-per-pixel (get-bytes-per-pixel (image-surface-get-format surface)))
+ (buffer (make-array (* width height bytes-per-pixel) :element-type '(unsigned-byte 8) :fill-pointer 0))
+ (data (cairo_image_surface_get_data pointer)))
+ (loop for i from 0 below (* width height bytes-per-pixel) do
+ (vector-push-extend (cffi:mem-ref data :uint8 i) buffer))
+ buffer)))
+
+
(defun image-surface-get-format (surface)
(with-surface (surface pointer)
(lookup-cairo-enum (cairo_image_surface_get_format pointer) table-format)))
Modified: tables.lisp
==============================================================================
--- tables.lisp (original)
+++ tables.lisp Tue May 27 21:34:00 2008
@@ -112,5 +112,5 @@
(defun lookup-enum (enum table)
(let ((cairo-enum (car (rassoc enum table))))
(unless cairo-enum
- (error "Could not find ~a in ~a." cairo-enum table))
+ (error "Could not find ~a in ~a." enum table))
cairo-enum))
Modified: tutorial/example.lisp
==============================================================================
--- tutorial/example.lisp (original)
+++ tutorial/example.lisp Tue May 27 21:34:00 2008
@@ -39,6 +39,79 @@
(- y (* height y-align) y-bearing))
(show-text text))))
+;;;; very simple text example
+(setf *context* (create-ps-context "simpletext.ps" 100 100))
+(move-to 0 100)
+(set-font-size 50)
+(show-text "foo")
+(destroy *context*)
+
+
+;;;;
+;;;; text placement example
+;;;;
+;;;; This example demonstrates the use of text-extents, by placing
+;;;; text aligned relative to a red marker.
+
+(defun mark-at (x y d red green blue)
+ "Make a rectangle of size 2d around x y with the given colors,
+ 50% alpha. Used for marking points."
+ (rectangle (- x d) (- y d) (* 2 d) (* 2 d))
+ (set-source-rgba red green blue 0.5)
+ (fill-path))
+
+(defun show-text-with-marker (text x y x-align y-align)
+ "Show text aligned relative to a red market at (x,y)."
+ (mark-at x y 2 1 0 0)
+ (set-source-rgba 0 0 0 0.6)
+ (show-text-aligned text x y x-align y-align))
+
+(defparameter width 500)
+(defparameter height 500)
+(defparameter text "Fog") ; contains g, which goes below baseline
+(defparameter size 50)
+(defparameter x 20d0)
+(defparameter y 50d0)
+(setf *context* (create-ps-context "text.ps" width height))
+;;(setf *context* (create-svg-context "text.svg" width height))
+;;(setf *context* (create-pdf-context "text.pdf" width height))
+;; white background
+(set-source-rgb 1 1 1)
+(paint)
+;; setup font
+(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
+;; first text in a box
+(multiple-value-bind (x-bearing y-bearing text-width text-height)
+ (text-extents text)
+ (let ((rect-x (+ x x-bearing))
+ (rect-y (+ y y-bearing)))
+ (rectangle rect-x rect-y text-width text-height)
+ (set-source-rgba 0 0 1 0.3) ; blue
+ (set-line-width 1)
+ (set-dash 0 '(5 5))
+ (stroke)))
+(set-source-rgba 0 0 0 0.6)
+(move-to x y)
+(show-text text)
+;; text automatically aligned
+;; (dolist (x-align '(0 0.5 1))
+;; (dolist (y-align '(0 0.5 1))
+;; (show-text-with-marker text (+ x (* x-align 300)) (+ y (* y-align 300) 100)
+;; x-align y-align)))
+(dolist (x-align '(0))
+ (dolist (y-align '(0))
+ (show-text-with-marker text (+ x (* x-align 300)) (+ y (* y-align 300) 100)
+ x-align y-align)))
+
+(show-text-with-marker text x (+ y 100d0) 0d0 0d0)
+;; done
+(destroy *context*)
+
+
+
;;;;
;;;; text placement example
;;;;
@@ -64,7 +137,9 @@
(defparameter size 50)
(defparameter x 20)
(defparameter y 50)
-(setf *context* (create-ps-context "text.ps" width height))
+(setf *context* (create-ps-context "text2.ps" width height))
+;;(setf *context* (create-svg-context "text.svg" width height))
+;;(setf *context* (create-pdf-context "text.pdf" width height))
;; white background
(set-source-rgb 1 1 1)
(paint)
@@ -91,6 +166,9 @@
(dolist (y-align '(0 0.5 1))
(show-text-with-marker text (+ x (* x-align 300)) (+ y (* y-align 300) 100)
x-align y-align)))
+
+(show-text-with-marker text (+ x 0d0) (+ y 0d0 0d0) 0d0 0d0)
+
;; done
(destroy *context*)
Modified: tutorial/hearts.png
==============================================================================
Binary files. No diff available.
More information about the Cl-cairo2-cvs
mailing list