diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/mkpsenc.tcl | 191 |
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 {} { |