gui/controller.ss
(module controller mzscheme
  (require (lib "class.ss")
           "interfaces.ss"
           "../schemeunit.ss")
  
  (provide controller%)
  
  (define controller%
    (class* object% (controller<%>)
      (super-instantiate ())
      
      (init-field model-case%
                  model-suite%
                  view%
                  test)
      
      (public get-view
              get-root-model
              
              run-model
              clear-model
              select-model
              
              on-model-status-change
              on-view-selection-change)
      
      (define root-model #f)
      (define view #f)

      (define (get-root-model) root-model)
      (define (get-view) view)
      
      (define (run-model model)
        (send model run))

      (define (clear-model model)
        (send model clear))
      
      (define (select-model model)
        (send (send model get-view-link) select #t))
        
      ;; create : -> void
      (define (create)
        (set! root-model (create-model test #f))
        (set! view (instantiate view% () (root-model root-model) (controller this)))
        (send (get-view) show #t))
      
      ;; create-model : test model<%> -> model<%>
      (define (create-model test parent)
        (cond [(test-case? test)
               (instantiate model-case% () (controller this) (parent parent) (test test))]
              [(test-suite? test)
               (let* [(model (instantiate model-suite% () 
                               (controller this) (parent parent) (test test)))
                      (children (map (lambda (c) (create-model c model))
                                     (test-suite-tests test)))]
                 (send model set-children children)
                 model)]))
      
      ;; on-model-status-change : model<%> boolean -> void
      ;; The changed? flag indicates whether the given model actually changed status.
      (define (on-model-status-change model changed?)
        (send (get-view) update-model-view model)
        (let [(parent (send model get-parent))]
          (when parent (send parent on-child-status-change model changed?))))
      
      (define (on-view-selection-change view model)
        (send (get-view) set-selection model))
      
      (create)
      ))
  )