1#############################################################################
2#  Pops up a dialog window to get the input file name from the user, then
3#  calls Igd_LoadGraph {window fname} to do the dirty work. If the file
4#  fname doesn't exist, Igd_LoadGraph will give an error message in the
5#  message window and nothing happens. For input file format see the
6#  comments at Igd_LoadGraph.
7#############################################################################
8
9proc Igd_load_from_file { toplevel_name } {
10
11    global igd_windowFromToplevel
12
13    set window $igd_windowFromToplevel($toplevel_name)
14
15    set entry_length 30
16    set arg0 [list "Load graph from file: " "~/vrp_pics/" $entry_length]
17    set fname [join [Igd_dialog_box $toplevel_name.ask \
18	"Load graph from file" $arg0]]
19    if { [string length $fname] && ($fname != "CANCEL")} {
20	if { [Igd_LoadGraph $window $fname] } {
21	    Igd_print_msg $toplevel_name "Loaded graph from file $fname"
22	}
23    } else {
24	Igd_print_msg $toplevel_name "No graph has been loaded"
25    }
26}
27
28#############################################################################
29#  Pops up a dialog window to get the output file name from the user, then
30#  calls Igd_SaveGraph {window fname} to save the graph on window's canvas.
31#  If the file already exists, Igd_SaveGraph will overwrite it.
32#############################################################################
33
34proc Igd_save_to_file { toplevel_name } {
35
36    global igd_windowFromToplevel
37
38    set window $igd_windowFromToplevel($toplevel_name)
39
40    set entry_length 30
41    set arg0 [list "Save graph to file: " "~/vrp_pics/" $entry_length]
42    set fname [join [Igd_dialog_box $toplevel_name.ask \
43	"Save graph to file" $arg0]]
44    if { [string length $fname] && ($fname != "CANCEL")} {
45	if { [Igd_SaveGraph $window $fname] } {
46	    Igd_print_msg $toplevel_name "Saved graph into file $fname"
47	}
48    } else {
49	Igd_print_msg $toplevel_name "Graph hasn't been saved"
50    }
51}
52
53#############################################################################
54#  Pops up a dialog window to get the output file name from the user, then
55#  calls Igd_SavePs {window fname} to save the postscript version of the graph
56#  on window's canvas. If file already exists, Igd_SavePs will overwrite it.
57#############################################################################
58
59proc Igd_save_postscript_to_file { toplevel_name } {
60
61    global igd_windowFromToplevel
62
63    set window $igd_windowFromToplevel($toplevel_name)
64
65    set entry_length 30
66    set arg0 [list "Save PostScript to file: " "~/vrp_pics/" $entry_length]
67    set fname [join [Igd_dialog_box $toplevel_name.ask \
68	"Save PostScript" $arg0]]
69    if {[string length $fname] && ($fname != "CANCEL")} {
70	if { [Igd_SavePs $window $fname] } {
71	    Igd_print_msg $toplevel_name "PostScript saved into file $fname"
72	}
73    } else {
74	Igd_print_msg $toplevel_name "PostScript hasn't been saved"
75    }
76}
77
78#############################################################################
79# Quit the whole application.
80#############################################################################
81
82proc Igd_QuitAll {} {
83
84    global igd_applWindows igd_applWindowCount igd_applWindowNum \
85	    igd_applDefaults igd_applIntPattern igd_applIntOrEmptyPattern \
86	    igd_applDashPattern igd_applSpacesPattern igd_applDescList \
87	    igd_applCheckFonts
88
89    # get rid of all the windows
90    foreach window $igd_applWindows {
91	Igd_QuitWindow $window
92    }
93
94    # unset all the variables
95    foreach option $igd_applDescList {
96	unset igd_applDefaults($option)
97    }
98
99    unset igd_applWindows igd_applWindowCount igd_applWindowNum \
100	    igd_applIntPattern igd_applIntOrEmptyPattern igd_applDashPattern \
101	    igd_applSpacesPattern igd_applDescList igd_applCheckFonts
102
103    # now exit from the application
104    exit
105}
106
107#############################################################################
108#  Read the graph from file fname. The input file format is the following:
109#      c Empty lines or lines starting with a 'c' will be skipped.
110#    First list the window properties, like this:
111#      w node_dash {2 2}
112#    Then give the number of nodes and edges
113#      p nodenum edgenum    -- number of nodes and edges
114#    List the descriptions of nodes. The nodes are going to be displayed in
115#    this order.
116#      n node_id x y key weight label dash radius
117#        node_id:  identifier of the node. should be unique.
118#        x, y: coordinates of the node.
119#        key: indicates (as a binary number) which of the following
120#             data is given: weight, label, dash pattern, radius.
121#             e.g., if key = 1101_2 = 11 = 8+2+1 then the weight,
122#             dash pattern, and radius are listed after the key
123#             (in this order), but not the label.
124#    List the descriptions of edges. The edges are going to be displayed in
125#    this order.
126#      a edge_id tail head key weight dash
127#        edge_id: identifier of the edge.
128#        tail, head: node identifiers of the endpoints of the edge.
129#        key: indicates (as a binary number) which of the following
130#             data is given: weight, dash patter. To be consistent with
131#             notation at nodes, weight adds 8, dash pattern adds 2 to key.
132#
133#    Note : values containing spaces must be enclosed in brackets {}.
134#
135#  The function first opens the file fname, creates a dummy window to
136#  load the graph into that. If the end of the file is reached without
137#  any problems then the window is erased and the dummy graph is copied
138#  onto the window.
139#  The file is read line by line. Empty lines or lines starting with a 'c'
140#  are skipped. First the window description and the number of nodes/edges
141#  have to be given, then description of nodes, then description of edges.
142#  The id, coordinates, and the key are required for a node. If weight is
143#  not given, no weight will be displayed; if no label is given, the id
144#  of the node is going to be displayed as its label; if no dash pattern
145#  or radius is given, default values will be used.
146#  Similarly for the edges, the id, endpoints and key are required; no
147#  weight is displayed if none given; and default value is used if dash
148#  pattern is not given.
149#
150#  The function returns 1 if successful, 0 if not.
151#############################################################################
152
153proc Igd_LoadGraph { window fname } {
154
155    global igd_applDescList igd_applIntPattern igd_windowToplevel \
156	    igd_windowDesc igd_windowTitle igd_windowNodes igd_windowEdges \
157	    igd_nodeCoord igd_nodeDesc igd_edgeEnds igd_edgeDesc
158
159    set toplevel_name $igd_windowToplevel($window)
160
161    # open the file for reading only. If file doesn't exist, give error
162    # message
163    if { [catch {open $fname r} f] } {
164	Igd_message_box $toplevel_name.mbox error 500 1 \
165		"\n ERROR while trying to open the file $fname for reading:\n \
166		\n $f\n"
167	return 0
168    }
169
170    # everything will be loaded into a temporary graph, so that if there
171    # are problems during loading, the original setup and the graph in
172    # the window are not destroyed.
173    set tmp_win "__tmp__"
174
175    # copy the application defaults to this window
176    Igd_CopyApplDefaultToWindow $tmp_win
177
178    # read in the window description, and number of nodes and edges.
179
180    # read in a line first
181    if { [catch {gets $f line} r] } {
182	Igd_load_error $window $fname $r
183	return 0
184    }
185
186    while { ![eof $f] } {
187	set key [lindex $line 0]
188
189	switch -exact -- $key {
190	    c {
191	    }
192	    "" {
193	    }
194	    w {
195		if { [llength $line] != 3 } {
196		    Igd_load_incorrect_num $window $fname $line
197		    return 0
198		}
199		set option [lindex $line 1]
200		if { $option == "title" } {
201		    set igd_windowTitle($tmp_win) [lindex $line 2]
202		} else {
203		    if { [lsearch $igd_applDescList $option] >= 0 } {
204			set igd_windowDesc($option,$tmp_win) [lindex $line 2]
205		    }
206		}
207	    }
208	    p {
209		if { [llength $line] != 3 } {
210		    Igd_load_incorrect_num $window $fname $line
211		    return 0
212		}
213		set win_tmp_nodenum [lindex $line 1]
214		set win_tmp_edgenum [lindex $line 2]
215		# if nodenum and edgenum are not integers, return
216		if { ![regexp -- $igd_applIntPattern $win_tmp_nodenum] || \
217			![regexp -- $igd_applIntPattern $win_tmp_edgenum] } {
218		    Igd_message_box $toplevel_name.mbox error 500 1 \
219			    "\n Number of nodes and edges have to be integers.\
220			    \n Loading graph aborted. \n "
221		    return 0
222		}
223		# if nodenum 0 but edgenum is nonzero, return
224		if { $win_tmp_nodenum == 0 && $win_tmp_edgenum != 0 } {
225		    Igd_message_box $toplevel_name.mbox error 500 1 \
226			    "\n Number of nodes is zero but number of edges\n\
227			     is nozero. Loading graph aborted. \n"
228		    return 0
229		}
230	    }
231	    n {
232		break
233	    }
234	    a {
235		break
236	    }
237	    default {
238		Igd_message_box $toplevel_name.mbox error 500 1 \
239			"\n Expected a line starting with a c or w\n \
240			but got $key. Loading graph aborted.\n"
241		return 0
242	    }
243	}
244	# read in a line
245	if { [catch {gets $f line} r] } {
246	    Igd_load_error $window $fname $r
247	    return 0
248	}
249    }
250
251    # if p nodenum edgenum is missing, give error message
252    if { ![info exists win_tmp_nodenum] || ![info exists win_tmp_edgenum] } {
253	Igd_load_error $window $fname "Did not get a line with the number\
254		of nodes and edges. \n"
255	return 0
256    }
257
258    # now read in the description of nodes. the first node info is already
259    # in line.
260    set node_count 0
261    set igd_windowNodes($tmp_win) {}
262    while { ![eof $f] } {
263	set key [lindex $line 0]
264
265	switch -exact -- $key {
266	    c {
267	    }
268	    "" {
269	    }
270	    n {
271		if { [Igd_read_node $window $fname $tmp_win $line] } {
272		    incr node_count
273		} else {
274		    return 0
275		}
276	    }
277	    a {
278		break
279	    }
280	    default {
281		Igd_message_box $toplevel_name.mbox error 500 1 \
282			"\n Expected a line starting with a c or n\n \
283			but got $key. Loading graph aborted.\n "
284		return 0
285	    }
286	}
287
288	# read in a line
289	if { [catch {gets $f line} r] } {
290	    Igd_load_error $window $fname $r
291	    return 0
292	}
293    }
294
295    if { $node_count != $win_tmp_nodenum } {
296	Igd_message_box $toplevel_name.mbox warning 500 1 \
297		"\n WARNING: Number of nodes was given incorrectly\n"
298    }
299
300    # now read in the description of edges. the first edge is already in
301    # line
302    set edge_count 0
303    set igd_windowEdges($tmp_win) {}
304    while { ![eof $f] } {
305	set key [lindex $line 0]
306
307	switch -exact -- $key {
308	    c {
309	    }
310	    "" {
311	    }
312	    a {
313		if { [Igd_read_edge $window $fname $tmp_win $line] } {
314		    incr edge_count
315		} else {
316		    return 0
317		}
318	    }
319	    default {
320		Igd_message_box $toplevel_name.mbox error 500 1 \
321			"\n Expected a line starting with a c or a\n \
322			but got $key. Loading graph aborted.\n "
323		return 0
324	    }
325	}
326	# read in a line
327	if { [catch {gets $f line} r] } {
328	    Igd_load_error $window $fname $r
329	    return 0
330	}
331    }
332
333    if { $edge_count != $win_tmp_edgenum } {
334	Igd_message_box $toplevel_name.mbox warning 500 1 \
335		"\n WARNING: Number of edges was given incorrectly\n"
336    }
337
338    # now that the graph has been read in correctly, display it.
339
340    # first erase the window
341    Igd_EraseWindow $window
342
343    # set the title of the window
344    Igd_RenameWindow $window $igd_windowTitle($tmp_win)
345
346    # copy window descriptions (and have their effect at once)
347    Igd_SetAndExecuteWindowDesc $window \
348	    $igd_windowDesc(canvas_width,$tmp_win)\
349	    $igd_windowDesc(canvas_height,$tmp_win) \
350	    $igd_windowDesc(viewable_width,$tmp_win) \
351	    $igd_windowDesc(viewable_height,$tmp_win) \
352	    $igd_windowDesc(disp_nodelabels,$tmp_win) \
353	    $igd_windowDesc(disp_nodeweights,$tmp_win) \
354	    $igd_windowDesc(disp_edgeweights,$tmp_win) \
355	    $igd_windowDesc(node_dash,$tmp_win) \
356	    $igd_windowDesc(edge_dash,$tmp_win) \
357	    $igd_windowDesc(node_radius,$tmp_win) \
358	    $igd_windowDesc(interactive_mode,$tmp_win) \
359	    $igd_windowDesc(mouse_tracking,$tmp_win) \
360	    $igd_windowDesc(scale_factor,$tmp_win) \
361	    $igd_windowDesc(nodelabel_font,$tmp_win) \
362	    $igd_windowDesc(nodeweight_font,$tmp_win) \
363	    $igd_windowDesc(edgeweight_font,$tmp_win)
364
365    # display the nodes
366    foreach node $igd_windowNodes($tmp_win) {
367	set tmp "$tmp_win,$node"
368	Igd_MakeNode $window $node \
369		[expr int($igd_nodeCoord(x,$tmp) * $igd_windowDesc(scale_factor,$window)) + 1] \
370		[expr int($igd_nodeCoord(y,$tmp) * $igd_windowDesc(scale_factor,$window)) + 1] \
371		$igd_nodeDesc(label,$tmp) $igd_nodeDesc(dash,$tmp) \
372		$igd_nodeDesc(radius,$tmp)
373	if { [info exists igd_nodeDesc(weight,$tmp)] } {
374	    Igd_MakeNodeWeight $window $node $igd_nodeDesc(weight,$tmp)
375	}
376    }
377    foreach edge $igd_windowEdges($tmp_win) {
378	set tmp "$tmp_win,$edge"
379	Igd_MakeEdge $window $edge \
380		$igd_edgeEnds(tail,$tmp) $igd_edgeEnds(head,$tmp) \
381		$igd_edgeDesc(dash,$tmp)
382	if { [info exists igd_edgeDesc(weight,$tmp)] } {
383	    Igd_MakeEdgeWeight $window $edge $igd_edgeDesc(weight,$tmp)
384	}
385    }
386
387    # "erase" and unset the dummy window
388    foreach edge $igd_windowEdges($tmp_win) {
389	set tmp "$tmp_win,$edge"
390	unset igd_edgeEnds(tail,$tmp) igd_edgeEnds(head,$tmp) \
391		igd_edgeDesc(dash,$tmp)
392	if { [info exists igd_edgeDesc(weight,$tmp)] } {
393	    unset igd_edgeDesc(weight,$tmp)
394	}
395    }
396    foreach node $igd_windowNodes($tmp_win) {
397	set tmp "$tmp_win,$node"
398	unset igd_nodeCoord(x,$tmp) igd_nodeCoord(y,$tmp) \
399		igd_nodeDesc(radius,$tmp) igd_nodeDesc(dash,$tmp) \
400		igd_nodeDesc(label,$tmp)
401	if { [info exists igd_nodeDesc(weight,$tmp)] } {
402	    unset igd_nodeDesc(weight,$tmp)
403	}
404    }
405    unset igd_windowTitle($tmp_win) igd_windowNodes($tmp_win) \
406	    igd_windowEdges($tmp_win)
407
408    foreach option $igd_applDescList {
409	unset igd_windowDesc($option,$tmp_win)
410    }
411
412
413    return 1
414
415}
416
417
418#############################################################################
419# Interpret the list 'line' as node description. Give an error message if
420# data is invalid.
421#############################################################################
422
423proc Igd_read_node { window fname tmp_win line } {
424
425    global igd_applIntPattern igd_applDashPattern igd_applSpacesPattern \
426	    igd_windowToplevel igd_windowTitle igd_windowDesc igd_windowNodes \
427	    igd_nodeDesc igd_nodeCoord
428
429    set toplevel_name $igd_windowToplevel($window)
430
431    set node_id [lindex $line 1]
432    if { [lsearch $igd_windowNodes($tmp_win) $node_id] >= 0 } {
433	# node id already exists
434	Igd_message_box $toplevel_name.mbox warning 500 1 \
435		"\n WARNING: node id $node_id already exists, \n \n \
436		$line \n \n \
437		will not be displayed. (loading graph from file $fname)\n "
438    } else {
439	if { [llength $line] < 5 || [llength $line] > 9 } {
440	    Igd_load_incorrect_num $window $fname $line
441	    return 0
442	}
443
444	set x [lindex $line 2] ; set y [lindex $line 3]
445	if { ![regexp -- $igd_applIntPattern $x] } {
446	    Igd_message_box $toplevel_name.mbox error 500 1 \
447		    "\n Invalid x coordinate in the description of node\n \n \
448		    $line \n \n \
449		    (loading graph from file $fname)\n"
450	    return 0
451	}
452	if { ![regexp -- $igd_applIntPattern $y] } {
453	    Igd_message_box $toplevel_name.mbox error 500 1 \
454		    "\n Invalid y coordinate in the description of node\n \n \
455		    $line \n \n \
456		    (loading graph from file $fname)\n"
457	    return 0
458	}
459
460	set node_key [lindex $line 4]
461	if { ![regexp -- $igd_applIntPattern $node_key] || $node_key > 15 } {
462	    Igd_message_box $toplevel_name.mbox error 500 1 \
463		    "\n Invalid key in the description of node\n \n \
464		    $line \n \n \
465		    (loading graph from file $fname)\n"
466	    return 0
467	}
468
469	set ind 5
470	if { [expr $node_key & 0x08] > 0 } {
471	    if { [llength $line] <= $ind } {
472		Igd_load_incorrect_num $window $fname $line
473		return 0
474	    }
475	    set w [lindex $line $ind]
476	    incr ind
477	} else {
478	    # no weight is assigned to the node by default, this is just dummy
479	    set w ""
480	}
481	if { [expr $node_key & 0x04] > 0 } {
482	    if { [llength $line] <= $ind } {
483		Igd_load_incorrect_num $window $fname $line
484		return 0
485	    }
486	    set l [lindex $line $ind]
487	    incr ind
488	} else {
489	    # node id is going to be displayed as the label of the node
490	    # if no label is specified
491	    set l $node_id
492	}
493	if { [expr $node_key & 0x02] > 0 } {
494	    if { [llength $line] <= $ind } {
495		Igd_load_incorrect_num $window $fname $line
496		return 0
497	    }
498	    set d [lindex $line $ind]
499	    if { ![regexp -- $igd_applDashPattern $d] } {
500		Igd_message_box $toplevel_name.mbox error 500 1 \
501			"\n Invalid dash pattern in the description of node\n\
502			\n $line \n \n \
503			(loading graph from file $fname)\n"
504		return 0
505	    }
506	    incr ind
507	} else {
508	    # dash will be the default dash if nothing else is specified
509	    set d $igd_windowDesc(node_dash,$tmp_win)
510	}
511	if { [expr $node_key & 0x01] > 0 } {
512	    if { [llength $line] <= $ind } {
513		Igd_load_incorrect_num $window $fname $line
514		return 0
515	    }
516	    set r [lindex $line $ind]
517	    if { ![regexp -- $igd_applIntPattern $r] } {
518		Igd_message_box $toplevel_name.mbox error 500 1 \
519			"\n Invalid radius in the description of node\n\
520			\n $line \n \n \
521			(loading graph from file $fname)\n"
522		return 0
523	    }
524	    incr ind
525	} else {
526	    # default will be used if no radius is given
527	    set r $igd_windowDesc(node_radius,$tmp_win)
528	}
529
530	# the node is valid: set the data structure:
531	lappend igd_windowNodes($tmp_win) $node_id
532	set igd_nodeCoord(x,$tmp_win,$node_id) $x
533	set igd_nodeCoord(y,$tmp_win,$node_id) $y
534	if { ![regexp -- $igd_applSpacesPattern $w] } {
535	    set igd_nodeDesc(weight,$tmp_win,$node_id) $w
536	}
537	set igd_nodeDesc(label,$tmp_win,$node_id) $l
538	set igd_nodeDesc(dash,$tmp_win,$node_id) $d
539	set igd_nodeDesc(radius,$tmp_win,$node_id) $r
540
541	return 1
542    }
543}
544
545#############################################################################
546# Interpret the list 'line' as edge description. Give an error message if
547# data is invalid.
548#############################################################################
549
550proc Igd_read_edge { window fname tmp_win line } {
551
552    global igd_applIntPattern igd_applDashPattern igd_applSpacesPattern \
553	    igd_windowToplevel igd_windowTitle igd_windowDesc igd_windowNodes \
554	    igd_windowEdges igd_edgeDesc igd_edgeEnds
555
556    set toplevel_name $igd_windowToplevel($window)
557
558    set edge_id [lindex $line 1]
559    if { [Igd_ExistsEdge $tmp_win $edge_id] } {
560	# edge id already exists
561	Igd_message_box $toplevel_name.mbox warning 500 1 \
562		"\n WARNING: edge id $edge_id already exists, \n \n \
563		$line \n \n \
564		will not be displayed. (loading graph from file $fname)\n "
565    } else {
566	if { [llength $line] < 5 || [llength $line] > 7 } {
567	    Igd_load_incorrect_num $window $fname $line
568	    return 0
569	}
570
571	set tail [lindex $line 2] ; set head [lindex $line 3]
572	if { ![Igd_ExistsNode $tmp_win $tail] || \
573		![Igd_ExistsNode $tmp_win $head] } {
574	    Igd_message_box $toplevel_name.mbox error 500 1 \
575		    "\n One (or both) endpoint(s) of edge \n \n \
576		    $line \n \n doesn't exist. Loading graph aborted.\n"
577	    return 0
578	}
579
580	set edge_key [lindex $line 4]
581	if { ![regexp -- $igd_applIntPattern $edge_key] || $edge_key > 15 } {
582	    Igd_message_box $toplevel_name.mbox error 500 1 \
583		    "\n Invalid key in the description of edge\n \n \
584		    $line \n \n \
585		    (loading graph from file $fname)\n"
586	    return 0
587	}
588
589	set ind 5
590	if { [expr $edge_key & 0x08] > 0 } {
591	    if { [llength $line] <= $ind } {
592		Igd_load_incorrect_num $window $fname $line
593		return 0
594	    }
595	    set w [lindex $line $ind]
596	    incr ind
597	} else {
598	    # no weight is assigned to the edge by default, this is just dummy
599	    set w ""
600	}
601	if { [expr $edge_key & 0x02] > 0 } {
602	    if { [llength $line] <= $ind } {
603		Igd_load_incorrect_num $window $fname $line
604		return 0
605	    }
606	    set d [lindex $line $ind]
607	    if { ![regexp -- $igd_applDashPattern $d] } {
608		Igd_message_box $toplevel_name.mbox error 500 1 \
609			"\n Invalid dash pattern in the description of edge\n\
610			\n $line \n \n \
611			(loading graph from file $fname)\n"
612		return 0
613	    }
614	    incr ind
615	} else {
616	    # dash will be the default dash if nothing else is specified
617	    set d $igd_windowDesc(edge_dash,$tmp_win)
618	}
619
620	# the edge is valid: set the data structure:
621	lappend igd_windowEdges($tmp_win) $edge_id
622	set igd_edgeEnds(tail,$tmp_win,$edge_id) $tail
623	set igd_edgeEnds(head,$tmp_win,$edge_id) $head
624	if { ![regexp -- $igd_applSpacesPattern $w] } {
625	    set igd_edgeDesc(weight,$tmp_win,$edge_id) $w
626	}
627	set igd_edgeDesc(dash,$tmp_win,$edge_id) $d
628
629	return 1
630    }
631}
632
633
634#############################################################################
635# Error message when loading.
636#############################################################################
637
638proc Igd_load_error { window fname text } {
639
640    global igd_windowToplevel
641
642    Igd_message_box $igd_windowToplevel($window).mbox error 500 1 \
643	    "\n ERROR while trying to load from file $fname: \n \n $text \n\
644	     Loading graph aborted.\n"
645}
646
647#############################################################################
648# Error message if the number of entries in a line is incorrect.
649#############################################################################
650
651proc Igd_load_incorrect_num { window fname line } {
652
653    global igd_windowToplevel
654
655    Igd_message_box $igd_windowToplevel($window).mbox error 500 1 \
656	    "\n Incorrect number of entries in line\n \n \
657	    $line \n \n\
658	    while loading from file $fname\n\
659	    Loading graph aborted.\n"
660}
661
662#############################################################################
663# Save the graph on window's canvas into the file fname. If the file fname
664# already exists, it is going to be overwritten. Returns 1 if successfull,
665# 0 if not. Format is the same as at Igd_LoadGraph.
666#############################################################################
667
668proc Igd_SaveGraph { window fname } {
669
670    global igd_applDescList igd_windowToplevel igd_windowTitle igd_windowDesc \
671	    igd_windowNodes igd_windowNodeCount igd_windowEdges \
672	    igd_applSpacesPattern igd_nodeCoord igd_nodeDesc igd_edgeEnds \
673	    igd_edgeDesc
674
675    set toplevel_name $igd_windowToplevel($window)
676
677    # open file for writing only. if file already exists, overwrite.
678    # f is going to be the file id if open is successful.
679    if { [catch {open $fname w} f] }  {
680	Igd_message_box $toplevel_name.mbox error 500 1 \
681		"\n ERROR while trying to open the file $fname for writing: \n\
682		\n $f\n "
683	return 0
684    }
685
686    puts $f "c The following entries describe the window properties."
687
688    if { [catch {puts $f [list w title $igd_windowTitle($window)]} r] } {
689	Igd_save_error $window $fname $r
690	return 0
691    }
692    foreach option $igd_applDescList {
693	if { [catch {puts $f [list w $option \
694		$igd_windowDesc($option,$window)]} r] } {
695	    Igd_save_error $window $fname $r
696	    return 0
697	}
698    }
699
700    puts -nonewline $f "\n"
701
702    puts $f "c The following two numbers are the number of nodes and\
703	    edges in the graph"
704
705    set node_count $igd_windowNodeCount($window)
706    set edge_count [llength $igd_windowEdges($window)]
707    if { [catch {puts $f [list p $node_count $edge_count]} r] } {
708	Igd_save_error $window $fname $r
709	return 0
710    }
711
712    puts -nonewline $f "\n"
713
714    puts $f "c The following entries list the nodes, the nodes are supposed "
715    puts $f "c to be displayed exactly in this order. The first number is the "
716    puts $f "c node id, the second and third are the node's coordinates."
717    puts $f "c The fourth number is a key that indicates (as a binary number)"
718    puts $f "c which of the following data is given: weight, label, "
719    puts $f "c dash pattern, radius."
720
721    set node_list [Igd_NodeOrderInDisplayList $window]
722    foreach node $node_list {
723	set tmp "$window,$node"
724	set out_list [list n $node \
725		[expr int(double($igd_nodeCoord(x,$tmp)) / $igd_windowDesc(scale_factor,$window))] \
726		[expr int(double($igd_nodeCoord(y,$tmp)) / $igd_windowDesc(scale_factor,$window))]]
727	set key 0
728	if { [info exists igd_nodeDesc(weight,$tmp)] } {
729	    incr key 8
730	    lappend out_list $igd_nodeDesc(weight,$tmp)
731	}
732	lappend out_list $igd_nodeDesc(label,$tmp)
733	incr key 4
734	lappend out_list $igd_nodeDesc(dash,$tmp)
735	incr key 2
736	lappend out_list $igd_nodeDesc(radius,$tmp)
737	incr key 1
738	set out_list [linsert $out_list 4 $key]
739	if { [catch {puts $f $out_list} r] } {
740	    Igd_save_error $window $fname $r
741	    return 0
742	}
743    }
744
745    puts -nonewline $f "\n"
746
747    puts $f "c The following entries list the edges, the edges are supposed"
748    puts $f "c to be displayed exactly in this order. The first number is the "
749    puts $f "c edge id, the second and third are the node id of its "
750    puts $f "c endpoints. The fourth number is a key that indicates (as a"
751    puts $f "c binary number) which of the following data is given: weight,"
752    puts $f "c dash pattern."
753
754    set edge_list [Igd_EdgeOrderInDisplayList $window]
755    foreach edge $edge_list {
756	set tmp "$window,$edge"
757	set out_list [list a $edge $igd_edgeEnds(tail,$tmp) \
758		$igd_edgeEnds(head,$tmp)]
759	set key 0
760	if { [info exists igd_edgeDesc(weight,$tmp)] } {
761	    incr key 8
762	    lappend out_list $igd_edgeDesc(weight,$tmp)
763	}
764	lappend out_list $igd_edgeDesc(dash,$tmp)
765	incr key 2
766	set out_list [linsert $out_list 4 $key]
767	if { [catch {puts $f $out_list} r] } {
768	    Igd_save_error $window $fname $r
769	    return 0
770	}
771    }
772
773    # close the file
774    if { [catch {close $f} r] } {
775	Igd_save_error $window $fname $r
776	return 0
777    }
778
779    # all went fine
780    return 1
781}
782
783#############################################################################
784# Error message when saving.
785#############################################################################
786
787proc Igd_save_error { window fname text } {
788
789    global igd_windowToplevel
790
791    Igd_message_box $igd_windowToplevel($window).mbox error 500 1 \
792	    "\n ERROR while trying to write into the file $fname: \n \n $text \n"
793}
794
795
796#############################################################################
797# Save the PostScript version of the graph on window's canvas.
798# which = canvas then save the entire canvas; which = viewable then save the
799# viewable region only.
800#
801# The function calculates the best way of fitting the picture on an 8x11
802# paper (by scaling and/or rotating the picture). It saves a greyscale
803# version of the picture.
804#############################################################################
805
806proc Igd_SavePs { window fname } {
807
808    global igd_windowToplevel igd_windowMouseTrackerID igd_windowDesc
809
810    set c $igd_windowToplevel($window).c
811
812    # hide the mouse tracker while the canvas is copied so it won't show
813    # on the picture
814    $c itemconfigure $igd_windowMouseTrackerID($window) -state hidden
815
816    set w [winfo width $c]
817    set h [winfo height $c]
818
819    # note 1 pixel is .8 printers point. The paper size is 8x11 in,
820    # we use 6x9 in from it. 6 in = 423 pp = 540 pix; 9in = 648 pp = 810 pix.
821
822    if { $w <= 540 && $h <= 810 } {
823	# canvas fits onto the paper as it is.
824	if { [catch {$c postscript -colormode gray -file $fname} result] } {
825	    Igd_postscript_error $window $result
826	    set return_value 0
827	} else {
828	    set return_value 1
829	}
830    } elseif { $w <= 810 && $h <= 540 } {
831	# canvas fits onto the paper if rotated.
832	if { [catch {$c postscript -colormode gray -rotate 1 -file $fname} \
833		result] } {
834	    Igd_postscript_error $window $result
835	    set return_value 0
836	} else {
837	    set return_value 1
838	}
839    } elseif { double($h)/ double($w) > 1.5 } {
840	# canvas is much taller than wide: scale wrt height
841	if { [catch {$c postscript -colormode gray -pageheight 9i \
842		-file $fname} result] } {
843	    Igd_postscript_error $window $result
844	    set return_value 0
845	} else {
846	    set return_value 1
847	}
848    } elseif { double($w)/ double($h) > 1.5 } {
849	# canvas is much wider than high: scale wrt width AND rotate
850	if { [catch {$c postscript -colormode gray -pagewidth 9i -rotate 1 \
851		-file $fname} \
852		result] } {
853	    Igd_postscript_error $window $result
854	    set return_value 0
855	} else {
856	    set return_value 1
857	}
858    } elseif { $h >= $w } {
859	# canvas is a little higher than wide: scale wrt width
860	if { [catch {$c postscript -colormode gray -pagewidth 6i \
861		-file $fname} result] } {
862	    Igd_postscript_error $window $result
863	    set return_value 0
864	} else {
865	    set return_value 1
866	}
867    } else {
868	# $h < $w: scale wrt height AND rotate
869	if { [catch {$c postscript -colormode gray -pageheight 6i -rotate 1 \
870		-file $fname} \
871		result] } {
872	    Igd_postscript_error $window $result
873	    set return_value 0
874	} else {
875	    set return_value 1
876	}
877    }
878
879    # bring back the mouse tracker
880    $c itemconfigure $igd_windowMouseTrackerID($window) -state normal
881
882    return $return_value
883}
884
885#############################################################################
886# Error message when saving the postscript.
887#############################################################################
888
889proc Igd_postscript_error { window fname text } {
890
891    global igd_windowToplevel
892
893    Igd_message_box $igd_windowToplevel($window).mbox error 500 1 \
894	    "\n ERROR while trying to save the PostScript version of the\
895	    canvas into file $fname: \n \n $text \n"
896}
897
898