home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / print.tcl < prev    next >
Text File  |  1997-08-14  |  9KB  |  356 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Westmount Technology    1994
  4. #
  5. #      File:           @(#)print.tcl    /main/titanic/3
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)print.tcl    /main/titanic/3   14 Aug 1997 Copyright 1994 Westmount Technology
  10.  
  11. # Start user added include file section
  12.  
  13. global Print::options
  14. set Print::options {
  15.     doPrintBox title scale autoScale orientation horNumPages verNumPages
  16.     pageWidth pageHeight file type printer configVersion systemVersion
  17. }
  18.  
  19. # End user added include file section
  20.  
  21.  
  22. Class Print : {Object} {
  23.     constructor
  24.     method destructor
  25. }
  26.  
  27. constructor Print {class this name} {
  28.     set this [Object::constructor $class $this $name]
  29.     # Start constructor user section
  30.     # End constructor user section
  31.     return $this
  32. }
  33.  
  34. method Print::destructor {this} {
  35.     # Start destructor user section
  36.     # End destructor user section
  37. }
  38.  
  39.  
  40. # Print diagrams.
  41. #
  42. proc Print::printDiagrams {args} {
  43.     Print::processOptions options i $args
  44.     set diagrams [lrange $args $i end]
  45.  
  46.     # Process context.
  47.     #
  48.     eval [[ClientContext::global] getCustomFileContents printbox tcl tcl]
  49.     if {![info exists options(configVersion)]} {
  50.         error "exportDiagram needs -configVersion <configVersion>"
  51.     }
  52.     if {![info exists options(systemVersion)]} {
  53.         error "exportDiagram needs -systemVersion <systemVersion>"
  54.     }
  55.  
  56.     # Configure Printer.
  57.     #
  58.     set printer [Printer new]
  59.     if [info exists options(pageWidth)] {
  60.         $printer pageWidth $options(pageWidth)
  61.     }
  62.     if [info exists options(pageHeight)] {
  63.         $printer pageHeight $options(pageHeight)
  64.     }
  65.     if [info exists options(printer)] {
  66.         $printer id $options(printer)
  67.     }
  68.     if [info exists options(title)] {
  69.         set title $options(title)
  70.     } else {
  71.         set diag [lindex $diagrams 0]
  72.         set file [$diag file]
  73.         set title "[$file qualifiedName :].[$file type]"
  74.     }
  75.  
  76.     # Open printer.
  77.     #
  78.     if [info exists options(file)] {
  79.         if [catch {$printer openFile $title $options(file)} msg] {
  80.             wmtkerror $msg
  81.             return
  82.         }
  83.     } else {
  84.         if [catch {$printer openPrinter $title} msg] {
  85.             wmtkerror $msg
  86.             return
  87.         }
  88.     }
  89.  
  90.     # Print each diagram in the list.
  91.     #
  92.     foreach diag $diagrams {
  93.         set file [$diag file]
  94.         set diagName "[$file qualifiedName :].[$file type]"
  95.         wmtkmessage "Printing diagram '$diagName'..."
  96.         set type [string toupper [$file type]]
  97.         set printOut [${type}PrintOut new -diagram $diag \
  98.             -infoBoxSize  [expr {${DiagramPrintOut::offset} + 2}] \
  99.             -infoBoxLocation ${DiagramPrintOut::location} ]
  100.         if {$type == "CAD"} {
  101.             $printOut config \
  102.                 -configVersion $options(configVersion) \
  103.                 -systemVersion $options(systemVersion) \
  104.         }
  105.         Print::setOptions $printOut options
  106.         $printer print $printOut
  107.         $printOut delete
  108.     }
  109.     if [catch {$printer close} msg] {
  110.         wmtkerror $msg
  111.     }
  112.     wmtkmessage "Done"
  113.     $printer delete
  114. }
  115.  
  116. proc Print::printVersionTree {args} {
  117.  
  118.     Print::processOptions options i $args
  119.  
  120.     # Process context.
  121.     #
  122.     eval [[ClientContext::global] getCustomFileContents prtreebox tcl tcl]
  123.  
  124.     # Configure Printer.
  125.     #
  126.     set printer [Printer new]
  127.     if [info exists options(pageWidth)] {
  128.         $printer pageWidth $options(pageWidth)
  129.     }
  130.     if [info exists options(pageHeight)] {
  131.         $printer pageHeight $options(pageHeight)
  132.     }
  133.     if [info exists options(printer)] {
  134.         $printer id $options(printer)
  135.     }
  136.     if [info exists options(title)] {
  137.         set title $options(title)
  138.     } else {
  139.         set title ""
  140.     }
  141.  
  142.     # Open printer.
  143.     #
  144.     if [info exists options(file)] {
  145.         if [catch {$printer openFile $title $options(file)} msg] {
  146.             wmtkerror $msg
  147.             return
  148.         }
  149.     } else {
  150.         if [catch {$printer openPrinter $title} msg] {
  151.             wmtkerror $msg
  152.             return
  153.         }
  154.     }
  155.  
  156.     wmtkmessage "Printing version tree..."
  157.     set printOut [TreePrintOut new [.main infoView]]
  158.  
  159.     $printOut infoBoxSize  [expr {${TreePrintOut::offset} + 2}]
  160.     $printOut infoBoxLocation ${TreePrintOut::location}
  161.  
  162.     if [info exists options(doPrintBox)] {
  163.         $printOut doInfoBox $options(doPrintBox)
  164.     }
  165.     if [info exists options(title)] {
  166.         $printOut title $options(title)
  167.     }
  168.     if [info exists options(scale)] {
  169.         $printOut scale $options(scale)
  170.     }
  171.     if [info exists options(autoScale)] {
  172.         $printOut autoScale $options(autoScale)
  173.     }
  174.     if [info exists options(orientation)] {
  175.         $printOut landscape [expr {$options(orientation) == "landscape"}]
  176.     }
  177.     if [info exists options(horNumPages)] {
  178.         $printOut horNumPages $options(horNumPages)
  179.     }
  180.     if [info exists options(verNumPages)] {
  181.         $printOut verNumPages $options(verNumPages)
  182.     }
  183.  
  184.     $printer print $printOut
  185.     $printOut delete
  186.  
  187.     if [catch {$printer close} msg] {
  188.         wmtkerror $msg
  189.     }
  190.     wmtkmessage "Done"
  191.     $printer delete
  192. }
  193.  
  194. # Export a diagram to a file in a certain format.
  195. #
  196. proc Print::exportDiagram {args} {
  197.     Print::processOptions options i $args
  198.  
  199.     set diag [lrange $args $i end]
  200.     set file [$diag file]
  201.     set diagName "[$file qualifiedName :].[$file type]"
  202.     wmtkmessage "Exporting diagram '$diagName'..."
  203.  
  204.     # Process context.
  205.     #
  206.     if {![info exists options(configVersion)]} {
  207.         error "exportDiagram needs -configVersion <configVersion>"
  208.     }
  209.     if {![info exists options(systemVersion)]} {
  210.         error "exportDiagram needs -systemVersion <systemVersion>"
  211.     }
  212.  
  213.     # Configure Printer.
  214.     #
  215.     set printer [Printer new]
  216.     if [info exists options(pageWidth)] {
  217.         $printer pageWidth $options(pageWidth)
  218.     }
  219.     if [info exists options(pageHeight)] {
  220.         $printer pageHeight $options(pageHeight)
  221.     }
  222.     if [info exists options(printer)] {
  223.         $printer id $options(printer)
  224.     }
  225.     if [info exists options(title)] {
  226.         set title $options(title)
  227.     } else {
  228.         set title $diagName
  229.     }
  230.     if {![info exists options(file)]} {
  231.         error "exportDiagram needs -file option"
  232.     }
  233.     set file $options(file)
  234.     if {![info exists options(type)]} {
  235.         error "exportDiagram needs -type option"
  236.     }
  237.     set exportType $options(type)
  238.  
  239.     # Export the diagram.
  240.     #
  241.     set type [string toupper [[$diag file] type]]
  242.     set printOut [${type}PrintOut new -diagram $diag]
  243.     if {$type == "CAD"} {
  244.         $printOut config \
  245.             -configVersion $options(configVersion) \
  246.             -systemVersion $options(systemVersion) \
  247.     }
  248.     Print::setOptions $printOut options
  249.     # Export is always without info box, single page, auto-scale.
  250.     $printOut doInfoBox 0
  251.     $printOut horNumPages 1
  252.     $printOut verNumPages 1
  253.     $printOut autoScale 1
  254.  
  255.     if [catch {
  256.         $printer printEncapsulated $printOut $title $file $exportType
  257.     } msg] {
  258.         wmtkerror $msg
  259.     }
  260.     $printer delete
  261.     wmtkmessage "Done"
  262. }
  263.  
  264. proc Print::processOptions {options_array index argv} {
  265.     upvar $options_array options
  266.     upvar $index i
  267.     foreach opt ${Print::options} {
  268.         set $opt ""
  269.         set isOpt($opt) 1
  270.     }
  271.     set argc [llength $argv]
  272.     for {set i 0} {$i < $argc} {incr i} {
  273.         set arg [lindex $argv $i]
  274.         if {[string range $arg 0 0] != "-"} {
  275.             break
  276.         }
  277.         set opt [string range $arg 1 end]
  278.         if {![info exists isOpt($opt)]} {
  279.             error "unknown option $arg"
  280.         }
  281.         incr i
  282.         set options($opt) [lindex $argv $i]
  283.     }
  284. }
  285.  
  286.  
  287. # Set print options in $printOut. Command line options in 'options_array'
  288. # override options saved in the diagram, which override the defaults.
  289. #
  290. proc Print::setOptions {printOut options_array} {
  291.     upvar $options_array options
  292.     set diag [$printOut diagram]
  293.     set props [PIPropInfo new]
  294.     $props load $diag
  295.     if [info exists options(doPrintBox)] {
  296.         $printOut doInfoBox $options(doPrintBox)
  297.     } else {
  298.         set doInfoBox [$props getProperty M4_print_box]
  299.         if {$doInfoBox != ""} {
  300.             $printOut doInfoBox $doInfoBox
  301.         }
  302.     }
  303.     if [info exists options(title)] {
  304.         $printOut title $options(title)
  305.     } else {
  306.         set title [$props getProperty M4_ps_title]
  307.         if {$title != ""} {
  308.             $printOut title $title
  309.         }
  310.     }
  311.     if [info exists options(scale)] {
  312.         $printOut scale $options(scale)
  313.     } else {
  314.         set scale [$props getProperty M4_ps_scale]
  315.         if {$scale != ""} {
  316.             $printOut scale $scale
  317.         }
  318.     }
  319.     if [info exists options(autoScale)] {
  320.         $printOut autoScale $options(autoScale)
  321.     } else {
  322.         set autoScale [$props getProperty M4_ps_auto_scale]
  323.         if {$autoScale != ""} {
  324.             $printOut autoScale $autoScale
  325.         }
  326.     }
  327.     if [info exists options(orientation)] {
  328.         $printOut landscape [expr {$options(orientation) == "landscape"}]
  329.     } else {
  330.         set landscape [$props getProperty M4_ps_mode]
  331.         if {$landscape != ""} {
  332.             $printOut landscape [expr {$landscape == "landscape"}]
  333.         }
  334.     }
  335.     if [info exists options(horNumPages)] {
  336.         $printOut horNumPages $options(horNumPages)
  337.     } else {
  338.         set horNumPages [$props getProperty M4_ps_columns]
  339.         if {$horNumPages != ""} {
  340.             $printOut horNumPages $horNumPages
  341.         }
  342.     }
  343.     if [info exists options(verNumPages)] {
  344.         $printOut verNumPages $options(verNumPages)
  345.     } else {
  346.         set verNumPages [$props getProperty M4_ps_rows]
  347.         if {$verNumPages != ""} {
  348.             $printOut verNumPages $verNumPages
  349.         }
  350.     }
  351.     $props delete
  352. }
  353.  
  354. # Do not delete this line -- regeneration end marker
  355.  
  356.