gtk (surface-ink-flush): New. Keep a glib-only copy of the surface.

The new flush procedure signals the glib thread to update its copy.

diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm
index dbb4c730b46f2c358fa1b0e27ba2e8f47670ec6e..4be56302a987f23987ed35f4c9eafbc540c3a4b6 100644 (file)
--- a/src/gtk/fix-layout.scm
+++ b/src/gtk/fix-layout.scm
@@ -1723,7 +1723,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (<fix-ink>)
 
   ;; Cairo Image Surface -- a |cairo_surface_t| alien.
-  (surface define standard initial-value #f))
+  (surface define standard)
+
+  ;; For use by the glib thread only.
+  (exposed define standard initial-value #f))
 
 (define-method initialize-instance ((ink <surface-ink>) width height)
   (call-next-method ink)
@@ -1731,16 +1734,46 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (set-surface-ink-surface! ink (cairo-image-surface-create width height)))
 
 (define-method fix-ink-draw-callback ((ink <surface-ink>) widget window cr area)
-  (declare (ignore window area))
+  (declare (ignore area))
   (%trace ";drawing "ink" on "widget"\n")
   (let ((view (fix-layout-view widget))
        (extent (fix-ink-extent ink))
-       (surface (surface-ink-surface ink)))
+       (surface (get-exposed ink window)))
     (let ((x (fix:- (fix-rect-x extent) (fix-rect-x view)))
          (y (fix:- (fix-rect-y extent) (fix-rect-y view))))
       (cairo-set-source-surface cr surface x y)
       (cairo-paint cr))))
 
+(define (get-exposed ink window)
+  (or (surface-ink-exposed ink)
+      (let ((extent (fix-ink-extent ink))
+           (scale (C-call "gdk_window_get_scale_factor" window)))
+       (let ((width (fix:* scale (fix-rect-width extent)))
+             (height (fix:* scale (fix-rect-height extent))))
+         (let* ((surface (gdk-window-create-similar-surface window
+                                                            width height))
+                (cr (cairo-create surface)))
+           (cairo-set-source-surface cr (surface-ink-surface ink) 0 0)
+           (cairo-paint cr)
+           (cairo-destroy cr)
+           (set-surface-ink-exposed! ink surface)
+           surface)))))
+
+(define (surface-ink-flush ink)
+  (let ((surface (surface-ink-surface ink))
+       (exposed (surface-ink-exposed ink)))
+    (cairo-surface-flush surface)
+    (if exposed
+       (signal-thread-event glib-thread
+         (lambda ()
+           (%trace2 ";surface-ink-flush copying\n")
+           (let ((cr (cairo-create exposed)))
+             (cairo-set-source-surface cr surface 0 0)
+             (cairo-paint cr)
+             (cairo-destroy cr))
+           (cairo-surface-flush exposed))))
+    (drawing-damage ink)))
+
 (define (set-surface-ink-position! ink x y)
   (set-fix-rect-position! (fix-ink-extent ink) x y))
 \f

diff --git a/src/gtk/gtk-graphics.scm b/src/gtk/gtk-graphics.scm
index 7444ba2f84da785c86c709864b987e2bdd248d80..8acc3274ea68e177cbbeeb2925a7a2a008a10d8d 100644 (file)
--- a/src/gtk/gtk-graphics.scm
+++ b/src/gtk/gtk-graphics.scm
@@ -271,9 +271,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
       (cairo-fill cr))))
 
 (define (gtk-graphics/flush device)
-  (let ((graphics (graphics-device/descriptor device)))
-    (cairo-surface-flush (surface-ink-surface graphics))
-    (drawing-damage graphics)))
+  (surface-ink-flush (graphics-device/descriptor device)))
 
 (define (gtk-graphics/set-background-color device name)
   (let ((graphics (graphics-device/descriptor device)))

diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index 819348aa8aa5b74b77123a053db7f0d8970d9668..724d52e2ce0a77976687f661d3f9a91004e0def6 100644 (file)
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -180,6 +180,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
          c-enum-constant-values)
   (import (pango)
           make-pango-layout pango-rectangle pangos->pixels pixels->pangos)
+  (import (glib thread)
+         glib-thread)
   (import (gtk gtk-widget)
          set-gtk-widget-destroy-callback!
          gtk-widget-destroy-callback
@@ -252,6 +254,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
          <surface-ink> surface-ink? make-surface-ink
          surface-ink-surface set-surface-ink-position!
+         surface-ink-flush
          ))
 
 (define-package (gtk keys)