From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Sun, 7 Apr 2013 17:18:56 +0000 (-0700)
Subject: Add cairo-surface-write-to-png.
X-Git-Tag: mit-scheme-pucked-9.2.12~522
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=919418e2f2b667ddb45d37ba5e4fc3473af8141d;p=mit-scheme.git

Add cairo-surface-write-to-png.

This should really use cairo_surface_write_to_png_stream.
---

diff --git a/src/gtk/cairo.scm b/src/gtk/cairo.scm
index cbb22f62e..0c3bbb007 100644
--- a/src/gtk/cairo.scm
+++ b/src/gtk/cairo.scm
@@ -65,6 +65,11 @@ USA.
       object
       (error:wrong-type-argument object "a cairo_surface_t alien" operator)))
 
+(define (cairo-surface-write-to-png surface filename)
+  (guarantee-cairo-surface surface 'cairo-surface-write-to-png)
+  (guarantee-string filename 'cairo-surface-write-to-png)
+  (C-call "cairo_surface_write_to_png" surface filename))
+
 (define (cairo-surface-flush surface)
   (guarantee-cairo-surface surface 'cairo-surface-flush)
   (C-call "cairo_surface_flush" surface))
diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index f68449473..bea8ed114 100644
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -134,6 +134,7 @@ USA.
   (export (gtk)
 	  cairo-image-surface-create
 	  cairo-surface-destroy
+	  cairo-surface-write-to-png
 	  cairo-surface-flush
 	  cairo-pattern-create-linear
 	  cairo-pattern-create-radial