2007/03/24

文字列を螺旋にそって描く。これに似ているけど、もっと単純に、ASCIIのみからなる文字列を同心円状の渦巻に沿って出力する。交差はさせない。(できない)

howm wiki - spiral.el
http://howm.sourceforge.jp/cgi-bin/hiki/hiki.cgi?SpiralDotEl

昨日定義した関数たちを改良して、
  • 螺旋のパラメータを指定できるようにする
  • state の列に真偽値ではなく各文字を対応させる(同じ座標の state を飛ばす処理も必要)
ようにする。
;; num -> direction -> type -> [state]
(define (make-spiral-states length start-x start-y start-direction l-or-r)
(define (make-spiral-series total)
(let* ((most (floor (/ (- (sqrt (+ 1 (* 8 (- total 1)))) 1) 2)))
(lmost (iota (- most 1) 2 1))
(rest (- total (fold + 1 lmost))))
(append (list 2) lmost (if (zero? rest) '() (list rest)))))
(let ((series (make-spiral-series length))
(init-state (make-state start-x start-y start-direction))
(turn (if (equal? l-or-r 'left) turn-left turn-right)))
(scanf init-state (concatenate (map (lambda (n) (append (keep-moving n) (list turn))) series)))))

;; [state] -> [codes]
(define (normalize states)
(let R ((ps '()) (codes (map car states)))
(cond ((null? codes)
ps)
((member (car codes) ps)
(R ps (cdr codes)))
(else
(R (cons (car codes) ps) (cdr codes))))))

;; [codes] -> [state]
(define (stick-char codes chars)
(map (cut list <> <>) codes chars))

;; [state] -> [[char]]
(define (bitmap ps)
(define (range xs)
(list-ec (: i (apply min xs) (+ (apply max xs) 1)) i))
(define (corresponding-char code ps)
(cond ((null? ps) " ")
((equal? code (caar ps)) (cadar ps))
(else (corresponding-char code (cdr ps)))))
(let ((codes (map car ps)))
(list-ec (: x (range (map car codes)))
(list-ec (: y (range (map cadr codes)))
(corresponding-char (list x y) ps)))))

;; [[char]] -> string
(define (picture bitmap)
(string-join
(map (lambda (line) (string-join (map x->string line) "" 'strict-infix))
bitmap)
"\n" 'strict-infix))


(define (display-spiral string)
(let ((length (string-length string)))
(display
(picture
(bitmap
(stick-char
(normalize (make-spiral-states length 0 0 2 'left))
(string->list (string-join (string-split string #[\s]) "+" 'strict-infix))))))
(newline)
(values)))
実行例(サンプルの文字列は Gauche のトップページから引用)
gosh> (display-spiral "Gauche is an R5RS Scheme implementation developed to be a handy script interpreter,
which allows programmers and system administrators to write small to large scripts for their daily chores.
Quick startup, built-in system interface, native multilingual support are some of my goals.")


Gauche+
i
nterpreter,+which+all s
i o +
+ all+to+large+scri w a
t m p s n
p s ,+built-in+sy t + +
i + p s s p R
r e u ingual+su t + r 5
c t t l p e f o R
s i r i +my+g p m o g S
+ r a t f o o + r r +
y w t l o a r i + a S
d + s u + .sl t n t m c
n o + m e + t h m h
a t k + mos+era e e e e
h + c e r i r m
+ s i vitan+,ecaf r s e
a r u + + +
+ o Q+.serohc+yliad a i
e t n m
b artsinimda+metsys+d p
+ l
ot+depoleved+noitatneme


スクリプトの全体→ spiral-string.scm

No comments :