gtk: Add gtk-graphics/make.

diff --git a/src/gtk/gtk-graphics.scm b/src/gtk/gtk-graphics.scm
index ff08b1ccfcfaa7d3df832c035721d106f2f49607..0f0197869e0e0ba048d24571b037b592e541075d 100644 (file)
--- a/src/gtk/gtk-graphics.scm
+++ b/src/gtk/gtk-graphics.scm
@@ -94,6 +94,12 @@ USA.
          (gtk-widget-show-all window)
          (make-device graphics)))))
 
+(define (gtk-graphics/make width height)
+  (guarantee-positive-fixnum width 'gtk-graphics/open)
+  (guarantee-positive-fixnum height 'gtk-graphics/open)
+  (%make-graphics-device gtk-graphics-device-type
+                        (make-gtk-graphics width height)))
+
 (define (toplevel graphics)
   (let ((widgets (fix-drawing-widgets (fix-ink-drawing graphics))))
     (if (null? (cdr widgets))

diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index bea8ed11449f01f4fb89615de5ed5ed599a94b67..d319d68bc1fa873adc3e292411a24960028291c1 100644 (file)
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -406,14 +406,18 @@ USA.
   (import (gtk fix-layout)
          fix-ink-extent fix-rect-height fix-rect-width
          ->color set-surface-ink-surface! drawing-damage)
+  (import (runtime graphics)
+         %make-graphics-device)
   (export ()
+         gtk-graphics-device-type
          gtk-graphics/set-background-color
          gtk-graphics/set-foreground-color
          gtk-graphics/draw-line
          gtk-graphics/draw-text
          gtk-graphics/draw-circle
          gtk-graphics/fill-polygon-list
-         gtk-graphics/flush))
+         gtk-graphics/flush
+         gtk-graphics/make))
 
 (define-package (gtk swat)
   (parent (gtk))