;******************************************************************************
;
; File name     : mkPlot.stk
; Creation date : Aug-3-1993
; Last update   : Aug-17-1993
;
;******************************************************************************
;
; STk adaptation of the Tk widget demo.
;
; mkPlot:
; Create a top-level window containing a canvas displaying a simple graph 
; with data points that can be moved interactively.
;
;******************************************************************************

(provide "mkPlot")

(define (mkPlot)
  (let ((c ".top-plot.c") (font "-Adobe-helvetica-medium-r-*-180-*"))
    (catch (destroy .top-plot))
    (toplevel ".top-plot")
    (dpos .top-plot)
    (wm 'title .top-plot "Plot Demonstration")
    (wm 'iconname .top-plot "Plot")

    (message ".top-plot.m" 
	     :font "-Adobe-Times-Medium-R-Normal-*-180-*" :width 400
	     :bd 2 :relief "raised" 
	     :text "This window displays a canvas widget containing a simple 2-dimensional plot.  You can doctor the data by dragging any of the points with mouse button 1.")

    (canvas c :relief "raised" :width 450 :height 300)
    (set! c (string->widget ".top-plot.c"))
    (button ".top-plot.ok" :text "OK" :command '(destroy .top-plot))
    (pack .top-plot.m .top-plot.c :side "top" :fill "x")
    (pack .top-plot.ok :side "bottom" :pady 5)

    (c 'create 'line 100 250 400 250 :width 2)
    (c 'create 'line 100 250 100 50 :width 2)
    (c 'create 'text 225 20 :text "A Simple Plot" :font font :fill "brown")
    
    (for ((i 0 (+ i 1)))
	 (<= i 10)
	 (let ((x (+ 100 (* i 30))))
	   (c 'create 'line x 250 x 245 :width 2)
	   (c 'create 'text x 254 :text (* i 10) :anchor "n" :font font)))

    (for ((i 0 (+ i 1)))
	 (<= i 5)
	 (let ((y (- 250 (* i 40))))
	   (c 'create 'line 100 y 105 y :width 2)
	   (c 'create 'text 96 y
	      :text (& (* i 50) ".0") :anchor "e" :font font)))

    (for-each (lambda (p)
		(let* ((x (+ 100 (* 3 (car p)))) 
		       (y (- 250 (/ (* 4 (cadr p)) 5)))
		       (item (c 'create 'oval (- x 6) (- y 6) (+ x 6) (+ y 6)
				:width 1 :outline "black" :fill "SkyBlue2")))
		  (c 'addtag 'point 'withtag item)))
	      '((12 56) (20 94) (33 98) (32 120) (61 180) (75 160) (98 223)))

    (c 'bind 'point "<Any-Enter>"
       '(.top-plot.c 'itemconfig 'current :fill "red"))
    (c 'bind 'point "<Any-Leave>"
       '(.top-plot.c 'itemconfig 'current :fill "SkyBlue2"))
    (c 'bind 'point "<1>" `(plotDown ,(widget-name c) %x %y))
    (c 'bind 'point "<ButtonRelease-1>" `(,(widget-name c) 'dtag "selected"))
    (bind c "<B1-Motion>" `(plotMove ,(widget-name c) %x %y))))


(define plot_lastX 0)
(define plot_lastY 0)


(define (plotDown w x y)
  (w 'dtag 'selected)
  (w 'addtag 'selected 'withtag 'current)
  (w 'raise 'current)
  (set! plot_lastX x)
  (set! plot_lastY y))


(define (plotMove w x y)
  (w 'move 'selected (- x plot_lastX) (- y plot_lastY))
  (set! plot_lastX x)
  (set! plot_lastY y))