From a06e6a9dbc872373c0d5c8092534929be60019a3 Mon Sep 17 00:00:00 2001
From: Masaya Tojo <masaya@tojo.tokyo>
Date: Sun, 24 Jun 2018 12:08:19 +0900
Subject: Revert "Change to multi-collection"
This reverts commit 98916db99f0481074c69e401cbbc9dfac2b97117.
---
tojoqk/compiled/pict-sexp_rkt.dep | 1 -
tojoqk/compiled/pict-sexp_rkt.zo | Bin 11195 -> 0 bytes
tojoqk/pict-sexp.rkt | 114 --------------------------------------
3 files changed, 115 deletions(-)
delete mode 100644 tojoqk/compiled/pict-sexp_rkt.dep
delete mode 100644 tojoqk/compiled/pict-sexp_rkt.zo
delete mode 100644 tojoqk/pict-sexp.rkt
(limited to 'tojoqk')
diff --git a/tojoqk/compiled/pict-sexp_rkt.dep b/tojoqk/compiled/pict-sexp_rkt.dep
deleted file mode 100644
index 609942f..0000000
--- a/tojoqk/compiled/pict-sexp_rkt.dep
+++ /dev/null
@@ -1 +0,0 @@
-("6.12" ("557165c7f453a5c25fdde80c631121564dbffba6" . "c3776e5726554e08e99c1cc23a73ae54cd1b7847") (collects #"pict" #"main.rkt") (collects #"racket" #"main.rkt") (collects #"racket" #"runtime-config.rkt"))
diff --git a/tojoqk/compiled/pict-sexp_rkt.zo b/tojoqk/compiled/pict-sexp_rkt.zo
deleted file mode 100644
index 3df0983..0000000
Binary files a/tojoqk/compiled/pict-sexp_rkt.zo and /dev/null differ
diff --git a/tojoqk/pict-sexp.rkt b/tojoqk/pict-sexp.rkt
deleted file mode 100644
index 8bf8222..0000000
--- a/tojoqk/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)
--
cgit v1.2.3