From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Wed, 20 Jul 2011 15:30:41 +0000 (-0700)
Subject: Added blink? and spin? flags.
X-Git-Tag: mit-scheme-pucked-9.2.12~680
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c08031552ad5b1df5dac169e3ceb386a96900b8e;p=mit-scheme.git

Added blink? and spin? flags.
---

diff --git a/src/gtk/fix-demo.scm b/src/gtk/fix-demo.scm
index fd682af89..36fb6265d 100644
--- a/src/gtk/fix-demo.scm
+++ b/src/gtk/fix-demo.scm
@@ -24,6 +24,9 @@ USA.
 ;;;; A small drawing in two fix-layout widgets.
 ;;; package: (gtk demo)
 
+(define blink? #t)
+(define spin? #t)
+
 (define (make-fix-layout-demo)
   (let* ((window (gtk-window-new 'toplevel))
 	 (vbox (gtk-vbox-new #t 0))
@@ -52,10 +55,14 @@ USA.
 	(fix-drawing-add-ink! drawing cursor2 'bottom)
 	(set-demo-drawing-cursor-inks!
 	 drawing (list (list cursor1 layout1) (list cursor2 layout2))))
-      (let ((thread (start-blinking drawing)))
-	(%trace "; Cursor blinking courtesy of "thread".\n"))
-      (let ((thread (start-spinning drawing)))
-	(%trace "; Ring spinning courtesy of "thread".\n"))
+      (if blink?
+	  (let ((thread (start-blinking drawing)))
+	    (%trace "; Cursor blinking courtesy of "thread".\n"))
+	  (%trace "; Cursor blinking disabled.\n"))
+      (if spin?
+	  (let ((thread (start-spinning drawing)))
+	    (%trace "; Ring spinning courtesy of "thread".\n"))
+	  (%trace "; Ring spinning disabled.\n"))
       (set-fix-layout-drawing! layout1 drawing 175 150)
       (set-fix-layout-drawing! layout2 drawing 175 150))
     (gtk-widget-grab-focus layout1)