; koch snowflake
(define (replace xs old new)
(let loop ((xs xs) (zs (list)))
(cond ((null? xs) (reverse zs))
((equal? (car xs) old)
(loop (cdr xs) (append (reverse new) zs)))
(else (loop (cdr xs) (cons (car xs) zs))))))
(define (koch n len)
(let koch ((pat (string->list "F++F++F")) (n n) (len len))
(if (positive? n)
(let ((new (replace pat #\F (string->list "F-F++F-F"))))
(koch new (- n 1) (/ len 3)))
(let draw ((pat pat))
(when (pair? pat)
(display "currentpoint translate") (newline)
(case (car pat)
((#\F) (display 0) (display " ") (display len)
(display " rlineto") (newline))
((#\-) (display "60 rotate") (newline))
((#\+) (display "-60 rotate") (newline)))
(draw (cdr pat)))))))
(define (draw-koch n)
(display "%!") (newline)
(display "newpath") (newline)
(display "426 316 moveto") (newline)
(display "90 rotate") (newline)
(display "2 setlinewidth") (newline)
(koch n 243)
(display "stroke") (newline)
(display "showpage") (newline))
(draw-koch 4)