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
132
133
134
135
136
|
############################################################################
#
# File: pscript.icn
#
# Subject: Procedure for explicitly writing PostScript
#
# Author: Gregg M. Townsend
#
# Date: February 21, 2003
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# This file contains procedures for writing PostScript output explicitly,
# as contrasted with the procedures in psrecord.icn that write PostScript
# as a side effect of normal graphics calls.
#
# epsheader(f, x, y, w, h, flags) writes an Encapsulated PostScript
# file header and initializes the PostScript coordinate system.
#
# psprotect(s) adds escapes to protect characters that are special in
# PostScript strings, notably parentheses and backslash.
#
############################################################################
#
# epsheader(f, x, y, w, h, flags) aids the creation of an Encapsulated
# PostScript file by writing a header. An EPS file can either be
# incorporated as part of a larger document or sent directly to a
# PostScript printer.
#
# Epsheader() writes the first portion of the PostScript output to file
# f; the calling program then generates the rest. It is the caller's
# responsibility to ensure that the rest of the file conforms to the
# requirements for EPS files as documented in the PostScript Reference
# Manual, second edition.
#
# (x,y,w,h) specify the range of coordinates that are to be used in the
# generated PostScript code. Epsheader() generates PostScript commands
# that center this region on the page and clip anything outside it.
#
# If the flags string contains the letter "r" and abs(w) > abs(h), the
# coordinate system is rotated to place the region in "landscape" mode.
#
# The generated header also defines an "inch" operator that can be used
# for absolute measurements as shown in the example below.
#
# Usage example:
#
# f := open(filename, "w") | stop("can't open ", filename)
# epsheader(f, x, y, w, h)
# write(f, ".07 inch setlinewidth")
# write(f, x1, " ", y1, " moveto ", x2, " ", y2, " lineto stroke")
# ...
# write(f, "showpage")
#
############################################################################
#
# psprotect(s) adds a backslash character before each parenthesis or
# backslash in s. These characters are special in PostScript strings.
# The characters \n \r \t \b \f are also replaced by escape sequences,
# for readability, although this is not required by PostScript.
#
############################################################################
$define PSPoint 72 # PostScript points per inch
# 8.5x11" paper size parameters -- change these to use A4 or something else
$define PageWidth 8.5
$define PageHeight 11.0
$define HorzMargin 0.75
$define VertMargin 1.0
procedure epsheader(f, x, y, w, h, flags) #: write PostScript header
local xctr, yctr, xsize, ysize, xscale, yscale, dx, dy
if w < 0 then
x -:= (w := -w)
if h < 0 then
y -:= (h := -h)
xctr := integer(PSPoint * PageWidth / 2) # PS center coordinates
yctr := integer(PSPoint * PageHeight / 2)
xsize := PSPoint * (PageWidth - HorzMargin) # usable width
ysize := PSPoint * (PageHeight - VertMargin) # usable height
if w > h & upto('r', \flags) then
xsize :=: ysize
xscale := xsize / w
yscale := ysize / h
xscale >:= yscale
yscale >:= xscale
dx := integer(xscale * w / 2 + 0.99999)
dy := integer(yscale * h / 2 + 0.99999)
if xsize > ysize then
dx :=: dy
write(f, "%!PS-Adobe-3.0 EPSF-3.0")
write(f, "%%BoundingBox: ",
xctr - dx, " ", yctr - dy, " ", xctr + dx, " ", yctr + dy)
write(f, "%%Creator: ", &progname)
write(f, "%%CreationDate: ", &dateline)
write(f, "%%EndComments")
write(f)
write(f, xctr, " ", yctr, " translate")
if xsize > ysize then
write(f, "90 rotate \n", -dy, " ", -dx, " translate")
else
write(f, -dx, " ", -dy, " translate")
write(f, xscale, " ", yscale, " scale")
write(f, -x, " ", -y, " translate")
write(f, x, " ", y, " moveto ", x, " ", y + h, " lineto ",
x + w, " ", y + h, " lineto ", x + w, " ", y, " lineto ")
write(f, "closepath clip newpath")
write(f, "/inch { ", 72 / xscale, " mul } bind def")
write(f, "1 72 div inch setlinewidth")
write(f)
return
end
procedure psprotect(s) #: escape special PostScript characters
local t
s ? {
t := ""
while t ||:= tab(upto('()\\\n\r\t\b\f')) do {
t ||:= "\\"
t ||:= map(move(1), "()\\\n\r\t\b\f", "()\\nrtbf")
}
return t ||:= tab(0)
}
end
|
