(module pict-test mzscheme
  (require "pict.ss"
           "loc-wrapper.ss"
           "term.ss"
           (lib "mrpict.ss" "texpict")
           (lib "class.ss")
           (lib "mred.ss" "mred"))
  
  (dc-for-text-size (make-object bitmap-dc%))
  
  (define (tst . x)
    (build-lines '() (map loc-wrapper->tree x)))
  
  #;
  (define x
    (loc-wrapper->tree
     (to-loc-wrapper (in-hole P 
                              1))))
  
  (define y
    (loc-wrapper->tree
     (to-loc-wrapper (w ,(or (term x)
                             (term y))))))
  
  (define (m-s-t a b c) (make-string-token a b c 'roman))
  
  (define (same? x y)
    (cond
      [(and (pair? x) (pair? y))
       (and (same? (car x) (car y))
            (same? (cdr x) (cdr y)))]
      [(and (pict-token? x) (pict-token? y))
       (and (equal? (token-column x) (token-column y))
            (equal? (token-span y) (token-span y)))]
      [else (equal? x y)]))
  
#;
  (begin
    (printf "~s\n"
          (same?
           (tst (to-loc-wrapper (e f .
                                   g)))
           (list (list (make-spacer-token 0 3)
                       (m-s-t 3 1 "g")
                       (m-s-t 4 1 ")"))
                 (list (m-s-t 0 1 "(")
                       (m-s-t 1 1 "e")
                       (m-s-t 2 1 " ")
                       (m-s-t 3 1 "f")
                       (m-s-t 4 2 " .")))))


  (printf "~s\n"
          (same?
           (tst (to-loc-wrapper (e f
                                   . g)))
           (list (list (make-spacer-token 0 5)
                       (m-s-t 5 1 "g")
                       (m-s-t 6 1 ")"))
                 (list (m-s-t 0 1 "(")
                       (m-s-t 1 1 "e")
                       (m-s-t 2 1 " ")
                       (m-s-t 3 1 "f")
                       (m-s-t 4 2 " .")))))

  (printf "~s\n"
          (same?
           (tst (to-loc-wrapper (e 1
                                   2)))
           (list (list (make-spacer-token 0 3)
                       (m-s-t 3 1 "2")
                       (m-s-t 4 1 ")"))
                 (list (m-s-t 0 1 "(")
                       (m-s-t 1 1 "e")
                       (m-s-t 2 1 " ")
                       (m-s-t 3 1 "1")))))
  
  (printf "~s\n"
          (same?
           (tst (to-loc-wrapper (e 1)))
           (list (list (m-s-t 0 1 "(")
                       (m-s-t 1 1 "e")
                       (m-s-t 2 1 " ")
                       (m-s-t 3 1 "1")
                       (m-s-t 4 1 ")")))))
  
  (printf "~s\n"
          (same?
           (tst (to-loc-wrapper (in-hole P 
                                         Q)))
           (list (list (make-spacer-token 0 9)
                       (make-pict-token 9 0 'ignored)
                       (make-string-token 9 1 "Q" 'roman)
                       (make-pict-token 10 0 'ignored))
                 (list (make-pict-token 0 9 'ignored)
                       (make-string-token 9 1 "P" 'roman)))))
  
  (printf "~s\n"
          (same?
           (tst (to-loc-wrapper (a
                                 (b
                                  c))))
           (list (list (make-spacer-token 0 2)
                       (make-string-token 2 1 "c" 'roman)
                       (make-string-token 3 1 ")" 'roman)
                       (make-string-token 4 1 ")" 'roman))
                 (list (make-spacer-token 0 1)
                       (make-string-token 1 1 "(" 'roman)
                       (make-string-token 2 1 "b" 'roman))
                 (list (make-string-token 0 1 "(" 'roman)
                       (make-string-token 1 1 "a" 'roman)))))
  
  (printf "~s\n"
          (same? (tst (to-loc-wrapper (in-hole x (y
                                                  (in-hole z w)))))
                 (list (list (make-spacer-token 0 12)
                             (make-pict-token 12 9 'ignored)
                             (make-string-token 21 1 "z" 'roman)
                             (make-pict-token 22 1 'ignored)
                             (make-string-token 23 1 "w" 'roman)
                             (make-pict-token 24 1 'ignored)
                             (make-string-token 25 1 ")" 'roman)
                             (make-pict-token 26 0 'ignored))
                       (list (make-pict-token 0 9 'ignored)
                             (make-string-token 9 1 "x" 'roman)
                             (make-pict-token 10 1 'ignored)
                             (make-string-token 11 1 "(" 'roman)
                             (make-string-token 12 1 "y" 'roman)))))
  
  ))