private/color-test.ss
#|

tests the color setting ability during a reductino sequence.

when run, you expect to see a red and a blue snip. as you reduce you expect to see a spectrum from blue to red

|#

(module color-test mzscheme
  (require "../reduction-semantics.ss"
           "../gui.ss"
           "../subst.ss"
           (lib "mred.ss" "mred")
           (lib "class.ss"))
  
  (reduction-steps-cutoff 1)
  
  (define reductions
    (reduction-relation
     (language)
     (--> (number_1 word)
          (,(+ (term number_1) 1) word)
          inc)))
  
  (define (get-range term-node)
    (let loop ([node term-node])
      (let ([parents (term-node-parents node)])
        (cond
          [(null? parents) (list node)]
          [else (cons node (loop (car parents)))]))))
  
  (define (pred sexp term-node) 
    (let* ([parents (get-range term-node)]
           [max-val (car (term-node-expr (car parents)))])
      (for-each
       (λ (node)
         (let ([val (car (term-node-expr node))])
           (term-node-set-color! node
                                 (make-object color% 
                                   (floor (- 255 (* val (/ 255 max-val))))
                                   0
                                   (floor (* val (/ 255 max-val)))))))
       parents)))
  
  (traces/pred (language)
               reductions 
               (list '(1 word))
               pred)
  
  
  )