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