diff options
Diffstat (limited to 'tkimg/ps/tests')
-rw-r--r-- | tkimg/ps/tests/all.tcl | 24 | ||||
-rw-r--r-- | tkimg/ps/tests/folder.ps | 137 | ||||
-rw-r--r-- | tkimg/ps/tests/logo.pdf | bin | 0 -> 1154 bytes | |||
-rw-r--r-- | tkimg/ps/tests/test.ps | 426 |
4 files changed, 587 insertions, 0 deletions
diff --git a/tkimg/ps/tests/all.tcl b/tkimg/ps/tests/all.tcl new file mode 100644 index 0000000..672eef7 --- /dev/null +++ b/tkimg/ps/tests/all.tcl @@ -0,0 +1,24 @@ +# all.tcl -- -*- tcl -*- +# +# Import common functionality, then run the tests in this directory. +# +# Copyright (c) 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# +# RCS: @(#) $Id: all.tcl,v 1.1.1.1 2016/01/25 21:20:47 joye Exp $ + +set _pwd [pwd] +cd [file dirname [file join [pwd] [info script]]] +set _here [pwd] +cd $_pwd +source [file join [file dirname [file dirname $_here]] tests all.tcl] +unset _pwd _here + +set ::tcltest::testSingleFile false +set ::tcltest::testsDirectory [file dirname [info script]] + +# We need to ensure that the testsDirectory is absolute +::tcltest::normalizePath ::tcltest::testsDirectory + +run_tests +exit diff --git a/tkimg/ps/tests/folder.ps b/tkimg/ps/tests/folder.ps new file mode 100644 index 0000000..895af4b --- /dev/null +++ b/tkimg/ps/tests/folder.ps @@ -0,0 +1,137 @@ +%!PS-Adobe-3.0 EPSF-3.0 +%%Title: folder.ps +%%Creator: Jan Nijtmans +%%BoundingBox: 0 615 16 627 +%%Pages: 1 +%%DocumentFonts: +%%EndComments +%%EndProlog +%%Page: 1 1 +% remember original state +/origstate save def +% build a temporary dictionary +20 dict begin +% define space for color conversions +/grays 16 string def % space for gray scale line +/npixls 0 def +/rgbindx 0 def +% lower left corner +0 615 translate +% size of image (on paper, in 1/72inch coords) +15.98400 12.02400 scale +% define 'colorimage' if it isn't defined +% ('colortogray' and 'mergeprocs' come from xwd2ps +% via xgrab) +/colorimage where % do we know about 'colorimage'? + { pop } % yes: pop off the 'dict' returned + { % no: define one + /colortogray { % define an RGB->I function + /rgbdata exch store % call input 'rgbdata' + rgbdata length 3 idiv + /npixls exch store + /rgbindx 0 store + 0 1 npixls 1 sub { + grays exch + rgbdata rgbindx get 20 mul % Red + rgbdata rgbindx 1 add get 32 mul % Green + rgbdata rgbindx 2 add get 12 mul % Blue + add add 64 idiv % I = .5G + .31R + .18B + put + /rgbindx rgbindx 3 add store + } for + grays 0 npixls getinterval + } bind def + + % Utility procedure for colorimage operator. + % This procedure takes two procedures off the + % stack and merges them into a single procedure. + + /mergeprocs { % def + dup length + 3 -1 roll + dup + length + dup + 5 1 roll + 3 -1 roll + add + array cvx + dup + 3 -1 roll + 0 exch + putinterval + dup + 4 2 roll + putinterval + } bind def + + /colorimage { % def + pop pop % remove 'false 3' operands + {colortogray} mergeprocs + image + } bind def + } ifelse % end of 'false' case +% define the colormap +/cmap 9 string def +% load up the colormap +currentfile cmap readhexstring +ffffff 000000 f0ff80 +pop pop % lose return values from readhexstring +% rlecmapimage expects to have 'w h bits matrix' on stack +/rlecmapimage { + /buffer 1 string def + /rgbval 3 string def + /block 384 string def + + % proc to read a block from file, and return RGB data + { currentfile buffer readhexstring pop + /bcount exch 0 get store + bcount 128 ge + { % it's a non-run block + 0 1 bcount 128 sub + { currentfile buffer readhexstring pop pop + + % look up value in color map + /rgbval cmap buffer 0 get 3 mul 3 getinterval store + + % and put it in position i*3 in block + block exch 3 mul rgbval putinterval + } for + block 0 bcount 127 sub 3 mul getinterval + } + + { % else it's a run block + currentfile buffer readhexstring pop pop + + % look up value in colormap + /rgbval cmap buffer 0 get 3 mul 3 getinterval store + + 0 1 bcount { block exch 3 mul rgbval putinterval } for + + block 0 bcount 1 add 3 mul getinterval + } ifelse + } % end of proc + false 3 colorimage +} bind def +16 12 8 % dimensions of data +[16 0 0 -12 0 12] % mapping matrix +rlecmapimage +020003010800 +010081010202028101000600 +8200010204028101000500 +0c010200 +81010209028101000100 +81010209028101000100 +81010209028101000100 +81010209028101000100 +81010209028101000100 +81010209028101000100 +81010209028101000100 +0c010200 +% +showpage +% stop using temporary dictionary +end +% restore original state +origstate restore +%%Trailer diff --git a/tkimg/ps/tests/logo.pdf b/tkimg/ps/tests/logo.pdf Binary files differnew file mode 100644 index 0000000..c1533a2 --- /dev/null +++ b/tkimg/ps/tests/logo.pdf diff --git a/tkimg/ps/tests/test.ps b/tkimg/ps/tests/test.ps new file mode 100644 index 0000000..c882478 --- /dev/null +++ b/tkimg/ps/tests/test.ps @@ -0,0 +1,426 @@ +%!PS-Adobe-3.0 EPSF-3.0 +%%Creator: Tk Canvas Widget +%%For: Jan Nijtmans,,,, +%%Title: Window .c +%%CreationDate: Sun Mar 5 10:20:51 2000 +%%BoundingBox: 163 296 450 497 +%%Pages: 1 +%%DocumentData: Clean7Bit +%%Orientation: Portrait +%%EndComments + +%%BeginProlog +50 dict begin + +% This is a standard prolog for Postscript generated by Tk's canvas +% widget. +% RCS: @(#) $Id: test.ps,v 1.1.1.1 2016/01/25 21:20:47 joye 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). + +/baseline 0 def +/stipimage 0 def +/height 0 def +/justify 0 def +/lineLength 0 def +/spacing 0 def +/stipple 0 def +/strings 0 def +/xoffset 0 def +/yoffset 0 def +/tmpstip null def + +% Define the array ISOLatin1Encoding (which specifies how characters are +% encoded for ISO-8859-1 fonts), if it isn't already present (Postscript +% level 2 is supposed to define it, but level 1 doesn't). + +systemdict /ISOLatin1Encoding known not { + /ISOLatin1Encoding [ + /space /space /space /space /space /space /space /space + /space /space /space /space /space /space /space /space + /space /space /space /space /space /space /space /space + /space /space /space /space /space /space /space /space + /space /exclam /quotedbl /numbersign /dollar /percent /ampersand + /quoteright + /parenleft /parenright /asterisk /plus /comma /minus /period /slash + /zero /one /two /three /four /five /six /seven + /eight /nine /colon /semicolon /less /equal /greater /question + /at /A /B /C /D /E /F /G + /H /I /J /K /L /M /N /O + /P /Q /R /S /T /U /V /W + /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore + /quoteleft /a /b /c /d /e /f /g + /h /i /j /k /l /m /n /o + /p /q /r /s /t /u /v /w + /x /y /z /braceleft /bar /braceright /asciitilde /space + /space /space /space /space /space /space /space /space + /space /space /space /space /space /space /space /space + /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent + /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron + /space /exclamdown /cent /sterling /currency /yen /brokenbar /section + /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen + /registered /macron + /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph + /periodcentered + /cedillar /onesuperior /ordmasculine /guillemotright /onequarter + /onehalf /threequarters /questiondown + /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla + /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex + /Idieresis + /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply + /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn + /germandbls + /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla + /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex + /idieresis + /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide + /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn + /ydieresis + ] def +} if + +% font ISOEncode font +% This procedure changes the encoding of a font from the default +% Postscript encoding to ISOLatin1. It's typically invoked just +% before invoking "setfont". The body of this procedure comes from +% Section 5.6.1 of the Postscript book. + +/ISOEncode { + dup length dict begin + {1 index /FID ne {def} {pop pop} ifelse} forall + /Encoding ISOLatin1Encoding def + currentdict + end + + % 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" + % for the font. + + /Temporary exch definefont +} bind def + +% StrokeClip +% +% 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. + +/StrokeClip { + {strokepath} stopped { + (This Postscript printer gets limitcheck overflows when) = + (stippling dashed lines; lines will be printed solid instead.) = + [] 0 setdash strokepath} if + clip +} bind def + +% 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 +% aliasing effects. + +/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. + dup round dup 1 lt {pop 1} if + exch div mul +} bind def + +% 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. + +/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 + % corresponds to the size of one stipple dot. + 1 EvenPixels dup scale + + % 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 + % differently on them. + + pathbbox + 4 2 roll + 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 + % each position + + 6 index exch { + 2 index 5 index 3 index { + % Stack now: width height string y1 y2 x y + + gsave + 1 index exch translate + 5 index 5 index true matrix tmpstip imagemask + grestore + } for + pop + } for + pop pop pop pop pop +} bind def + +% -- AdjustColor -- +% 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. + +/AdjustColor { + CL 2 lt { + currentgray + CL 0 eq { + .5 lt {0} {1} ifelse + } if + setgray + } if +} bind def + +% 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. + +/DrawText { + /stipple exch def + /justify exch def + /yoffset exch def + /xoffset exch def + /spacing exch def + /strings exch def + + % First scan through all of the text to find the widest line. + + /lineLength 0 def + strings { + stringwidth pop + dup lineLength gt {/lineLength exch def} {pop} ifelse + newpath + } forall + + % 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 + newpath + + % 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. + + translate + 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. + + 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 + % display it. + + strings { + dup stringwidth pop + 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. + + gsave + /char (X) def + { + char 0 3 -1 roll put + currentpoint + gsave + char true charpath clip StippleText + grestore + char stringwidth translate + moveto + } forall + grestore + } {show} ifelse + 0 spacing neg translate + } forall +} bind def + +%%EndProlog +%%BeginSetup +/CL 2 def +%%EndSetup + +%%Page: 1 1 +save +306.0 396.0 translate +0.9606 0.9606 scale +-148 -104 translate +0 209 moveto 297 209 lineto 297 0 lineto 0 0 lineto closepath clip newpath +gsave +2 195 translate +/TkPhoto { + gsave + 32 dict begin + /tinteger exch def + /transparent 1 string def + transparent 0 tinteger put + /olddict exch def + olddict /DataSource get dup type /filetype ne { + olddict /DataSource 3 -1 roll + 0 () /SubFileDecode filter put + } { + pop + } ifelse + /newdict olddict maxlength dict def + olddict newdict copy pop + /w newdict /Width get def + /crpp newdict /Decode get length 2 idiv def + /str w string def + /pix w crpp mul string def + /substrlen 2 w log 2 log div floor exp cvi def + /substrs [ + { + substrlen string + 0 1 substrlen 1 sub { + 1 index exch tinteger put + } for + /substrlen substrlen 2 idiv def + substrlen 0 eq {exit} if + } loop + ] def + /h newdict /Height get def + 1 w div 1 h div matrix scale + olddict /ImageMatrix get exch matrix concatmatrix + matrix invertmatrix concat + newdict /Height 1 put + newdict /DataSource pix put + /mat [w 0 0 h 0 0] def + newdict /ImageMatrix mat put + 0 1 h 1 sub { + mat 5 3 -1 roll neg put + olddict /DataSource get str readstring pop pop + /tail str def + /x 0 def + olddict /DataSource get pix readstring pop pop + { + tail transparent search dup /done exch not def + {exch pop exch pop} if + /w1 exch length def + w1 0 ne { + newdict /DataSource pix x crpp mul w1 crpp mul getinterval put + newdict /Width w1 put + mat 4 x neg put + /x x w1 add def + newdict image + /tail tail w1 tail length w1 sub getinterval def + } if + done {exit} if + tail substrs { + anchorsearch {pop} if + } forall + /tail exch def + tail length 0 eq {exit} if + /x w tail length sub def + } loop + } for + end + grestore +} bind def + + + +%%0 -12 translate +gsave +16 12 scale +/DeviceRGB setcolorspace + +<< + /ImageType 1 + /Width 16 + /Height 12 + /BitsPerComponent 8 + /DataSource currentfile /ASCIIHexDecode filter + /ImageMatrix [16 0 0 -12 0 12] + /Decode [0 1 0 1 0 1] +>> +1 TkPhoto +010101FFFFFFFF010101010101010101000000000000000000000000000000 +000000000000000000000000000000000000000000000000000000000000 +0000000101FFFFFFFFFFFF0101010101010101000000000000000000F0FF80 +F0FF80F0FF80F0FF80000000000000000000000000000000000000000000 +00000000000001FFFFFFFFFFFFFFFF01010101010101000000000000F0FF80 +F0FF80F0FF80F0FF80F0FF80F0FF80000000000000000000000000000000 +000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFF010101000000000000 +000000000000000000000000000000000000000000000000000000000000 +000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFF010101000000 +F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80 +F0FF80000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFF0101 +01000000F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80 +F0FF80F0FF80000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFF +FF010101000000F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80 +F0FF80F0FF80F0FF80000000000000000000000000FFFFFFFFFFFFFFFFFF +FFFFFFFF010101000000F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80 +F0FF80F0FF80F0FF80F0FF80000000000000000000000000FFFFFFFFFFFF +FFFFFFFFFFFFFF010101000000F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80 +F0FF80F0FF80F0FF80F0FF80F0FF80000000000000000000000000FFFFFF +FFFFFFFFFFFFFFFFFFFF010101000000F0FF80F0FF80F0FF80F0FF80F0FF80 +F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80000000000000000000000000 +FFFFFFFFFFFFFFFFFFFFFFFFFF010101000000F0FF80F0FF80F0FF80F0FF80 +F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80F0FF80000000000000000000 +000000FFFFFFFFFFFFFFFFFFFFFFFFFF010101000000000000000000000000 +000000000000000000000000000000000000000000000000000000000000 +000000000000> + grestore +grestore +restore showpage + +%%Trailer +end +%%EOF |