(require "graph-view")

(pack c)
(define g (graph '("Albany" "Austin" "Columbus" "Harrisburg" "Lansing"
		   "Raleigh" "Sacramento" "Springfield" 
		   "Tallahassee" "Trenton") ; Z - hack to make multi
		 '(("Albany" "Austin") ("Albany" "Austin"))))

(map (lambda (x) (set-attribute! 'weight 377 x)) (set-edge->list (edges g)))
(define verts (vertices g))
(define vsets (choose verts 2))
(add-edges! vsets g)

(define xcrds (make-vector 10))
(vector-set! xcrds 0 609.0)
(vector-set! xcrds 1 324.0)
(vector-set! xcrds 2 411.0)
(vector-set! xcrds 3 474.0)
(vector-set! xcrds 4 268.0)
(vector-set! xcrds 5 552.0)
(vector-set! xcrds 6 59.0 )
(vector-set! xcrds 7 252.0)
(vector-set! xcrds 8 524.0)
(vector-set! xcrds 9 611.0)

(define ycrds (make-vector 10))
(vector-set! ycrds 0 402.0)
(vector-set! ycrds 1 760.0)
(vector-set! ycrds 2 610.0)
(vector-set! ycrds 3 449.0)
(vector-set! ycrds 4 401.0)
(vector-set! ycrds 5 597.0)
(vector-set! ycrds 6 704.0)
(vector-set! ycrds 7 544.0)
(vector-set! ycrds 8 756.0)
(vector-set! ycrds 9 518.0)

(define gv (make <graph-view> :graph g :xpixels 800 :ypixels 900
			      :xcoords xcrds :ycoords ycrds))
(define c (slot-ref gv 'graph-canvas))
(define vgs (vertices gv))
(define egs (edges gv))

(define albany (list-ref vgs 0)) 
(define austin (list-ref vgs 1))
(define columbus (list-ref vgs 2))
(define harrisburg (list-ref vgs 3))
(define lansing (list-ref vgs 4))
(define raleigh (list-ref vgs 5))
(define sacramento (list-ref vgs 6))
(define springfield (list-ref vgs 7))
(define tallahassee (list-ref vgs 8))
(define trenton (list-ref vgs 9))


(define cities vgs)

(define votes (list 	(list albany 33) 
			(list austin 32) 
			(list columbus 21)
			(list harrisburg 23)
			(list lansing 18)
		   	(list raleigh 12)
			(list sacramento 54)
			(list springfield 22)
			(list tallahassee 25)
			(list Trenton 13)))

(for-each (lambda (x) (set! (size x) (cadr (assoc x votes)))) cities)

(map (lambda (x) (set! (font x) "-*-times-bold-i-normal--34-180-*-*-*-*-*-*"))
	cities)

(define (distance city1 city2)
	(cond (   (eq? city1 albany)
			(cond ( (eq? city2 albany)        0)
			      ( (eq? city2 austin)        377)
			      ( (eq? city2 harrisburg)    318)
			      ( (eq? city2 columbus)      174)
			      ( (eq? city2 lansing)       209)
			      ( (eq? city2 trenton)       168)
			      ( (eq? city2 raleigh)       233)
			      ( (eq? city2 sacramento)    450)
			      ( (eq? city2 tallahassee)   178)
			      ( (eq? city2 springfield)   257)))
	      (   (eq? city1 austin)
			(cond ( (eq? city2 albany)        377)
			      ( (eq? city2 austin)        0)
			      ( (eq? city2 harrisburg)    335)
			      ( (eq? city2 columbus)      228)
			      ( (eq? city2 lansing)       241)
			      ( (eq? city2 trenton)       269)
			      ( (eq? city2 raleigh)       299)
			      ( (eq? city2 sacramento)    232)
			      ( (eq? city2 tallahassee)   238)
			      ( (eq? city2 springfield)   239)))
	      (   (eq? city1 harrisburg)
			(cond ( (eq? city2 albany)        318)
			      ( (eq? city2 austin)        335)
			      ( (eq? city2 harrisburg)    0)
			      ( (eq? city2 columbus)      154)
			      ( (eq? city2 lansing)       179)
			      ( (eq? city2 trenton)       228)
			      ( (eq? city2 raleigh)       278)
			      ( (eq? city2 sacramento)    431)
			      ( (eq? city2 tallahassee)   198)
			      ( (eq? city2 springfield)   239)))
	      (   (eq? city1 columbus)
			(cond ( (eq? city2 albany)        174)
			      ( (eq? city2 austin)        228)
			      ( (eq? city2 harrisburg)    154)
			      ( (eq? city2 columbus)      0)
			      ( (eq? city2 lansing)       149)
			      ( (eq? city2 trenton)       134)
			      ( (eq? city2 raleigh)       139)
			      ( (eq? city2 sacramento)    339)
			      ( (eq? city2 tallahassee)   160)
			      ( (eq? city2 springfield)   185)))
	      (   (eq? city1 lansing)
			(cond ( (eq? city2 albany)        209)
			      ( (eq? city2 austin)        241)
			      ( (eq? city2 harrisburg)    179)
			      ( (eq? city2 columbus)      149)
			      ( (eq? city2 lansing)       0)
			      ( (eq? city2 trenton)       197)
			      ( (eq? city2 raleigh)       233)
			      ( (eq? city2 sacramento)    323)
			      ( (eq? city2 tallahassee)   208)
			      ( (eq? city2 springfield)   185)))
	      (   (eq? city1 trenton)
			(cond ( (eq? city2 albany)        168)
			      ( (eq? city2 austin)        269)
			      ( (eq? city2 harrisburg)    228)
			      ( (eq? city2 columbus)      134)
			      ( (eq? city2 lansing)       197)
			      ( (eq? city2 trenton)       0)
			      ( (eq? city2 raleigh)       155)
			      ( (eq? city2 sacramento)    373)
			      ( (eq? city2 tallahassee)   178)
			      ( (eq? city2 springfield)   179)))
	      (   (eq? city1 raleigh)
			(cond ( (eq? city2 albany)        233)
			      ( (eq? city2 austin)        299)
			      ( (eq? city2 harrisburg)    278)
			      ( (eq? city2 columbus)      139)
			      ( (eq? city2 lansing)       233)
			      ( (eq? city2 trenton)       155)
			      ( (eq? city2 raleigh)       0)
			      ( (eq? city2 sacramento)    443)
			      ( (eq? city2 tallahassee)   124)
			      ( (eq? city2 springfield)   227)))
	      (   (eq? city1 sacramento)
			(cond ( (eq? city2 albany)        450)
			      ( (eq? city2 austin)        232)
			      ( (eq? city2 harrisburg)    431)
			      ( (eq? city2 columbus)      339)
			      ( (eq? city2 lansing)       323)
			      ( (eq? city2 trenton)       373)
			      ( (eq? city2 raleigh)       443)
			      ( (eq? city2 sacramento)    0)
			      ( (eq? city2 tallahassee)   408)
			      ( (eq? city2 springfield)   383)))
	      (   (eq? city1 tallahassee)
			(cond ( (eq? city2 albany)        178)
			      ( (eq? city2 austin)        238)
			      ( (eq? city2 harrisburg)    198)
			      ( (eq? city2 columbus)      160)
			      ( (eq? city2 lansing)       208)
			      ( (eq? city2 trenton)       178)
			      ( (eq? city2 raleigh)       124)
			      ( (eq? city2 sacramento)    408)
			      ( (eq? city2 tallahassee)   0)
			      ( (eq? city2 springfield)   251)))
	      (   (eq? city1 springfield)
			(cond ( (eq? city2 albany)        257)
			      ( (eq? city2 austin)        239)
			      ( (eq? city2 harrisburg)    239)
			      ( (eq? city2 columbus)      185)
			      ( (eq? city2 lansing)       185)
			      ( (eq? city2 trenton)       179)
			      ( (eq? city2 raleigh)       227)
			      ( (eq? city2 sacramento)    383)
			      ( (eq? city2 tallahassee)   251)
			      ( (eq? city2 springfield)   0)))
	)
)

; assign weights based on distance function
(map (lambda (x)
	(let* ((verts (vertices x))
	       (vert-list (set-vertex->list verts))
	       (vert-tab  (slot-ref gv 'vertex-table))
	       (v1 (hash-table-get vert-tab (car vert-list)))
	       (v2 (hash-table-get vert-tab (cadr vert-list))))
	    (set-attribute! 'weight (distance v1 v2) x)))
			(set-edge->list (edges g)))

(define tree-edges (kruskal g))

(map (lambda (x)
	(let* ((etab (slot-ref gv 'edge-table))
	       (eg (hash-table-get etab x)))
	    (slot-set! eg 'width 4))) (set-edge->list tree-edges))

(map (lambda (x)
	(let* ((e (slot-ref x 'edge))
	       (cost (find-attribute 'weight e)))
	   (cond ((< cost 200) (slot-set! x 'color "blue"))
		 ((< cost 300) (slot-set! x 'color "green"))
		 ((< cost 400) (slot-set! x 'color "yellow"))
		 (#t (slot-set! x 'color "red"))))) egs)

(define link-title (make <text-item> :parent c :coords '(420 65) 
		:text "Link"
		:font "-*-times-bold-r-normal--128-240-*-*-*-*-*-*"))
;(bind-for-dragging c :tag (cid link-title))

(define software (make <text-item> :parent c :coords '(410 140) 
		:text "Software for Discrete Math"
		:font "-*-times-bold-i-normal--64-240-*-*-*-*-*-*"))
;(bind-for-dragging c :tag (cid software))

(define general (make <text-item> :parent c :coords '(425 215) 
		:text "General Purpose Graph Computing/Visualization"
		:font "-*-times-bold-r-normal--32-240-*-*-*-*-*-*"))
;(bind-for-dragging c :tag (cid general))

(define users   (make <text-item> :parent c :coords '(425 250) 
		:text "Education, Research, Industry"
		:font "-*-times-bold-r-normal--32-240-*-*-*-*-*-*"))
;(bind-for-dragging c :tag (cid users))


(define title (make <text-item> :parent c :coords '(420 365) 
		:text "Application: Networking Costs"
		:font "-*-times-bold-i-normal--48-240-*-*-*-*-*-*"))
;(bind-for-dragging c :tag (cid title))

(define base 500)
(make <rectangle> :parent c :coords (list 60 base 100 (+ base 10))
                             :fill "blue")
(set! base (+ base 20))

(make <rectangle> :parent c :coords (list 60 base 100 (+ base 10))
                             :fill "green")
(set! base (+ base 20))

(make <rectangle> :parent c :coords (list 60 base 100 (+ base 10))
                             :fill "yellow")
(set! base (+ base 20))

(make <rectangle> :parent c :coords (list 60 base 100 (+ base 10))
                             :fill "red")


(define airfares (make <text-item> :parent c :coords '(140 480) 
		:text "Monthly Rates"
		:font "-*-helvetica-bold-r-normal--24-180-*-*-*-*-*-*"))
;(bind-for-dragging c :tag (cid airfares))

(define t1 (make <text-item> :parent c :coords '(150 505) 
		:text (string-append "$100-199")
		:font "-*-helvetica-medium-r-normal--18-140-*-*-*-*-*-*"))

(define t2 (make <text-item> :parent c :coords '(150 525) 
		:text (string-append "$200-299")
		:font "-*-helvetica-medium-r-normal--18-140-*-*-*-*-*-*"))

(define t3 (make <text-item> :parent c :coords '(150 545) 
		:text (string-append "$300-399")
		:font "-*-helvetica-medium-r-normal--18-140-*-*-*-*-*-*"))

(define t4 (make <text-item> :parent c :coords '(150 565) 
		:text (string-append "$400-499")
		:font "-*-helvetica-medium-r-normal--18-140-*-*-*-*-*-*"))
;(bind-for-dragging c :tag (cid t1))
;(bind-for-dragging c :tag (cid t2))
;(bind-for-dragging c :tag (cid t3))
;(bind-for-dragging c :tag (cid t4))

(define bound (make <rectangle> :parent c :coords '(40 320 750 850) 
					  :width 3
					  :fill "white"))
(lower bound)