ALPHALINUX5/util/ALPHALINUX5/lib/blt2.4/demos/page.tcl

   1 #!/home/people/tkys/Eos/util/ALPHALINUX5/bin/bltwish
   2 #!/usr/local/bin/tclsh
   3
   4 array set page "
   5     rows        2
   6     columns     2
   7     padx        0.5
   8     pady        0.5
   9     width       8.5
  10     height      11
  11     gutter      0.25
  12 "
  13
  14 proc Pica { dist } {
  15     expr $dist * 72.0
  16 }
  17
  18 # ------------------------------------------------------------------
  19 #
  20 # TileFiles
  21 #
  22 #       Tiles graph postscript files together in a pre-defined
  23 #       grid.
  24 #
  25 # Arguments:
  26 #       outFile -- Resulting tiled PostScript output file.
  27 #       args    -- Names of input graph PostScript files.
  28 #
  29 # ------------------------------------------------------------------
  30
  31 proc TileFiles { outFile args } {
  32     global page
  33
  34     set row 0
  35     set column 0
  36
  37
  38     set padx [Pica $page(padx)]
  39     set pady [Pica $page(padx)]
  40     set width [Pica $page(width)]
  41     set height [Pica $page(height)]
  42     set gutter [Pica $page(gutter)]
  43
  44     set totalGutters [expr $gutter * ($page(columns) - 1)]
  45     set w [expr $width - (2 * $padx) - $totalGutters]
  46     set totalGutters [expr $gutter * ($page(rows) - 1)]
  47     set h [expr $height - (2 * $pady) - $totalGutters]
  48
  49     set cellWidth  [expr double($w) / $page(columns)]
  50     set cellHeight [expr double($h) / $page(rows)]
  51
  52     set out [open $outFile "w"]
  53
  54     puts $out "%!PS-Adobe-3.0 EPSF-3.0"
  55     puts $out "%%Pages: 1"
  56     puts $out "%%Title: (Graph tiler)"
  57     puts $out "%%DocumentNeededResources: font Helvetica Courier"
  58     puts $out "%%CreationDate: [clock format [clock seconds]]"
  59     puts $out "%%EndComments"
  60
  61     puts $out "/showsheet { showpage } bind def"
  62     puts $out "/showpage { } def"
  63     puts $out "$padx $pady translate"
  64
  65     set first {}
  66     foreach inFile $args {
  67         set in [open $inFile "r"]
  68
  69         # Warning, this is assuming that the BoundingBox is in the first
  70         # twenty lines of the graph's PostScript.
  71
  72         for { set count 0 } { $count < 20 } { incr count } {
  73             gets $in line
  74             if { [string match "%%BoundingBox:*" $line] } {
  75                 set bbox $line
  76                 break;
  77             }
  78             append first "$line\n"
  79             if { [eof $in] } {
  80                 break
  81             }
  82         }
  83         if { ![info exists bbox] } {
  84             error "can't find \"%%BoundingBox:\" line"
  85         }
  86         set n [scan $bbox "%%%%BoundingBox: %d %d %d %d" x1 y1 x2 y2]
  87         if { $n != 4} {
  88             error "Bad bounding box line \"$bbox\""
  89         }
  90
  91         set rest [read $in]
  92         close $in
  93
  94         set x [expr ($cellWidth + $gutter) * $column]
  95         set y [expr ($cellHeight + $gutter) * $row]
  96
  97         set w [expr abs($x2 - $x1)]
  98         set h [expr abs($y2 - $y1)]
  99
 100         set scaleX [expr $cellWidth / $w]
 101         set scaleY [expr $cellHeight / $h]
 102         if { $scaleX > $scaleY } {
 103             set scale $scaleY
 104         } else {
 105             set scale $scaleX
 106         }
 107         puts $out "% "
 108         puts $out "% Tiling \"$inFile\" at ($row,$column)"
 109         puts $out "% "
 110         puts $out "gsave"
 111         puts $out "$x $y translate"
 112         puts $out "$scale $scale scale"
 113         puts $out "-$x1 -$y1 translate"
 114         puts $out $first
 115         puts $out $rest
 116         puts $out "grestore"
 117         incr column
 118         if { $column >= $page(columns) } {
 119             set column 0
 120             incr row
 121         }
 122     }
 123     puts $out "showsheet"
 124     close $out
 125 }
 126
 127 eval TileFiles $argv
 128
 129
 130
 131
 132