chiark / gitweb /
Delete some imports from SB-PCL
[clg] / pango / pango.lisp
index 3a0a8f92a8d4ec078a87b4f250ca15a0f305809a..4b8bc759be4a055437eaa050078dc87baf1db91e 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.13 2007-04-06 14:51:26 espen Exp $
+;; $Id: pango.lisp,v 1.16 2007-10-17 18:07:32 espen Exp $
 
 (in-package "PANGO")
 
+(defconstant +pango-scale+ 1024)
+
+(defun device-to-pango-units (device-units)
+  (round (* device-units +pango-scale+)))
+
 (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 #.(concatenate 'string 
-                           (pkg-variable "pango" "libdir")
-                           "/libpangocairo-1.0." asdf:*dso-extension*) 
-                        :prefix "pango_cairo"))
+  (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)
@@ -49,16 +42,16 @@   (define-types-by-introspection "Pango"))
 (defclass font-description (boxed)
   ((family
     :allocation :virtual
-    :initarg :family
+    :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 string)
+    :type (static string))
    (style
     :allocation :virtual
-    :initarg :style
+    :initarg :style :initform :normal
     :getter "pango_font_description_get_style"
     :setter "pango_font_description_set_style"
     :boundp %font-description-style-boundp
@@ -67,7 +60,7 @@ (defclass font-description (boxed)
     :type style)
    (variant
    :allocation :virtual
-   :initarg :variant
+   :initarg :variant :initform :normal
    :getter "pango_font_description_get_variant"
    :setter "pango_font_description_set_variant"
    :boundp %font-description-variant-boundp
@@ -75,7 +68,7 @@ (defclass font-description (boxed)
    :accessor font-description-variant
    :type variant)
    (weight
-   :allocation :virtual
+   :allocation :virtual :initform :normal
    :initarg :weight
    :getter "pango_font_description_get_weight"
    :setter "pango_font_description_set_weight"
@@ -84,7 +77,7 @@ (defclass font-description (boxed)
    :accessor font-description-weight
    :type weight)
    (stretch
-   :allocation :virtual
+   :allocation :virtual :initform :normal
    :initarg :stretch
    :getter "pango_font_description_get_stretch"
    :setter "pango_font_description_set_stretch"
@@ -94,16 +87,18 @@ (defclass font-description (boxed)
    :type stretch)
    (size
    :allocation :virtual
-   :initarg :size
-   :setter (setf font-description-size)
+;   :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")
-   (absolute-size-p
+   (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
@@ -118,11 +113,11 @@ (defclass layout (gobject)
     :type context)
    (text
     :allocation :virtual
-    :initarg text
+    :initarg :text
     :getter "pango_layout_get_text"
     :setter %layout-set-text
     :accessor layout-text
-    :type string)
+    :type (static string))
    (attributes 
     :allocation :virtual
     :initarg :attributes
@@ -142,6 +137,7 @@ (defclass layout (gobject)
     :initarg :width
     :getter "pango_layout_get_width"
     :setter "pango_layout_set_width"
+    :unbound -1
     :accessor layout-width
     :type int)
    (wrap
@@ -162,7 +158,7 @@ (defclass layout (gobject)
     :allocation :virtual
     :initarg :indent
     :getter "pango_layout_get_indent"
-    :setter "pango_layout_set_indetn"
+    :setter "pango_layout_set_indent"
     :accessor layout-indent
     :type int)
    (spacing
@@ -193,12 +189,12 @@ (defclass layout (gobject)
     :setter "pango_layout_set_alignment"
     :accessor layout-alignment
     :type alignment)
-   (tab-array
+   (tabs
     :allocation :virtual
-    :initarg :tab-array
-    :getter "pango_layout_tab_array"
-    :setter "pango_layout_tab-array"
-    :accessor layout-tab-array
+    :initarg :tabs
+    :getter "pango_layout_get_tabs"
+    :setter "pango_layout_set_tabs"
+    :accessor layout-tabs
     :type tab-array)
    (single-paragraph
     :allocation :virtual
@@ -221,10 +217,9 @@ (defclass cairo-font-map (interface)
 
 ;;;; Font description
 
-(defmethod initialize-instance ((desc font-description) &key absolute-size)
+(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)
 
@@ -284,13 +279,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)
@@ -308,6 +314,17 @@ (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
 
@@ -330,7 +347,7 @@ (defbinding layout-copy () (referenced layout)
 (defbinding layout-context-changed () nil
   (layout layout))
 
-(defbinding %layout-set-text () nil
+(defbinding %layout-set-text (text layout) nil
   (layout layout)
   (text string)
   (-1 int))
@@ -340,6 +357,16 @@ (defbinding layout-set-markup () nil
   (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