Merge commit '5aad878400425d3af44433a47c13824385689e1d' as 'tkimg'

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
new 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