;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: cairo.lisp,v 1.3 2006-02-07 17:04:40 espen Exp $
+;; $Id: cairo.lisp,v 1.7 2006-12-24 14:28:20 espen Exp $
(in-package "CAIRO")
(defclass font-face (proxy)
()
- (:metaclass proxy-class))
+ (:metaclass proxy-class)
+ (:ref %font-face-reference)
+ (:unref %font-face-destroy))
(defclass font-options (proxy)
((antialias
:setter "font_options_set_hint_metrics"
:accessor font-options-hint-metrics
:type hint-metrics))
- (:metaclass proxy-class))
+ (:metaclass proxy-class)
+ (:ref %font-options-reference)
+ (:unref %font-options-destroy))
(defclass scaled-font (proxy)
()
- (:metaclass proxy-class))
+ (:metaclass proxy-class)
+ (:ref %scaled-font-reference)
+ (:unref %scaled-font-destroy))
(defclass matrix (struct)
((xx :allocation :alien :initarg :xx :initform 1.0
:setter "cairo_pattern_set_matrix"
:accessor pattern-matrix
:type matrix))
- (:metaclass proxy-class))
+ (:metaclass proxy-class)
+ (:ref %pattern-reference)
+ (:unref %pattern-destroy))
+
+
+ (defclass surface (proxy)
+ ()
+ (:metaclass proxy-class)
+ (:ref %surface-reference)
+ (:unref %surface-destroy))
(defclass context (proxy)
((target
:writer (setf matrix)
:type matrix)
)
- (:metaclass proxy-class))
-
- (defclass surface (proxy)
- ()
- (:metaclass proxy-class))
+ (:metaclass proxy-class)
+ (:ref %reference)
+ (:unref %destroy))
(defclass image-surface (surface)
((width
:getter "cairo_image_surface_get_height"
:reader surface-height
:type int))
- (:metaclass proxy-class))
+ (:metaclass proxy-class)
+ (:ref %surface-reference)
+ (:unref %surface-destroy))
+
;; (defclass path (proxy)
;; ()
(defbinding %destroy () nil
(location pointer))
-(defmethod reference-foreign ((class (eql (find-class 'context))) location)
- (%reference location))
-
-(defmethod unreference-foreign ((class (eql (find-class 'context))) location)
- (%destroy location))
-
(defbinding (save-context "cairo_save") () nil
(cr context))
(defbinding status () status
(cr context))
+(defun ensure-color-component (component)
+ (etypecase component
+ (float component)
+ (integer (/ component 256.0))))
+
(defbinding (set-source-color "cairo_set_source_rgba") (cr red green blue &optional (alpha 1.0)) nil
(cr context)
- (red double-float)
- (green double-float)
- (blue double-float)
- (alpha double-float))
+ ((ensure-color-component red) double-float)
+ ((ensure-color-component green) double-float)
+ ((ensure-color-component blue) double-float)
+ ((ensure-color-component alpha) double-float))
(defbinding set-source-surface () nil
(cr context)
(defbinding new-path () nil
(cr context))
+#?(pkg-exists-p "cairo" :atleast-version "1.2")
+(defbinding new-sub-path () nil
+ (cr context))
+
(defbinding close-path () nil
(cr context))
(defbinding %pattern-destroy () nil
(location pointer))
-(defmethod reference-foreign ((class (eql (find-class 'pattern))) location)
- (%pattern-reference location))
-
-(defmethod unreference-foreign ((class (eql (find-class 'pattern))) location)
- (%pattern-destroy location))
-
(defbinding pattern-status () status
(pattern pattern))
(defbinding (matrix "cairo_get_matrix") () nil
(cr context)
- ((make-instance 'matrix) matrix :return))
+ ((make-instance 'matrix) matrix :in/return))
(defbinding identity-matrix () nil
(cr context))
(defbinding user-to-device () nil
(cr context)
- (x double-float :in-out)
- (y double-float :in-out))
+ (x double-float :in/out)
+ (y double-float :in/out))
-(defbinding user-to-device-distance () nil
+(defbinding user-to-device-distance (cr dx &optional (dy 0.0)) nil
(cr context)
- (dx double-float :in-out)
- (dy double-float :in-out))
+ (dx double-float :in/out)
+ (dy double-float :in/out))
(defbinding device-to-user () nil
(cr context)
- (x double-float :in-out)
- (y double-float :in-out))
+ (x double-float :in/out)
+ (y double-float :in/out))
-(defbinding device-to-user-distance () nil
+(defbinding device-to-user-distance (cr dx &optional (dy 0.0)) nil
(cr context)
- (dx double-float :in-out)
- (dy double-float :in-out))
+ (dx double-float :in/out)
+ (dy double-float :in/out))
;;; Text
(defbinding text-extents (cr text &optional (extents (make-instance 'text-extents))) nil
(cr context)
(text string)
- (extents text-extents :return))
+ (extents text-extents :in/return))
(defbinding glyph-extents (cr glyphs &optional (extents (make-instance 'text-extents))) nil
(cr context)
(glyphs (vector glyph))
((length glyphs) int)
- (extents text-extents :return))
+ (extents text-extents :in/return))
;;; Fonts
(defbinding %font-face-destroy () nil
(location pointer))
-(defmethod reference-foreign ((class (eql (find-class 'font-face))) location)
- (%font-face-reference location))
-
-(defmethod unreference-foreign ((class (eql (find-class 'font-face))) location)
- (%font-face-destroy location))
-
(defbinding font-face-status () status
(font-face font-face))
(defbinding %scaled-font-destroy () nil
(location pointer))
-(defmethod reference-foreign ((class (eql (find-class 'scaled-font))) location)
- (%scaled-font-reference location))
-
-(defmethod unreference-foreign ((class (eql (find-class 'scaled-font))) location)
- (%scaled-font-destroy location))
-
(defbinding scaled-font-status () status
(scaled-font scaled-font))
(defbinding scaled-font-extents (scaled-font &optional (extents (make-instance 'text-extents))) nil
(scaled-font scaled-font)
- (extents text-extents :return))
+ (extents text-extents :in/return))
(defbinding scaled-font-glyph-extents (scaled-font glyphs &optional (extents (make-instance 'text-extents))) nil
(scaled-font scaled-font)
(glyphs (vector glyph))
((length glyphs) int)
- (extents text-extents :return))
+ (extents text-extents :in/return))
(defbinding %scaled-font-create () pointer
(font-face font-face)
(ctm matrix)
(options font-options))
-(defmethod initialize-instance ((scaled-font scaled-font) &key font-face font-matrix cmt options)
- (setf
- (slot-value scaled-font 'location)
- (%scaled-font-create font-face font-matrix cmt options))
- (call-next-method))
+(defmethod allocate-foreign ((scaled-font scaled-font) &key font-face font-matrix cmt options)
+ (%scaled-font-create font-face font-matrix cmt options))
(defbinding %font-options-destroy () nil
(location pointer))
-(defmethod reference-foreign ((class (eql (find-class 'font-options))) location)
- (%font-options-copy location))
-
-(defmethod unreference-foreign ((class (eql (find-class 'font-options))) location)
- (%font-options-destroy location))
-
(defbinding font-options-status () status
(font-options font-options))
(defbinding %font-options-create () pointer)
-(defmethod initialize-instance ((font-options font-options) &rest initargs)
+(defmethod allocate-foreign ((font-options font-options) &rest initargs)
(declare (ignore initargs))
- (setf (slot-value font-options 'location) (%font-options-create))
- (call-next-method))
+ (%font-options-create))
(defbinding font-options-merge () nil
- (options1 font-options :return)
+ (options1 font-options :in/return)
(options2 font-options))
(defbinding font-options-hash () unsigned-int
(defbinding %surface-destroy () nil
(location pointer))
-(defmethod reference-foreign ((class (eql (find-class 'surface))) location)
- (%surface-reference location))
-
-(defmethod unreference-foreign ((class (eql (find-class 'surface))) location)
- (%surface-destroy location))
-
(defbinding surface-create-similar () surface
(other surface)
(format surface-format )
(defbinding surface-get-font-options () nil
(surface surface)
- ((make-instance 'font-options) font-options :return))
+ ((make-instance 'font-options) font-options :in/return))
(defbinding surface-set-device-offset () nil
(surface surface)
;; Image Surface
;; Should data be automatically freed when the surface is GCed?
-(defmethod initialize-instance ((surface image-surface)
- &key width height stride format data)
- (setf
- (slot-value surface 'location)
- (if (not data)
- (%image-surface-create format width height)
- (%image-surface-create-for-data data format width height
- (or
- stride
- (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8))))))
- (ceiling (* width element-size)))))))
- (call-next-method))
+(defmethod allocate-foreign ((surface image-surface)
+ &key width height stride format data)
+ (if (not data)
+ (%image-surface-create format width height)
+ (%image-surface-create-for-data data format width height
+ (or
+ stride
+ (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8))))))
+ (ceiling (* width element-size)))))))
(defbinding %image-surface-create () image-surface
;;; Matrices
(defbinding matrix-init () nil
- (matrix matrix :return)
+ (matrix matrix :in/return)
(xx double-float) (yx double-float)
(xy double-float) (yy double-float)
(x0 double-float) (y0 double-float))
(defbinding matrix-init-identity () nil
- (matrix matrix :return))
+ (matrix matrix :in/return))
(defbinding matrix-init-translate () nil
- (matrix matrix :return)
+ (matrix matrix :in/return)
(tx double-float)
(ty double-float))
(defbinding matrix-init-scale () nil
- (matrix matrix :return)
+ (matrix matrix :in/return)
(sx double-float)
(sy double-float))
(defbinding matrix-init-rotate () nil
- (matrix matrix :return)
+ (matrix matrix :in/return)
(radians double-float))
(defbinding matrix-translate () nil
- (matrix matrix :return)
+ (matrix matrix :in/return)
(tx double-float)
(ty double-float))
(defbinding matrix-scale () nil
- (matrix matrix :return)
+ (matrix matrix :in/return)
(sx double-float)
(sy double-float))
(defbinding matrix-rotate () nil
- (matrix matrix :return)
+ (matrix matrix :in/return)
(radians double-float))
(defbinding matrix-invert () nil
- (matrix matrix :return))
+ (matrix matrix :in/return))
(defbinding matrix-multiply () nil
(result matrix :out)
(b matrix))
(defbinding matrix-transform-distance () nil
- (matrix matrix :return)
+ (matrix matrix :in/return)
(dx double-float)
(dy double-float))
(defbinding matrix-transform-point () nil
- (matrix matrix :return)
+ (matrix matrix :in/return)
(x double-float)
(y double-float))
~mdw / clg / blobdiff