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

   1 ;; Common Lisp bindings for librsvg
   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: rsvg.lisp,v 1.1 2005/11/10 08:53:24 espen Exp $
  24
  25 (in-package "RSVG")
  26
  27
  28 (eval-when (:compile-toplevel :load-toplevel :execute)
  29
  30   (defclass dimension-data (struct)
  31     ((width
  32       :allocation :alien
  33       :initarg :width
  34       :accessor dimension-data-width
  35       :type int)
  36      (height
  37       :allocation :alien
  38       :initarg :height
  39       :accessor dimension-data-height
  40       :type int)
  41      (em
  42       :allocation :alien
  43       :initarg :em
  44       :accessor dimension-data-em
  45       :type double-float)
  46      (ex
  47       :allocation :alien
  48       :initarg :ex
  49       :accessor dimension-data-ex
  50       :type double-float))
  51     (:metaclass struct-class))
  52
  53
  54   (defclass handle (proxy)
  55     ((base-uri
  56       :allocation :virtual
  57       :getter "rsvg_handle_get_base_uri"
  58       :setter "rsvg_handle_set_base_uri"
  59       :accessor handle-base-uri
  60       :type string)
  61      (dimensions
  62       :allocation :virtual
  63       :getter handle-get-dimensions
  64       :reader handle-dimensions
  65       :type dimension-data)
  66      (title
  67       :allocation :virtual
  68       :getter "rsvg_handle_get_title"
  69       :reader handle-title
  70       :type string)
  71      (description
  72       :allocation :virtual
  73       :getter "rsvg_handle_get_desc"
  74       :reader handle-description
  75       :type string)
  76      (metadata
  77       :allocation :virtual
  78       :getter "rsvg_handle_get_metadata"
  79       :reader handle-metadata
  80       :type string))
  81     (:metaclass proxy-class))
  82
  83 )
  84
  85 (defbinding init () nil)
  86 (defbinding term () nil)
  87
  88 (defbinding set-default-dpi () nil
  89   (dpi-x double-float)
  90   (dpi-y double-float))
  91
  92 (defbinding handle-set-dpi () nil
  93   (handle handle)
  94   (dpi-x double-float)
  95   (dpi-y double-float))
  96
  97
  98 (defbinding handle-get-dimensions (handle &optional (dimensions (make-instance 'dimension-data))) nil
  99   (handle handle)
 100   (dimensions dimension-data :return))
 101
 102
 103
 104 (defbinding handle-close () boolean
 105   (handle handle)
 106   (nil gerror :out))
 107
 108 (defbinding %handle-new () pointer)
 109
 110 (defbinding %handle-new-from-file () pointer
 111   (filename pathname)
 112   (nil gerror :out))
 113
 114 (defmethod initialize-instance ((handle handle) &key filename)
 115   (multiple-value-bind (location gerror)
 116       (cond
 117        (filename (%handle-new-from-file filename))
 118        (t (%handle-new)))
 119     (if gerror
 120         (signal-gerror gerror)
 121       (setf (slot-value handle 'location) location)))
 122   (call-next-method))
 123
 124
 125 (defbinding %handle-free () nil
 126   (location pointer))
 127
 128 (defmethod unreference-foreign ((class (eql (find-class 'handle))) location)
 129   (%handle-free location))
 130
 131
 132
 133
 134 ;;; Cairo interface
 135
 136 (defbinding cairo-render () nil
 137   (cr cairo:context)
 138   (handle handle))