From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Mon, 19 Mar 2018 00:17:16 +0000 (-0700)
Subject: glib: Move color procedures to Pango.
X-Git-Tag: mit-scheme-pucked-x11-0.2.2~21
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1db008f194199ae44acd3f593cd662490fcab570;p=mit-scheme.git

glib: Move color procedures to Pango.
---

diff --git a/src/glib/NEWS b/src/glib/NEWS
index e9445b255..54c112bea 100644
--- a/src/glib/NEWS
+++ b/src/glib/NEWS
@@ -23,7 +23,8 @@ mit-scheme-pucked-glib 0.7 - Matt Birkholz, 2018-03-16
 ======================================================
 
 Require the use of with-glib-lock, except with the globally exported
-open-input-gfile, open-output-gfile, and gdirectory-read.
+open-input-gfile, open-output-gfile, and gdirectory-read.  Color
+procedures can now be found in the (pango) package.
 
 mit-scheme-pucked-glib 0.6 - Matt Birkholz, 2018-01-12
 ======================================================
diff --git a/src/glib/debian/changelog b/src/glib/debian/changelog
index 389a83494..61749a2f8 100644
--- a/src/glib/debian/changelog
+++ b/src/glib/debian/changelog
@@ -2,6 +2,9 @@ mit-scheme-pucked-glib (0.7) birchwood; urgency=low
 
   * Require the use of with-glib-lock, except with the globally
     exported open-input-gfile, open-output-gfile, and gdirectory-read.
+    Color procedures can now be found in the (pango) package.
+
+ -- Matt Birkholz <matt@birchwood-abbey.net>  Fri, 16 Mar 2018 00:00:00 -0700
 
 mit-scheme-pucked-glib (0.6) birchwood; urgency=low
 
diff --git a/src/glib/glib.scm b/src/glib/glib.scm
index ef1aac4c4..3296cfc01 100644
--- a/src/glib/glib.scm
+++ b/src/glib/glib.scm
@@ -78,48 +78,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (bit-ior . ints)
   (reduce bitwise-ior 0 ints))
 
-(define-integrable (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)
-    color))
-
-(define (guarantee-color object operator)
-  (if (color? object)
-      object
-      (error:wrong-type-argument object "a color" operator)))
-
 ;;; GLib Mutex
 
 (define glib-mutex)