home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / print.tcl < prev    next >
Encoding:
Text File  |  1997-01-09  |  7.1 KB  |  279 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Westmount Technology    1994
  4. #
  5. #      File:           @(#)print.tcl    /main/hindenburg/2
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)print.tcl    /main/hindenburg/2   9 Jan 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.  
  117. # Export a diagram to a file in a certain format.
  118. #
  119. proc Print::exportDiagram {args} {
  120.     Print::processOptions options i $args
  121.  
  122.     set diag [lrange $args $i end]
  123.     set file [$diag file]
  124.     set diagName "[$file qualifiedName :].[$file type]"
  125.     wmtkmessage "Exporting diagram '$diagName'..."
  126.  
  127.     # Process context.
  128.     #
  129.     if {![info exists options(configVersion)]} {
  130.         error "exportDiagram needs -configVersion <configVersion>"
  131.     }
  132.     if {![info exists options(systemVersion)]} {
  133.         error "exportDiagram needs -systemVersion <systemVersion>"
  134.     }
  135.  
  136.     # Configure Printer.
  137.     #
  138.     set printer [Printer new]
  139.     if [info exists options(pageWidth)] {
  140.         $printer pageWidth $options(pageWidth)
  141.     }
  142.     if [info exists options(pageHeight)] {
  143.         $printer pageHeight $options(pageHeight)
  144.     }
  145.     if [info exists options(printer)] {
  146.         $printer id $options(printer)
  147.     }
  148.     if [info exists options(title)] {
  149.         set title $options(title)
  150.     } else {
  151.         set title $diagName
  152.     }
  153.     if {![info exists options(file)]} {
  154.         error "exportDiagram needs -file option"
  155.     }
  156.     set file $options(file)
  157.     if {![info exists options(type)]} {
  158.         error "exportDiagram needs -type option"
  159.     }
  160.     set exportType $options(type)
  161.  
  162.     # Export the diagram.
  163.     #
  164.     set type [string toupper [[$diag file] type]]
  165.     set printOut [${type}PrintOut new -diagram $diag]
  166.     if {$type == "CAD"} {
  167.         $printOut config \
  168.             -configVersion $options(configVersion) \
  169.             -systemVersion $options(systemVersion) \
  170.     }
  171.     Print::setOptions $printOut options
  172.     # Export is always without info box, single page, auto-scale.
  173.     $printOut doInfoBox 0
  174.     $printOut horNumPages 1
  175.     $printOut verNumPages 1
  176.     $printOut autoScale 1
  177.  
  178.     if [catch {
  179.         $printer printEncapsulated $printOut $title $file $exportType
  180.     } msg] {
  181.         wmtkerror $msg
  182.     }
  183.     $printer delete
  184.     wmtkmessage "Done"
  185. }
  186.  
  187. proc Print::processOptions {options_array index argv} {
  188.     upvar $options_array options
  189.     upvar $index i
  190.     foreach opt ${Print::options} {
  191.         set $opt ""
  192.         set isOpt($opt) 1
  193.     }
  194.     set argc [llength $argv]
  195.     for {set i 0} {$i < $argc} {incr i} {
  196.         set arg [lindex $argv $i]
  197.         if {[string range $arg 0 0] != "-"} {
  198.             break
  199.         }
  200.         set opt [string range $arg 1 end]
  201.         if {![info exists isOpt($opt)]} {
  202.             error "unknown option $arg"
  203.         }
  204.         incr i
  205.         set options($opt) [lindex $argv $i]
  206.     }
  207. }
  208.  
  209.  
  210. # Set print options in $printOut. Command line options in 'options_array'
  211. # override options saved in the diagram, which override the defaults.
  212. #
  213. proc Print::setOptions {printOut options_array} {
  214.     upvar $options_array options
  215.     set diag [$printOut diagram]
  216.     set props [PIPropInfo new]
  217.     $props load $diag
  218.     if [info exists options(doPrintBox)] {
  219.         $printOut doInfoBox $options(doPrintBox)
  220.     } else {
  221.         set doInfoBox [$props getProperty M4_print_box]
  222.         if {$doInfoBox != ""} {
  223.             $printOut doInfoBox $doInfoBox
  224.         }
  225.     }
  226.     if [info exists options(title)] {
  227.         $printOut title $options(title)
  228.     } else {
  229.         set title [$props getProperty M4_ps_title]
  230.         if {$title != ""} {
  231.             $printOut title $title
  232.         }
  233.     }
  234.     if [info exists options(scale)] {
  235.         $printOut scale $options(scale)
  236.     } else {
  237.         set scale [$props getProperty M4_ps_scale]
  238.         if {$scale != ""} {
  239.             $printOut scale $scale
  240.         }
  241.     }
  242.     if [info exists options(autoScale)] {
  243.         $printOut autoScale $options(autoScale)
  244.     } else {
  245.         set autoScale [$props getProperty M4_ps_auto_scale]
  246.         if {$autoScale != ""} {
  247.             $printOut autoScale $autoScale
  248.         }
  249.     }
  250.     if [info exists options(orientation)] {
  251.         $printOut landscape [expr {$options(orientation) == "landscape"}]
  252.     } else {
  253.         set landscape [$props getProperty M4_ps_mode]
  254.         if {$landscape != ""} {
  255.             $printOut landscape [expr {$landscape == "landscape"}]
  256.         }
  257.     }
  258.     if [info exists options(horNumPages)] {
  259.         $printOut horNumPages $options(horNumPages)
  260.     } else {
  261.         set horNumPages [$props getProperty M4_ps_columns]
  262.         if {$horNumPages != ""} {
  263.             $printOut horNumPages $horNumPages
  264.         }
  265.     }
  266.     if [info exists options(verNumPages)] {
  267.         $printOut verNumPages $options(verNumPages)
  268.     } else {
  269.         set verNumPages [$props getProperty M4_ps_rows]
  270.         if {$verNumPages != ""} {
  271.             $printOut verNumPages $verNumPages
  272.         }
  273.     }
  274.     $props delete
  275. }
  276.  
  277. # Do not delete this line -- regeneration end marker
  278.  
  279.