summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-01-03 16:24:11 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-01-03 16:24:11 (GMT)
commit497b85748d56fb3aa77b7f62ea9eaf98d49f6e22 (patch)
treeda5c9fd647a371b5d775043a16d581a195e74f82 /library
parentbcf3d9f03773bc0637c730660eb32b008a923422 (diff)
downloadtk-497b85748d56fb3aa77b7f62ea9eaf98d49f6e22.zip
tk-497b85748d56fb3aa77b7f62ea9eaf98d49f6e22.tar.gz
tk-497b85748d56fb3aa77b7f62ea9eaf98d49f6e22.tar.bz2
Simplify the postscript generation.
Diffstat (limited to 'library')
-rw-r--r--library/mkpsenc.tcl191
1 files changed, 99 insertions, 92 deletions
diff --git a/library/mkpsenc.tcl b/library/mkpsenc.tcl
index 07c5217..e3c5f46 100644
--- a/library/mkpsenc.tcl
+++ b/library/mkpsenc.tcl
@@ -3,17 +3,19 @@
# This file generates the postscript prolog used by Tk.
namespace eval ::tk {
- # Creates Postscript encoding vector for given encoding
+ # Creates Postscript encoding vector for ISO-8859-1 (could theoretically
+ # handle any 8-bit encoding, but Tk never generates characters outside
+ # ASCII).
#
- proc CreatePostscriptEncoding {encoding} {
+ proc CreatePostscriptEncoding {} {
variable psglyphs
# 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"
+ set result "\[\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}]]]
+ set enc [encoding convertfrom "iso8859-1" \
+ [format %c [expr {$i+$j}]]]
catch {
set hexcode {}
set hexcode [format %04X [scan $enc %c]]
@@ -26,7 +28,7 @@ namespace eval ::tk {
}
append result "\n"
}
- append result "\] def\n"
+ append result "\]"
return $result
}
@@ -1088,64 +1090,69 @@ namespace eval ::tk {
FB4B afii57700
}
- proc ps_literal {string} {
- variable ps_preamable ;# sic
- foreach line [split $string \n] {
- set line [string trim $line]
- if {$line eq ""} continue
- append ps_preamable $line \n
+ variable ps_preamble {}
+
+ namespace eval ps {
+ namespace ensemble create
+ namespace export {[a-z]*}
+ proc literal {string} {
+ upvar 0 ::tk::ps_preamble preamble
+ foreach line [split $string \n] {
+ set line [string trim $line]
+ if {$line eq ""} continue
+ append preamble $line \n
+ }
+ return
}
- return
- }
- proc ps_variable {name value} {
- variable ps_preamable
- append ps_preamable "/$name $value def\n"
- return
- }
- proc ps_function {name body} {
- variable ps_preamable
- append ps_preamable "/$name \{"
- foreach line [split $body \n] {
- set line [string trim $line]
- # Strip blank lines and comments from the bodies of functions
- if {$line eq "" } continue
- if {[string match {[%#]*} $line]} continue
- append ps_preamable $line " "
+ proc variable {name value} {
+ upvar 0 ::tk::ps_preamble preamble
+ append preamble "/$name $value def\n"
+ return
+ }
+ proc function {name body} {
+ upvar 0 ::tk::ps_preamble preamble
+ append preamble "/$name \{"
+ foreach line [split $body \n] {
+ set line [string trim $line]
+ # Strip blank lines and comments from the bodies of functions
+ if {$line eq "" } continue
+ if {[string match {[%#]*} $line]} continue
+ append preamble $line " "
+ }
+ append preamble "\} bind def\n"
+ return
}
- append ps_preamable "\} bind def\n"
- return
}
- # Precalculate entire prolog when this file is loaded (to speed things up)
- ps_literal {
+ ps literal {
%%BeginProlog
% This is a standard prolog for Postscript generated by Tk's canvas
% widget.
- % RCS: @(#) $Id: mkpsenc.tcl,v 1.6 2009/05/01 15:21:02 dkf Exp $
+ % RCS: @(#) $Id: mkpsenc.tcl,v 1.7 2010/01/03 16:24:13 dkf Exp $
}
- ps_literal [CreatePostscriptEncoding [encoding system]]
- ps_literal {50 dict begin}
+ ps variable CurrentEncoding [CreatePostscriptEncoding]
+ ps literal {50 dict begin}
# 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).
- ps_variable baseline 0
- ps_variable stipimage 0
- ps_variable height 0
- ps_variable justify 0
- ps_variable lineLength 0
- ps_variable spacing 0
- ps_variable stipple 0
- ps_variable strings 0
- ps_variable xoffset 0
- ps_variable yoffset 0
- ps_variable tmpstip null
- ps_variable baselineSampler "( TXygqPZ)"
+ # 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).
+ ps variable baseline 0
+ ps variable stipimage 0
+ ps variable height 0
+ ps variable justify 0
+ ps variable lineLength 0
+ ps variable spacing 0
+ ps variable stipple 0
+ ps variable strings 0
+ ps variable xoffset 0
+ ps variable yoffset 0
+ ps variable tmpstip null
+ ps variable baselineSampler "( TXygqPZ)"
# Put an extra-tall character in; done this way to avoid encoding trouble
- ps_literal {baselineSampler 0 196 put}
+ ps literal {baselineSampler 0 196 put}
- ps_function cstringshow {
+ ps function cstringshow {
{
dup type /stringtype eq
{ show } { glyphshow }
@@ -1153,12 +1160,13 @@ namespace eval ::tk {
} forall
}
- ps_function cstringwidth {
+ ps function cstringwidth {
0 exch 0 exch
{
dup type /stringtype eq
{ stringwidth } {
- currentfont /Encoding get exch 1 exch put (\001) stringwidth
+ currentfont /Encoding get exch 1 exch put (\001)
+ stringwidth
}
ifelse
exch 3 1 roll add 3 1 roll add exch
@@ -1166,11 +1174,12 @@ namespace eval ::tk {
}
# font ISOEncode font
+ #
# 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.
- ps_function ISOEncode {
+ ps function ISOEncode {
dup length dict begin
{1 index /FID ne {def} {pop pop} ifelse} forall
/Encoding CurrentEncoding def
@@ -1188,7 +1197,7 @@ namespace eval ::tk {
# 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.
- ps_function StrokeClip {
+ ps function StrokeClip {
{strokepath} stopped {
(This Postscript printer gets limitcheck overflows when) =
(stippling dashed lines; lines will be printed solid instead.) =
@@ -1200,14 +1209,15 @@ namespace eval ::tk {
#
# 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 aliasing effects.
- ps_function EvenPixels {
+ # the closest size that is an exact multiple of the device's pixel
+ # size. This allows stipple patterns to be displayed without aliasing
+ # effects.
+ ps function EvenPixels {
% 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.
+ % 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
exch div mul
}
@@ -1220,7 +1230,7 @@ namespace eval ::tk {
# "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.
- ps_function StippleFill {
+ ps function StippleFill {
% The following code is needed to work around a NeWSprint bug.
/tmpstip 1 index def
% Change the scaling so that one user unit in user coordinates
@@ -1256,7 +1266,7 @@ namespace eval ::tk {
#
# 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 variable.
- ps_function AdjustColor {
+ ps function AdjustColor {
CL 2 lt {
currentgray
CL 0 eq {
@@ -1273,21 +1283,21 @@ namespace eval ::tk {
# 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
+ # 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
+ # 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
+ # 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
+ # 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, function 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.
- ps_function DrawText {
+ ps function DrawText {
/stipple exch def
/justify exch def
/yoffset exch def
@@ -1306,16 +1316,17 @@ namespace eval ::tk {
pathbbox dup /baseline exch def
exch pop exch sub /height exch def pop
newpath
- % Translate and rotate coordinates first so that the origin is at the
- % upper-left corner of the text's bounding box. Remember that angle
- % for rotating, and x and y for positioning are still on the stack.
+ % Translate and rotate coordinates first so that the origin is at
+ % the upper-left corner of the text's bounding box. Remember that
+ % angle for rotating, and x and y for positioning are still on the
+ % stack.
translate
rotate
lineLength xoffset mul
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
- % first line of text.
+ % Now use the baseline and justification information to translate
+ % so that the origin is at the baseline and positioning point for
+ % the first line of text.
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
@@ -1325,10 +1336,10 @@ namespace eval ::tk {
justify neg mul 0 moveto
stipple {
% 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.
+ % 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.
gsave
/char (X) def
{
@@ -1360,13 +1371,13 @@ namespace eval ::tk {
} forall
}
- # Define the "TkPhoto" function variants, which are modified versions of
- # the original "transparentimage" function posted by ian@five-d.com (Ian
- # Kemmish) to comp.lang.postscript. For a monochrome colorLevel this is a
- # slightly different version that uses the imagemask command instead of
- # image.
+ # Define the "TkPhoto" function variants, which are modified versions
+ # of the original "transparentimage" function posted by ian@five-d.com
+ # (Ian Kemmish) to comp.lang.postscript. For a monochrome colorLevel
+ # this is a slightly different version that uses the imagemask command
+ # instead of image.
- ps_function TkPhotoColor {
+ ps function TkPhotoColor {
gsave
32 dict begin
/tinteger exch def
@@ -1433,7 +1444,7 @@ namespace eval ::tk {
end
grestore
}
- ps_function TkPhotoMono {
+ ps function TkPhotoMono {
gsave
32 dict begin
/dummyInteger exch def
@@ -1471,11 +1482,7 @@ namespace eval ::tk {
grestore
}
- ps_literal %%EndProlog
-
- rename ps_function {}
- rename ps_literal {}
- rename ps_variable {}
+ ps literal %%EndProlog
}
proc tk::ensure_psenc_is_loaded {} {