cl-cairo2-cvs

Download

cl-cairo2-cvs@common-lisp.net

May 2008

1 participants
1 discussions

[cl-cairo2-cvs] r20 - tutorial
by tpapp＠common-lisp.net 28 May '08

28 May '08

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.

1 0