# Creates Postscript encoding vector for given encoding
proc ::tk::CreatePostscriptEncoding {encoding} {
# now check for known. Even if it is known, it can be other
# than we need. GhostScript seems to be happy with such approach
set result
"/CurrentEncoding \[\n"
for {set i
0} {$i<256} {incr i
8} {
for {set j
0} {$j<8} {incr j
} {
set enc
[encoding convertfrom
$encoding [format %c
[expr {$i+$j}]]]
if {[catch {format %04X
[scan $enc %c
]} hexcode
]} {set hexcode
{}}
if [info exists
::tk::psglyphs($hexcode)] {
append result
"/$::tk::psglyphs($hexcode)"
# List of adobe glyph names. Converted from glyphlist.txt, downloaded
03B0 upsilondieresistonos
# precalculate entire prolog when this file is loaded
set ps_preamable
"%%BeginProlog\n"
append ps_preamable
[CreatePostscriptEncoding
[encoding system
]]
% This is a standard prolog
for Postscript generated by Tk's
canvas
% RCS
: @(#) $Id: mkpsenc.tcl,v 1.3 2002/07/19 14:37:21 drh Exp $
% The definitions below just define all of the variables used in
% any of the procedures here. This is needed
for obscure reasons
% explained on p.
716 of the Postscript manual
(Section H
.2.7,
% "Initializing Variables," in the section on Encapsulated Postscript
).
currentfont
/Encoding get exch
1 exch put
(\001) stringwidth
exch
3 1 roll add
3 1 roll add exch
% This procedure changes the
encoding of a
font from the
default
% Postscript
encoding to current system
encoding. It's typically invoked just
% before invoking
"setfont". The body of this procedure comes from
% Section
5.6.1 of the Postscript book.
{1 index
/FID ne
{def
} {pop pop
} ifelse
} forall
/Encoding CurrentEncoding def
% I'm not sure why it's necessary to use
"definefont" on this new
% font, but it seems to be important
; just use the name
"Temporary"
/Temporary exch definefont
% This procedure converts the current path into a clip area under
% the assumption of stroking. It's a bit tricky because some Postscript
% interpreters get errors during strokepath
for dashed lines. If
% this happens then turn off dashes and try again.
(This Postscript printer
gets limitcheck overflows when
) =
(stippling dashed lines
; lines will be printed solid instead.
) =
[] 0 setdash strokepath
} if
% desiredSize EvenPixels closestSize
% The procedure below is used
for stippling. Given the optimal size
% of a dot in a stipple pattern in the current user coordinate system
,
% compute the closest size that is an exact multiple of the device's
% pixel size. This allows stipple patterns to be displayed without
% Compute exact number of device pixels per stipple dot.
dup
0 matrix currentmatrix dtransform
dup mul exch dup mul add sqrt
% Round to an integer
, make sure the number is at least
1, and compute
% user coord distance corresponding to this.
dup round dup
1 lt
{pop
1} if
% width height
string StippleFill
--
% Given a path already
set up and a clipping region generated from
% it
, this procedure will fill the clipping region with a stipple
% pattern.
"String" contains a proper
image description of the
% stipple pattern and
"width" and
"height" give its dimensions. Each
% stipple dot is assumed to be about one unit across in the current
% user coordinate system. This procedure trashes the graphics state.
% The following code is needed to work around a NeWSprint bug.
% Change the scaling so that one user unit in user coordinates
% corresponds to the size of one stipple dot.
% Compute the bounding box occupied by the path
(which is now
% the clipping region
), and round the
lower coordinates down
% to the nearest starting point
for the stipple pattern. Be
% careful about negative numbers
, since the rounding works
5 index div dup
0 lt
{1 sub
} if cvi
5 index mul
4 1 roll
6 index div dup
0 lt
{1 sub
} if cvi
6 index mul
3 2 roll
% Stack now
: width height
string y1 y2 x1 x2
% Below is a doubly-nested
for loop to iterate across this area
% in units of the stipple pattern size
, going up columns then
% across rows
, blasting out a stipple-pattern-sized rectangle at
2 index
5 index
3 index
{
% Stack now
: width height
string y1 y2 x y
5 index
5 index true matrix tmpstip imagemask
% Given a color value already
set for output by the caller
, adjusts
% that value to a grayscale or mono value
if requested by the CL
% x y strings spacing xoffset yoffset justify stipple DrawText
--
% This procedure does all of the real work of drawing
text. The
% color and
font must already have been
set by the caller
, and the
% following arguments must be on the stack
:
% x
, y
- Coordinates at which to draw
text.
% strings
- An
array of strings
, one
for each line of the
text item
,
% in order from top to bottom.
% spacing
- Spacing between lines.
% xoffset
- Horizontal offset
for text bbox relative to x and y
: 0 for
% nw
/w
/sw anchor
, -0.5
for n
/center
/s
, and
-1.0
for ne
/e
/se.
% yoffset
- Vertical offset
for text bbox relative to x and y
: 0 for
% nw
/n
/ne anchor
, +0.5 for w
/center
/e
, and
+1.0 for sw
/s
/se.
% justify
- 0 for left justification
, 0.5 for center
, 1 for right justify.
% stipple
- Boolean value indicating whether or not
text is to be
% drawn in stippled fashion. If
text is stippled
,
% procedure StippleText must have been defined to call
% StippleFill in the right way.
% Also
, when this procedure is invoked
, the color and
font must already
% have been
set for the
text.
% First
scan through all of the
text to find the widest line.
dup lineLength gt
{/lineLength exch def
} {pop
} ifelse
% Compute the baseline offset and the actual
font height.
0 0 moveto
(TXygqPZ
) false charpath
pathbbox dup
/baseline exch def
exch pop exch sub
/height exch def pop
% Translate coordinates first so that the origin is at the upper-left
% corner of the
text's bounding box. Remember that x and y
for
% positioning are still on the stack.
strings length
1 sub spacing mul height add yoffset mul translate
% Now use the baseline and justification information to translate so
% that the origin is at the baseline and positioning point
for the
justify lineLength mul baseline neg translate
% Iterate over each of the lines to output it. For each line
,
% compute its width again so it can be properly justified
, then
% The
text is stippled
, so turn it into a path and print
% by calling StippledText
, which in turn calls StippleFill.
% Unfortunately
, many Postscript interpreters will get
% overflow errors
if we try to do the whole
string at
% once
, so do it a character at a
time.
dup type
/stringtype eq
{
% This segment is a
string.
char true charpath clip StippleText
char stringwidth translate
% This segment is glyph name
currentfont
/Encoding get exch
1 exch put
gsave
(\001) true charpath clip StippleText
(\001) stringwidth translate
proc tk::ensure_psenc_is_loaded {} {