;; Fraktale Mengen in der komplexen Ebene

(require-library "gui.ss" "gui")

(define *n-colors* (length some-colors))

(define draw-complex
  (lambda (canvas
	   color-index
	   upper-left-x upper-left-y width height
	   pixel-width pixel-height)
    (letrec
        ((y-loop
          (lambda (pixel-y)
            (let ((y (+ upper-left-y
                        (/ (* pixel-y height) pixel-height))))
              (letrec
                  ((x-loop
                    (lambda (pixel-x)
                      (if (< pixel-x pixel-width)
                          (let ((x (+ upper-left-x
                                      (/ (* pixel-x width) pixel-width))))
                            (let ((index
                                   (color-index (make-rectangular x y))))
                              (draw-point canvas
					  pixel-x pixel-y
                                          (if index
                                              (list-ref
					       some-colors
					       (modulo index *n-colors*))
                                              black))
                              (x-loop (+ 1 pixel-x))))))))
                (if (< pixel-y pixel-height)
                    (begin
                      (x-loop 0)
                      (y-loop (+ 1 pixel-y)))))))))
      (y-loop 0))))

(define make-divergence-index
  (lambda (next limit)
    (lambda (c)
      (letrec
          ((loop (lambda (x index)
                   (cond
                     ((> index limit)
                      #f)
                     ((> (magnitude x) 2.0)
                      index)
                     (else
                      (loop (next c x) (+ 1 index)))))))
        (loop (exact->inexact c) 0)))))

(define interactive-complex
  (lambda (color-index pixel-width pixel-height)
    (letrec
	((upper-left-x-text (make-text-field "Links Oben/X"
					     (lambda () (update))))
	 (get-upper-left-x
	  (lambda ()
	    (string->number (text-field-contents upper-left-x-text))))
	 (upper-left-y-text (make-text-field "Links Unten/Y"
					     (lambda () (update))))
	 (get-upper-left-y
	  (lambda ()
	    (string->number (text-field-contents upper-left-y-text))))
	 (width-text (make-text-field "Breite" (lambda () (update))))
	 (get-width
	  (lambda ()
	    (string->number (text-field-contents width-text))))
	 (height-text (make-text-field "Höhe" (lambda () (update))))
	 (get-height
	  (lambda ()
	    (string->number (text-field-contents height-text))))
	 (update
	  (lambda ()
	    (draw-complex canvas
			  color-index
			  (get-upper-left-x) (get-upper-left-y)
			  (get-width) (get-height)
			  pixel-width pixel-height)))
	 (canvas (make-bitmap-canvas pixel-width pixel-height)))
      (let* ((text-field-panel
	      (make-horizontal-panel (list upper-left-x-text
					   upper-left-y-text
					   width-text
					   height-text)))
	     (frame (make-frame "Fraktal"
				(make-vertical-panel
				 (list canvas text-field-panel)))))
	(show-frame frame)))))


;; Mandelbrot-Menge

(interactive-complex (make-divergence-index
		      (lambda (c x)
			(+ (* x x) c))
		      100)
		     300 200)

;; Julia-Menge

;; (interactive-complex (make-divergence-index
;;                       (lambda (c x)
;;                         (+ (* x x) 0.32+0.043i))
;;                       100)
;;                     300 200)
	
(define threaded-interactive-complex
  (lambda (color-index pixel-width pixel-height)
    (letrec
	((upper-left-x-text (make-text-field "Links Oben/X"
					     (lambda () (update))))
	 (get-upper-left-x
	  (lambda ()
	    (string->number (text-field-contents upper-left-x-text))))
	 (upper-left-y-text (make-text-field "Links Unten/Y"
					     (lambda () (update))))
	 (get-upper-left-y
	  (lambda ()
	    (string->number (text-field-contents upper-left-y-text))))
	 (width-text (make-text-field "Breite" (lambda () (update))))
	 (get-width
	  (lambda ()
	    (string->number (text-field-contents width-text))))
	 (height-text (make-text-field "Höhe" (lambda () (update))))
	 (get-height
	  (lambda ()
	    (string->number (text-field-contents height-text))))
	 (drawing-thread #f)
	 (update
	  (lambda ()
	    (if drawing-thread
		(kill-thread drawing-thread))
	    (set! drawing-thread
                  (thread
                   (lambda ()
                     (draw-complex canvas
                                   color-index
                                   (get-upper-left-x) (get-upper-left-y)
                                   (get-width) (get-height)
                                   pixel-width pixel-height))))))
	 (canvas (make-bitmap-canvas pixel-width pixel-height)))
      (let* ((text-field-panel
	      (make-horizontal-panel (list upper-left-x-text
					   upper-left-y-text
					   width-text
					   height-text)))
	     (frame (make-frame "Fraktal"
				(make-vertical-panel
				 (list canvas text-field-panel)))))
	(show-frame frame)))))