groworld/sketcher/ls.ss

38 lines
1.3 KiB
Scheme
Raw Normal View History

2009-05-01 20:34:29 +00:00
#lang scheme/base
(provide (all-defined-out))
; try all the rules on this character -
; returns #f if none are matched
(define (run-rules char rules)
(foldl
(lambda (rule str)
(if str ; if str is not #f
str ; then we have already found a rule, return it
(if (char=? char (string-ref (car rule) 0)) ; check this rule
(cadr rule) ; return the string
#f))) ; no match
#f
rules))
; runs the lsystem rules on every character in a string,
; returns the new string
(define (search-replace str rules pos result)
(cond
((>= pos (string-length str)) result)
(else
(let ((ret (run-rules (string-ref str pos) rules)))
(if (string? ret)
(search-replace str rules (+ pos 1)
(string-append result ret))
(search-replace str rules (+ pos 1)
(string-append result (string (string-ref str pos)))))))))
; runs the search-replace multiple (n) times on a string
(define (lsystem-generate n str rules)
(cond
((zero? n) str)
(else
(lsystem-generate (- n 1)
(search-replace str rules 0 "") rules))))