;; 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 (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")