summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog9
-rw-r--r--generic/tkCanvPs.c28
-rw-r--r--generic/tkFont.c178
-rw-r--r--library/mkpsenc.tcl191
4 files changed, 213 insertions, 193 deletions
diff --git a/ChangeLog b/ChangeLog
index 47302fe..abbae49 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2010-01-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tkFont.c (Tk_TextLayoutToPostscript): Simplified the code to
+ * generic/tkCanvPs.c (TkCanvPostscriptCmd): generate the preamble
+ * library/mkpsenc.tcl: for PS generation and
+ also simplify the code to output text following the observation that
+ it effectively only produces ASCII anyway, even when it might have the
+ option to do otherwise in theory.
+
2010-01-03 Pat Thoyts <patthoyts@users.sourceforge.net>
* library/tearoff.tcl: tearoff menus should be transient and use the
diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c
index d397b9a..33bc89d 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.27 2009/05/01 15:04:03 dkf Exp $
+ * RCS: @(#) $Id: tkCanvPs.c,v 1.28 2010/01/03 16:24:13 dkf Exp $
*/
#include "tkInt.h"
@@ -178,7 +178,7 @@ TkCanvPostscriptCmd(
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
Tcl_DString buffer;
- static const char *psenccmd = "::tk::ensure_psenc_is_loaded";
+ Tcl_Obj *preambleObj;
int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of area to be
* marked up, measured in canvas units from
* the positioning point on the page (reflects
@@ -186,14 +186,28 @@ TkCanvPostscriptCmd(
* only to stop compiler warnings. */
/*
- * Initialize the data structure describing Postscript generation, then
- * process all the arguments to fill the data structure in.
+ * Get the generic preamble. We only ever bother with the ASCII encoding;
+ * the others just make life too complicated and never actually worked as
+ * such.
*/
- result = Tcl_EvalEx(interp, psenccmd, -1, TCL_EVAL_GLOBAL);
+ result = Tcl_Eval(interp, "::tk::ensure_psenc_is_loaded");
if (result != TCL_OK) {
return result;
}
+ preambleObj = Tcl_GetVar2Ex(interp, "::tk::ps_preamble", NULL,
+ TCL_LEAVE_ERR_MSG);
+ if (preambleObj == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(preambleObj);
+ Tcl_ResetResult(interp);
+
+ /*
+ * Initialize the data structure describing Postscript generation, then
+ * process all the arguments to fill the data structure in.
+ */
+
oldInfoPtr = canvasPtr->psInfo;
canvasPtr->psInfo = (Tk_PostscriptInfo) psInfoPtr;
psInfo.x = canvasPtr->xOrigin;
@@ -460,8 +474,7 @@ TkCanvPostscriptCmd(
* Insert the prolog
*/
- Tcl_AppendResult(interp, Tcl_GetVar(interp, "::tk::ps_preamable",
- TCL_GLOBAL_ONLY), NULL);
+ Tcl_AppendResult(interp, Tcl_GetString(preambleObj), NULL);
if (psInfo.chan != NULL) {
Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
@@ -602,6 +615,7 @@ TkCanvPostscriptCmd(
}
Tcl_DeleteHashTable(&psInfo.fontTable);
canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr;
+ Tcl_DecrRefCount(preambleObj);
return result;
}
diff --git a/generic/tkFont.c b/generic/tkFont.c
index 749f64b..76895e3 100644
--- a/generic/tkFont.c
+++ b/generic/tkFont.c
@@ -10,13 +10,13 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkFont.c,v 1.62 2010/01/02 22:52:38 dkf Exp $
+ * RCS: @(#) $Id: tkFont.c,v 1.63 2010/01/03 16:24:13 dkf Exp $
*/
#include "tkInt.h"
#include "tkFont.h"
-#define ROUND16(x) ((short)((x) + 0.5))
+#define ROUND16(x) ((short)((x) + 0.5))
/*
* The following structure is used to keep track of all the fonts that exist
@@ -417,9 +417,8 @@ TkFontPkgFree(
TkFontInfo *fiPtr = mainPtr->fontInfoPtr;
Tcl_HashEntry *hPtr, *searchPtr;
Tcl_HashSearch search;
- int fontsLeft;
+ int fontsLeft = 0;
- fontsLeft = 0;
for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
searchPtr != NULL;
searchPtr = Tcl_NextHashEntry(&search)) {
@@ -440,7 +439,7 @@ TkFontPkgFree(
hPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
while (hPtr != NULL) {
- ckfree((char *) Tcl_GetHashValue(hPtr));
+ ckfree(Tcl_GetHashValue(hPtr));
hPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&fiPtr->namedTable);
@@ -476,7 +475,7 @@ Tk_FontObjCmd(
{
int index;
Tk_Window tkwin = clientData;
- TkFontInfo *fiPtr;
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
static const char *const optionStrings[] = {
"actual", "configure", "create", "delete",
"families", "measure", "metrics", "names",
@@ -487,8 +486,6 @@ Tk_FontObjCmd(
FONT_FAMILIES, FONT_MEASURE, FONT_METRICS, FONT_NAMES
};
- fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
-
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
return TCL_ERROR;
@@ -640,13 +637,12 @@ Tk_FontObjCmd(
return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
}
case FONT_CREATE: {
- int skip, i;
+ int skip = 3, i;
const char *name;
char buf[16 + TCL_INTEGER_SPACE];
TkFontAttributes fa;
Tcl_HashEntry *namedHashPtr;
- skip = 3;
if (objc < 3) {
name = NULL;
} else {
@@ -701,9 +697,8 @@ Tk_FontObjCmd(
return result;
}
case FONT_FAMILIES: {
- int skip;
+ int skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
- skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
if (skip < 0) {
return TCL_ERROR;
}
@@ -726,7 +721,8 @@ Tk_FontObjCmd(
}
}
if (objc - skip != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "font ?-displayof window? text");
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? text");
return TCL_ERROR;
}
tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
@@ -844,9 +840,8 @@ UpdateDependentFonts(
Tcl_HashEntry *cacheHashPtr;
Tcl_HashSearch search;
TkFont *fontPtr;
- NamedFont *nfPtr;
+ NamedFont *nfPtr = Tcl_GetHashValue(namedHashPtr);
- nfPtr = Tcl_GetHashValue(namedHashPtr);
if (nfPtr->refCount == 0) {
/*
* Well nobody's using this named font, so don't have to tell any
@@ -948,15 +943,12 @@ TkCreateNamedFont(
const char *name, /* Name for the new named font. */
TkFontAttributes *faPtr) /* Attributes for the new named font. */
{
- TkFontInfo *fiPtr;
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
Tcl_HashEntry *namedHashPtr;
int isNew;
NamedFont *nfPtr;
- fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
-
namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &isNew);
-
if (!isNew) {
nfPtr = Tcl_GetHashValue(namedHashPtr);
if (nfPtr->deletePending == 0) {
@@ -1005,12 +997,10 @@ TkDeleteNamedFont(
Tk_Window tkwin, /* A window associated with interp. */
const char *name) /* Name for the new named font. */
{
- TkFontInfo *fiPtr;
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
NamedFont *nfPtr;
Tcl_HashEntry *namedHashPtr;
- fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
-
namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, name);
if (namedHashPtr == NULL) {
if (interp) {
@@ -1061,7 +1051,7 @@ Tk_GetFont(
Tk_Font tkfont;
Tcl_Obj *strPtr;
- strPtr = Tcl_NewStringObj((char *) string, -1);
+ strPtr = Tcl_NewStringObj(string, -1);
Tcl_IncrRefCount(strPtr);
tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr);
Tcl_DecrRefCount(strPtr);
@@ -1097,19 +1087,17 @@ Tk_AllocFontFromObj(
Tcl_Obj *objPtr) /* Object describing font, as: named font,
* native format, or parseable string. */
{
- TkFontInfo *fiPtr;
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
TkFont *fontPtr, *firstFontPtr, *oldFontPtr;
int isNew, descent;
NamedFont *nfPtr;
- fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
if (objPtr->typePtr != &tkFontObjType) {
SetFontFromAny(interp, objPtr);
}
oldFontPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
if (oldFontPtr != NULL) {
if (oldFontPtr->resourceRefCount == 0) {
/*
@@ -1277,7 +1265,8 @@ Tk_AllocFontFromObj(
Tk_Font
Tk_GetFontFromObj(
- Tk_Window tkwin, /* The window that the font will be used in. */
+ Tk_Window tkwin, /* The window that the font will be used
+ * in. */
Tcl_Obj *objPtr) /* The object from which to get the font. */
{
TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
@@ -1289,7 +1278,6 @@ Tk_GetFontFromObj(
}
fontPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
if (fontPtr != NULL) {
if (fontPtr->resourceRefCount == 0) {
/*
@@ -1393,9 +1381,8 @@ const char *
Tk_NameOfFont(
Tk_Font tkfont) /* Font whose name is desired. */
{
- TkFont *fontPtr;
+ TkFont *fontPtr = (TkFont *) tkfont;
- fontPtr = (TkFont *) tkfont;
return fontPtr->cacheHashPtr->key.string;
}
@@ -1420,13 +1407,12 @@ void
Tk_FreeFont(
Tk_Font tkfont) /* Font to be released. */
{
- TkFont *fontPtr, *prevPtr;
+ TkFont *fontPtr = (TkFont *) tkfont, *prevPtr;
NamedFont *nfPtr;
- if (tkfont == NULL) {
+ if (fontPtr == NULL) {
return;
}
- fontPtr = (TkFont *) tkfont;
fontPtr->resourceRefCount--;
if (fontPtr->resourceRefCount > 0) {
return;
@@ -1591,9 +1577,8 @@ Tk_FontId(
Tk_Font tkfont) /* Font that is going to be selected into
* GC. */
{
- TkFont *fontPtr;
+ TkFont *fontPtr = (TkFont *) tkfont;
- fontPtr = (TkFont *) tkfont;
return fontPtr->fid;
}
@@ -1665,13 +1650,12 @@ Tk_PostscriptFontName(
* which the name of the Postscript font that
* corresponds to tkfont will be appended. */
{
- TkFont *fontPtr;
+ TkFont *fontPtr = (TkFont *) tkfont;
Tk_Uid family, weightString, slantString;
char *src, *dest;
int upper, len;
len = Tcl_DStringLength(dsPtr);
- fontPtr = (TkFont *) tkfont;
/*
* Convert the case-insensitive Tk_Font family name to the case-sensitive
@@ -1897,11 +1881,9 @@ TkUnderlineCharsInContext(
int lastByte) /* Index of first byte after the last
* character. */
{
- TkFont *fontPtr;
+ TkFont *fontPtr = (TkFont *) tkfont;
int startX, endX;
- fontPtr = (TkFont *) tkfont;
-
TkpMeasureCharsInContext(tkfont, string, numBytes, 0, firstByte, -1, 0,
&startX);
TkpMeasureCharsInContext(tkfont, string, numBytes, 0, lastByte, -1, 0,
@@ -1960,7 +1942,7 @@ Tk_ComputeTextLayout(
int *widthPtr, /* Filled with width of string. */
int *heightPtr) /* Filled with height of string. */
{
- TkFont *fontPtr;
+ TkFont *fontPtr = (TkFont *) tkfont;
const char *start, *end, *special;
int n, y, bytesThisChunk, maxChunks, curLine, layoutHeight;
int baseline, height, curX, newX, maxWidth, *lineLengths;
@@ -1971,7 +1953,6 @@ Tk_ComputeTextLayout(
Tcl_DStringInit(&lineBuffer);
- fontPtr = (TkFont *) tkfont;
if ((fontPtr == NULL) || (string == NULL)) {
if (widthPtr != NULL) {
*widthPtr = 0;
@@ -2280,7 +2261,8 @@ void
Tk_DrawTextLayout(
Display *display, /* Display on which to draw. */
Drawable drawable, /* Window or pixmap in which to draw. */
- GC gc, /* Graphics context to use for drawing text. */
+ GC gc, /* Graphics context to use for drawing
+ * text. */
Tk_TextLayout layout, /* Layout information, from a previous call to
* Tk_ComputeTextLayout(). */
int x, int y, /* Upper-left hand corner of rectangle in
@@ -2337,7 +2319,8 @@ void
TkDrawAngledTextLayout(
Display *display, /* Display on which to draw. */
Drawable drawable, /* Window or pixmap in which to draw. */
- GC gc, /* Graphics context to use for drawing text. */
+ GC gc, /* Graphics context to use for drawing
+ * text. */
Tk_TextLayout layout, /* Layout information, from a previous call to
* Tk_ComputeTextLayout(). */
int x, int y, /* Upper-left hand corner of rectangle in
@@ -2454,7 +2437,8 @@ void
TkUnderlineAngledTextLayout(
Display *display, /* Display on which to draw. */
Drawable drawable, /* Window or pixmap in which to draw. */
- GC gc, /* Graphics context to use for drawing text. */
+ GC gc, /* Graphics context to use for drawing
+ * text. */
Tk_TextLayout layout, /* Layout information, from a previous call to
* Tk_ComputeTextLayout(). */
int x, int y, /* Upper-left hand corner of rectangle in
@@ -2552,7 +2536,7 @@ Tk_PointToChar(
* to the upper-left corner of the text
* layout. */
{
- TextLayout *layoutPtr;
+ TextLayout *layoutPtr = (TextLayout *) layout;
LayoutChunk *chunkPtr, *lastPtr;
TkFont *fontPtr;
int i, n, dummy, baseline, pos, numChars;
@@ -2570,7 +2554,6 @@ Tk_PointToChar(
* Find which line contains the point.
*/
- layoutPtr = (TextLayout *) layout;
fontPtr = (TkFont *) layoutPtr->tkfont;
lastPtr = chunkPtr = layoutPtr->chunks;
numChars = 0;
@@ -2700,7 +2683,7 @@ Tk_CharBbox(
* bounding box for the character specified by
* index, if non-NULL. */
{
- TextLayout *layoutPtr;
+ TextLayout *layoutPtr = (TextLayout *) layout;
LayoutChunk *chunkPtr;
int i, x = 0, w;
Tk_Font tkfont;
@@ -2711,7 +2694,6 @@ Tk_CharBbox(
return 0;
}
- layoutPtr = (TextLayout *) layout;
chunkPtr = layoutPtr->chunks;
tkfont = layoutPtr->tkfont;
fontPtr = (TkFont *) tkfont;
@@ -2812,11 +2794,10 @@ Tk_DistanceToTextLayout(
* (in pixels). */
{
int i, x1, x2, y1, y2, xDiff, yDiff, dist, minDist, ascent, descent;
+ TextLayout *layoutPtr = (TextLayout *) layout;
LayoutChunk *chunkPtr;
- TextLayout *layoutPtr;
TkFont *fontPtr;
- layoutPtr = (TextLayout *) layout;
fontPtr = (TkFont *) layoutPtr->tkfont;
ascent = fontPtr->fm.ascent;
descent = fontPtr->fm.descent;
@@ -2900,7 +2881,7 @@ Tk_IntersectTextLayout(
* rectangular area, in pixels. */
{
int result, i, x1, y1, x2, y2;
- TextLayout *layoutPtr;
+ TextLayout *layoutPtr = (TextLayout *) layout;
LayoutChunk *chunkPtr;
TkFont *fontPtr;
int left, top, right, bottom;
@@ -2912,7 +2893,6 @@ Tk_IntersectTextLayout(
* and see if they were all inside or all outside.
*/
- layoutPtr = (TextLayout *) layout;
chunkPtr = layoutPtr->chunks;
fontPtr = (TkFont *) layoutPtr->tkfont;
@@ -3006,9 +2986,7 @@ static inline int
sign(
double value)
{
- if (value < 0.0) return -1;
- if (value > 0.0) return 1;
- return 0;
+ return (value < 0.0) ? -1 : (value > 0.0) ? 1 : 0;
}
static inline int
@@ -3149,6 +3127,7 @@ TkIntersectAngledTextLayout(
for (i=0 ; i<layoutPtr->numChunks ; i++,chunkPtr++) {
double cx[4], cy[4];
+
if (chunkPtr->start[0] == '\n') {
/*
* Newline characters are not counted when computing area
@@ -3199,6 +3178,7 @@ TkIntersectAngledTextLayout(
for (j=0 ; j<4 ; j++) {
int k = (j+1) % 4;
+
if ( SidesIntersect(rx[j],ry[j], rx[k],ry[k], x1,y1, x2,y1) ||
SidesIntersect(rx[j],ry[j], rx[k],ry[k], x2,y1, x2,y2) ||
SidesIntersect(rx[j],ry[j], rx[k],ry[k], x2,y2, x1,y2) ||
@@ -3258,16 +3238,14 @@ Tk_TextLayoutToPostscript(
Tcl_Interp *interp, /* Filled with Postscript code. */
Tk_TextLayout layout) /* The layout to be rendered. */
{
+ TextLayout *layoutPtr = (TextLayout *) layout;
#define MAXUSE 128
- char buf[MAXUSE+30], uindex[5] = "\0\0\0\0", one_char[5];
+ char buf[MAXUSE+30];
LayoutChunk *chunkPtr;
- int i, j, used, c, baseline, charsize;
+ int i, j, used, baseline, charsize;
Tcl_UniChar ch;
- const char *p, *last_p, *glyphname;
- TextLayout *layoutPtr;
- int bytecount=0;
+ const char *p, *glyphname;
- layoutPtr = (TextLayout *) layout;
chunkPtr = layoutPtr->chunks;
baseline = chunkPtr->y;
used = 0;
@@ -3291,54 +3269,66 @@ Tk_TextLayoutToPostscript(
p = chunkPtr->start;
for (j = 0; j < chunkPtr->numDisplayChars; j++) {
/*
- * INTL: For now we just treat the characters as binary data
- * and display the lower byte. Eventually this should be
- * revised to handle international postscript fonts.
+ * INTL: We only handle symbols that have an encoding as a
+ * flyph from the standard set defined by Adobe. The rest get
+ * punted. Eventually this should be revised to handle more
+ * sophsticiated international postscript fonts.
*/
- last_p = p;
- p += (charsize = Tcl_UtfToUniChar(p,&ch));
- Tcl_UtfToExternal(interp, NULL, last_p, charsize, 0, NULL,
- one_char, 4, NULL, &bytecount, NULL);
- if (bytecount == 1) {
- c = UCHAR(one_char[0]);
- /* c = UCHAR( ch & 0xFF) */;
- if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
- || (c >= UCHAR(0x7f))) {
- /*
- * Tricky point: the "03" is necessary in the sprintf
- * below, so that a full three digits of octal are
- * always generated. Without the "03", a number
- * following this sequence could be interpreted by
- * Postscript as part of this sequence.
- */
+ charsize = Tcl_UtfToUniChar(p, &ch);
+ p += charsize;
- sprintf(buf + used, "\\%03o", c);
- used += 4;
- } else {
- buf[used++] = c;
- }
+ if ((ch == '(') || (ch == ')') || (ch == '\\')
+ || (ch < 0x20)) {
+ /*
+ * Tricky point: the "03" is necessary in the sprintf
+ * below, so that a full three digits of octal are always
+ * generated. Without the "03", a number following this
+ * sequence could be interpreted by Postscript as part of
+ * this sequence.
+ */
+
+ sprintf(buf + used, "\\%03o", ch);
+ used += 4;
+ } else if (ch <= 0x7f) {
+ /*
+ * Normal ASCII character.
+ */
+
+ buf[used++] = ch;
} else {
+ char uindex[5];
+
/*
- * This character doesn't belong to system character set.
- * So, we must use full glyph name.
+ * This character doesn't belong to the ASCII character
+ * set, so we use the full glyph name.
*/
sprintf(uindex, "%04X", ch); /* endianness? */
- glyphname = Tcl_GetVar2(interp,"::tk::psglyphs",uindex,0);
+ glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex,
+ 0);
if (glyphname) {
- if (used > 0 && buf [used-1] == '(') {
- --used;
+ if (used > 0 && buf[used-1] == '(') {
+ used--;
} else {
buf[used++] = ')';
}
buf[used++] = '/';
- while ((*glyphname) && (used < (MAXUSE+27))) {
- buf[used++] = *glyphname++ ;
+ while ((*glyphname) && (used < MAXUSE+27)) {
+ buf[used++] = *glyphname++;
}
buf[used++] = '(';
- }
+ } else {
+ /*
+ * No known mapping for the character into the space
+ * of PostScript glyphs. Ignore it. :-(
+ */
+#ifdef TK_DEBUG_POSTSCRIPT_OUTPUT
+ fprintf(stderr, "Warning: no mapping to PostScript "
+ "glyphs for \\u%04x\n", ch);
+#endif
+ }
}
if (used >= MAXUSE) {
buf[used] = '\0';
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 {} {
generated by cgit v0.12 at 2024-11-16 21:10:09 (GMT)