;;;
;;; mandel.sc
;;;

(module schematic-user)

(include "schematic.sch")

(definep *mandel-images* (make-vector 64))
(definep *max-image* 0)
(definep *current-image* 0)

(definep *display* 0)

(definep *mozaic-size* 16)
(definep *pixel-size* 2)

(definep *mandel-canvas* 0)
(definep *drag* 0)
(definep *ddr* 0)

;;;
;;; For color
;;;

(definep (make-rgb r g b)
  (format 
   #f "rgb:~a/~a/~a" 
   (number->string r 16) (number->string g 16) (number->string b 16)))

;;;
;;; A C routine which, given a string like "rgb:0/0/0", returns a 
;;; pointer to XColor structure. 
;;;

(define-c-external (parse-color TSCP) TSCP "StcTk_ParseColor")

(definep *black-color* (parse-color (make-rgb 0 0 0)))

(definep (generate-colors-vector n)
  (let ((v (make-vector (+ (* 3 n) 1))))
    (do ((i 0 (+ i 1)))
	((= i n))
      (vector-set! 
       v i (parse-color (make-rgb (- n 1 i) i 0))))
    (do ((i 0 (+ i 1)))
	((= i n))
      (vector-set! 
       v (+ n i) (parse-color (make-rgb 0 (- n 1 i) i))))
    (do ((i 0 (+ i 1)))
	((= i n))
      (vector-set! 
       v (+ n n i) (parse-color (make-rgb i 0 (- n 1 i)))))
    (vector-set! v (+ n n n) *black-color*)
    v))

(definep *colors-vector* (generate-colors-vector 16))

(definep *colors-multiplier* 8)

(definep *max-iter* (* *colors-multiplier* (vector-length *colors-vector*)))

;;;
;;;
;;;

(definep name-counter 0)

(definep (new-image-name)
  (let ((c name-counter))
    (set! name-counter (+ c 1))
    (format #f "image~a" c)))

;;;
;;;
;;;

(define-in-line (make-rectangular r i)
  (cons r i))

(define-in-line (real-part c)
  (car c))
  
(define-in-line (imag-part c)
  (cdr c))
  
;;;
;;; window class
;;; Lower-left and upper-right points are specified (by complex numbers)
;;; in LL and UR
;;; WIDTH and HEIGHT are integers which specify the size of the window
;;; NAME is the name of the Tk-window
;;;

;;;
;;; The last two slots are reserved for BEGIN-NEW-WINDOW and END-NEW-WINDOW
;;;

(definep (make-mandel-image-sub image-pointer image-name ll ur width height)
  (vector image-pointer image-name ll ur width height (cons -1 -1)))

;;;
;;; Translate window relative (integer) coordinate into the coodinate
;;; in the complex plain.
;;; Given four integers I, J, WIDTH, HEIGHT and two complex numbers LL and
;;; UR (see below), calculate the complex number which corresponds to *.
;;;
;;;
;;;        <---- Width -----> 
;;;    +   +-----------+----+ ur
;;;    |   |           |    |
;;; HEIGHT |           |J   |
;;;    |   |           |    |
;;;    |   |<----I---->*    |
;;;    |   |                |
;;;    |   |                |
;;;    +   +----------------+
;;;       ll
;;;

(definep (calc-complex-coordinate i j ll ur width height)
  (let ((llx (real-part ll))
	(lly (imag-part ll))
	(urx (real-part ur))
	(ury (imag-part ur)))
    ;; * = (llx + (I/WIDTH) (urx - llx), lly + ((HEIGHT-J)/HEIGHT) (ury - lly))
    (let ((cx (+ llx (/ (* i (- urx llx)) width)))
	  (cy (+ lly (/ (* (- height j) (- ury lly)) height))))
      (make-rectangular cx cy))))

;;;
;;; For the performance sake, we implement main drawing routine in C.
;;; This routine takes:
;;; (1) I, J---window coodinate of the point to be plotted,
;;; (2) LLX, LLY, URX, URY---X and Y coordinates of Lower-Left and
;;; Upper-Right point of the image (in the complex plane)
;;; (3) WIDTH, HEIGHT---the size of the image
;;; (4) MAX-ITER---maximum number of iterations
;;;

(define-c-external (calc-complex-coordinate-and-calc-mandel
		    int int double double double double int int int)
  int "calc_complex_coordinate_and_calc_mandel")
    
;;;
;;; In response to a mouse click, we prepare for creating a new image
;;;

(definep (begin-create-new-window self i j)
  (vector-set! self 6 (cons i j)))

;;;
;;; This would be a method in Schematic
;;;
;;; When this method is called, lower left position has already been 
;;; recorded in the 5th field of SELF by BEGIN-NEW-WINDOW method.
;;; At this point, we create a new window.
;;;

;;;
;;; (i1, j1) +-------------+
;;;          |             |
;;;          |             |
;;;          |             |
;;;          +-------------+ (i2, j2)
;;;


(definep (finish-create-new-window self i2c j2c)
  (let* ((ll     (vector-ref self 2))
	 (ur     (vector-ref self 3))
	 (width  (vector-ref self 4))
	 (height (vector-ref self 5))
	 (ij     (vector-ref self 6))
	 (i1 (adjust-x (car ij) width))
	 (j1 (adjust-y (cdr ij) height))
	 (i2 (adjust-x i2c width))
	 (j2 (adjust-y j2c height))
	 (di (- i2 i1))
	 (dj (- j2 j1))
	 (scale (floor (min (/ width di) (/ height dj)))))
    (format #t "~s / ~s = ~s, ~s / ~s = ~s~%" width di (/ width di) 
	    height dj (/ height dj))
    (let* ((new-ll (calc-complex-coordinate i1 j2 ll ur width height))
	   (new-ur (calc-complex-coordinate i2 j1 ll ur width height))
	   (new-width (* scale di))
	   (new-height (* scale dj))
	   (new-image 
	    (make-mandel-image 
	     *mandel-canvas* new-ll new-ur new-width new-height)))
      (first-set-mandel-image new-image)
      (future (draw-mandel new-image *pixel-size*)))))


(definep (adjust-x x width)
  (- x (/ (- 512 width) 2)))

(definep (adjust-y y height)
  (- y (/ (- 512 height) 2)))

(definep (convert-x x width)
  (+ x (/ (- 512 width) 2)))

(definep (convert-y y height)
  (+ y (/ (- 512 height) 2)))


(definep (make-mandel-image canvas ll ur width height)
  (let* ((image-name (new-image-name))
	 (im  (make-image "create" "photo" image-name :width 512 :height 512))
	 (result (make-mandel-image-sub im image-name ll ur width height)))
    result))

(definep (set-mandel-image self)
  (let* ((im (vector-ref self 0))
	 (image-name (vector-ref self 1))
	 (ll (vector-ref self 2))
	 (ur (vector-ref self 3))
	 (width (vector-ref self 4))
	 (height (vector-ref self 5)))
    (update-button 
     *display* "configure" 
     :text  (format #f "~a / ~a" *current-image* *max-image*))
    (update-canvas 
     *mandel-canvas* "create" "image" 
     (convert-x 1 width) (convert-y 1 height) :image image-name :anchor "nw")
    (update-canvas 
     *mandel-canvas* "create" "rectangle" 
     (convert-x 0 width) (convert-y 0 height) 
     (convert-x (+ width 2) width) (convert-y (+ height 2) height)
     :outline "black" :width 2)
    (update-canvas 
     *mandel-canvas* "create" "rectangle" 
     (convert-x 0 width) (convert-y 0 height) 
     (convert-x (+ width 0) width) (convert-y (+ height 0) height)
     :outline "gray" :width 1)))

(definep (first-set-mandel-image self)
  (set! *max-image* (+ *max-image* 1))
  (vector-set! *mandel-images* *max-image* self)
  (set! *current-image* *max-image*)
  (set-mandel-image (vector-ref *mandel-images* *current-image*)))


(definep (next-mandel-image)
  (if (= *max-image* *current-image*)
      (set! *current-image* 1)
      (set! *current-image* (+ 1 *current-image*)))
  *current-image*)


(definep (Start width height)
  ;; tell the window manager the title of the main window
  (wm "title" "." "Schematic")
  (label ".title" :text "Mandelbrot" :bd 4 
	 :fg "Brown" :bg "yellow" :relief "ridge")
  (label ".label" :text "Select a rectangle to zoom by mouse" 
	 :bd 4 :fg "Black" :bg "palegreen4" :relief "sunken")
  (frame ".bf")
  (make-button ".bf.run" :text "Run" :command (plambda () (exit)))
  (set! *mandel-canvas* (make-canvas ".c" :width width :height height))
  (update-canvas 
   *mandel-canvas* "create" "rectangle" 0 0 512 512
   :fill "pink" :outline "pink" :width 1)
  (make-button ".bf.quit" :text "Quit" 
	       :bg "RoyalBlue" :abg "red" :afg "blue"
	       :command (plambda () (exit)))
  (make-button ".bf.select" :text "Select" 
	       :bg "RoyalBlue" :abg "red" :afg "blue"
	       :command 
	       (plambda () 
		 (set-mandel-image 
		  (vector-ref *mandel-images* (next-mandel-image)))))
  (set! *display* 
	(make-button 
	 ".bf.display" :text "1/1" 
	 :bd 4 :fg "Brown" :bg "yellow" :relief "ridge"))
  (pack ".bf.select" ".bf.display" ".bf.quit" 
	:side "left" :fill "both" :expand #t)
  (set-int "cx1" 0)
  (set-int "cy1" 0)
  (set-int "cx2" 255)
  (set-int "cy2" 255)
  (bind ".c" "" "set cx1 %x")
  (bind ".c" "" "set cy1 %y")
  (bind ".c" ""
    (plambda ()
      (set! *ddr* (update-canvas *mandel-canvas*  "create"
				 "rectangle"
				 (get-int "cx1") (get-int "cy1") 
				 (get-int "cx1") (get-int "cy1") 
				 :outline "palegreen4"
				 :width 3))
      (set! *drag* 1)))

  (bind ".c" "" "set cx2 %x")
  (bind ".c" "" "set cy2 %y")
  (bind ".c" "" 
	(plambda ()
	  (if (= *drag* 1)
	      (canvas-set-coords 
	       *mandel-canvas* 
	       *ddr* (get-int "cx1") (get-int "cy1") 
	       (get-int "cx2") (get-int "cy2")))))
  
  
  (bind ".c" "" "set cx2 %x")
  (bind ".c" "" "set cy2 %y")
  (bind ".c" "" 
	(plambda ()
	  (if (= *drag* 1)
	      (begin (set! *drag* 0)
		     (update-canvas *mandel-canvas* "delete" *ddr*)
		     (format #t "Zoom~%")
		     (format #t 
			     "(x1,y1) = (~s,~s), (x2,y2) = (~s,~s)~%"
			     (get-int "cx1") (get-int "cy1") 
			     (get-int "cx2") (get-int "cy2"))
		     (begin-create-new-window  
		      (vector-ref *mandel-images* *current-image*) 
		      (get-int "cx1") (get-int "cy1"))
		     (finish-create-new-window 
		      (vector-ref *mandel-images* *current-image*) 
		      (get-int "cx2") (get-int "cy2"))))))
  (pack ".title" ".c" ".label" ".bf" :fill "both" :side "top" :expand #t)
  (first-set-mandel-image 
   (make-mandel-image 
    *mandel-canvas* (make-rectangular -2.0 -2.0) (make-rectangular 2.0 2.0)
    512 512))
  (future 
   (draw-mandel (vector-ref *mandel-images* *current-image*) *pixel-size*)))




;;;
;;; SELF = mandel-window
;;; Fill a square of size SIZE at the point specified by (I, J).
;;; (I, J) is a pair of integer which specifies location RELATIVE
;;; in the canvas. 
;;;

;;;
;;; Plot point (i, j)
;;;

;;;
;;; This would be a method in Schematic
;;;

(definep (plot-point self i j size)
  ;; this part is unncecessary if this is a class
  (let ((cvs (vector-ref self 0))
	(ll (vector-ref self 2))
	(ur (vector-ref self 3))
	(width (vector-ref self 4))
	(height (vector-ref self 5)))
    (let* ((m (calc-complex-coordinate-and-calc-mandel
	       i j (real-part ll) (imag-part ll) 
	       (real-part ur) (imag-part ur) width height *max-iter*)))
      (vector-ref *colors-vector* 
		  (inexact->exact (/ m *colors-multiplier*))))))

;;;
;;;
;;;

(define-c-external (c-update-image-put-plane pointer int int int int int int 
					     TSCP int int)
  int "C_UpdateImagePutPlane")

;;;
;;; This procedure fills IM (image) according to the contents of COLORS
;;; VECTOR.
;;; 
;;; COLORS is (NX-COLORS by NY-COLORS) vector
;;;

(define-in-line (fill-plane im x y dx dy nx ny colors nx-colors ny-colors)
  (c-update-image-put-plane im x y dx dy nx ny colors nx-colors ny-colors))

;;;
;;; Fill N x M pixels plane by tiles each of which consists of 
;;; SIZE x SIZE pixels.  During drawing, we update the screen 
;;; for every LINES-PER-UPDATE lines
;;;

(definep *vvvv* (make-vector (* 512 512) *black-color*))

(definep (plot-plane2 self n m size lines-per-update)
  (let* ((vsize (* (inexact->exact (/ n size)) (inexact->exact (/ m size)))))
    (let ((v *vvvv*)
	  (idx 0))
      (do ((j 0 (+ j size)))
	  ((>= j m))
	(do ((i 0 (+ i size)))
	    ((>= i n))
	  (vector-set! v idx (plot-point self i j size))
	  (set! idx (+ idx 1)))
	;; Jth line has just been written.  So we update line J - 3, 
	;; J - 2, J - 1, and J
	(if (= 0 (modulo (+ j 1) lines-per-update))
	    (begin
	      (fill-plane (vector-ref self 0) 0 (- j (- lines-per-update 1)) 
			  size size n lines-per-update v n m)
	      (future (update))
	      (yield)))))))
  
;;;
;;;
;;;

(definep *lines-per-update* 4)

(definep (draw-mandel self size)
  (let ((n (vector-ref self 4))
	(m (vector-ref self 5)))
    (plot-plane2 self n m size *lines-per-update*)))
  
;;;
;;; schematic-main
;;;

(definep (schematic-main args)
  (if (= (length args) 3)
      (begin (set! *pixel-size* (string->number (list-ref args 1)))
	     (set! *mozaic-size* (string->number (list-ref args 1)))))

  (if (= (length args) 2)
      (begin (set! *pixel-size* (string->number (list-ref args 1)))))

  (Start 512 512)
  ;; blocks forever
  (touch (make-future))  
)