;; Copyright (C) 1996 DIMACS Center, Rutgers, The State University of New Jersey
;; Author(s): Jonathan Berry

;; This software is copyrighted by the DIMACS Center at Rutgers, The State
;; University of New Jersey.  IT IS PROVIDED AS IS, AND THE AUTHORS, DIMACS, AND
;; RUTGERS, THE STATE UNIVERSITY OF NEW JERSEY  DISCLAIM
;; ALL LIABILITY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL
;; DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
;; DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
;; POSSIBILITY OF SUCH DAMAGE.

;; THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
;; IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
;; NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
;; MODIFICATIONS.

;; The authors hereby grant permission to use, copy, modify, distribute,
;; and license this software and its documentation for any purpose, provided
;; that existing copyright notices are retained in all copies and that this
;; notice is included verbatim in any distributions. No written agreement,
;; license, or royalty fee is required for any of the authorized uses.
;; Modifications to this software may be copyrighted by their authors
;; and need not follow the licensing terms described here, provided that
;; the new terms are clearly indicated on the first page of each file where
;; they apply.

;; Last File Update: 31-Jul-1996
;; 

(require "graph-view")

(define *link:new-graph-view* #f)
    
(define (new-graph-view gtype)
    (let ((f #f))
	(cond ((equal? gtype 'mhypergraph) (set! f mhypergraph))
	      ((equal? gtype 'muhypergraph) (set! f muhypergraph))
	      ((equal? gtype 'mdhypergraph) (set! f mdhypergraph))
	      ((equal? gtype 'hypergraph) (set! f hypergraph))
	      ((equal? gtype 'uhypergraph) (set! f uhypergraph))
	      ((equal? gtype 'dhypergraph) (set! f dhypergraph))
	      ((equal? gtype 'mbingraph) (set! f mbingraph))
	      ((equal? gtype 'mubingraph) (set! f mubingraph))
	      ((equal? gtype 'mdbingraph) (set! f mdbingraph))
	      ((equal? gtype 'bingraph) (set! f bingraph))
	      ((equal? gtype 'ubingraph) (set! f ubingraph))
	      ((equal? gtype 'dbingraph) (set! f dbingraph)))
	(set! *link:new-graph-view* (make <graph-view> :graph (f)))))

(define (binary-predicate op truth-msg falsity-msg)
  (set! *link:canvas-clicks* 0)
  (set! *link:selected-graph-view1* #f)
  (set! *link:selected-graph-view2* #f)
  (msg-window "Click with button 1 on two graphs, then click ok" 
    (lambda()
	(cond ((or (not  *link:selected-graph-view1*)
   		   (not *link:selected-graph-view2*))
			(link-msg "Error: did not find two selected graphs.")
			(after 3000))
       	      (#t (if (op (graph *link:selected-graph-view1*) 
                   	    (graph *link:selected-graph-view2*))
			(ans-window truth-msg #f)
			(ans-window falsity-msg #f)
	          )))
	(set! *link:selected-graph-view1* #f)
	(set! *link:selected-graph-view2* #f))))

(define (unary-operation op transform-to-binary)
  (set! *link:canvas-clicks* 0)
  (set! *link:selected-graph-view* #f)
  (msg-window "Click with button 1 on one graph, then click ok" 
    (lambda()
      (let ((g (graph *link:selected-graph-view*)))
        ;(if transform-to-binary (set! g (mbingraph g)))
        (let ((result (op g)))
	   (describe (map (lambda(x) (find-double-attribute 'x x)) (set-vertex->list
			(vertices result))))
	  ;(if transform-to-binary (set! result (mbingraph result)))
	  (cond ((not  *link:selected-graph-view*)
			(link-msg "Error: did not find a selected graph.")
			(after 3000))
       	      (#t (set! *link:new-graph-view* 
			(show-labeled-graph result 'custom)
	          )))
	  (set! *link:selected-graph-view* #f))))))

(define (binary-operation op transform-to-binary)
  (set! *link:canvas-clicks* 0)
  (set! *link:selected-graph-view1* #f)
  (set! *link:selected-graph-view2* #f)
  (msg-window "Click with button 1 on two graphs, then click ok" 
    (lambda()
      (let ((g1 (graph *link:selected-graph-view1*)) 
	    (g2 (graph *link:selected-graph-view2*)))
      (if transform-to-binary (set! g1 (mbingraph g1)))
      (if transform-to-binary (set! g2 (mbingraph g2)))
      (let ((result (op g1 g2)))
	(if transform-to-binary (set! result (mbingraph result)))
	(cond ((or (not  *link:selected-graph-view1*)
   		   (not *link:selected-graph-view2*))
			(link-msg "Error: did not find two selected graphs.")
			(after 3000))
       	      (#t (set! *link:new-graph-view* 
			(show-labeled-graph result 'custom)
	          )))
	(set! *link:selected-graph-view1* #f)
	(set! *link:selected-graph-view2* #f))))))
    
(define (main-menu-string)
	`(
	   ("File" 
		 ("Quit" ,(lambda() (bye)))
           )
	   ("Tutorial" ("Load" ,(lambda()(require "link-wtour"))))
	   ("Graph Windows" 
		 ("Graph"
		    (
			 ("Undirected"
			   (
			    ("No Multiple Edges" 
				,(lambda()(new-graph-view 'ubingraph)))
			    ("Multiple Edges Allowed"
				,(lambda()(new-graph-view 'mubingraph)))
			   )
			 )
			 ("Directed"
			   (
			    ("No Multiple Edges" 
				,(lambda()(new-graph-view 'dbingraph)))
			    ("Multiple Edges Allowed"
				,(lambda()(new-graph-view 'mdbingraph)))
			   )
			 )
			 ("Mixed"
			   (
			    ("No Multiple Edges" 
				,(lambda()(new-graph-view 'bingraph)))
			    ("Multiple Edges Allowed"
				,(lambda()(new-graph-view 'mbingraph)))
			   )
			 )
		    )
		)
		("Hypergraph"
		    (
			("Undirected"
			   (	
				("No Multiple Edges" 
				   ,(lambda()(new-graph-view 'uhypergraph)))
			    	("Multiple Edges Allowed"
				   ,(lambda()(new-graph-view 'muhypergraph)))
			   )
			)
			("Directed"
			   (
				("No Multiple Edges" 
				   ,(lambda()(new-graph-view 'dhypergraph)))
			    	("Multiple Edges Allowed"
				   ,(lambda()(new-graph-view 'mdhypergraph)))
			   )
			)
			("Mixed"
			   (
				("No Multiple Edges" 
				   ,(lambda()(new-graph-view 'hypergraph)))
			    	("Multiple Edges Allowed"
				   ,(lambda()(new-graph-view 'mhypergraph)))
			   )
			)
		    )
		)
	   )
	   ("Graph Operations" 
		 ("Complement" ,(lambda() (unary-operation complement #t)))
		 ("Isomorphism" ,(lambda() (binary-predicate isomorphic?
					     "nauty: They are isomorphic"
					     "nauty: They are not isomorphic")))
		 ("Line Graph" ,(lambda() (unary-operation line-graph #t)))
		 ("Product" ,(lambda() (binary-operation product #t)))
		 ("Sum" ,(lambda() (binary-operation sum #t)))
	   )
	)
)

(pack (make-menubar *root* (main-menu-string)))

(provide "main-window")