File: page.tcl

package info (click to toggle)
blt 2.5.3%2Bdfsg-4
  • links: PTS
  • area: main
  • in suites: buster
  • size: 24,864 kB
  • sloc: ansic: 133,724; tcl: 17,680; sh: 2,722; makefile: 799; cpp: 370
file content (131 lines) | stat: -rwxr-xr-x 2,923 bytes parent folder | download | duplicates (5)
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