gui.ss
;; should cache the count of new snips -- dont
;; use `count-snips'; use something associated with the
;; equal hash-table

(module gui mzscheme
  (require "private/stepper.ss"
           "private/traces.ss"
           "private/matcher.ss"
           "private/reduction-semantics.ss"
           "private/size-snip.ss"
           (lib "contract.ss")
           (lib "class.ss")
           (lib "mred.ss" "mred"))
  
  (define pp-contract
    (or/c (-> any/c string?)
          (-> any/c output-port? number? (is-a?/c text%) any)))
  
  (define ((reduction-sequence? red) terms)
    (let loop ([term (car terms)]
               [terms (cdr terms)])
      (or (null? terms)
          (and (member (car terms) (apply-reduction-relation red term))
               (loop (car terms)
                     (cdr terms))))))
  
  (provide/contract
   [traces (opt-> (compiled-lang?
                   reduction-relation?
                   any/c)
                  (pp-contract (listof any/c))
                  any)]
   [traces/pred (opt-> (compiled-lang?
                        reduction-relation?
                        (listof any/c)
                        (or/c (any/c . -> . any)
                              (any/c term-node? . -> . any)))
                       (pp-contract (listof any/c))
                       any)]
   [traces/multiple (opt-> (compiled-lang?
                            reduction-relation?
                            (listof any/c))
                           (pp-contract (listof any/c))
                           any)]
   
   [term-node? (-> any/c boolean?)]
   [term-node-parents (-> term-node? (listof term-node?))]
   [term-node-children (-> term-node? (listof term-node?))]
   [term-node-labels (-> term-node? (listof (union false/c string?)))]
   [term-node-set-red! (-> term-node? boolean? void?)]
   [term-node-set-color! (-> term-node? 
                             (or/c string? (is-a?/c color%) false/c)
                             void?)]
   [term-node-expr (-> term-node? any)]
   
   [stepper
    (opt-> (compiled-lang?
            reduction-relation?
            any/c)
           (pp-contract)
           void?)]
   [stepper/seed 
    (opt-> (compiled-lang?
            reduction-relation?
            (cons/c any/c (listof any/c)))
           (pp-contract)
           void?)])
  
   
  (provide reduction-steps-cutoff initial-font-size initial-char-width
           dark-pen-color light-pen-color dark-brush-color light-brush-color
           dark-text-color light-text-color
           default-pretty-printer))