(require "graph-view")
(require "flash")
(define xcrds (make-vector 7))
(vector-set! xcrds 0 0.5)
(vector-set! xcrds 1 0.3)
(vector-set! xcrds 2 0.1)
(vector-set! xcrds 3 0.5)
(vector-set! xcrds 4 0.5)
(vector-set! xcrds 5 0.7)
(vector-set! xcrds 6 0.9)

(define ycrds (make-vector 7))
(vector-set! ycrds 0 0.9)
(vector-set! ycrds 1 0.5)
(vector-set! ycrds 2 0.1)
(vector-set! ycrds 3 0.37)
(vector-set! ycrds 4 0.1)
(vector-set! ycrds 5 0.5)
(vector-set! ycrds 6 0.1)

 (define fanoplane (graph '(1 2 3 4 5 6 7) 
                              '((1 2 3) (1 4 5) (1 6 7)
                                (2 5 6) (2 4 7) 
                                (3 4 6) (3 5 7))))

(do  ((i 0 (+ i 1)))
     ((>= i 7) #f)
     (set-double-attribute! 'x (vector-ref  xcrds i) 
					 (vertex-ref fanoplane i))
     (set-double-attribute! 'y (vector-ref  ycrds i) 
					 (vertex-ref fanoplane i)))

(define fv (make <graph-view>  :graph fanoplane :layout 'custom))


(define vfv (vertices fv))
(define efv (edges fv))

;; color the vertices
(define (color-vertices fv)
	(map (lambda (x)
                (let ((r (modulo (quotient (random 100) 2) 2)))
                        (if (= r 0)
                                (set! (color x) "blue")
                                (set! (color x) "red")))) (vertices fv)))

(color-vertices fv)

;; assign colors to the edges simply to help visualize them
(set! (color (list-ref efv 0)) "orange")
(set! (color (list-ref efv 1)) "yellow")
(set! (color (list-ref efv 2)) "green")
(set! (color (list-ref efv 3)) "brown")
(set! (color (list-ref efv 4)) "purple")
(set! (color (list-ref efv 5)) "blue")
(set! (color (list-ref efv 6)) "black")

;; curve the central edge
(define e4 (list-ref efv 4))
(define seg1 (car (slot-ref e4 'seg-list)))
(define seg2 (cadr (slot-ref e4 'seg-list)))
(set! (coords seg1) '(90 260))
(set! (coords seg2) '(220 260))

;; thicken any monochromatic hyperedges
(define (find-monochromatic-triples fv)
  (map (lambda (x)
	(let* ((e (edge x))
	       (verts (vertices e))
	       (vtab (slot-ref fv 'vertex-table))
	       (vgs (map (lambda (y) (hash-table-get vtab y)) 
					(set-vertex->list verts))))
	   (jiggle x)
	   (set! (width x) 3)
	   (if (and (equal? (color (car vgs)) (color (cadr vgs)))
		    (equal? (color (cadr vgs)) (color (caddr vgs))))
		(begin (flash x)
		       (set! (width x) 6)))))
	efv))

(define (reset-edges fv)
  (map (lambda (x) (set! (width x) 1)) efv))


(hide-labels fv)
(show-label e4)

(provide "fanoplane")