(define n 10000)
(define *break* #f)
(define *continue* #f)

(define (test-run)
  (parameterize
      ((current-output-port (open-output-text-editor text)))
    (begin-busy-cursor)
    (set! *break* #f)
    (send run-button enable #f)
    (send gauge set-range n)
    (send gauge set-value 0)
    (let/cc exit
      (do ((i 1 (+ i 1)))
        ((> i n) (void))
        (yield)
        (let/cc next
          (set! *continue* next)
          (if *break* (exit))
          (do ((j 0 (+ j 1)))
            ((= j 1000) (void))
            (void))
          (send text erase)
          (printf "~a~n" i)
          (send gauge set-value i))))
    (printf "I counted to ~a.~n" (send gauge get-value))
    (send run-button enable #t)
    (end-busy-cursor)))


;;; Graphics
      
(define frame (instantiate frame% ("Test Control Strategy")))

(define menu-bar (instantiate menu-bar% (frame)))

(define file-menu (instantiate menu% ("&File" menu-bar)))

(define exit-menu-item (instantiate menu-item% ("E&xit" file-menu)
                         (callback (lambda (mi e)
                                     (exit)))))

(define edit-menu (instantiate menu% ("&Edit" menu-bar)))


(define panel-1 (instantiate horizontal-panel% (frame)
                  (alignment '(right center))))

(define run-button (instantiate button%
                     ("Run" panel-1)
                     (horiz-margin 4)
                     (callback (lambda (b e)
                                 (test-run)))))

(define stop-button (instantiate button%
                      ("Stop" panel-1)
                      (horiz-margin 4)
                      (callback (lambda (b e)
                                  (set! *break* #t)))))

(define canvas (instantiate editor-canvas% (frame)
                 (min-width 500)
                 (min-height 450)
                 (style '(no-hscroll hide-vscroll))))

(define text (instantiate text% ()))

(send canvas set-editor text)

(define gauge (instantiate gauge% ("Progress" 1 frame)))

(send frame show #t)