(require "graph-view")
(define g (graph '(1 2 3 4) '((1 2 3) (2 3 4))))
(define gv (make <graph-view> :graph g))
(define c  (slot-ref gv 'graph-canvas))
(define egs (edges gv))
(define eg (car egs))
(define eg1 (cadr egs))
(define segs (slot-ref eg 'seg-list))
(define sg1 (car segs))
(define sg2 (cadr segs))

(define (mid-point es)
	(let*  ((ln (slot-ref es 'line-item))
	        (crds (slot-ref ln 'coords))
	        (x1   (car crds))
	        (y1   (cadr crds))
		(p2 (cddddr crds))
	        (x2   (car p2))
	        (y2   (cadr p2))
                (xmid   (quotient (+ x1 x2) 2))
                (ymid   (quotient (+ y1 y2) 2)))
	  (list xmid ymid)))

(define (edge-draw-mode e mode)
	(let* ((c (slot-ref e 'parent))
	       (segs (slot-ref e 'seg-list))
	       (crds (coords (car segs)))
	       (smooth-flag (if (equal? mode 'star-draw) 0 1))
	       (move-all (if (equal? mode 'star-draw) #f #t)))
	   (map (lambda (x) 
			(if (= smooth-flag 1)
				(set! (coords x) (mid-point x))
				(set! (coords x) crds))
			(set! (smooth (slot-ref x 'line-item))smooth-flag))segs)
	   (bind-for-dragging c :tag (cid (slot-ref e 'edge-group))
				:button 2 
				:only-current move-all
        			:motion (lambda (w x y) 
			 	  (let ((segs (find-items c 'withtag 
						(slot-ref w 'cid))))
             				(map (lambda (es)
				      		(graph-object-motion es x y))
					segs))))))
(define (star-draw e) (edge-draw-mode e 'star-draw))
(define (path-draw e) (edge-draw-mode e 'path-draw))

;;; might be a useful example for the future (not used now)
(define (re-search-list re l)
	(cond ((null? l) #f)
	       ((re (car l)) (car l))
	       (#t (re-search-list re (cdr l)))))

(define-generic search-for-group-tag)
(define-method search-for-group-tag ((e <edge-item>))
	(let ((l (slot-ref e 'tags))
	      (re (string->regexp "group*")))
	   (re-search-list re l)))