[plt-scheme] Grafting a console onto universe, hackety hack.

Hi guys,

I was talking with one of my students who's implementing a little chat
server (and pig-latin translator) using universe, and naturally it occurred
to me that -- although I've had students implemented a basic command-line
editor earlier in the year (along the lines of what's in HtDP/2e) -- it'd be
nice to have the option of doing this kind of thing without messing around
with console input handling.

So I started playing around with the GUI toolkit, and produced the code
below: a console object and a demo file.  I'm curious about:

     1) whether there's a decent (and minimally intrusive) way to hook into
       universe to trigger events from this console -- polling a state variable
       in the tick handler is kinda icky
     2) whether there's any locking I'd need to do to make it safe for both the
       user-input-callback (see below) and a universe/big-bang event handler
       callback to call append-line as I'm doing below
     3) whether overriding on-char is really an OK way to make a text% object
       "read-only" from the user's perspective
     4) whether there's already some spiffy console-style class I've missed in
       the docs :)

Thanks,
jmj

;; --- console-demo.ss ------------------------------------
#lang scheme/gui

(require 2htdp/universe "console.ss")

;; Set up the console window:
(define the-frame
   (let ([new-es (make-eventspace)])
     ;; big-bang takes over the Interactions window's eventspace for use by
     ;; its on-key and on-mouse, so here we create and install a separate
     ;; event space to handle events in our console.
     ;; This means also that
     ;;  (a) we must install a stop-when test to halt the world when the
     ;;      window closes, and
     ;;  (b) after the world halts, (send the-frame show #t) can re-show the
     ;;      frame (but does NOT restart the world).
     (parameterize ([current-eventspace new-es])
       (new console-frame%
            [label "universe test"]
            [width 500]
            [height 400]
            [echo? #f]
            [user-input-callback
             (lambda (s)
               (send the-frame append-line (format "Received ~s." s)))]))))

;; world = Nat, representing the # of seconds elapsed

;; stop? : world -> bool
;; True iff the world should stop.
(define (stop? w) (not (send the-frame is-shown?)))

;; next : world -> world
;; Produces the next world.
;; EFFECT: every five seconds, shows "TICK!" in the console
(define (next w)
   (let ([w2 (add1 w)])
     (when (zero? (modulo w2 5))
       (send the-frame append-line "TICK!"))
     w2))

;; Run the show:
(define (run w0)
   (send the-frame show #t)
   (big-bang w0
             (on-tick next 1)
             (stop-when stop?)
             ))

;; Start it going:
(run 0)

;; -- end console-demo.ss -----------------------------------------


;; -- console.ss --------------------------------------------------
#lang scheme/gui

(provide console-frame%)

;; A frame containing two elements at creation:
;;    - a read-only output text% area
;;    - a text-field% for input
(define console-frame%
   (class frame%
     (super-new)

     (init-field user-input-callback  ;; string -> any
                 [echo? #f])
     ;; user-input-callback is called when the user presses Enter, with
     ;; the text-field%'s contents as input.

     ;; The area that displays console output:
     (define output-view
       (new (class text%
              (super-new)

              ;; Disable typing in this area:
              (define/override (on-char evt) (void))

              (inherit insert last-position)
              ;; string -> void
              ;; Appends a line at the end (bottom) of the text area.
              (define/public (append-line s)
                (let ([ins (lambda (s) (insert s (last-position)))])
                  (ins "\n")
                  (ins s)))

              ;; boolean -> void
              ;; If this area gets keyboard focus, give it to the input
              ;; area instead.
              (define/override (on-focus on?)
                (when on? (send entry-line focus)))
              )
            [auto-wrap #t]))

     (define ec (new editor-canvas%
                     [parent this]
                     [editor output-view]))

     ;; The area into which the user types their input:
     (define entry-line
       (new text-field%
            [label "text:"]
            [parent this]
            [callback (on-enter
                       (lambda (tf)
                         (let ([s (send tf get-value)])
                           (user-input-callback s)
                           (send tf set-value "")
                           (when echo?
                             (send output-view append-line s))
                           )))]))

     ;; string -> void
     ;; Appends the line to the console display.
     (define/public (append-line s) (send output-view append-line s))

     ))

;; on-enter : (text-field% -> X) -> (text-field% control-event<%> -> X)
;; Create a callback for a text field, to be triggered only when the user
;; presses Enter.
(define (on-enter f)
   (lambda (tf evt)
     (when (eq? (send evt get-event-type) 'text-field-enter)
       (f tf))))

;; -- end --------------------------------------------------