From bd2add337bf958877fee3a12ded99b88eb19768c Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 1 May 2009 15:03:17 +0000 Subject: Factor out some of the postscript generation code to the PS prolog. --- ChangeLog | 17 ++-- generic/tkCanvPs.c | 222 ++++++++++++---------------------------------------- library/mkpsenc.tcl | 113 +++++++++++++++++++++++++- 3 files changed, 175 insertions(+), 177 deletions(-) diff --git a/ChangeLog b/ChangeLog index de738ee..5e621eb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,10 +1,17 @@ +2009-05-01 Donal K. Fellows + + * generic/tkCanvPs.c (Tk_PostscriptPhoto): + * library/mkpsenc.tcl: Factor out the postscript code for converting + images into postscript so that the code bits are in the prolog and not + emitted at runtime if a non-thread-safe static says to... + 2009-04-30 Pat Thoyts - * win/tkWinWm.c: [Patch 2504402] Create icon bitmaps as device - independent bitmaps. This ensures the icon can be drawn properly - on various colour depth surfaces - in particular it fixes a - problem with remote desktop and looks better in the vista task - switching overlay. (cjmcdonald) + * win/tkWinWm.c: [Patch 2504402]: Create icon bitmaps as device + independent bitmaps. This ensures the icon can be drawn properly on + various colour depth surfaces - in particular it fixes a problem with + remote desktop and looks better in the vista task switching overlay. + (cjmcdonald) 2009-04-30 Donal K. Fellows diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c index 43fc88a..eaa6c5a 100644 --- a/generic/tkCanvPs.c +++ b/generic/tkCanvPs.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvPs.c,v 1.25 2008/12/07 16:34:12 das Exp $ + * RCS: @(#) $Id: tkCanvPs.c,v 1.26 2009/05/01 15:03:17 dkf Exp $ */ #include "tkInt.h" @@ -73,7 +73,7 @@ typedef struct TkPostscriptInfo { * NULL means return Postscript info as * result. Malloc'ed. */ char *channelName; /* If -channel is specified, the name of the - * channel to use. */ + * channel to use. */ Tcl_Channel chan; /* Open channel corresponding to fileName. */ Tcl_HashTable fontTable; /* Hash table containing names of all font * families used in output. The hash table @@ -192,7 +192,7 @@ TkCanvPostscriptCmd( result = Tcl_EvalEx(interp, psenccmd, -1, TCL_EVAL_GLOBAL); if (result != TCL_OK) { - return result; + return result; } oldInfoPtr = canvasPtr->psInfo; canvasPtr->psInfo = (Tk_PostscriptInfo) psInfoPtr; @@ -316,28 +316,28 @@ TkCanvPostscriptCmd( } if (psInfo.fileName != NULL) { - /* - * Check that -file and -channel are not both specified. - */ - - if (psInfo.channelName != NULL) { - Tcl_AppendResult(interp, "can't specify both -file", - " and -channel", NULL); - result = TCL_ERROR; - goto cleanup; - } - - /* - * Check that we are not in a safe interpreter. If we are, disallow - * the -file specification. - */ - - if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't specify -file in a", - " safe interpreter", NULL); - result = TCL_ERROR; - goto cleanup; - } + /* + * Check that -file and -channel are not both specified. + */ + + if (psInfo.channelName != NULL) { + Tcl_AppendResult(interp, "can't specify both -file", + " and -channel", NULL); + result = TCL_ERROR; + goto cleanup; + } + + /* + * Check that we are not in a safe interpreter. If we are, disallow + * the -file specification. + */ + + if (Tcl_IsSafe(interp)) { + Tcl_AppendResult(interp, "can't specify -file in a", + " safe interpreter", NULL); + result = TCL_ERROR; + goto cleanup; + } p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer); if (p == NULL) { @@ -351,24 +351,24 @@ TkCanvPostscriptCmd( } if (psInfo.channelName != NULL) { - int mode; - - /* - * Check that the channel is found in this interpreter and that it is - * open for writing. - */ - - psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName, &mode); - if (psInfo.chan == (Tcl_Channel) NULL) { - result = TCL_ERROR; - goto cleanup; - } - if ((mode & TCL_WRITABLE) == 0) { - Tcl_AppendResult(interp, "channel \"", psInfo.channelName, + int mode; + + /* + * Check that the channel is found in this interpreter and that it is + * open for writing. + */ + + psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName, &mode); + if (psInfo.chan == (Tcl_Channel) NULL) { + result = TCL_ERROR; + goto cleanup; + } + if ((mode & TCL_WRITABLE) == 0) { + Tcl_AppendResult(interp, "channel \"", psInfo.channelName, "\" wasn't opened for writing", NULL); - result = TCL_ERROR; - goto cleanup; - } + result = TCL_ERROR; + goto cleanup; + } } /* @@ -598,7 +598,7 @@ TkCanvPostscriptCmd( Tcl_Close(interp, psInfo.chan); } if (psInfo.channelName != NULL) { - ckfree(psInfo.channelName); + ckfree(psInfo.channelName); } Tcl_DeleteHashTable(&psInfo.fontTable); canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr; @@ -1429,16 +1429,12 @@ Tk_PostscriptPhoto( { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; int colorLevel = psInfoPtr->colorLevel; - static int codeIncluded = 0; - + const char *displayOperation; unsigned char *pixelPtr; char buffer[256], cspace[40], decode[40]; - int bpc; - int xx, yy, lineLen; + int bpc, xx, yy, lineLen, alpha; float red, green, blue; - int alpha; int bytesPerLine=0, maxWidth=0; - unsigned char opaque = 255; unsigned char *alphaPtr; int alphaOffset, alphaPitch, alphaIncr; @@ -1448,134 +1444,18 @@ Tk_PostscriptPhoto( return TCL_OK; } - /* - * Define the "TkPhoto" function, which is a modified version 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. - */ - - if (!codeIncluded && (colorLevel != 0)) { + if (colorLevel != 0) { /* * Color and gray-scale code. */ - codeIncluded = !0; - Tcl_AppendResult(interp, - "/TkPhoto { \n", - " gsave \n", - " 32 dict begin \n", - " /tinteger exch def \n", - " /transparent 1 string def \n", - " transparent 0 tinteger put \n", - " /olddict exch def \n", - " olddict /DataSource get dup type /filetype ne { \n", - " olddict /DataSource 3 -1 roll \n", - " 0 () /SubFileDecode filter put \n", - " } { \n", - " pop \n", - " } ifelse \n", - " /newdict olddict maxlength dict def \n", - " olddict newdict copy pop \n", - " /w newdict /Width get def \n", - " /crpp newdict /Decode get length 2 idiv def \n", - " /str w string def \n", - " /pix w crpp mul string def \n", - " /substrlen 2 w log 2 log div floor exp cvi def \n", - " /substrs [ \n", - " { \n", - " substrlen string \n", - " 0 1 substrlen 1 sub { \n", - " 1 index exch tinteger put \n", - " } for \n", - " /substrlen substrlen 2 idiv def \n", - " substrlen 0 eq {exit} if \n", - " } loop \n", - " ] def \n", - " /h newdict /Height get def \n", - " 1 w div 1 h div matrix scale \n", - " olddict /ImageMatrix get exch matrix concatmatrix \n", - " matrix invertmatrix concat \n", - " newdict /Height 1 put \n", - " newdict /DataSource pix put \n", - " /mat [w 0 0 h 0 0] def \n", - " newdict /ImageMatrix mat put \n", - " 0 1 h 1 sub { \n", - " mat 5 3 -1 roll neg put \n", - " olddict /DataSource get str readstring pop pop \n", - " /tail str def \n", - " /x 0 def \n", - " olddict /DataSource get pix readstring pop pop \n", - " { \n", - " tail transparent search dup /done exch not def \n", - " {exch pop exch pop} if \n", - " /w1 exch length def \n", - " w1 0 ne { \n", - " newdict /DataSource ", - " pix x crpp mul w1 crpp mul getinterval put \n", - " newdict /Width w1 put \n", - " mat 4 x neg put \n", - " /x x w1 add def \n", - " newdict image \n", - " /tail tail w1 tail length w1 sub getinterval def \n", - " } if \n", - " done {exit} if \n", - " tail substrs { \n", - " anchorsearch {pop} if \n", - " } forall \n", - " /tail exch def \n", - " tail length 0 eq {exit} if \n", - " /x w tail length sub def \n", - " } loop \n", - " } for \n", - " end \n", - " grestore \n", - "} bind def \n\n\n", NULL); - } else if (!codeIncluded && (colorLevel == 0)) { + displayOperation = "TkPhotoColor"; + } else { /* * Monochrome-only code */ - codeIncluded = !0; - Tcl_AppendResult(interp, - "/TkPhoto { \n", - " gsave \n", - " 32 dict begin \n", - " /dummyInteger exch def \n", - " /olddict exch def \n", - " olddict /DataSource get dup type /filetype ne { \n", - " olddict /DataSource 3 -1 roll \n", - " 0 () /SubFileDecode filter put \n", - " } { \n", - " pop \n", - " } ifelse \n", - " /newdict olddict maxlength dict def \n", - " olddict newdict copy pop \n", - " /w newdict /Width get def \n", - " /pix w 7 add 8 idiv string def \n", - " /h newdict /Height get def \n", - " 1 w div 1 h div matrix scale \n", - " olddict /ImageMatrix get exch matrix concatmatrix \n", - " matrix invertmatrix concat \n", - " newdict /Height 1 put \n", - " newdict /DataSource pix put \n", - " /mat [w 0 0 h 0 0] def \n", - " newdict /ImageMatrix mat put \n", - " 0 1 h 1 sub { \n", - " mat 5 3 -1 roll neg put \n", - " 0.000 0.000 0.000 setrgbcolor \n", - " olddict /DataSource get pix readstring pop pop \n", - " newdict /DataSource pix put \n", - " newdict imagemask \n", - " 1.000 1.000 1.000 setrgbcolor \n", - " olddict /DataSource get pix readstring pop pop \n", - " newdict /DataSource pix put \n", - " newdict imagemask \n", - " } for \n", - " end \n", - " grestore \n", - "} bind def \n\n\n", NULL); + displayOperation = "TkPhotoMono"; } /* @@ -1629,8 +1509,8 @@ Tk_PostscriptPhoto( " /DataSource currentfile /ASCIIHexDecode filter\n", NULL); sprintf(buffer, " /ImageMatrix [1 0 0 -1 0 %d]\n", height); - Tcl_AppendResult(interp, buffer, " /Decode ", decode, - "\n>>\n1 TkPhoto\n", NULL); + Tcl_AppendResult(interp, buffer, " /Decode ", decode, "\n>>\n1 ", + displayOperation, "\n", NULL); /* * Check the PhotoImageBlock information. We assume that: 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 {} -- cgit v0.12