38 lines
1.3 KiB
Scheme
38 lines
1.3 KiB
Scheme
|
#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))))
|