chiark - git - mdw - clg/blob - cairo/cairo.lisp

   1 ;; Common Lisp bindings for Cairo
   2 ;; Copyright 2005 Espen S. Johnsen <espen@users.sf.net>
   3 ;;
   4 ;; Permission is hereby granted, free of charge, to any person obtaining
   5 ;; a copy of this software and associated documentation files (the
   6 ;; "Software"), to deal in the Software without restriction, including
   7 ;; without limitation the rights to use, copy, modify, merge, publish,
   8 ;; distribute, sublicense, and/or sell copies of the Software, and to
   9 ;; permit persons to whom the Software is furnished to do so, subject to
  10 ;; the following conditions:
  11 ;;
  12 ;; The above copyright notice and this permission notice shall be
  13 ;; included in all copies or substantial portions of the Software.
  14 ;;
  15 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  16 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  17 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  18 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  19 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
  20 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
  21 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  22
  23 ;; $Id: cairo.lisp,v 1.10 2007-01-13 00:15:36 espen Exp $
  24
  25 (in-package "CAIRO")
  26
  27 (eval-when (:compile-toplevel :load-toplevel :execute)
  28   (define-enum-type surface-format :argb32 :rgb24 :a8 :a1)
  29   #?(pkg-exists-p "cairo" :atleast-version "1.2")
  30   (define-enum-type content :color :alpha :color-alpha)
  31   #?(pkg-exists-p "cairo" :atleast-version "1.2")
  32   (define-enum-type surface-type
  33     :image :pdf :ps :xlib :xcb :glitz :quartz :win32 :beos :directfb
  34     :svg :nquartz :os2)
  35
  36
  37   (define-enum-type status
  38     :success :no-memory :invalid-restore :invalid-pop-group
  39     :no-current-point :invalid-matrix :invalid-status :null-pointer
  40     :invalid-string :invalid-path-data :read-error :write-error
  41     :surface-finished :surface-type-mismatch :pattern-type-mismatch
  42     :invalid-content :invalid-format :invalid-visual :file-not-found
  43     :invalid-dash)
  44
  45   (define-enum-type fill-rule :winding :even-odd)
  46   (define-enum-type line-cap :butt :round :square)
  47   (define-enum-type line-join :miter :round :bevel)
  48   (define-enum-type font-slant :normal :itaic :oblique)
  49   (define-enum-type font-weight :normal :bold)
  50
  51   (define-enum-type operator
  52    :clear :source :over :in :out :atop :dest :dest-over
  53    :dest-in :dest-out :dest-atop :xor :add :saturate)
  54
  55   (define-enum-type antialias :default :none :gray :subpixel)
  56   (define-enum-type extend :none :repeat :reflect)
  57   (define-enum-type filter :fast :good :best :nearest :bilinear :gaussian)
  58   (define-enum-type subpixel-order :default :rgb :bgr :vrgb :vbgr)
  59   (define-enum-type hint-style :default :none :slight :medium :full)
  60   (define-enum-type hint-metrics :default :off :on)
  61
  62   (defclass glyph (struct)
  63     ((index
  64       :allocation :alien
  65       :initarg :index
  66       :accessor glyph-index
  67       :type unsigned-long)
  68      (x
  69       :allocation :alien
  70       :initarg :x
  71       :accessor glyph-x
  72       :type double-float)
  73      (y
  74       :allocation :alien
  75       :initarg :y
  76       :accessor glyph-y
  77       :type double-float))
  78     (:metaclass struct-class))
  79
  80   (defclass font-face (ref-counted-object)
  81     ()
  82     (:metaclass proxy-class)
  83     (:ref %font-face-reference)
  84     (:unref %font-face-destroy))
  85
  86   (defclass font-options (ref-counted-object)
  87     ((antialias
  88       :allocation :virtual
  89       :getter "font_options_get_antialias"
  90       :setter "font_options_set_antialias"
  91       :accessor font-options-antialias
  92       :type antialias)
  93      (subpixel-order
  94       :allocation :virtual
  95       :getter "font_options_get_subpixel_order"
  96       :setter "font_options_set_subpixel_order"
  97       :accessor font-options-subpixel-order
  98       :type subpixel-order)
  99      (hint-style
 100       :allocation :virtual
 101       :getter "font_options_get_hint_style"
 102       :setter "font_options_set_hint_style"
 103       :accessor font-options-hint-style
 104       :type hint-style)
 105      (hint-metrics
 106       :allocation :virtual
 107       :getter "font_options_get_hint_metrics"
 108       :setter "font_options_set_hint_metrics"
 109       :accessor font-options-hint-metrics
 110       :type hint-metrics))
 111     (:metaclass proxy-class)
 112     (:ref %font-options-reference)
 113     (:unref %font-options-destroy))
 114
 115   (defclass scaled-font (ref-counted-object)
 116     ()
 117     (:metaclass proxy-class)
 118     (:ref %scaled-font-reference)
 119     (:unref %scaled-font-destroy))
 120
 121   (defclass matrix (struct)
 122     ((xx :allocation :alien :initarg :xx :initform 1.0
 123          :accessor matrix-xx :type double-float)
 124      (yx :allocation :alien  :initarg :yx :initform 0.0
 125          :accessor matrix-yx :type double-float)
 126      (xy :allocation :alien  :initarg :xy :initform 1.0
 127          :accessor matrix-xy :type double-float)
 128      (yy :allocation :alien  :initarg :yy :initform 0.0
 129          :accessor matrix-yy :type double-float)
 130      (x0 :allocation :alien  :initarg :x0 :initform 0.0
 131          :accessor matrix-x0 :type double-float)
 132      (y0 :allocation :alien  :initarg :y0 :initform 0.0
 133          :accessor matrix-y0 :type double-float))
 134     (:metaclass struct-class))
 135
 136
 137   (defclass text-extents (struct)
 138     ((x-bearing :allocation :alien :reader text-extents-x-bearing :type double-float)
 139      (y-bearing :allocation :alien :reader text-extents-y-bearing :type double-float)
 140      (width :allocation :alien :reader text-extents-width :type double-float)
 141      (height :allocation :alien :reader text-extents-height :type double-float)
 142      (x-advance :allocation :alien :reader text-extents-x-advance :type double-float)
 143      (y-advance :allocation :alien :reader text-extents-y-advance :type double-float))
 144     (:metaclass struct-class))
 145
 146   (defclass pattern (ref-counted-object)
 147     ((extend
 148       :allocation :virtual
 149       :getter "cairo_pattern_get_extend"
 150       :setter "cairo_pattern_set_extend"
 151       :accessor pattern-extend
 152       :type extend)
 153      (filter
 154       :allocation :virtual
 155       :getter "cairo_pattern_get_filter"
 156       :setter "cairo_pattern_set_filter"
 157       :accessor pattern-filter
 158       :type filter)
 159      (matrix
 160       :allocation :virtual
 161       :getter "cairo_pattern_get_matrix"
 162       :setter "cairo_pattern_set_matrix"
 163       :accessor pattern-matrix
 164       :type matrix))
 165     (:metaclass proxy-class)
 166     (:ref %pattern-reference)
 167     (:unref %pattern-destroy))
 168
 169
 170   (defclass surface (ref-counted-object)
 171     (#?(pkg-exists-p "cairo" :atleast-version "1.2")
 172      (type
 173       :allocation :virtual
 174       :getter "cairo_surface_get_type"
 175       :reader surface-type
 176       :type surface-type)
 177      #?(pkg-exists-p "cairo" :atleast-version "1.2")
 178      (content
 179       :allocation :virtual
 180       :getter "cairo_surface_get_content"
 181       :reader surface-content
 182       :type content))
 183     (:metaclass proxy-class)
 184     (:ref %surface-reference)
 185     (:unref %surface-destroy))
 186
 187   (defclass context (ref-counted-object)
 188     ((target
 189       :allocation :virtual
 190       :getter "cairo_get_target"
 191       :reader target
 192       :type surface)
 193      (source
 194       :allocation :virtual
 195       :getter "cairo_get_source"
 196       :setter "cairo_set_source"
 197       :accessor source
 198       :type pattern)
 199      (antialias
 200       :allocation :virtual
 201       :getter "cairo_get_antialias"
 202       :setter "cairo_set_antialias"
 203       :accessor antialias
 204       :type antialias)
 205      (tolerance
 206       :allocation :virtual
 207       :getter "cairo_get_tolerance"
 208       :setter "cairo_set_tolerance"
 209       :accessor tolerance
 210       :type double-float)
 211      (fill-rule
 212       :allocation :virtual
 213       :getter "cairo_get_fill_rule"
 214       :setter "cairo_set_fill_rule"
 215       :accessor fill-rule
 216       :type fill-rule)
 217      (line-width
 218       :allocation :virtual
 219       :getter "cairo_get_line_width"
 220       :setter "cairo_set_line_width"
 221       :accessor line-width
 222       :type double-float)
 223      (line-cap
 224       :allocation :virtual
 225       :getter "cairo_get_line_cap"
 226       :setter "cairo_set_line_cap"
 227       :accessor line-cap
 228       :type line-cap)
 229      (line-join
 230       :allocation :virtual
 231       :getter "cairo_get_line_join"
 232       :setter "cairo_set_line_join"
 233       :accessor line-join
 234       :type line-join)
 235      (miter-limit
 236       :allocation :virtual
 237       :getter "cairo_get_miter_limit"
 238       :setter "cairo_set_miter_limit"
 239       :accessor miter-limit
 240       :type double-float)
 241      (font-matrix
 242       :allocation :virtual
 243       :getter "cairo_get_font_matrix"
 244       :setter "cairo_set_font_matrix"
 245       :accessor font-matrix
 246       :type matrix)
 247      (font-options
 248       :allocation :virtual
 249       :getter "cairo_get_font_options"
 250       :setter "cairo_set_font_options"
 251       :accessor font-options
 252       :type font-options)
 253      (font-face
 254       :allocation :virtual
 255       :getter "cairo_get_font_face"
 256       :setter "cairo_set_font_face"
 257       :accessor font-face
 258       :type font-face)
 259      (operator
 260       :allocation :virtual
 261       :getter "cairo_get_operator"
 262       :setter "cairo_set_operator"
 263       :accessor operator
 264       :type operator)
 265      (matrix
 266       :allocation :virtual
 267       :getter matrix
 268       :setter "cairo_set_matrix"
 269       :writer (setf matrix)
 270       :type matrix)
 271      )
 272     (:metaclass proxy-class)
 273     (:ref %reference)
 274     (:unref %destroy))
 275
 276   (defclass image-surface (surface)
 277     (#?(pkg-exists-p "cairo" :atleast-version "1.2")
 278      (data
 279       :allocation :virtual
 280       :getter "cairo_image_surface_get_data"
 281       :reader surface-data
 282       :type pointer)
 283      #?(pkg-exists-p "cairo" :atleast-version "1.2")
 284      (format
 285       :allocation :virtual
 286       :getter "cairo_image_surface_get_format"
 287       :reader surface-format
 288       :type surface-format)
 289      (width
 290       :allocation :virtual
 291       :getter "cairo_image_surface_get_width"
 292       :reader surface-width
 293       :type int)
 294      (height
 295       :allocation :virtual
 296       :getter "cairo_image_surface_get_height"
 297       :reader surface-height
 298       :type int)
 299      #?(pkg-exists-p "cairo" :atleast-version "1.2")
 300      (stride
 301       :allocation :virtual
 302       :getter "cairo_image_surface_get_stride"
 303       :reader surface-height
 304       :type int))
 305     (:metaclass proxy-class))
 306
 307   #?(pkg-exists-p "cairo" :atleast-version "1.2")
 308   (progn
 309     (defclass xlib-surface (surface)
 310       ((width
 311         :allocation :virtual
 312         :getter "cairo_xlib_surface_get_width"
 313         :reader surface-width
 314         :type int)
 315        (height
 316         :allocation :virtual
 317         :getter "cairo_xlib_surface_get_height"
 318         :reader surface-height
 319         :type int))
 320       (:metaclass proxy-class))
 321
 322     (defclass pdf-surface (surface)
 323       ()
 324       (:metaclass proxy-class))
 325
 326     (defclass ps-surface (surface)
 327       ()
 328       (:metaclass proxy-class))
 329
 330     (defclass svg-surface (surface)
 331       ()
 332       (:metaclass proxy-class)))
 333
 334
 335
 336 ;;   (defclass path (proxy)
 337 ;;     ()
 338 ;;     (:metaclass proxy-class))
 339
 340 )
 341
 342
 343 ;;; Cairo context
 344
 345 (defbinding %reference () pointer
 346   (location pointer))
 347
 348 (defbinding %destroy () nil
 349   (location pointer))
 350
 351 (defbinding (save-context "cairo_save") () nil
 352   (cr context))
 353
 354 (defbinding (restore-context "cairo_restore") () nil
 355   (cr context))
 356
 357 (defmacro with-context ((cr) &body body)
 358   (let ((context (make-symbol "CONTEXT")))
 359     `(let ((,context ,cr))
 360        (save-context ,context)
 361        (unwind-protect
 362            (progn ,@body)
 363          (restore-context ,context)))))
 364
 365 (defbinding status () status
 366   (cr context))
 367
 368 (defun ensure-color-component (component)
 369   (etypecase component
 370     (float component)
 371     (integer (/ component 256.0))))
 372
 373 (defbinding (set-source-color "cairo_set_source_rgba") (cr red green blue &optional (alpha 1.0)) nil
 374   (cr context)
 375   ((ensure-color-component red) double-float)
 376   ((ensure-color-component green) double-float)
 377   ((ensure-color-component blue) double-float)
 378   ((ensure-color-component alpha) double-float))
 379
 380 (defbinding set-source-surface (cr surface &optional (x 0.0) (y 0.0)) nil
 381   (cr context)
 382   (surface surface)
 383   (x double-float)
 384   (y double-float))
 385
 386 (defun set-source (cr source)
 387   (etypecase source
 388     (pattern (setf (source cr) source))
 389     (surface (set-source-surface cr source))
 390     (list (apply #'set-source-color cr source))
 391     (vector (apply #'set-source-color cr (coerce source 'list)))
 392     (null (set-source-color cr 0.0 0.0 0.0))))
 393
 394 (defbinding set-dash (cr dashes &optional (offset 0.0)) nil
 395   (cr context)
 396   (dashes (vector double-float))
 397   ((length dashes) int)
 398   (offset double-float))
 399
 400 (defbinding (paint "cairo_paint_with_alpha") (cr &optional (alpha 1.0)) nil
 401   (cr context)
 402   (alpha double-float))
 403
 404 (defbinding mask () nil
 405   (cr context)
 406   (pattern pattern))
 407
 408 (defbinding mask-surface () nil
 409   (cr context)
 410   (surface surface)
 411   (surface-x double-float)
 412   (surface-y double-float))
 413
 414 (defmacro defoperator (name &optional clip-p)
 415   (let ((iname (intern (format nil "%~A" name)))
 416         (pname (intern (format nil "%~A-PRESERVE" name))))
 417     `(progn
 418        (defbinding ,iname () nil
 419          (cr context))
 420        (defbinding ,pname () nil
 421          (cr context))
 422        (defun ,name (cr &optional preserve)
 423          (if preserve
 424              (,pname cr)
 425            (,iname cr)))
 426        ,(unless clip-p
 427           (let ((tname (intern (format nil "IN-~A-P" name)))
 428                 (ename (intern (format nil "~A-EXTENTS" name))))
 429             `(progn
 430                (defbinding ,tname () boolean
 431                  (cr context)
 432                  (x double-float)
 433                  (y double-float))
 434                (defbinding ,ename () nil
 435                  (cr context)
 436                  (x1 double-float :out)
 437                  (y1 double-float :out)
 438                  (x2 double-float :out)
 439                  (y2 double-float :out))))))))
 440
 441 (defoperator clip t)
 442 (defoperator stroke)
 443 (defoperator fill)
 444
 445 (defbinding reset-clip () nil
 446   (cr context))
 447
 448 (defbinding copy-page () nil
 449   (cr context))
 450
 451 (defbinding show-page () nil
 452   (cr context))
 453
 454
 455 ;;; Paths
 456
 457 (defbinding get-current-point () nil
 458   (cr context)
 459   (x double-float :out)
 460   (y double-float :out))
 461
 462 (defbinding new-path () nil
 463   (cr context))
 464
 465 #?(pkg-exists-p "cairo" :atleast-version "1.2")
 466 (defbinding new-sub-path () nil
 467   (cr context))
 468
 469 (defbinding close-path () nil
 470   (cr context))
 471
 472 (defmacro defpath (name args &optional relative-p)
 473   (flet ((def (name type)
 474            `(progn
 475               ,(when (eq type 'optimized-double-float)
 476                  `(declaim (ftype (function (context ,@(loop repeat (length args) collect 'double-float))) ,(first name))))
 477               (defbinding ,name () nil
 478                 (cr context)
 479                 ,@(mapcar #'(lambda (arg) (list arg type)) args)))))
 480
 481   `(progn
 482      ,(def name 'double-float)
 483      ,(let ((name (intern (format nil "FAST-~A" name)))
 484             (cname (gffi::default-alien-fname name)))
 485         (def (list name cname) 'optimized-double-float))
 486      ,@(when relative-p
 487          (let* ((rel-name (intern (format nil "REL-~A" name)))
 488                 (fast-rel-name (intern (format nil "FAST-REL-~A" name)))
 489                 (cname (gffi::default-alien-fname rel-name)))
 490            (list
 491             (def rel-name 'double-float)
 492             (def (list fast-rel-name cname) 'optimized-double-float)))))))
 493
 494
 495 (defpath arc (xc yc radius angle1 angle2))
 496 (defpath arc-negative (xc yc radius angle1 angle2))
 497 (defpath curve-to (x1 y1 x2 y2 x3 y3) t)
 498 (defpath line-to (x y) t)
 499 (defpath move-to (x y) t)
 500 (defpath rectangle (x y width height))
 501
 502 (defun circle (cr x y radius)
 503   (arc cr x y radius 0.0 (* pi 2)))
 504
 505 (defbinding glyph-path (cr glyphs) nil
 506   (cr context)
 507   (glyphs (vector glyph))
 508   ((length glyphs) int))
 509
 510 (defbinding text-path () nil
 511   (cr context)
 512   (text string))
 513
 514
 515
 516 ;;; Patterns
 517
 518 (defbinding (pattern-add-color-stop "cairo_pattern_add_color_stop_rgba")
 519     (pattern offset red green blue &optional (alpha 1.0)) nil
 520   (pattern pattern)
 521   (offset double-float)
 522   ((ensure-color-component red) double-float)
 523   ((ensure-color-component green) double-float)
 524   ((ensure-color-component blue) double-float)
 525   ((ensure-color-component alpha) double-float))
 526
 527 (defbinding (pattern-create "cairo_pattern_create_rgba")
 528     (red green blue &optional (alpha 1.0)) pattern
 529   ((ensure-color-component red) double-float)
 530   ((ensure-color-component green) double-float)
 531   ((ensure-color-component blue) double-float)
 532   ((ensure-color-component alpha) double-float))
 533
 534 (defbinding pattern-create-for-surface () pattern
 535   (surface surface))
 536
 537 (defbinding pattern-create-linear () pattern
 538   (x0 double-float)
 539   (y0 double-float)
 540   (x1 double-float)
 541   (y1 double-float))
 542
 543 (defbinding pattern-create-radial () pattern
 544   (cx0 double-float)
 545   (cy0 double-float)
 546   (radius0 double-float)
 547   (cx1 double-float)
 548   (cy1 double-float)
 549   (radius1 double-float))
 550
 551 (defbinding %pattern-reference () pointer
 552   (location pointer))
 553
 554 (defbinding %pattern-destroy () nil
 555   (location pointer))
 556
 557 (defbinding pattern-status () status
 558   (pattern pattern))
 559
 560
 561
 562 ;;; Transformations
 563
 564 (defbinding translate () nil
 565   (cr context)
 566   (tx double-float)
 567   (ty double-float))
 568
 569 (defbinding scale (cr sx &optional (sy sx)) nil
 570   (cr context)
 571   (sx double-float)
 572   (sy double-float))
 573
 574 (defun scale-to-device (cr &optional keep-rotation-p)
 575   (if keep-rotation-p
 576       (multiple-value-call #'scale cr (device-to-user-distance cr 1.0))
 577     (multiple-value-bind (x y)
 578         (multiple-value-call #'user-to-device cr (get-current-point cr))
 579       (identity-matrix cr)
 580       (translate cr x y))))
 581
 582 (defbinding rotate () nil
 583   (cr context)
 584   (angle double-float))
 585
 586 (defbinding transform () nil
 587   (cr context)
 588   (matrix matrix))
 589
 590 (defbinding (matrix "cairo_get_matrix") () nil
 591   (cr context)
 592   ((make-instance 'matrix) matrix :in/return))
 593
 594 (defbinding identity-matrix () nil
 595   (cr context))
 596
 597 (defbinding user-to-device () nil
 598   (cr context)
 599   (x double-float :in/out)
 600   (y double-float :in/out))
 601
 602 (defbinding user-to-device-distance (cr dx &optional (dy dx)) nil
 603   (cr context)
 604   (dx double-float :in/out)
 605   (dy double-float :in/out))
 606
 607 (defbinding device-to-user () nil
 608   (cr context)
 609   (x double-float :in/out)
 610   (y double-float :in/out))
 611
 612 (defbinding device-to-user-distance (cr dx &optional (dy dx)) nil
 613   (cr context)
 614   (dx double-float :in/out)
 615   (dy double-float :in/out))
 616
 617
 618 ;;; Text
 619
 620 (defbinding select-font-face () nil
 621   (cr context)
 622   (family string)
 623   (slant font-slant)
 624   (weight font-weight))
 625
 626 (defbinding set-font-size () nil
 627   (cr context)
 628   (size double-float))
 629
 630 (defbinding show-text () nil
 631   (cr context)
 632   (text string))
 633
 634 (defbinding show-glyphs () nil
 635   (cr context)
 636   (glyphs (vector glyph))
 637   ((length glyphs) int))
 638
 639 (defbinding font-extents () boolean
 640   (cr context))
 641
 642 (defbinding text-extents (cr text &optional (extents (make-instance 'text-extents))) nil
 643   (cr context)
 644   (text string)
 645   (extents text-extents :in/return))
 646
 647 (defbinding glyph-extents (cr glyphs &optional (extents (make-instance 'text-extents))) nil
 648   (cr context)
 649   (glyphs (vector glyph))
 650   ((length glyphs) int)
 651   (extents text-extents :in/return))
 652
 653
 654 ;;; Fonts
 655
 656 (defbinding %font-face-reference () pointer
 657   (location pointer))
 658
 659 (defbinding %font-face-destroy () nil
 660   (location pointer))
 661
 662 (defbinding font-face-status () status
 663   (font-face font-face))
 664
 665
 666
 667 ;;; Scaled Fonts
 668
 669 (defbinding %scaled-font-reference () pointer
 670   (location pointer))
 671
 672 (defbinding %scaled-font-destroy () nil
 673   (location pointer))
 674
 675 (defbinding scaled-font-status () status
 676   (scaled-font scaled-font))
 677
 678 (defbinding scaled-font-extents (scaled-font &optional (extents (make-instance 'text-extents))) nil
 679   (scaled-font scaled-font)
 680   (extents text-extents :in/return))
 681
 682 (defbinding scaled-font-glyph-extents (scaled-font glyphs &optional (extents (make-instance 'text-extents))) nil
 683   (scaled-font scaled-font)
 684   (glyphs (vector glyph))
 685   ((length glyphs) int)
 686   (extents text-extents :in/return))
 687
 688 (defbinding %scaled-font-create () pointer
 689   (font-face font-face)
 690   (font-matrix matrix)
 691   (ctm matrix)
 692   (options font-options))
 693
 694 (defmethod allocate-foreign ((scaled-font scaled-font) &key font-face font-matrix cmt options)
 695   (%scaled-font-create font-face font-matrix cmt options))
 696
 697
 698
 699 ;;; Font Options
 700
 701
 702 (defbinding %font-options-copy () nil
 703   (location pointer))
 704
 705 (defbinding %font-options-destroy () nil
 706   (location pointer))
 707
 708 (defbinding font-options-status () status
 709   (font-options font-options))
 710
 711 (defbinding %font-options-create () pointer)
 712
 713 (defmethod allocate-foreign ((font-options font-options) &rest initargs)
 714   (declare (ignore initargs))
 715   (%font-options-create))
 716
 717 (defbinding font-options-merge () nil
 718   (options1 font-options :in/return)
 719   (options2 font-options))
 720
 721 (defbinding font-options-hash () unsigned-int
 722   (options font-options))
 723
 724 (defbinding font-options-equal-p () boolean
 725   (options1 font-options)
 726   (options2 font-options))
 727
 728
 729
 730 ;;; Surfaces
 731
 732 (defbinding %surface-reference () pointer
 733   (location pointer))
 734
 735 (defbinding %surface-destroy () nil
 736   (location pointer))
 737
 738 (defbinding surface-create-similar () surface
 739   (other surface)
 740   (format surface-format )
 741   (width int)
 742   (height int))
 743
 744 (defbinding surface-finish () nil
 745   (surface surface))
 746
 747 (defbinding surface-flush () nil
 748   (surface surface))
 749
 750 (defbinding surface-get-font-options () nil
 751   (surface surface)
 752   ((make-instance 'font-options) font-options :in/return))
 753
 754 (defbinding surface-set-device-offset () nil
 755   (surface surface)
 756   (x-offset double-float)
 757   (y-offset double-float))
 758
 759 (defbinding surface-status () status
 760   (surface surface))
 761
 762 (defbinding %surface-mark-dirty () nil
 763   (surface surface))
 764
 765 (defbinding %surface-mark-dirty-rectangle () nil
 766   (surface surface)
 767   (x int)
 768   (y int)
 769   (width int)
 770   (height int))
 771
 772 (defun surface-mark-dirty (surface &optional x y width height)
 773   (if x
 774       (%surface-mark-dirty-rectangle surface x y width height)
 775     (%surface-mark-dirty surface)))
 776
 777 #?(pkg-exists-p "cairo" :atleast-version "1.2")
 778 (defbinding surface-set-fallback-resolution () nil
 779   (surface surface)
 780   (x-pixels-per-inch double-float)
 781   (y-pixels-per-inch double-float))
 782
 783
 784 ;; Image Surface
 785
 786 ;; Should data be automatically freed when the surface is GCed?
 787 (defmethod allocate-foreign ((surface image-surface)
 788                              &key width height stride format data)
 789   (if (not data)
 790       (%image-surface-create format width height)
 791     (%image-surface-create-for-data data format width height
 792      (or
 793       stride
 794       (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8))))))
 795         (ceiling (* width element-size)))))))
 796
 797
 798 (defbinding %image-surface-create () image-surface
 799   (format surface-format)
 800   (width int)
 801   (hegit int))
 802
 803 (defbinding %image-surface-create-for-data () image-surface
 804   (data pointer)
 805   (format surface-format)
 806   (width int)
 807   (hegit int)
 808   (stride int))
 809
 810
 811
 812 ;;; PNG Surface
 813
 814 (defbinding image-surface-create-from-png (filename) image-surface
 815   ((truename filename) pathname))
 816
 817
 818
 819
 820 ;;; Matrices
 821
 822 (defbinding matrix-init () nil
 823   (matrix matrix :in/return)
 824   (xx double-float) (yx double-float)
 825   (xy double-float) (yy double-float)
 826   (x0 double-float) (y0 double-float))
 827
 828 (defbinding matrix-init-identity () nil
 829   (matrix matrix :in/return))
 830
 831 (defbinding matrix-init-translate () nil
 832   (matrix matrix :in/return)
 833   (tx double-float)
 834   (ty double-float))
 835
 836 (defbinding matrix-init-scale () nil
 837   (matrix matrix :in/return)
 838   (sx double-float)
 839   (sy double-float))
 840
 841 (defbinding matrix-init-rotate () nil
 842   (matrix matrix :in/return)
 843   (radians double-float))
 844
 845 (defbinding matrix-translate () nil
 846   (matrix matrix :in/return)
 847   (tx double-float)
 848   (ty double-float))
 849
 850 (defbinding matrix-scale () nil
 851   (matrix matrix :in/return)
 852   (sx double-float)
 853   (sy double-float))
 854
 855 (defbinding matrix-rotate () nil
 856   (matrix matrix :in/return)
 857   (radians double-float))
 858
 859 (defbinding matrix-invert () nil
 860   (matrix matrix :in/return))
 861
 862 (defbinding matrix-multiply () nil
 863   (result matrix :out)
 864   (a matrix)
 865   (b matrix))
 866
 867 (defbinding matrix-transform-distance () nil
 868   (matrix matrix :in/return)
 869   (dx double-float)
 870   (dy double-float))
 871
 872 (defbinding matrix-transform-point () nil
 873   (matrix matrix :in/return)
 874   (x double-float)
 875   (y double-float))
 876
 877
 878