Fun With MrEd Components - A Retro Status Indicator

I'm happily hacking away on a MrEd based Scheme app. For the most part, I'm finding MrEd an ideal environment to develop desktop apps in (more thoughts to come on this, when I've got more experience under my belt).

While the windowing toolkit isn't huge, I'm finding it easy to extend. I've done this mostly by trial and error, but just today learned about this recipe that would have taught me how to do build my own components.

Here's a fun component I put together today. I needed to convey to the user that the operation they just triggered is going to take some time. I could have grabbed a loading icon and just hacked that in place. But I couldn't resist going retro and using the classic ASCII loading hack that involves overwriting the following characters in quick succession:

 - \ | / -

One aspect of this component that was pleasantly surprising was the use of threads. In Java, Swing and threads don't get along particularly well. Not to mention, in Java, you need to jump through hoops to even stop a thread. This sort of programming in Scheme was a breeze.

;;
;; Declare my module
;;
(module status-spinner mzscheme
  (require (lib "mred.ss" "mred")  (lib "class.ss"))

  ;; The module will just provide the spinner component. Remember a % is just a
  ;; convention that says this name is a class.
  (provide status-spinner%)
  
  ;; Let's define the class
  (define status-spinner%
    (class horizontal-panel%

      ;; A spinner can optionally be provided with a size.
      (init-field parent (spinner-size 10))

      ;; The spinner is just text, so let's find the right font
      (define font (send the-font-list find-or-create-font spinner-size 'modern 'normal 'bold #f 'smoothed #f))

       ;; Part of the magic, choosing the text to show
      (define chars (vector "-" "\\" "|" "/"))
      
      ;; Setup our super class. Just like: super(...) in Java
      (super-new (parent parent) (stretchable-height #f) (stretchable-width #f))

      ;; Define where we'll stash our spinner text, the output. It's just a
      ;; plain text/message component
      (define output (new message% (label "") (min-width (inexact->exact (* 1.5 spinner-size))) (parent this) (font font)))

      ;; This is where we'll store the thread, but for now we don't have one.
      (define worker #f)
      

      ;; Our start function. We'll call this to make the spinner go.
      (define/public (start)
        (if (not worker)
            (set! worker (thread (lambda ()
                                   ;; This is an infinite loop, which keeps us spinning
                                   (let loop ((i 0))
                                     (send output set-label (vector-ref chars (modulo i (vector-length chars))))
                                     (sleep/yield .1) ; sleep for .1 seconds
                                     (loop (add1 i))))))))
      
      ;; Our stop method. Couldn't be easier to implement. Just kill the
      ;; thread. Ahhh, wish you could do this in Java.
      (define/public (stop)
        (if worker
            (begin              
              (kill-thread worker)
              (set! worker #f)
              (send output set-label ""))))
      ))
  )

And here's a sample usage:

  ;; we make a frame, spinner and two buttons. Wire one button
  ;; to send 'start' to the spinner and one to send 'stop'.
  ;; Easy, right?
  (define (test)
    (let* ((f (new frame% (label "Spinner Test")))
           (s (new status-spinner% (parent f) (spinner-size 12)))
           (b (new button% (label "Start") (parent f) (callback
                                                       (lambda (b evt)
                                                         (send s start)))))
           (e (new button% (label "End") (parent f) (callback
                                                     (lambda (e evt)
                                                       (send s stop))))))
      (send f show #t)))

And here it is in action: