diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/mkpsenc.tcl | 113 |
1 files changed, 112 insertions, 1 deletions
diff --git a/library/mkpsenc.tcl b/library/mkpsenc.tcl index 7f82182..dea846b 100644 --- a/library/mkpsenc.tcl +++ b/library/mkpsenc.tcl @@ -1121,7 +1121,7 @@ namespace eval ::tk { %%BeginProlog % This is a standard prolog for Postscript generated by Tk's canvas % widget. - % RCS: @(#) $Id: mkpsenc.tcl,v 1.4 2008/12/05 10:27:50 dkf Exp $ + % RCS: @(#) $Id: mkpsenc.tcl,v 1.5 2009/05/01 15:03:17 dkf Exp $ } ps_literal [CreatePostscriptEncoding [encoding system]] ps_literal {50 dict begin} @@ -1360,6 +1360,117 @@ 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. + + ps_function TkPhotoColor { + 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 + } + ps_function TkPhotoMono { + gsave + 32 dict begin + /dummyInteger exch def + /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 + /pix w 7 add 8 idiv string 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 + 0.000 0.000 0.000 setrgbcolor + olddict /DataSource get pix readstring pop pop + newdict /DataSource pix put + newdict imagemask + 1.000 1.000 1.000 setrgbcolor + olddict /DataSource get pix readstring pop pop + newdict /DataSource pix put + newdict imagemask + } for + end + grestore + } + ps_literal %%EndProlog rename ps_function {} |