3 # Creates Postscript encoding vector for given encoding
6 proc ::tk::CreatePostscriptEncoding {encoding} {
7 # now check for known. Even if it is known, it can be other
8 # than we need. GhostScript seems to be happy with such approach
9 set result
"/CurrentEncoding \[\n"
10 for {set i
0} {$i<256} {incr i
8} {
11 for {set j
0} {$j<8} {incr j
} {
12 set enc
[encoding convertfrom
$encoding [format %c
[expr {$i+$j}]]]
13 if {[catch {format %04X
[scan $enc %c
]} hexcode
]} {set hexcode
{}}
14 if [info exists
::tk::psglyphs($hexcode)] {
15 append result
"/$::tk::psglyphs($hexcode)"
17 append result
"/space"
22 append result
"\] def\n"
26 # List of adobe glyph names. Converted from glyphlist.txt, downloaded
393 0390 iotadieresistonos
424 03B0 upsilondieresistonos
727 207D parenleftsuperior
728 207E parenrightsuperior
740 208D parenleftinferior
741 208E parenrightinferior
933 F6DE threequartersemdash
959 F6F8 Hungarumlautsmall
1008 F7A1 exclamdownsmall
1014 F7BF questiondownsmall
1017 F7E2 Acircumflexsmall
1025 F7EA Ecircumflexsmall
1029 F7EE Icircumflexsmall
1035 F7F4 Ocircumflexsmall
1041 F7FB Ucircumflexsmall
1084 # precalculate entire prolog when this file is loaded
1085 # (to speed things up)
1086 set ps_preamable
"%%BeginProlog\n"
1087 append ps_preamable
[CreatePostscriptEncoding
[encoding system
]]
1088 append ps_preamable
{
1090 % This is a standard prolog
for Postscript generated by Tk's
canvas
1093 % The definitions below just define all of the variables used in
1094 % any of the procedures here. This is needed
for obscure reasons
1095 % explained on p.
716 of the Postscript manual
(Section H
.2.7,
1096 % "Initializing Variables," in the section on Encapsulated Postscript
).
1113 dup type
/stringtype eq
1114 { show
} { glyphshow
}
1125 dup type
/stringtype eq
1127 currentfont
/Encoding get exch
1 exch put
(\001) stringwidth
1130 exch
3 1 roll add
3 1 roll add exch
1135 % font ISOEncode
font
1136 % This procedure changes the
encoding of a
font from the
default
1137 % Postscript
encoding to current system
encoding. It's typically invoked just
1138 % before invoking
"setfont". The body of this procedure comes from
1139 % Section
5.6.1 of the Postscript book.
1142 dup length dict begin
1143 {1 index
/FID ne
{def
} {pop pop
} ifelse
} forall
1144 /Encoding CurrentEncoding def
1148 % I'm not sure why it's necessary to use
"definefont" on this new
1149 % font, but it seems to be important
; just use the name
"Temporary"
1152 /Temporary exch definefont
1157 % This procedure converts the current path into a clip area under
1158 % the assumption of stroking. It's a bit tricky because some Postscript
1159 % interpreters get errors during strokepath
for dashed lines. If
1160 % this happens then turn off dashes and try again.
1163 {strokepath
} stopped
{
1164 (This Postscript printer
gets limitcheck overflows when
) =
1165 (stippling dashed lines
; lines will be printed solid instead.
) =
1166 [] 0 setdash strokepath
} if
1170 % desiredSize EvenPixels closestSize
1172 % The procedure below is used
for stippling. Given the optimal size
1173 % of a dot in a stipple pattern in the current user coordinate system
,
1174 % compute the closest size that is an exact multiple of the device's
1175 % pixel size. This allows stipple patterns to be displayed without
1179 % Compute exact number of device pixels per stipple dot.
1180 dup
0 matrix currentmatrix dtransform
1181 dup mul exch dup mul add sqrt
1183 % Round to an integer
, make sure the number is at least
1, and compute
1184 % user coord distance corresponding to this.
1185 dup round dup
1 lt
{pop
1} if
1189 % width height
string StippleFill
--
1191 % Given a path already
set up and a clipping region generated from
1192 % it
, this procedure will fill the clipping region with a stipple
1193 % pattern.
"String" contains a proper
image description of the
1194 % stipple pattern and
"width" and
"height" give its dimensions. Each
1195 % stipple dot is assumed to be about one unit across in the current
1196 % user coordinate system. This procedure trashes the graphics state.
1199 % The following code is needed to work around a NeWSprint bug.
1201 /tmpstip
1 index def
1203 % Change the scaling so that one user unit in user coordinates
1204 % corresponds to the size of one stipple dot.
1205 1 EvenPixels dup
scale
1207 % Compute the bounding box occupied by the path
(which is now
1208 % the clipping region
), and round the
lower coordinates down
1209 % to the nearest starting point
for the stipple pattern. Be
1210 % careful about negative numbers
, since the rounding works
1211 % differently on them.
1215 5 index div dup
0 lt
{1 sub
} if cvi
5 index mul
4 1 roll
1216 6 index div dup
0 lt
{1 sub
} if cvi
6 index mul
3 2 roll
1218 % Stack now
: width height
string y1 y2 x1 x2
1219 % Below is a doubly-nested
for loop to iterate across this area
1220 % in units of the stipple pattern size
, going up columns then
1221 % across rows
, blasting out a stipple-pattern-sized rectangle at
1225 2 index
5 index
3 index
{
1226 % Stack now
: width height
string y1 y2 x y
1229 1 index exch translate
1230 5 index
5 index true matrix tmpstip imagemask
1239 % Given a color value already
set for output by the caller
, adjusts
1240 % that value to a grayscale or mono value
if requested by the CL
1247 .5 lt
{0} {1} ifelse
1253 % x y strings spacing xoffset yoffset justify stipple DrawText
--
1254 % This procedure does all of the real work of drawing
text. The
1255 % color and
font must already have been
set by the caller
, and the
1256 % following arguments must be on the stack
:
1258 % x
, y
- Coordinates at which to draw
text.
1259 % strings
- An
array of strings
, one
for each line of the
text item
,
1260 % in order from top to bottom.
1261 % spacing
- Spacing between lines.
1262 % xoffset
- Horizontal offset
for text bbox relative to x and y
: 0 for
1263 % nw
/w
/sw anchor
, -0.5
for n
/center
/s
, and
-1.0
for ne
/e
/se.
1264 % yoffset
- Vertical offset
for text bbox relative to x and y
: 0 for
1265 % nw
/n
/ne anchor
, +0.5 for w
/center
/e
, and
+1.0 for sw
/s
/se.
1266 % justify
- 0 for left justification
, 0.5 for center
, 1 for right justify.
1267 % stipple
- Boolean value indicating whether or not
text is to be
1268 % drawn in stippled fashion. If
text is stippled
,
1269 % procedure StippleText must have been defined to call
1270 % StippleFill in the right way.
1272 % Also
, when this procedure is invoked
, the color and
font must already
1273 % have been
set for the
text.
1283 % First
scan through all of the
text to find the widest line.
1288 dup lineLength gt
{/lineLength exch def
} {pop
} ifelse
1292 % Compute the baseline offset and the actual
font height.
1294 0 0 moveto
(TXygqPZ
) false charpath
1295 pathbbox dup
/baseline exch def
1296 exch pop exch sub
/height exch def pop
1299 % Translate coordinates first so that the origin is at the upper-left
1300 % corner of the
text's bounding box. Remember that x and y
for
1301 % positioning are still on the stack.
1304 lineLength xoffset mul
1305 strings length
1 sub spacing mul height add yoffset mul translate
1307 % Now use the baseline and justification information to translate so
1308 % that the origin is at the baseline and positioning point
for the
1309 % first line of
text.
1311 justify lineLength mul baseline neg translate
1313 % Iterate over each of the lines to output it. For each line
,
1314 % compute its width again so it can be properly justified
, then
1318 dup cstringwidth pop
1319 justify neg mul
0 moveto
1323 % The
text is stippled
, so turn it into a path and print
1324 % by calling StippledText
, which in turn calls StippleFill.
1325 % Unfortunately
, many Postscript interpreters will get
1326 % overflow errors
if we try to do the whole
string at
1327 % once
, so do it a character at a
time.
1332 dup type
/stringtype eq
{
1333 % This segment is a
string.
1335 char
0 3 -1 roll put
1338 char true charpath clip StippleText
1340 char stringwidth translate
1344 % This segment is glyph name
1345 % Temporary override
1346 currentfont
/Encoding get exch
1 exch put
1348 gsave
(\001) true charpath clip StippleText
1350 (\001) stringwidth translate
1355 } {cstringshow
} ifelse
1356 0 spacing neg translate
1365 proc tk::ensure_psenc_is_loaded {} {