Add Gdk/DrawingPrimitives

diff --git a/gdk/cl-gtk2-gdk.asd b/gdk/cl-gtk2-gdk.asd
index 2a7496c..a091b2e 100644 (file)
--- a/gdk/cl-gtk2-gdk.asd
+++ b/gdk/cl-gtk2-gdk.asd
@@ -11,5 +11,6 @@
                (:file "gdk.display")
                (:file "gdk.screen")
                (:file "gdk.region")
-               (:file "gdk.gc"))
+               (:file "gdk.gc")
+               (:file "gdk.drawing-primitives"))
   :depends-on (:cl-gtk2-glib :cffi :cl-gtk2-pango))
\ No newline at end of file

diff --git a/gdk/gdk.drawing-primitives.lisp b/gdk/gdk.drawing-primitives.lisp
new file mode 100644 (file)
index 0000000..03e7324
--- /dev/null
+++ b/gdk/gdk.drawing-primitives.lisp
@@ -0,0 +1,298 @@
+(in-package :gdk)
+
+(defcfun gdk-drawable-get-size :void
+  (drawable (g-object drawable))
+  (width (:pointer :int))
+  (height (:pointer :int)))
+
+(defun drawable-get-size (drawable)
+  (with-foreign-objects ((x :int)
+                         (y :int))
+    (gdk-drawable-get-size drawable x y)
+    (values (mem-ref x :int) (mem-ref y :int))))
+
+(export 'drawable-get-size)
+
+(defcfun (draw-point "gdk_draw_point") :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (x :int)
+  (y :int))
+
+(export 'draw-point)
+
+(defcfun gdk-draw-points :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (points :pointer)
+  (n :int))
+
+(defun draw-points (drawable gc points)
+  (let ((n (length points)))
+    (with-foreign-object (points-ptr 'point-cstruct n)
+      (let ((i 0))
+        (map nil
+             (lambda (pt)
+                 (gobject::copy-slots-to-native
+                  pt
+                  (inc-pointer points-ptr (* i (foreign-type-size 'point-cstruct)))
+                  (gobject::g-boxed-cstruct-wrapper-info-cstruct-description (gobject::get-g-boxed-foreign-info 'point)))
+                 (incf i))
+             points))
+      (gdk-draw-points drawable gc points-ptr n))))
+
+(export 'draw-points)
+
+(defcfun (draw-line "gdk_draw_line") :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (x1 :int)
+  (y1 :int)
+  (x2 :int)
+  (y2 :int))
+
+(export 'draw-line)
+
+(defcfun gdk-draw-lines :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (points :pointer)
+  (n :int))
+
+(defun draw-lines (drawable gc points)
+  (let ((n (length points)))
+    (with-foreign-object (points-ptr 'point-cstruct n)
+      (let ((i 0))
+        (map nil
+             (lambda (pt)
+                 (gobject::copy-slots-to-native
+                  pt
+                  (inc-pointer points-ptr (* i (foreign-type-size 'point-cstruct)))
+                  (gobject::g-boxed-cstruct-wrapper-info-cstruct-description (gobject::get-g-boxed-foreign-info 'point)))
+                 (incf i))
+             points))
+      (gdk-draw-lines drawable gc points-ptr n))))
+
+(export 'draw-lines)
+
+(defcfun (draw-pixbuf "gdk_draw_pixbuf") :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (pixbuf (g-object pixbuf))
+  (src-x :int)
+  (src-y :int)
+  (dest-x :int)
+  (dest-y :int)
+  (width :int)
+  (height :int)
+  (dither rgb-dither)
+  (x-dither :int)
+  (y-dither :int))
+
+(export 'draw-pixbuf)
+
+(defcfun gdk-draw-segments :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (segments :pointer)
+  (n-segments :int))
+
+(defun draw-segments (drawable gc segments)
+  (let ((n (length segments)))
+    (with-foreign-object (segments-ptr 'segment-cstruct n)
+      (let ((i 0))
+        (map nil
+             (lambda (segment)
+               (gobject::copy-slots-to-native
+                segment
+                (inc-pointer segments-ptr (* i (foreign-type-size 'segment-cstruct)))
+                (gobject::g-boxed-cstruct-wrapper-info-cstruct-description (gobject::get-g-boxed-foreign-info 'segment)))
+               (incf i))
+             segments))
+      (gdk-draw-segments drawable gc segments-ptr n))))
+
+(export 'draw-segments)
+
+(defcfun (draw-rectangle "gdk_draw_rectangle") :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (filled :boolean)
+  (x :int)
+  (y :int)
+  (width :int)
+  (height :int))
+
+(defcfun (draw-arc "gdk_draw_arc") :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (filled :boolean)
+  (x :int)
+  (y :int)
+  (width :int)
+  (height :int)
+  (angle1 :int)
+  (angle2 :int))
+
+(export 'draw-arc)
+
+(defcfun gdk-draw-polygon :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (filled :boolean)
+  (points :pointer)
+  (n-points :int))
+
+(defun draw-polygon (drawable gc filled points)
+  (let ((n (length points)))
+    (with-foreign-object (points-ptr 'point-cstruct n)
+      (let ((i 0))
+        (map nil
+             (lambda (point)
+               (gobject::copy-slots-to-native
+                point
+                (inc-pointer points-ptr (* i (foreign-type-size 'point-cstruct)))
+                (gobject::g-boxed-cstruct-wrapper-info-cstruct-description (gobject::get-g-boxed-foreign-info 'point)))
+               (incf i))
+             points))
+      (gdk-draw-polygon drawable gc filled points-ptr n))))
+
+(export 'draw-polygon)
+
+(defcfun gdk-draw-trapezoids :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (trapezoids :pointer)
+  (n :int))
+
+(defun draw-trapezoids (drawable gc trapezoids)
+  (let ((n (length trapezoids)))
+    (with-foreign-object (trapezoids-ptr 'trapezoid-cstruct n)
+      (let ((i 0))
+        (map nil
+             (lambda (trapezoid)
+               (gobject::copy-slots-to-native
+                trapezoid
+                (inc-pointer trapezoids-ptr (* i (foreign-type-size 'trapezoid-cstruct)))
+                (gobject::g-boxed-cstruct-wrapper-info-cstruct-description (gobject::get-g-boxed-foreign-info 'trapezoid)))
+               (incf i))
+             trapezoids))
+      (gdk-draw-trapezoids drawable gc trapezoids-ptr n))))
+
+(export 'draw-trapezoids)
+
+;; TODO
+;; void                gdk_draw_glyphs                     (GdkDrawable *drawable,
+;;                                                          GdkGC *gc,
+;;                                                          PangoFont *font,
+;;                                                          gint x,
+;;                                                          gint y,
+;;                                                          PangoGlyphString *glyphs);
+;; void                gdk_draw_glyphs_transformed         (GdkDrawable *drawable,
+;;                                                          GdkGC *gc,
+;;                                                          const PangoMatrix *matrix,
+;;                                                          PangoFont *font,
+;;                                                          gint x,
+;;                                                          gint y,
+;;                                                          PangoGlyphString *glyphs);
+;; void                gdk_draw_layout_line                (GdkDrawable *drawable,
+;;                                                          GdkGC *gc,
+;;                                                          gint x,
+;;                                                          gint y,
+;;                                                          PangoLayoutLine *line);
+;; void                gdk_draw_layout_line_with_colors    (GdkDrawable *drawable,
+;;                                                          GdkGC *gc,
+;;                                                          gint x,
+;;                                                          gint y,
+;;                                                          PangoLayoutLine *line,
+;;                                                          const GdkColor *foreground,
+;;                                                          const GdkColor *background);
+
+(defcfun (draw-layout "gdk_draw_layout") :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (x :int)
+  (y :int)
+  (layout (g-object pango-layout)))
+
+(export 'draw-layout)
+
+(defcfun (draw-layout-with-colors "gdk_draw_layout_with_colors") :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (x :int)
+  (y :int)
+  (layout (g-object pango-layout))
+  (foreground (g-boxed-foreign color))
+  (background (g-boxed-foreign color)))
+
+(export 'draw-layout-with-colors)
+
+;; ignored:
+;; void                gdk_draw_string                     (GdkDrawable *drawable,
+;;                                                          GdkFont *font,
+;;                                                          GdkGC *gc,
+;;                                                          gint x,
+;;                                                          gint y,
+;;                                                          const gchar *string);
+;; void                gdk_draw_text                       (GdkDrawable *drawable,
+;;                                                          GdkFont *font,
+;;                                                          GdkGC *gc,
+;;                                                          gint x,
+;;                                                          gint y,
+;;                                                          const gchar *text,
+;;                                                          gint text_length);
+;; void                gdk_draw_text_wc                    (GdkDrawable *drawable,
+;;                                                          GdkFont *font,
+;;                                                          GdkGC *gc,
+;;                                                          gint x,
+;;                                                          gint y,
+;;                                                          const GdkWChar *text,
+;;                                                          gint text_length);
+
+
+(defcfun (draw-drawable "gdk_draw_drawable") :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (src (g-object drawable))
+  (x-src :int)
+  (y-src :int)
+  (x-dest :int)
+  (y-dest :int)
+  (width :int)
+  (height :int))
+
+(export 'draw-drawable)
+
+(defcfun (draw-image "gdk_draw_image") :void
+  (drawable (g-object drawable))
+  (gc (g-object graphics-context))
+  (image (g-object gdk-image))
+  (x-src :int)
+  (y-src :int)
+  (x-dest :int)
+  (y-dest :int)
+  (width :int)
+  (height :int))
+
+(export 'draw-image)
+
+(defcfun (drawable-get-image "gdk_drawable_get_image") (g-object gdk-image)
+  (drawable (g-object drawable))
+  (x :int)
+  (y :int)
+  (width :int)
+  (height :int))
+
+(export 'drawable-get-image)
+
+(defcfun (drawable-copy-to-image "gdk_drawable_copy_to_image") (g-object gdk-image)
+  (drawable (g-object drawable))
+  (image (g-object gdk-image))
+  (src-x :int)
+  (src-y :int)
+  (dest-x :int)
+  (dest-y :int)
+  (width :int)
+  (height :int))
+
+(export 'drawable-copy-to-image)

diff --git a/gdk/gdk.functions.lisp b/gdk/gdk.functions.lisp
index 2094ed4..922f841 100644 (file)
--- a/gdk/gdk.functions.lisp
+++ b/gdk/gdk.functions.lisp
@@ -18,41 +18,6 @@
 
 (export 'gdk-window-events)
 
-(defcfun gdk-gc-new (g-object graphics-context :already-referenced)
-  (drawable (g-object drawable)))
-
-(defcfun gdk-draw-line :void
-  (drawable (g-object drawable))
-  (gc (g-object graphics-context))
-  (x1 :int)
-  (y1 :int)
-  (x2 :int)
-  (y2 :int))
-
-(defcfun gdk-gc-set-rgb-fg-color :void
-  (gc (g-object graphics-context))
-  (color (g-boxed-foreign color)))
-
-(defcfun gdk-drawable-get-size :void
-  (drawable (g-object drawable))
-  (width (:pointer :int))
-  (height (:pointer :int)))
-
-(defun drawable-get-size (drawable)
-  (with-foreign-objects ((x :int)
-                         (y :int))
-    (gdk-drawable-get-size drawable x y)
-    (values (mem-ref x :int) (mem-ref y :int))))
-
-(export 'drawable-get-size)
-
-(defcfun gdk-draw-layout :void
-  (drawable (g-object drawable))
-  (gc (g-object graphics-context))
-  (x :int)
-  (y :int)
-  (layout (g-object pango-layout)))
-
 (defcfun gdk-atom-name (glib:g-string :free-from-foreign t)
   (atom gdk-atom))
 

diff --git a/gdk/gdk.gc.lisp b/gdk/gdk.gc.lisp
index 575a26f..9b274e2 100644 (file)
--- a/gdk/gdk.gc.lisp
+++ b/gdk/gdk.gc.lisp
@@ -22,12 +22,12 @@
 
 (export (boxed-related-symbols 'gc-values))
 
-(defcfun (graphics-context-new "gdk_gc_new") (g-object graphics-context)
+(defcfun (graphics-context-new "gdk_gc_new") (g-object graphics-context :already-referenced)
   (drawable (g-object drawable)))
 
 (export 'graphics-context-new)
 
-(defcfun (graphics-context-new-with-values "gdk_gc_new_with_values") (g-object graphics-context)
+(defcfun (graphics-context-new-with-values "gdk_gc_new_with_values") (g-object graphics-context :already-referenced)
   (drawable (g-object drawable))
   (values (g-boxed-foreign gc-values))
   (values-mask gc-values-mask))

diff --git a/gdk/gdk.objects.lisp b/gdk/gdk.objects.lisp
index a3dee82..ae3a38f 100644 (file)
--- a/gdk/gdk.objects.lisp
+++ b/gdk/gdk.objects.lisp
@@ -99,6 +99,13 @@
   (:round 1)
   (:bevel 2))
 
+(define-g-enum "GdkRgbDither"
+    rgb-dither
+    (:export t :type-initializer "gdk_rgb_dither_get_type")
+  (:none 0)
+  (:normal 1)
+  (:max 2))
+
 (define-g-object-class "GdkDisplay" display ()
   ((:cffi name display-name (glib:g-string :free-from-foreign nil)
           "gdk_display_get_name" nil)
@@ -209,6 +216,24 @@
 
 (export (boxed-related-symbols 'span))
 
+(define-g-boxed-cstruct segment nil
+  (x1 :int :initform 0)
+  (y1 :int :initform 0)
+  (x2 :int :initform 0)
+  (y2 :int :initform 0))
+
+(export (boxed-related-symbols 'segment))
+
+(define-g-boxed-cstruct trapezoid nil
+  (y1 :double :initform 0d0)
+  (x11 :double :initform 0d0)
+  (x21 :double :initform 0d0)
+  (y2 :double :initform 0d0)
+  (x12 :double :initform 0d0)
+  (x22 :double :initform 0d0))
+
+(export (boxed-related-symbols 'trapezoid))
+
 (define-g-object-class "GdkGC" graphics-context ()
   ((:cffi screen graphics-context-screen (g-object screen)
           "gdk_gc_get_screen" nil)
@@ -243,7 +268,21 @@
    (:cffi colormap graphics-context-colormap (g-object colormap)
           "gdk_gc_get_colormap" "gdk_gc_set_colormap")))
 
-(define-g-object-class "GdkDrawable" drawable () ())
+(define-g-object-class "GdkDrawable" drawable ()
+  ((:cffi display drawable-display (g-object display)
+          "gdk_drawable_get_display" nil)
+   (:cffi screen drawable-screen (g-object screen)
+          "gdk_drawable_get_screen" nil)
+   (:cffi visual drawable-visual (g-object visual)
+          "gdk_drawable_get_visual" nil)
+   (:cffi colormap drawable-colormap (g-object colormap)
+          "gdk_drawable_get_colormap" "gdk_drawable_set_colormap")
+   (:cffi depth drawable-depth :int
+          "gdk_drawable_get_depth" nil)
+   (:cffi clip-region drawable-clip-region (g-boxed-foreign region :return)
+          "gdk_drawable_get_clip_region" nil)
+   (:cffi visible-region drawable-visible-region (g-boxed-foreign region :return)
+          "gdk_drawable_get_visible_region" nil)))
 
 (define-g-object-class "GdkPixmap" pixmap (:superclass drawable) ())
 

diff --git a/gdk/gdk.package.lisp b/gdk/gdk.package.lisp
index 607d5ee..9604c94 100755 (executable)
--- a/gdk/gdk.package.lisp
+++ b/gdk/gdk.package.lisp
@@ -1,14 +1,7 @@
 (defpackage :gdk
   (:use :cl :gobject :cffi :pango :iter)
   (:export #:gdk-window-events
-           #:gdk-gc-set-rgb-fg-color
-           #:gdk-drawable-get-size
-           #:gdk-draw-line
-           #:gdk-gc-new
-           #:drawable-get-size
-           #:gdk-draw-layout
-           #:gdk-atom-as-string
-           #:gdk-window-events))
+           #:gdk-atom-as-string))
 
 (in-package :gdk)