via: Danny Yoo, at http://hashcollision.org/svn/repos/htdocs/plt/mr-ed-notes.txt

There are notes on *MrEd*; *MrEd* is a graphical user interface toolkit, and I'd like to write some tutorial notes on it, since I will need to know it intimately soon.

I'll try to make this tutorial example-oriented, because trying to go through all the widgets in alphabetical order might be exhausting.

Programming graphical programs in PLT Scheme requires something more than the regular *mzscheme* runtime, because *mzscheme* only provides textual support. There is a separate runtime called *mred* that we should use to start up graphical programs.

bash-3.00$ mred
%end
 
 
This brings up a graphical REPL by default, just as running *mzscheme*
without arguments starts up an interactive REPL
 
 Like *mzscheme*, we can start up programs by passing their names to
it:
 
 
<code shell>
bash-3.00$ cat hello.ss
(module hello mzscheme
  (display "hello world"))
bash-3.00$ 
bash-3.00$ mred -u hello.ss
hello world

So *mred* is just like *mzscheme*, except that it also provides hooks to graphical libraries. If we're in a Unix environment, we can even use *ldd* to see that *mred* is linked up against a lot of graphical libraries, compared to *mzscheme*:

bash-3.00$ ldd `which mred`
        libSM.so.6 =>    /usr/openwin/lib/libSM.so.6
        libICE.so.6 =>   /usr/openwin/lib/libICE.so.6
        libXaw.so.5 =>   /usr/openwin/lib/libXaw.so.5
        libXmu.so.4 =>   /usr/openwin/lib/libXmu.so.4
        libXt.so.4 =>    /usr/openwin/lib/libXt.so.4
        libX11.so.4 =>   /usr/openwin/lib/libX11.so.4
        ...

For the rest of these notes, if we try running our graphical programs, we should remember to use *mred*, not *mzscheme*. If we use the wrong executable, we're likely to see an predicable error message:

bash-3.00$ mzscheme -u hello-gui.ss
dynamic-require: unknown module: #%mred-kernel; need to run in MrEd instead of MzScheme

If we're running these programs in *DrScheme*, there's no need to worry about any of this stuff, because *DrScheme* is running on top of *MrEd* already.

Like everything else in PLT Scheme, the interesting stuff is in the libraries. The core graphical module library that we'll want to know about is the one in the *MrEd* collection, and every *MrEd* graphical program will probably contain this module require:

    (require (lib "mred.ss" "mred"))

after which, we can get access to a lot of graphical primitives like frames, buttons, and other widget goodness. Actually, because MrEd is written in object oriented style, we'll also have to import the class library too:

    (require (lib "mred.ss" "mred")
             (lib "class.ss"))

Without class support, we'll have access to these widgets, but we won't be able to do anything useful with them.

Tradition demands that we make a “hello world” application.

(module hello mzscheme
  (require (lib "mred.ss" "mred")
           (lib "class.ss"))
 
  (define frame
    (new frame% [label "Hello World"]))
 
  (define message-in-frame
    (new message% 
         [label "Hello, this is a message"]
         [parent frame]))
 
  (send frame show #t))

How do we know what kind of messages we can send a frame% or a message% instance? Those are in the MrEd reference, here:

• frame% http://download.plt-scheme.org/doc/301/html/mred/mred-Z-H-100.html#node_sec_3.19

• message% http://download.plt-scheme.org/doc/301/html/mred/mred-Z-H-187.html#node_sec_3.34

It's a little startling at first to see that a frame% can take in so many initialization variables, but that's ok: most of them already have reasonable defaults.

Once we have this example working, it might be a good idea to brush through Chapter 2 of the MrEd reference manual, just to get a feeling for the core widgets we have available to us:

http://download.plt-scheme.org/doc/301/html/mred/mred-Z-H-3.html#node_chap_2

Writing GUI programs can be a little unsettling at first, because the user is very much in control over the behavior of the program. We attach our behavior to the controls we give the user — we assign *callbacks* to a button — and wait for the user to fire them off.

Let's try a simple example: we'll make a frame that has a button, and pressing that button will bring up a “you pressed me!” window:

(module hello-2 mzscheme
  (require (lib "mred.ss" "mred")
           (lib "class.ss"))
 
  (define (you-pressed-me)
    (let* ([frame (new frame% [label ""])])
      (new message% 
           [parent frame]
           [label "You pressed me!"])
      (send frame show #t)
      frame))
 
  (define application-frame (new frame% [label "My Application"]))
  (define button (new button% 
                      [label "Press Me"]
                      [parent application-frame]
                      [callback 
                       (lambda (button event)
                         (you-pressed-me))]))
 
  (send application-frame show #t))

Here, whenever someone presses that “Press Me” button, we'll get called back by MrEd. The documentation in *button%* guarantees that the callback will be passed the button being pressed, as well as a control-event% instance that describes what just happened.

There are several different *control-event%*s,

http://download.plt-scheme.org/doc/301/html/mred/mred-Z-H-89.html#node_tag_Temp_91

and in this case, the type of the *control-event%* will be *'button*. We're completely ignoring the content of the event at this moment, just because we know to call *you-pressed-me*, but other events will have more interesting content.

Let's try another example — here's one that introduces a text-field%:

(module sample-gui mzscheme
  (require (lib "mred.ss" "mred")
           (lib "class.ss")
           (lib "etc.ss"))
 
  (define gui%
    (class object%
      (super-new)
 
      (define frame (void))
      (define entry (void))
      (define result (void))
 
      (define (initialize-gui)
        (set! frame (new frame% [label "test"]))
        (set! entry (new text-field% 
                         [label "entry: "]
                         [parent frame]
                         [callback entry-callback]))
        (set! result (new text-field% 
                          [label "result: "]
                          [parent frame]
                          [enabled #f])))
 
      (define (entry-callback field event)
        (define (is-enter? event)
          (symbol=? 'text-field-enter
                    (send event get-event-type)))
        (when (is-enter? event)
          (update-result)))
 
      (define (update-result)
        (let* ([entry-str (send entry get-value)]
               [entry-num (string->number entry-str)])
          (cond [entry-num
                 (send result set-value 
                       (number->string (* 2 entry-num)))]
                [else
                 (send result set-value 
                       (format "~a: not number" entry-str))])))
 
      (define/public (show b)
        (send frame show b))
 
      ;; at the end, initialize the gui -- by this time we have
      ;; everything defined.
      (initialize-gui)))
 
  (define my-gui (new gui%))
  (send my-gui show #t))

The class here is hardcoded to double any number in the entry that we pass in. Unlike the previous example, we do look at the event: whenever we receive an event from our *entry*, we watch to see if the user has pressed enter first, following the documentation of the text-field% callback to know what to expect.

We can generalize this to do something other than doubling, by adding initialization parameters to our *gui%* class to let people customize further. In fact, we can make our gui% class itself a subclass of frame%.

(module sample-gui mzscheme
  (require (lib "mred.ss" "mred")
           (lib "class.ss")
           (lib "etc.ss"))
 
  (define gui%
    (class frame%
      (init label)
      (init number-function)
      (define -number-function number-function)
      (super-new [label label])
 
      (define entry (void))
      (define result (void))
 
      (define (initialize-gui!)
        (set! entry (new text-field% 
                         [label "entry: "]
                         [parent this]
                         [callback entry-callback]))
        (set! result (new text-field% 
                          [label "result: "]
                          [parent this]
                          [enabled #f])))
 
 
      (define (entry-callback field event)
        (define (is-enter? event)
          (symbol=? 'text-field-enter
                    (send event get-event-type)))
        (when (is-enter? event)
          (update-result)))
 
 
      (define (update-result)
        (let* ([entry-str (send entry get-value)]
               [entry-num (string->number entry-str)])
          (cond [entry-num
                 (send result set-value 
                       (number->string (-number-function entry-num)))]
                [else
                 (send result set-value 
                       (format "~a: not number" entry-str))])))
 
 
      ;; at the end, initialize the GUI.
      (initialize-gui!)))
 
  (define my-gui (new gui% 
                      [label "squares"]
                      [min-width 300]
                      [number-function (lambda (n) (* n n))]))
  (send my-gui show #t))

And now we have a *gui%* that we can customize using the initialization variable of the *frame%*, and we can provide our own *number-function*.

Still, everything is still not roses and sunshine, because our program above seems to be one big spagetti blob of frames, buttons, textfields, and callback logic. Even though this example is toy, we should ask ourselves: can we do better?

One popular way to deal with this problem of entanglement is to partition our GUI applications into three separate parts:

• Model: the guts of the program that do the interesting work.

• View: the graphical elements.

• Controller: the bridge that connects the model and view together.

In the context of the above program, the Model involves our number-function, the View the *entry* and *result* textfields, and our Controller the callbacks that cooperate with the Model and the View.

The book How To Design Program covers this GUI-designing approach in chapter 22.3:

http://www.htdp.org/2003-09-26/Book/curriculum-Z-H-28.html#node_sec_22.3

Read that chapter first, and then come back here.

Let's see what our sample-gui could look like under this paradigm:

(module sample-gui mzscheme
  (require (lib "mred.ss" "mred")
           (lib "class.ss")
           (lib "etc.ss"))
 
  (define view%
    (class frame%
      (init [label "test"])
      (super-new [label label])
 
      ;; The entry callback here does nothing until it's rewired
      ;; by the controller.
      (define (entry-callback text-field control-event)
        (void))
 
      (define/public (set-entry-callback! f)
        (set! entry-callback f))
 
      (define entry-field 
        (new text-field%
             [label "entry: "]
             [parent this]
             [callback (lambda args
                         (apply entry-callback args))]))
      (define result-field 
        (new text-field%
             [label "result: "]
             [parent this]
             [enabled #f]))
 
      (define/public (get-entry-field)
        entry-field)
 
      (define/public (get-result-field)
        result-field)))
 
 
  (define controller%
    (class object%
      [init model]
      [init view]
      (super-new)
 
      (define entry (send view get-entry-field))
      (define result (send view get-result-field))
 
      (define (entry-callback field event)
        (define (is-enter? event)
          (symbol=? 'text-field-enter
                    (send event get-event-type)))
        (when (is-enter? event)
          (update-result)))
 
      (define (update-result)
        (let* ([entry-str (send entry get-value)]
               [entry-num (string->number entry-str)])
          (cond [entry-num
                 (send result set-value 
                       (number->string (model entry-num)))]
                [else
                 (send result set-value 
                       (format "~a: not number" entry-str))])))
 
      (send view set-entry-callback! entry-callback)))
 
 
  (define (simple-squaring-gui)
    (let ([model (lambda (n) (* n n))]
          [view (new view% [label "Squares"])])
      (let ([controller (new controller%
                             [model model]
                             [view view])])
        (send view show #t)))))

Some notes:

• We create our view object with the intention that it can be at

least viewed without a model. Furthermore, we set things up so

   that the controller can rewire the view with callbacks.

• Because our model is so simple, we're just passing a function

off.

• As MVC dicates, the model and the view have no clue about each

other's existance. We let the controller handle the relationship

   between these two parts.  This lets us code up and test our Model
   and View separately from each other.

So in the remainder of this tutorial, we'll try to stay with good GUI practice and use the Model-View-Controller pattern in writing our applications.

By now, we should know enough to build a simple calculator GUI. Because we're doing this with Scheme, let's make this a Reverse-Polish-Notation calculator, just for fun.

(For more information on RPN, see: http://www.hpmuseum.org/rpn.htm)

We'll do a simplified calculator that just handles addition and multiplication, since anything more complicated will take too much space.

Let's consider a GUI that might look something like this:

   +---------------+
   | ------------- |
   +-------+-------+
   | 1 2 3 | Reset |
   | 4 5 6 |       |
   | 7 8 9 |       |
   | 0 + * | Enter |
   +-------+-------+

Because we know about MVC, we know we can start writing useful things even before touching the view. Let's get a model down. Here's an implementation of a toy RPN calculator model.

(module rpn mzscheme
  ;; Defines a rough-and-dirty simulation of a very simple
  ;; RPN calculator.  This is meant to be a toy.
 
  (require (lib "plt-match.ss")
           (lib "struct.ss")
           (lib "list.ss")
           (lib "etc.ss"))
 
  (provide (all-defined))  
 
  ;; A calculator is a (make-calc s x l) 
  ;; where s is a (listof number), x is a number, and
  ;; l is a symbol.
  (define-struct calc (stack x-reg last-cmd) (make-inspector))
 
  ;; new-calc: -> calc
  ;; Returns a fresh calculator state.
  (define (new-calc)
    (make-calc empty 0 'Reset))
 
  ;; A command is one of the following
  ;; (list 0 1 2 3 4 5 6 7 8 9 '+ '* 'Enter 'Reset)
 
  ;; binops: (listof (cons symbol (cons (number number -> number) empty)))
  (define binops (list (list '+ +)
                       (list '* *)))
 
  ;; binop-cmd?: command -> boolean
  ;; Returns true if the command looks like a binary operator
  (define (binop-cmd? cmd)
    (and (assoc cmd binops) #t))
 
  ;; binop-cmd->binop: command -> (number number -> number)
  ;; Looks up the function associated to the cmd.
  (define (binop-cmd->binop cmd)
    (second (assoc cmd binops)))
 
 
  ;; eval-command: calc command -> calc
  ;; Evaluates the given command, and returns the new state
  ;; of the calculator.
  (define (eval-command a-calc a-cmd)
    (match (list a-calc a-cmd)
      [(list _ 'Reset)
       (new-calc)]
      [(list (struct calc (stack x-reg _)) 'Enter)
       (copy-struct calc a-calc
                    [calc-stack (cons x-reg stack)]
                    [calc-last-cmd 'Enter])]
      [(list (struct calc (stack x-reg last-cmd)) cmd)
       (=> continue-matching)
       (cond
         [(binop-cmd? cmd) (eval-binop-command a-calc cmd)]
         [(number? cmd) (eval-digit-command a-calc cmd)]
         [else (continue-matching)])]
      [else (error 'eval-command "Don't know how to evaluate ~a" a-cmd)]))
 
 
  ;; eval-binop-command: calc binop-cmd -> calc
  ;; Applies the binary operator binop-cmd on the calc a-calc.
  (define (eval-binop-command a-calc binop-cmd)
    (define (dispatch binop-cmd x y)
      ((binop-cmd->binop binop-cmd) x y))
 
    (match a-calc
      [(struct calc ((list) x-reg last-cmd))
       ;; delegate by restarting, but with a 0 on the stack.
       (eval-binop-command 
        (copy-struct calc a-calc [calc-stack (list 0)]) binop-cmd)]
      [(struct calc ((list head rest ...) x-reg last-cmd))
       (copy-struct calc a-calc 
                    [calc-stack rest]
                    [calc-x-reg (dispatch binop-cmd head x-reg)]
                    [calc-last-cmd binop-cmd])]))
 
 
  ;; eval-digit-command: calc number-between-0-and-9 -> calc
  ;; Enters a new digit into our calculator.
  (define (eval-digit-command a-calc digit)
    (match a-calc
      [(struct calc (stack x-reg last-cmd))
       (cond [(number? last-cmd)
              (copy-struct calc a-calc
                           [calc-x-reg (+ (* x-reg 10) digit)]
                           [calc-last-cmd digit])]
             [(binop-cmd? last-cmd)
              (copy-struct calc a-calc
                           [calc-stack (cons x-reg stack)]
                           [calc-x-reg digit]
                           [calc-last-cmd digit])]
             [else
              (copy-struct calc a-calc
                           [calc-x-reg digit]
                           [calc-last-cmd digit])])]))
 
 
  ;; run: (listof command) -> calc
  ;; eval-command's evey command in cmds, and returns the
  ;; last calculator state.
  (define (run cmds)
    (foldl (lambda (cmd calc) (eval-command calc cmd)) (new-calc) cmds)))

I had a bit of *fun* with this; please forgive me. Most of the logic in the model above tries to simulate what an HP calculator does when we press its keys, so some of it is more convoluted than I had planned. Oh well, at least this logic is not entangled with any GUI code.

Again, because this model is indepedent of anything fundamentally graphical, we can play with the model — even unit test this — without a GUI. For example, the expression:

     (* (+ 3 4) (+ 5 6)) 

corresponds to the sequence of commands in RPN:

'(3 Enter 4 + 5 Enter 6 + *)

When we evaluate this, we get the expected value in our x-register:

> (calc-x-reg (run '(3 Enter 4 + 5 Enter 6 + *)))
77

So we have a usable model. Hurrah!

We'd now like a GUI to push its buttons. The idea here is that we can get a fresh new calculator with *new-calc*. With it, we can then apply successive commands by using *eval-command*. We can imagine that every button press of our calculator will send a command off to our model, and between button presses, we'll show the state of the *calc-x-reg* of our calculator.

We can make the ugliest minimal view in the world just to make sure this idea has a chance of working:

  (define ugly-view%
    (class frame%
      (super-new)
 
      (define (on-button-pressed cmd)
        (void))
 
      (define/public (set-on-button-pressed f)
        (set! on-button-pressed f))
 
      (define (make-command-button label cmd)
        (new button%
             [label label]
             [parent this]
             [callback (lambda (button evt)
                         (on-button-pressed cmd))]))
 
      (define text-field (new text-field%
                              [label #f]
                              [parent this]
                              [enabled #f]))
 
      (define/public (get-text-field) text-field)
 
      (let* ([cmds '(Reset 0 1 2 3 4 5 6 7 8 9 + * Enter)]
             [labels (map (lambda (c) (format "~a" c)) cmds)])
        (for-each make-command-button labels cmds))))

This is something that we can look at with admiration (or disgust):

> (send (new ugly-view% [label "hello world"]) show #t)

Or we can use this view a part of a working GUI program. All we need to do now is write a controller that hooks up our calculator model to it.

  (define rpn-controller%
    (class object%
      [init model]
      [init view]
      (super-new)
 
      (define current-model model)
 
      (define (update-view!)
        (send (send view get-text-field) 
              set-value
              (format "~a" (calc-x-reg current-model))))
 
      (send view set-on-button-pressed 
                  (lambda (cmd)
                    (set! current-model
                          (eval-command current-model cmd))
                    (update-view!)))
 
      (update-view!)))

With these three pieces together, we can bring things to life by linking them up:

> (define (test-rpn-gui)
    (let ([model (new-calc)]
          [view (new ugly-view% [label "ugly!"])])
      (let ([controller (new rpn-controller%
                             [model model]
                             [view view])])
        (send view show #t))))

But the view itself is not very human-friendly. We should do some work to make the GUI a little more visually reasonable. But how do we do that?

We can use containers to control the layout of our widgets. All the views that we've done so far have placed widgets from top to bottom, but we can go horizontal too. One useful container is called the *horizontal-panel%*.

For example:

(module test-horizontal mzscheme
  (require (lib "mred.ss" "mred")
           (lib "class.ss"))
  (define f (new frame% [label ""]))
  (define h (new horizontal-panel% 
                 [parent f]
                 [alignment '(center center)]))
  (new message% [label "hello"] [parent h])
  (new message% [label "world"] [parent h])
  (send f show #t))

A *horizontal-panel%* allows us to lay thing out horizontally, and *vertical-panel%* does a similar job from top to down. A combination of two containers is enough to get us a simple grid-like layout.

Let's attempt the view again, but with a slightly more reasonable layout.

(module another-view mzscheme
  (require (lib "mred.ss" "mred")
           (lib "etc.ss")
           (lib "class.ss"))
 
  (define less-ugly-view%
    (class frame%
      (super-new)
 
      (define (on-button-pressed cmd)
        (void))
 
      (define/public (set-on-button-pressed f)
        (set! on-button-pressed f))
 
      (define (make-command-button label cmd parent)
        (new button%
             [label label]
             [parent parent]
             [callback (lambda (button evt)
                         (on-button-pressed cmd))]))
 
      (define text-field (new text-field%
                              [label #f]
                              [parent this]
                              [enabled #f]))
 
      (define/public (get-text-field) text-field)
 
      (define left-right (new horizontal-panel% [parent this]))
      (define left-side-panel (new vertical-panel% [parent left-right]))
      (define right-side-panel (new vertical-panel% [parent left-right]))
 
      (make-command-button "Reset" 'Reset right-side-panel)
      (new panel% [parent right-side-panel])
      (make-command-button "Enter" 'Enter right-side-panel)
 
      (let* ([cmdss '((7 8 9) 
                     (4 5 6)
                     (1 2 3)
                     (0 + *))]
             [rows (build-list
                    4
                    (lambda (i)
                      (new horizontal-panel% [parent left-side-panel])))])
        (for-each (lambda (commands row)
                    (for-each (lambda (cmd)
                                (make-command-button (format "~a" cmd)
                                                     cmd
                                                     row))
                              commands))
                  cmdss rows))))
 
  (send (new less-ugly-view% [label ""]) show #t))

So this is something we'd be able to hook up with our other components.

[fill me in]

[fill me in]

[fill me in]

[fill me in]