Simplify the postscript generation.

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 {} {