1 files changed, 0 insertions, 114 deletions
diff --git a/pict-sexp.rkt b/pict-sexp.rkt
deleted file mode 100644
index 8bf8222..0000000
--- a/pict-sexp.rkt
+++ /dev/null
@@ -1,114 +0,0 @@
-#lang racket
-(require pict)
-
-(define CELL-SIZE 30)
-(define ARROW-LENGTH 40)
-(define ARROW-SIZE 15)
-
-(define (square n)
-  (rectangle n n))
-
-(define (need-arrow? x)
-  (or (pair? x)
-      (< 2 (string-length (~a x)))))
-
-(define (pict-cell x)
-  (cond
-    [(need-arrow? x)
-     (cc-superimpose (square CELL-SIZE)
-                     (scale (filled-ellipse CELL-SIZE CELL-SIZE) 1/4))]
-    [else
-     (cc-superimpose (square CELL-SIZE)
-                     (text (~a x)))]))
-
-(define (pict-cons-cell pair)
-  (hc-append -1
-             (pict-cell (car pair))
-             (pict-cell (cdr pair))))
-
-(define (cdr-find _ p)
-  (values (- (pict-width p) (/ CELL-SIZE 2.0))
-          (/ CELL-SIZE 2.0)))
-
-(define (car-find p _)
-  (values (/ CELL-SIZE 2.0)
-          (/ CELL-SIZE 2.0)))
-
-(define (left-find p p1)
-  (values (- (pict-width p) (pict-width p1))
-          (/ CELL-SIZE 2.0)))
-
-(define (top-find p p1)
-  (values (/ CELL-SIZE 2.0)
-          (- (pict-height p) (pict-height p1))))
-
-(define (horizontal-combined p1 p2)
-  (ht-append ARROW-LENGTH p1 p2))
-
-(define (vertical-combined n p1 p2)
-  (vl-append (- (* (+ CELL-SIZE ARROW-LENGTH) n)
-                (pict-height p1))
-             p1 p2))
-
-(define (arrow-from-cdr p1 p2)
-  (pin-arrow-line ARROW-SIZE
-                  (horizontal-combined p1 p2)
-                  p1 cdr-find
-                  p2 left-find))
-
-(define (arrow-from-car n p1 p2)
-  (pin-arrow-line ARROW-SIZE
-                  (vertical-combined n p1 p2)
-                  p1 car-find
-                  p2 top-find))
-
-(define (pict-atom x)
-  (cc-superimpose (cellophane (filled-rectangle CELL-SIZE CELL-SIZE) 0)
-                  (text (~a x))))
-
-
-(define (cdr* lst)
-  (if (null? lst)
-      '()
-      (cdr lst)))
-
-(define (pict-sexp/helper sexp height-list fail)
-  (when (and (pair? height-list)
-             (<= 0 (car height-list)))
-    (fail))
-  (cond
-    [(pair? sexp)
-     (let*-values ([(cell) (pict-cons-cell sexp)]
-                   [(cell-1 height-list)
-                    (cond
-                      [(need-arrow? (cdr sexp))
-                       (let-values ([(pict-cdr cdr-height-list)
-                                     (pict-sexp/helper (cdr sexp)
-                                                       (cdr* height-list)
-                                                       fail)])
-                         (values (arrow-from-cdr cell pict-cdr)
-                                 (cons 0 cdr-height-list)))]
-                      [else (values cell (cons 0 (cdr* height-list)))])]
-                   [(cell-2 height-list)
-                    (cond
-                      [(need-arrow? (car sexp))
-                       (let retry ([len 1] [height-list (map sub1 height-list)])
-                         (let/cc escape
-                           (let/cc fail
-                             (let-values ([(pict-car height-list)
-                                           (pict-sexp/helper (car sexp)
-                                                             height-list
-                                                             fail)])
-                               (escape (arrow-from-car len cell pict-car)
-                                       (map (λ (x) (+ x len)) height-list))))
-                           (retry (add1 len) (map sub1 height-list))))]
-                      [else (values cell height-list)])])
-       (values (lt-superimpose cell-1 cell-2) height-list))]
-    [else
-     (values (pict-atom sexp) (cons 0 (cdr* height-list)))]))
-
-(define (pict-sexp sexp)
-  (define-values (result height-list)
-    (pict-sexp/helper sexp '() (λ () (error "pict-sexp: implementation error"))))
-  result)
-(provide pict-sexp)