(load "lsystem.ss")

(define (is-forward? lcommand)
  (eq? (car lcommand) 'f))

(define (is-rotate? lcommand)
  (eq? (car lcommand) 'r))

(define (is-offshoot? lcommand)
  (eq? (car lcommand) 'o))

(define (get-distance lcommand)
  (if (is-forward? lcommand)
      (cdr lcommand)
      (error "Attempt to get distance from command that is not forward!")))

(define (get-angle lcommand)
  (if (is-rotate? lcommand)
      (cdr lcommand)
      (error "Attempt to get angle from command that is not rotate!")))

(define (get-offshoot-commands lcommand)
  (if (is-offshoot? lcommand)
      (cdr lcommand)
      (error "Attempt to get offshoot commands from command that is not an offshoot!")))

;;;
;;; Drawing an L-System Curve
;;;

;;; Don't use this now!

(define (convert-to-curve lcommands)
  (if (null? lcommands)
      (lambda (t) (make-point 0.0 0.0)) ; the leaves (just a point for now)
      (if (is-forward? (car lcommands))
	  (connect-ends 
	   (make-vertical-line (get-distance (car lcommands)) (make-rgb 
							       (exact->inexact (/ (+ (random 15) 139) 256))
							       (exact->inexact (/ (+ (random 5) 69) 256))
							       (exact->inexact (/ (+ (random 5) 19) 256))))
	   ;; SaddleBrown
	   (convert-to-curve (cdr lcommands)))
	  (if (is-rotate? (car lcommands))
	      ;; L-system turns are clockwise, so we need to use - angle
	      (rotate-around-origin (convert-to-curve (cdr lcommands))
				    (- (get-angle (car lcommands))))
	      (if (is-offshoot? (car lcommands))
		  (connect-rigidly
		   (convert-to-curve (get-offshoot-commands (car lcommands)))
		   (convert-to-curve (cdr lcommands)))
		  (error "Bad lcommand!"))))))

(define (connect-curve-list-to-end curve1 curvelist)
  (cons curve1
	(map (lambda (curve)
	       (translate curve (x-of-point (curve1 1.0)) (y-of-point (curve1 1.0))))
	     curvelist)))

(define (convert-to-curve-list lcommands leaf line)
  (if (null? lcommands)
      ;;; leaf
      (list (leaf))
      (if (is-forward? (car lcommands))
	  (connect-curve-list-to-end
	   (line (get-distance (car lcommands)))
	   (convert-to-curve-list (cdr lcommands) leaf line))
	  (if (is-rotate? (car lcommands))
	      ;; L-system turns are clockwise, so we need to use - angle
	      (map
	       (lambda (curve)
		 (rotate-around-origin curve (get-angle (car lcommands))))
	       (convert-to-curve-list (cdr lcommands) leaf line))
	      (if (is-offshoot? (car lcommands))
		  (append
		   (convert-to-curve-list (get-offshoot-commands (car lcommands)) leaf line)
		   (convert-to-curve-list (cdr lcommands) leaf line))
		  (error "Bad lcommand!"))))))

;;;
;;; Rewriting
;;;

(define (rewrite-lcommands lcommands replacement)
  (flatten-commands
   (map (lambda (command)  
	  (if (is-forward? command)
	      replacement ; forwards are replaced with replacement 
	      (if (is-offshoot? command)
					; we need to replace all forwards in an offshoot command also	
		  (make-offshoot-command (rewrite-lcommands (get-offshoot-commands command) replacement))
		  (if (is-rotate? command)
		      command ; rotates are unchanged
		      (error "Bad command: " command)))))
	lcommands)))

;;;
;;; 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 "The Great Lambda Tree of Knowledge"))

(define tree-commands
  (make-lsystem-command 
   (make-forward-command 1)
   (make-offshoot-command
    (make-lsystem-command
     (make-rotate-command 30) 
     (make-forward-command 1)))
   (make-forward-command 1)
   (make-offshoot-command
    (make-lsystem-command
     (make-rotate-command -60) 
     (make-forward-command 1)))
   (make-forward-command 1)))

(define (make-lsystem-fractal replace-commands start level)
  ((n-times
    (lambda (previous-commands)
      (rewrite-lcommands previous-commands replace-commands))
    level)
   start))

(define (make-tree-fractal level)
  (make-lsystem-fractal tree-commands (make-lsystem-command (make-forward-command 1)) level))

;(define (draw-lsystem-fractal lcommands)
;  (smart-draw-curve-points (position-curve (convert-to-curve lcommands) 0.5 0.1) 0.003))
;  (draw-curve-points (position-curve (convert-to-curve lcommands) 0.5 0.1) 50000))

(define (draw-lsystem-fractal lcommands)
;  (smart-draw-curve-points (position-curve (convert-to-curve lcommands) 0.5 0.1) 0.003))
  (draw-curve-points (position-curve (connect-curves-evenly (convert-to-curve-list lcommands)) 0.5 0.1) 50000))

(define (window-draw-point point)
  (let ((x (x-of-point point))
	(y (y-of-point point)))
    (if (or (< x 0.0) (> x 1.0))
	(printf "Warning: point x coordinate is out of range (should be between 0.0 and 1.0): ~a~n" x))
    (if (or (< y 0.0) (> y 1.0)) 
	(printf "Warning: point y coordinate is out of range (should be between 0.0 and 1.0): ~a~n" y))
    ((draw-pixel window) (convert-posn (make-posn x y)) (color-of-point point))))

(define (make-vertical-line distance color)
  (lambda (t)
    (make-colored-point 0.0 (* distance t) color)))

(define (make-color r g b)
  (make-rgb (exact->inexact (/ r 256))
	    (exact->inexact (/ g 256))
	    (exact->inexact (/ b 256))))

(define (draw-region x1 y1 x2 y2 color)
  (let ((pos2 (convert-posn x2 y2)))
    ((draw-solid-rectangle window) 
     (convert-posn (make-posn x1 y1))
     (posn-x pos2) (posn-y pos2)
     color)))

(define (draw-lambda-tree-of-knowledge)
  (draw-region 0 0 1.0 0.0 0.85 (make-color 108 156 195))
  (draw-region 0 0 1.0 0.85 1.0 (make-color 124 232 0))
  (draw-curve-points (position-curve
    (connect-curves-evenly (convert-to-curve-list
      (make-tree-fractal 5)
      (lambda () (make-splotch-curve
		  (make-color (+ 128 (random 128)) (+ 128 (random 128)) (random 50))))
      (lambda (dist) (make-vertical-line dist (make-color 238 197 45)))))
    0.5 0.15) 50000))