chiark / gitweb /
Minor change to define-callback
[clg] / pango / pango.lisp
index 75ee2b0856548d524f076968c2c813f044fe3ac4..bd522cf8e47c0a01608219fae330724a41727da5 100644 (file)
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: pango.lisp,v 1.12 2006/08/30 11:08:13 espen Exp $
+;; $Id: pango.lisp,v 1.15 2007/09/07 07:39:59 espen Exp $
 
 (in-package "PANGO")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (init-types-in-library #.(concatenate 'string 
-                           (pkg-variable "pango" "libdir")
-                           "/libpango-1.0." asdf:*dso-extension*) 
-                        :prefix "pango_")
-  (init-types-in-library #.(concatenate 'string 
-                           (pkg-variable "pango" "libdir")
-                           "/libpangoxft-1.0." asdf:*dso-extension*) 
-                        :prefix "pango_xft")
-  (init-types-in-library #.(concatenate 'string 
-                           (pkg-variable "pango" "libdir")
-                           "/libpangoft2-1.0." asdf:*dso-extension*) 
-                        :prefix "pango_fc"))
+  (init-types-in-library pango "libpango-1.0" :prefix "pango_")
+  (init-types-in-library pango "libpangoxft-1.0" :prefix "pango_xft")
+  (init-types-in-library pango "libpangoft2-1.0" :prefix "pango_fc")
+  (init-types-in-library pango "libpangocairo-1.0" :prefix "pango_cairo"))
 
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (define-types-by-introspection "Pango")
-
-  (defclass font-description (boxed)
-    ((family
-      :allocation :virtual
-      :initarg :family
-      :getter "pango_font_description_get_family"
-      :setter "pango_font_description_set_family"
-      :boundp %font-description-family-boundp
-      :makunbound %font-description-family-makunbound
-      :accessor font-description-family
-      :type string)
-     (style
-      :allocation :virtual
-      :initarg :style
-      :getter "pango_font_description_get_style"
-      :setter "pango_font_description_set_style"
-      :boundp %font-description-style-boundp
-      :makunbound %font-description-style-makunbound
-      :accessor font-description-style
-      :type style)
-     (variant
-      :allocation :virtual
-      :initarg :variant
-      :getter "pango_font_description_get_variant"
-      :setter "pango_font_description_set_variant"
-      :boundp %font-description-variant-boundp
-      :makunbound %font-description-variant-makunbound
-      :accessor font-description-variant
-      :type variant)
-     (weight
-      :allocation :virtual
-      :initarg :weight
-      :getter "pango_font_description_get_weight"
-      :setter "pango_font_description_set_weight"
-      :boundp %font-description-weight-boundp
-      :makunbound %font-description-weight-makunbound
-      :accessor font-description-weight
-      :type weight)
-     (stretch
-      :allocation :virtual
-      :initarg :stretch
-      :getter "pango_font_description_get_stretch"
-      :setter "pango_font_description_set_stretch"
-      :boundp %font-description-stretch-boundp
-      :makunbound %font-description-stretch-makbound
-      :accessor font-description-stretch
-      :type stretch)
-     (size
-      :allocation :virtual
-      :initarg :size
-      :setter (setf font-description-size)
-      :getter "pango_font_description_get_size"
-      :boundp %font-description-size-boundp
-      :makunbound %font-description-size-makunbound
-      :reader font-description-size
-      :type integer)
-     #?(pkg-exists-p "pango" :atleast-version "1.8.0")
-     (absolute-size-p
-      :allocation :virtual
-      :getter "pango_font_description_get_size_is_absolute"
-      :boundp %font-description-size-boundp
-      :reader font-description-size-is-absolute-p
-      :type boolean))
-    (:metaclass boxed-class)))
-
-
-(defmethod initialize-instance ((desc font-description) &key absolute-size)
+  (define-types-by-introspection "Pango"))
+  
+(defclass font-description (boxed)
+  ((family
+    :allocation :virtual
+    :initarg :family :initform "Sans"
+    :getter "pango_font_description_get_family"
+    :setter "pango_font_description_set_family"
+    :boundp %font-description-family-boundp
+    :makunbound %font-description-family-makunbound
+    :accessor font-description-family
+    :type (static string))
+   (style
+    :allocation :virtual
+    :initarg :style :initform :normal
+    :getter "pango_font_description_get_style"
+    :setter "pango_font_description_set_style"
+    :boundp %font-description-style-boundp
+    :makunbound %font-description-style-makunbound
+    :accessor font-description-style
+    :type style)
+   (variant
+   :allocation :virtual
+   :initarg :variant :initform :normal
+   :getter "pango_font_description_get_variant"
+   :setter "pango_font_description_set_variant"
+   :boundp %font-description-variant-boundp
+   :makunbound %font-description-variant-makunbound
+   :accessor font-description-variant
+   :type variant)
+   (weight
+   :allocation :virtual :initform :normal
+   :initarg :weight
+   :getter "pango_font_description_get_weight"
+   :setter "pango_font_description_set_weight"
+   :boundp %font-description-weight-boundp
+   :makunbound %font-description-weight-makunbound
+   :accessor font-description-weight
+   :type weight)
+   (stretch
+   :allocation :virtual :initform :normal
+   :initarg :stretch
+   :getter "pango_font_description_get_stretch"
+   :setter "pango_font_description_set_stretch"
+   :boundp %font-description-stretch-boundp
+   :makunbound %font-description-stretch-makbound
+   :accessor font-description-stretch
+   :type stretch)
+   (size
+   :allocation :virtual
+;   :initarg :size :initform 16 ; handled by initialize instance
+;   :setter (setf font-description-size)
+   :setter %set-font-description-size
+   :getter "pango_font_description_get_size"
+   :boundp %font-description-size-boundp
+   :makunbound %font-description-size-makunbound
+   :reader font-description-size
+   :type integer)
+   #?(pkg-exists-p "pango" :atleast-version "1.8.0")
+   (size-is-absolute-p
+   :allocation :virtual
+;   :initarg :size-is-absolute :initform nil ; handled by initialize instance
+   :getter "pango_font_description_get_size_is_absolute"
+   :boundp %font-description-size-boundp
+   :reader font-description-size-is-absolute-p
+   :type boolean))
+  (:metaclass boxed-class))
+
+(defclass layout (gobject)
+  ((context
+    :allocation :virtual
+    :getter "pango_layout_get_context"
+    :reader layout-context
+    :type context)
+   (text
+    :allocation :virtual
+    :initarg :text
+    :getter "pango_layout_get_text"
+    :setter %layout-set-text
+    :accessor layout-text
+    :type (static string))
+   (attributes 
+    :allocation :virtual
+    :initarg :attributes
+    :getter "pango_layout_get_attributes"
+    :setter "pango_layout_set_attributes"
+    :accessor layout-attributes
+    :type attr-list)
+   (font-description 
+    :allocation :virtual
+    :initarg :font-description
+    :getter "pango_layout_get_font_description"
+    :setter "pango_layout_set_font_description"
+    :accessor layout-font-description
+    :type font-description)
+   (width
+    :allocation :virtual
+    :initarg :width
+    :getter "pango_layout_get_width"
+    :setter "pango_layout_set_width"
+    :unbound -1
+    :accessor layout-width
+    :type int)
+   (wrap
+    :allocation :virtual
+    :initarg :wrap
+    :getter "pango_layout_get_wrap"
+    :setter "pango_layout_set_wrap"
+    :accessor layout-wrap
+    :type wrap-mode)
+   (ellipsize
+    :allocation :virtual
+    :initarg :ellipsize
+    :getter "pango_layout_get_ellipsize"
+    :setter "pango_layout_set_ellipsize"
+    :accessor layout-ellipsize
+    :type ellipsize-mode)
+   (indent
+    :allocation :virtual
+    :initarg :indent
+    :getter "pango_layout_get_indent"
+    :setter "pango_layout_set_indetn"
+    :accessor layout-indent
+    :type int)
+   (spacing
+    :allocation :virtual
+    :initarg :spacing
+    :getter "pango_layout_get_spacing"
+    :setter "pango_layout_set_spacing"
+    :accessor layout-spacing
+    :type int)
+   (justify
+    :allocation :virtual
+    :initarg :justify
+    :getter "pango_layout_get_justify"
+    :setter "pango_layout_set_justify"
+    :accessor layout-justify-p
+    :type boolean)
+   (auto-dir
+    :allocation :virtual
+    :initarg :auto-dir
+    :getter "pango_layout_get_auto_dir"
+    :setter "pango_layout_set_auto_dir"
+    :accessor layout-auto-dir-p
+    :type boolean)
+   (alignment
+    :allocation :virtual
+    :initarg :alignment
+    :getter "pango_layout_get_alignment"
+    :setter "pango_layout_set_alignment"
+    :accessor layout-alignment
+    :type alignment)
+   (tabs
+    :allocation :virtual
+    :initarg :tabs
+    :getter "pango_layout_get_tabs"
+    :setter "pango_layout_set_tabs"
+    :accessor layout-tabs
+    :type tab-array)
+   (single-paragraph
+    :allocation :virtual
+    :initarg :single-paragraph
+    :getter "pango_layout_get_single_paragraph_mode"
+    :setter "pango_layout_set_single_paragraph_mode"
+    :accessor layout-single-paragraph-p
+    :type boolean))
+  (:metaclass gobject-class))
+
+(defclass cairo-font-map (interface)
+  ((resolution
+    :allocation :virtual
+    :getter "pango_cairo_font_map_get_resolution"
+    :setter "pango_cairo_font_map_set_resolution"
+    :accessor cairo-font-map-resolution
+    :type double-float))
+  (:metaclass interface-class))
+
+
+;;;; Font description
+
+(defmethod initialize-instance ((desc font-description) &key (size 16) size-is-absolute)
   (call-next-method)
-  (when absolute-size
-    (setf (font-description-size desc t) absolute-size)))
+  (setf (font-description-size desc size-is-absolute) size))
 
 (defbinding %font-description-new () pointer)
 
@@ -170,13 +274,24 @@ (defbinding %font-description-set-absolute-size () nil
   (desc font-description)
   (size double-float))
 
-(defun (setf font-description-size) (size desc &optional absolute-p)
-  (if absolute-p
+(defun (setf font-description-size) (size desc &optional (absolute-p nil absolute-given-p))
+  (cond
+    (absolute-p
       #?(pkg-exists-p "pango" :atleast-version "1.8.0")
       (%font-description-set-absolute-size desc size)
       #?-(pkg-exists-p "pango" :atleast-version "1.8.0")
-      (error "Setting of absolute font size requires at least Pango 1.8.0")
-    (%font-description-set-size desc size)))
+      (error "Setting of absolute font size requires at least Pango 1.8.0"))
+    (#?(pkg-exists-p "pango" :atleast-version "1.8.0") absolute-given-p
+     #?-(pkg-exists-p "pango" :atleast-version "1.8.0") t
+     (%font-description-set-size desc size))
+    #?(pkg-exists-p "pango" :atleast-version "1.8.0")
+    (t (if (font-description-size-is-absolute-p desc)
+          (%font-description-set-absolute-size desc size)
+        (%font-description-set-size desc size))))
+  size)
+
+(defun %set-font-description-size (size desc)
+  (setf (font-description-size desc) size))
 
 (defbinding font-description-merge (desc merge-desc &optional replace-p) nil
   (desc font-description)
@@ -193,3 +308,138 @@ (defbinding font-description-from-string () font-description
 
 (defbinding font-description-to-string () string
   (desc font-description))
+
+(defbinding font-description-copy () font-description
+  (font-description font-description))
+
+(defun ensure-font-description (font-description &optional copy-p)
+  (etypecase font-description
+    (font-description (if copy-p
+                         (font-description-copy font-description)
+                       font-description))
+    (string (font-description-from-string font-description))
+    (list (apply #'make-instance 'font-description font-description))))
+
+
+;;;; Layout
+
+(defmethod initialize-instance ((layout layout) &key markup)
+  (call-next-method)
+  (when markup
+    (layout-set-markup layout markup)))
+
+(defmethod allocate-foreign ((layout layout) &key context)
+  (etypecase context
+    (context (%layout-new context))
+    (cairo:context (%cairo-create-layout context))))
+
+(defbinding %layout-new () pointer
+  (context context))
+
+(defbinding layout-copy () (referenced layout)
+  (layout layout))
+
+(defbinding layout-context-changed () nil
+  (layout layout))
+
+(defbinding %layout-set-text (text layout) nil
+  (layout layout)
+  (text string)
+  (-1 int))
+
+(defbinding layout-set-markup () nil
+  (layout layout)
+  (markup string)
+  (-1 int))
+
+(defbinding layout-get-size () nil
+  (layout layout)
+  (width int :out)
+  (height int :out))
+
+(defbinding layout-get-pixel-size () nil
+  (layout layout)
+  (width int :out)
+  (height int :out))
+
+
+
+;;; Cairo Rendering
+
+(defbinding (cairo-create-font-map "pango_cairo_font_map_new") 
+    () (referenced font-map))
+
+(defbinding cairo-font-map-get-default () font-map)
+
+(defbinding cairo-font-map-create-context () (referenced context)
+  (font-map cairo-font-map))
+
+(defbinding (cairo-context-resolution "pango_cairo_context_get_resolution")
+    () double-float
+  (context context))
+
+(defbinding %cairo-context-set-resolution () nil
+  (context context)
+  (dpi double-float))
+
+(defun (setf cairo-context-resolution) (dpi context)
+  (%cairo-context-set-resolution context dpi))
+
+(defbinding (cairo-context-font-options "pango_cairo_context_get_font_options")
+    () cairo:font-options
+  (context context))
+
+(defbinding %cairo-context-set-font-options () nil
+  (context context)
+  (font-options cairo:font-options))
+
+(defun (setf cairo-context-font-options) (font-options context)
+  (%cairo-context-set-font-options context font-options))
+
+(defbinding %cairo-create-layout () pointer
+  (cr cairo:context))
+
+(defbinding cairo-update-layout () nil
+  (cr cairo:context)
+  (layout layout))
+
+(defbinding cairo-show-glyph-string () nil
+  (cr cairo:context)
+  (font font)
+  (glyphs glyph-string))
+
+(defbinding cairo-show-layout-line () nil
+  (cr cairo:context)
+  (line layout-line))
+
+(defbinding cairo-show-layout () nil
+  (cr cairo:context)
+  (layout layout))
+
+(defbinding cairo-show-error-underline () nil
+  (cr cairo:context)
+  (x double-float)
+  (y double-float)
+  (width double-float)
+  (height double-float))
+
+(defbinding cairo-glyph-string-path () nil
+  (cr cairo:context)
+  (font font)
+  (glyphs glyph-string))
+
+(defbinding cairo-layout-line-path () nil
+  (cr cairo:context)
+  (line layout-line))
+
+(defbinding cairo-layout-path () nil
+  (cr cairo:context)
+  (layout layout))
+
+(defbinding cairo-error-underline-path () nil
+  (cr cairo:context)
+  (x double-float)
+  (y double-float)
+  (width double-float)
+  (height double-float))
+