pango: Punt exported color procedures.

Use simple flo:vector aliases in Cairo and Gtk-Screen.  Simplify
Gtk's.

diff --git a/src/cairo/cairo.pkg b/src/cairo/cairo.pkg
index fedd620b4ac3d732aab36065224a954a1fffbd01..948a742ac9fe430f2fa41f3bb7475c86548eaa5a 100644 (file)
--- a/src/cairo/cairo.pkg
+++ b/src/cairo/cairo.pkg
@@ -40,8 +40,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
          execute-glib-cleanup
          gobject-alien)
   (import (pango)
-         ->color color-red color-green color-blue color-alpha
-         guarantee-color
+         ->color
          guarantee-pango-layout)
   (export (cairo)
          cairo-image-surface-create

diff --git a/src/cairo/cairo.scm b/src/cairo/cairo.scm
index 79da4f4d2827981755b5c92f32deaa7be41bec1f..12ed2cd60e10a14b8a2606207d5baca26770e213 100644 (file)
--- a/src/cairo/cairo.scm
+++ b/src/cairo/cairo.scm
@@ -26,6 +26,15 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (C-include "cairo")
 
+(define-integrable (color-red o) (flo:vector-ref o 0))
+(define-integrable (color-green o) (flo:vector-ref o 1))
+(define-integrable (color-blue o) (flo:vector-ref o 2))
+(define-integrable (color-alpha o) (flo:vector-ref o 3))
+
+(define (guarantee-color object operator)
+  (if (not (and (flo:flonum? object) (fix:= 4 (flo:vector-length object))))
+      (error:wrong-type-argument object "an rgba color" operator)))
+
 (define (cairo-image-surface-create width height)
   (let ((surface (make-alien '|cairo_surface_t|))
        (copy (make-alien '|cairo_surface_t|)))

diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg
index f1f1d96f3d25d5006596e25b4805f6342ad06ec1..b72db119d90f4cc24a5e87d24900ced672696db6 100644 (file)
--- a/src/gtk-screen/gtk-screen.pkg
+++ b/src/gtk-screen/gtk-screen.pkg
@@ -70,7 +70,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
          assert-glib-locked assert-without-interruption
          gobject-alien gobject-unref!)
   (import (pango)
-         make-rgba-color
          pango-context-get-metrics
          pango-context-spacing
          pango-font-description-free

diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm
index 1c5a68ab0448b29cc88f54be426208a5203b87b5..c9a3b25e358de1957b4ea8c75c142613ddce2127 100644 (file)
--- a/src/gtk-screen/gtk-screen.scm
+++ b/src/gtk-screen/gtk-screen.scm
@@ -2625,6 +2625,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (set-rectangle-ink-color! cursor "green")
   (set-rectangle-ink-fill-color! cursor (make-rgba-color 0. 1. 0. .5)))
 
+(define (make-rgba-color red green blue alpha)
+  (let ((color (flo:vector-cons 4)))
+    (flo:vector-set! color 0 red)
+    (flo:vector-set! color 1 green)
+    (flo:vector-set! color 2 blue)
+    (flo:vector-set! color 3 alpha)
+    color))
+
 (define (guarantee-cursor-ink object)
   (if (cursor-ink? object) object
       (error:wrong-type-argument object "<cursor-ink>" 'guarantee-cursor-ink)))

diff --git a/src/gtk/gtk.scm b/src/gtk/gtk.scm
index 6fc6f64ccdedaba87089e630625e82af65b6f53d..5c8aae5ded86b7ea2d874aa048817347d8f67523 100644 (file)
--- a/src/gtk/gtk.scm
+++ b/src/gtk/gtk.scm
@@ -80,29 +80,13 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (bit-ior . ints)
   (reduce bitwise-ior 0 ints))
 
-(define-integrable (color? object)
+(define (color? object)
   (and (flo:flonum? object) (fix:= 4 (flo:vector-length object))))
-(define-integrable (make-color) (flo:vector-cons 4))
-(define-integrable-operator (color-red o)
-  (if (color? o) (flo:vector-ref o 0) (error:wrong-type-argument o "a color")))
-(define-integrable-operator (color-green o)
-  (if (color? o) (flo:vector-ref o 1) (error:wrong-type-argument o "a color")))
-(define-integrable-operator (color-blue o)
-  (if (color? o) (flo:vector-ref o 2) (error:wrong-type-argument o "a color")))
-(define-integrable-operator (color-alpha o)
-  (if (color? o) (flo:vector-ref o 3) (error:wrong-type-argument o "a color")))
-(define-integrable-operator (set-color-red! o r)
-  (if (color? o) (flo:vector-set! o 0 r)(error:wrong-type-argument o"a color")))
-(define-integrable-operator (set-color-green! o g)
-  (if (color? o) (flo:vector-set! o 1 g)(error:wrong-type-argument o"a color")))
-(define-integrable-operator (set-color-blue! o b)
-  (if (color? o) (flo:vector-set! o 2 b)(error:wrong-type-argument o"a color")))
-(define-integrable-operator (set-color-alpha! o a)
-  (if (color? o) (flo:vector-set! o 3 a)(error:wrong-type-argument o"a color")))
-(define-integrable-operator (make-rgba-color red green blue alpha)
-  (let ((color (make-color)))
-    (set-color-red! color red)
-    (set-color-green! color green)
-    (set-color-blue! color blue)
-    (set-color-alpha! color alpha)
+
+(define (make-rgba-color red green blue alpha)
+  (let ((color (flo:vector-cons 4)))
+    (flo:vector-set! color 0 red)
+    (flo:vector-set! color 1 green)
+    (flo:vector-set! color 2 blue)
+    (flo:vector-set! color 3 alpha)
     color))
\ No newline at end of file

diff --git a/src/pango/pango.pkg b/src/pango/pango.pkg
index ea6c895023c9910dfaba13aeb8ff4b75b7941628..ed2c4049e975c46aec781964269623722b06d9c2 100644 (file)
--- a/src/pango/pango.pkg
+++ b/src/pango/pango.pkg
@@ -35,9 +35,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (files "pango")
   ;;(depends-on "../glib/glib.ext")
   (export (pango)
-         color? make-color color-red color-green color-blue color-alpha
-         set-color-red! set-color-green! set-color-blue! set-color-alpha!
-         make-rgba-color guarantee-color
          ->color pango-color-parse
          <pango-layout> guarantee-pango-layout
          pango-layout-get-context

diff --git a/src/pango/pango.scm b/src/pango/pango.scm
index 13e1907d6b1055a9f85b1de90fc23deb2ea734ff..e68e75bdb0b9ea39b2178a721f268fd06b687f79 100644 (file)
--- a/src/pango/pango.scm
+++ b/src/pango/pango.scm
@@ -32,7 +32,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
      (if (alien-null? ALIEN)
         (error MESSAGE ...)))))
 
-(define-integrable (color? object)
+(define (color? object)
   (and (flo:flonum? object) (fix:= 4 (flo:vector-length object))))
 
 (define-integrable (make-color) (flo:vector-cons 4))
@@ -47,7 +47,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define-integrable (set-color-blue! o b) (flo:vector-set! o 2 b))
 (define-integrable (set-color-alpha! o a) (flo:vector-set! o 3 a))
 
-(define-integrable (make-rgba-color red green blue alpha)
+(define (rgba-color red green blue alpha)
   (let ((color (make-color)))
     (set-color-red! color red)
     (set-color-green! color green)
@@ -55,13 +55,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (set-color-alpha! color alpha)
     color))
 
-(define (guarantee-color object operator)
-  (if (color? object)
-      object
-      (error:wrong-type-argument object "a color" operator)))
-
-(define white (make-rgba-color 1. 1. 1. 1.))
-(define black (make-rgba-color 0. 0. 0. 1.))
+(define white (rgba-color 1. 1. 1. 1.))
+(define black (rgba-color 0. 0. 0. 1.))
 
 (define (->color spec operator)
   (assert-glib-locked '->color)