From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Sat, 14 Nov 2009 04:12:14 +0000 (+0300)
Subject: Add Gdk/Pango-interaction
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=495dc322bd9688ebffaf62a736fa3c4a21a63ebb;p=cl-gtk2.git

Add Gdk/Pango-interaction
---

diff --git a/gdk/cl-gtk2-gdk.asd b/gdk/cl-gtk2-gdk.asd
index d01a233..204344b 100644
--- a/gdk/cl-gtk2-gdk.asd
+++ b/gdk/cl-gtk2-gdk.asd
@@ -26,5 +26,6 @@
                (:file "gdk.key-values")
                (:file "gdk.selections")
                (:file "gdk.drag-and-drop")
-               (:file "gdk.input-devices"))
+               (:file "gdk.input-devices")
+               (:file "gdk.pango"))
   :depends-on (:cl-gtk2-glib :cffi :cl-gtk2-pango))
\ No newline at end of file
diff --git a/gdk/gdk.pango.lisp b/gdk/gdk.pango.lisp
new file mode 100644
index 0000000..d0408ed
--- /dev/null
+++ b/gdk/gdk.pango.lisp
@@ -0,0 +1,109 @@
+(in-package :gdk)
+
+(define-g-object-class "GdkPangoRenderer" gdk-pango-renderer
+  (:superclass pango-renderer :export t
+               :interfaces nil :type-initializer
+               "gdk_pango_renderer_get_type")
+  ((screen gdk-pango-renderer-screen "screen"
+           "GdkScreen" t nil)))
+
+(defcfun gdk-pango-renderer-new (g-object gdk-pango-renderer :already-referenced)
+  (screen (g-object screen)))
+
+(export 'gdk-pango-renderer-new)
+
+(defcfun gdk-pango-renderer-get-default (g-object gdk-pango-renderer)
+  (screen (g-object screen)))
+
+(export 'gdk-pango-renderer-get-default)
+
+(defcfun gdk-pango-renderer-set-drawable :void
+  (renderer (g-object gdk-pango-renderer))
+  (drawable (g-object drawable)))
+
+(export 'gdk-pango-renderer-set-drawable)
+
+(defcfun gdk-pango-renderer-set-gc :void
+  (renderer (g-object gdk-pango-renderer))
+  (gc (g-object graphics-context)))
+
+(export 'gdk-pango-renderer-set-gc)
+
+(defcfun gdk-pango-renderer-set-stipple :void
+  (renderer (g-object gdk-pango-renderer))
+  (part pango-render-part)
+  (stipple (g-object pixmap)))
+
+(export 'gdk-pango-renderer-set-stipple)
+
+(defcfun gdk-pango-renderer-set-override-color :void
+  (renderer (g-object gdk-pango-renderer))
+  (part pango-render-part)
+  (color (g-boxed-foreign color)))
+
+(export 'gdk-pango-renderer-set-override-color)
+
+(defcfun gdk-pango-context-get (g-object pango-context :already-referenced))
+
+(export 'gdk-pango-context-get)
+
+(defcfun gdk-pango-context-get-for-screen (g-object pango-context :already-referenced)
+  (screen (g-object screen)))
+
+(export 'gdk-pango-context-get-for-screen)
+
+;; ignored:
+;; void                gdk_pango_context_set_colormap      (PangoContext *context,
+;;                                                          GdkColormap *colormap);
+
+;; TODO:
+;;                     GdkPangoAttrEmbossed;
+;;                     GdkPangoAttrEmbossColor;
+;;                     GdkPangoAttrStipple;
+;; PangoAttribute *    gdk_pango_attr_emboss_color_new     (const GdkColor *color);
+;; PangoAttribute *    gdk_pango_attr_embossed_new         (gboolean embossed);
+;; PangoAttribute *    gdk_pango_attr_stipple_new          (GdkBitmap *stipple);
+
+(defcfun gdk_pango_layout_get_clip_region (g-boxed-foreign region :return)
+  (layout (g-object pango-layout))
+  (x-origin :int)
+  (y-origin :int)
+  (index-ranges (:pointer :int))
+  (n-ranges :int))
+
+(defun gdk-pango-layout-get-clip-region (layout x-origin y-origin index-ranges)
+  (let ((n (length index-ranges)))
+    (assert (zerop (mod n 2)))
+    (let ((n-ranges (/ n 2)))
+      (with-foreign-object (ranges :int n)
+        (let ((i 0))
+          (map nil
+               (lambda (x)
+                 (setf (mem-aref ranges :int i) x)
+                 (incf i))
+               index-ranges))
+        (gdk_pango_layout_get_clip_region layout x-origin y-origin index-ranges n-ranges)))))
+
+(export 'gdk-pango-layout-get-clip-region)
+
+(defcfun gdk_pango_layout_line_get_clip_region (g-boxed-foreign region :return)
+  (layout-line (g-boxed-foreign pango-layout-line))
+  (x-origin :int)
+  (y-origin :int)
+  (index-ranges (:pointer :int))
+  (n-ranges :int))
+
+(defun gdk-pango-layout-line-get-clip-region (layout-line x-origin y-origin index-ranges)
+  (let ((n (length index-ranges)))
+    (assert (zerop (mod n 2)))
+    (let ((n-ranges (/ n 2)))
+      (with-foreign-object (ranges :int n)
+        (let ((i 0))
+          (map nil
+               (lambda (x)
+                 (setf (mem-aref ranges :int i) x)
+                 (incf i))
+               index-ranges))
+        (gdk_pango_layout_line_get_clip_region layout-line x-origin y-origin index-ranges n-ranges)))))
+
+(export 'gdk-pango-layout-line-get-clip-region)
diff --git a/pango/pango.lisp b/pango/pango.lisp
index 8f834fb..2df572f 100644
--- a/pango/pango.lisp
+++ b/pango/pango.lisp
@@ -37,3 +37,36 @@
   (:weak-ltr 4)
   (:weak-rtl 5)
   (:neutral 6))
+
+(define-g-object-class "PangoRenderer" pango-renderer
+  (:superclass g-object :export t :interfaces
+               nil :type-initializer
+               "pango_renderer_get_type")
+  nil)
+
+(define-g-object-class "PangoContext" pango-context
+  (:superclass g-object :export t :interfaces
+               nil :type-initializer
+               "pango_context_get_type")
+  nil)
+
+(define-g-enum "PangoRenderPart"
+    pango-render-part
+    (:export t :type-initializer "pango_render_part_get_type")
+  (:foreground 0)
+  (:background 1)
+  (:underline 2)
+  (:strikethrough 3))
+
+(define-g-boxed-opaque pango-layout-line "PangoLayoutLine"
+  :alloc (error "Use Pango to create PANGO-LAYOUT-LINEs"))
+
+(export (boxed-related-symbols 'pango-layout-line))
+
+(define-g-enum "PangoRenderPart"
+    pango-render-part
+    (:export t :type-initializer "pango_render_part_get_type")
+  (:foreground 0)
+  (:background 1)
+  (:underline 2)
+  (:strikethrough 3))