(clear) ; try all the rules on this character - ; returns #f if none are matched (define (lsys-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 (lsys-search-replace str rules pos result) (cond ((>= pos (string-length str)) result) (else (let ((ret (lsys-run-rules (string-ref str pos) rules))) (if (string? ret) (lsys-search-replace str rules (+ pos 1) (string-append result ret)) (lsys-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 (ls-generate n str rules) (cond ((zero? n) str) (else (ls-generate (- n 1) (lsys-search-replace str rules 0 "") rules)))) ; todo: get rid of all these (define branch-obj (with-state (translate (vector 0.5 0 0)) (scale (vector 1 0.5 0.5)) (rotate (vector 0 0 90)) (build-plane))) (with-primitive branch-obj (hide 1) (apply-transform)) (define leaf-obj (with-state (translate (vector 0.5 0 0)) ; (scale (vector 1 0.5 0.5)) (rotate (vector 0 0 90)) (build-plane))) (with-primitive leaf-obj (hide 1) (apply-transform)) ; builds objects from a string (define (ls-build root string angle branch-scale) (let ((parent-stack '(root)) (last-obj root) (obj-list '()) (rot 0)) (define (make-component src-obj tex) (let ((obj (with-state (hint-unlit) (texture (load-texture tex)) (translate (vector 1 0.01 0)) (rotate (vector 0 0 rot)) (set! rot 0) (build-copy src-obj)))) (with-primitive obj (hide 0) ;(apply-transform) (when (not (zero? last-obj)) (parent last-obj))) (set! last-obj obj) (set! obj-list (cons obj obj-list)))) (hint-ignore-depth) (for-each (lambda (char) (cond ((char=? #\F char) (make-component branch-obj "textures/branch-a.png")) ((char=? #\G char) (make-component branch-obj "textures/branch-b.png")) ((char=? #\L char) (make-component leaf-obj "textures/leaf-a.png")) ((char=? #\B char) (make-component leaf-obj "textures/leaf-b.png")) ((char=? #\+ char) (set! rot (+ rot angle))) ((char=? #\- char) (set! rot (- rot angle))) ((char=? #\[ char) (push) (set! parent-stack (cons last-obj parent-stack)) (scale (vector branch-scale branch-scale branch-scale)) ) ((char=? #\] char) (pop) (set! last-obj (car parent-stack)) (set! parent-stack (cdr parent-stack))))) (string->list string)))) (define (animate obj-list) (let ((c 0)) (for-each (lambda (obj) (with-primitive obj (translate (vector 0 (* 0.1 (sin (+ c (time)))) 0))) (set! c (+ c 1))) obj-list))) (ortho) (set-camera-transform (mmul (mrotate (vector 0 0 90)) (mtranslate (vector -9 0 -10)))) (set-ortho-zoom -15) (clear-texture-cache) (define trees '()) (colour 0.2) (for ((i (in-range 0 10))) (let ((t2 (with-state (translate (vector 0 (* 20 (crndf)) (rndf))) (build-locator)))) (set! trees (cons t2 trees)) (ls-build t2 (ls-generate 3 "F" '(("F" "G-[-F+G+FB]+F[+F-G-FL]-F"))) (+ 10 (random 20)) 0.9))) (every-frame (animate trees))