/[cl-cairo2]/surface.lisp
ViewVC logotype

Diff of /surface.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 17 by tpapp, Sun Mar 23 22:58:24 2008 UTC revision 20 by tpapp, Wed May 28 01:34:00 2008 UTC
# Line 113  Line 113 
113                                 width height)                                 width height)
114     width height t))     width height t))
115    
116    (defun get-bytes-per-pixel (format)
117      (case format
118        (format-argb32 4)
119        (format-rgb24 3)
120        (format-a8 1)
121        (otherwise (error (format nil "unknown format: ~a" format))))) ;todo: how does format-a1 fit in here?
122    
123    (defun image-surface-get-data (surface)
124      (with-surface (surface pointer)
125        (let* ((width (image-surface-get-width surface))
126               (height (image-surface-get-height surface))
127               (bytes-per-pixel (get-bytes-per-pixel (image-surface-get-format surface)))
128               (buffer (make-array (* width height bytes-per-pixel) :element-type '(unsigned-byte 8) :fill-pointer 0))
129               (data (cairo_image_surface_get_data pointer)))
130          (loop for i from 0 below (* width height bytes-per-pixel) do
131             (vector-push-extend (cffi:mem-ref data :uint8 i) buffer))
132          buffer)))
133    
134    
135  (defun image-surface-get-format (surface)  (defun image-surface-get-format (surface)
136    (with-surface (surface pointer)    (with-surface (surface pointer)
137      (lookup-cairo-enum (cairo_image_surface_get_format pointer) table-format)))      (lookup-cairo-enum (cairo_image_surface_get_format pointer) table-format)))

Legend:
Removed from v.17  
changed lines
  Added in v.20

  ViewVC Help
Powered by ViewVC 1.1.5