;;; ;;; lsystem.ss ;;; UVA CS200 Spring 2004 ;;; Problem Set 3 ;;; (load "graphics.ss") ;;; ;;; Abstraction for representing L-System Commands using lists. ;;; ;;; CommandSequence ::= (CommandList) (define make-lsystem-command list) ;;; ;;; We represent the different commands as lists where the first item in the ;;; list is a tag that indicates the type of command: 'f for forward, 'r for rotate ;;; and 'o for offshoot. We use quoted letters --- 'f is short for ;;; (quote f) --- to make tags - they evaluate to the letter after the quote. ;;; ;;; Command ::= F (define (make-forward-command) (cons 'f #f)) ;; No value, just use false. ;;; Command ::= R (define (make-rotate-command angle) (cons 'r angle)) ;;; Command ::= O (define (make-offshoot-command commandsequence) (cons 'o commandsequence)) (define (is-lsystem-command? lcommand) (or (is-forward? lcommand) (is-rotate? lcommand) (is-offshoot? lcommand))) ;;; ;;; Flattening Command Lists ;;; (define (flatten-commands ll) (if (null? ll) ll (if (is-lsystem-command? (car ll)) (cons (car ll) (flatten-commands (cdr ll))) (flat-append (car ll) (flatten-commands (cdr ll)))))) (define (flat-append lst ll) (if (null? lst) ll (cons (car lst) (flat-append (cdr lst) ll)))) ;;; ;;; L-System commands for the tree fractal ;;; ;;; F1 ::= (F1 O(R30 F1) F1 O(R-60 F1) F1) (define tree-commands (make-lsystem-command (make-forward-command) (make-offshoot-command (make-lsystem-command (make-rotate-command 30) (make-forward-command))) (make-forward-command) (make-offshoot-command (make-lsystem-command (make-rotate-command -60) (make-forward-command))) (make-forward-command))) (define (make-tree-fractal level) (make-lsystem-fractal tree-commands (make-lsystem-command (make-forward-command)) level)) (define (draw-lsystem-fractal lcommands) (draw-curve-points (position-curve (connect-curves-evenly (convert-lcommands-to-curvelist lcommands)) 0.5 0.1) 50000)) ;;; ;;; Set up a graphics window ;;; (close-graphics) (open-graphics) ;;; This window is hard coded into the drawing routines, so we don't need to remember ;;; to pass it. (define window (make-window window-width window-height "CS 200 L-System Fractals"))