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