tkcanvps.c

linux系统下的音频通信

 */

int
Tk_CanvasPsColor(interp, canvas, colorPtr)
    Tcl_Interp *interp;			/* Interpreter for returning Postscript
					 * or error message. */
    Tk_Canvas canvas;			/* Information about canvas. */
    XColor *colorPtr;			/* Information about color. */
{
    TkCanvas *canvasPtr = (TkCanvas *) canvas;
    TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
    int tmp;
    double red, green, blue;
    char string[200];

    if (psInfoPtr->prepass) {
	return TCL_OK;
    }

    /*
     * If there is a color map defined, then look up the color's name
     * in the map and use the Postscript commands found there, if there
     * are any.
     */

    if (psInfoPtr->colorVar != NULL) {
	char *cmdString;

	cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
		Tk_NameOfColor(colorPtr), 0);
	if (cmdString != NULL) {
	    Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
	    return TCL_OK;
	}
    }

    /*
     * No color map entry for this color.  Grab the color's intensities
     * and output Postscript commands for them.  Special note:  X uses
     * a range of 0-65535 for intensities, but most displays only use
     * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
     * X scale.  This means that there's no way to get perfect white,
     * since the highest intensity is only 65280 out of 65535.  To
     * work around this problem, rescale the X intensity to a 0-255
     * scale and use that as the basis for the Postscript colors.  This
     * scheme still won't work if the display only uses 4 bits per color,
     * but most diplays use at least 8 bits.
     */

    tmp = colorPtr->red;
    red = ((double) (tmp >> 8))/255.0;
    tmp = colorPtr->green;
    green = ((double) (tmp >> 8))/255.0;
    tmp = colorPtr->blue;
    blue = ((double) (tmp >> 8))/255.0;
    sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
	    red, green, blue);
    Tcl_AppendResult(interp, string, (char *) NULL);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_CanvasPsFont --
 *
 *	This procedure is called by individual canvas items when
 *	they want to output text.  Given information about an X
 *	font, this procedure will generate Postscript commands
 *	to set up an appropriate font in Postscript.
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs
 *	then an error message will be left in interp->result.
 *	If no error occurs, then additional Postscript will be
 *	appended to the interp->result.
 *
 * Side effects:
 *	The Postscript font name is entered into psInfoPtr->fontTable
 *	if it wasn't already there.
 *
 *--------------------------------------------------------------
 */

int
Tk_CanvasPsFont(interp, canvas, tkfont)
    Tcl_Interp *interp;			/* Interpreter for returning Postscript
					 * or error message. */
    Tk_Canvas canvas;			/* Information about canvas. */
    Tk_Font tkfont;			/* Information about font in which text
					 * is to be printed. */
{
    TkCanvas *canvasPtr = (TkCanvas *) canvas;
    TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
    char *end;
    char pointString[20];
    Tcl_DString ds;
    int i, points;

    /*
     * First, look up the font's name in the font map, if there is one.
     * If there is an entry for this font, it consists of a list
     * containing font name and size.  Use this information.
     */

    Tcl_DStringInit(&ds);
    
    if (psInfoPtr->fontVar != NULL) {
	char *list, **argv;
	int argc;
	double size;
	char *name;

	name = Tk_NameOfFont(tkfont);
	list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
	if (list != NULL) {
	    if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) {
		badMapEntry:
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "bad font map entry for \"", name,
			"\": \"", list, "\"", (char *) NULL);
		return TCL_ERROR;
	    }
	    if (argc != 2) {
		goto badMapEntry;
	    }
	    size = strtod(argv[1], &end);
	    if ((size <= 0) || (*end != 0)) {
		goto badMapEntry;
	    }

	    Tcl_DStringAppend(&ds, argv[0], -1);
	    points = (int) size;
	    
	    ckfree((char *) argv);
	    goto findfont;
	}
    } 

    points = Tk_PostscriptFontName(tkfont, &ds);

    findfont:
    sprintf(pointString, "%d", points);
    Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ",
	    pointString, " scalefont ", (char *) NULL);
    if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) {
	Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL);
    }
    Tcl_AppendResult(interp, "setfont\n", (char *) NULL);
    Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
    Tcl_DStringFree(&ds);

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_CanvasPsBitmap --
 *
 *	This procedure is called to output the contents of a
 *	sub-region of a bitmap in proper image data format for
 *	Postscript (i.e. data between angle brackets, one bit
 *	per pixel).
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs
 *	then an error message will be left in interp->result.
 *	If no error occurs, then additional Postscript will be
 *	appended to interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
    Tcl_Interp *interp;			/* Interpreter for returning Postscript
					 * or error message. */
    Tk_Canvas canvas;			/* Information about canvas. */
    Pixmap bitmap;			/* Bitmap for which to generate
					 * Postscript. */
    int startX, startY;			/* Coordinates of upper-left corner
					 * of rectangular region to output. */
    int width, height;			/* Height of rectangular region. */
{
    TkCanvas *canvasPtr = (TkCanvas *) canvas;
    TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
    XImage *imagePtr;
    int charsInLine, x, y, lastX, lastY, value, mask;
    unsigned int totalWidth, totalHeight;
    char string[100];
    Window dummyRoot;
    int dummyX, dummyY;
    unsigned dummyBorderwidth, dummyDepth;

    if (psInfoPtr->prepass) {
	return TCL_OK;
    }

    /*
     * The following call should probably be a call to Tk_SizeOfBitmap
     * instead, but it seems that we are occasionally invoked by custom
     * item types that create their own bitmaps without registering them
     * with Tk.  XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
     * it shouldn't matter here.
     */

    XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
	    (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
	    (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
    imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0,
	    totalWidth, totalHeight, 1, XYPixmap);
    Tcl_AppendResult(interp, "<", (char *) NULL);
    mask = 0x80;
    value = 0;
    charsInLine = 0;
    lastX = startX + width - 1;
    lastY = startY + height - 1;
    for (y = lastY; y >= startY; y--) {
	for (x = startX; x <= lastX; x++) {
	    if (XGetPixel(imagePtr, x, y)) {
		value |= mask;
	    }
	    mask >>= 1;
	    if (mask == 0) {
		sprintf(string, "%02x", value);
		Tcl_AppendResult(interp, string, (char *) NULL);
		mask = 0x80;
		value = 0;
		charsInLine += 2;
		if (charsInLine >= 60) {
		    Tcl_AppendResult(interp, "\n", (char *) NULL);
		    charsInLine = 0;
		}
	    }
	}
	if (mask != 0x80) {
	    sprintf(string, "%02x", value);
	    Tcl_AppendResult(interp, string, (char *) NULL);
	    mask = 0x80;
	    value = 0;
	    charsInLine += 2;
	}
    }
    Tcl_AppendResult(interp, ">", (char *) NULL);
    XDestroyImage(imagePtr);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_CanvasPsStipple --
 *
 *	This procedure is called by individual canvas items when
 *	they have created a path that they'd like to be filled with
 *	a stipple pattern.  Given information about an X bitmap,
 *	this procedure will generate Postscript commands to fill
 *	the current clip region using a stipple pattern defined by the
 *	bitmap.
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs
 *	then an error message will be left in interp->result.
 *	If no error occurs, then additional Postscript will be
 *	appended to interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
Tk_CanvasPsStipple(interp, canvas, bitmap)
    Tcl_Interp *interp;			/* Interpreter for returning Postscript
					 * or error message. */
    Tk_Canvas canvas;			/* Information about canvas. */
    Pixmap bitmap;			/* Bitmap to use for stippling. */
{
    TkCanvas *canvasPtr = (TkCanvas *) canvas;
    TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
    int width, height;
    char string[100];
    Window dummyRoot;
    int dummyX, dummyY;
    unsigned dummyBorderwidth, dummyDepth;

    if (psInfoPtr->prepass) {
	return TCL_OK;
    }

    /*
     * The following call should probably be a call to Tk_SizeOfBitmap
     * instead, but it seems that we are occasionally invoked by custom
     * item types that create their own bitmaps without registering them
     * with Tk.  XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
     * it shouldn't matter here.
     */

    XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
	    (int *) &dummyX, (int *) &dummyY, (unsigned *) &width,
	    (unsigned *) &height, &dummyBorderwidth, &dummyDepth);
    sprintf(string, "%d %d ", width, height);
    Tcl_AppendResult(interp, string, (char *) NULL);
    if (Tk_CanvasPsBitmap(interp, (Tk_Canvas) canvasPtr, bitmap, 0, 0,
	    width, height) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_CanvasPsY --
 *
 *	Given a y-coordinate in canvas coordinates, this procedure
 *	returns a y-coordinate to use for Postscript output.
 *
 * Results:
 *	Returns the Postscript coordinate that corresponds to
 *	"y".
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

double
Tk_CanvasPsY(canvas, y)
    Tk_Canvas canvas;			/* Token for canvas on whose behalf
					 * Postscript is being generated. */
    double y;				/* Y-coordinate in canvas coords. */
{
    TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;

    return psInfoPtr->y2 - y;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_CanvasPsPath --
 *
 *	Given an array of points for a path, generate Postscript
 *	commands to create the path.
 *
 * Results:
 *	Postscript commands get appended to what's in interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

void
Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
    Tcl_Interp *interp;			/* Put generated Postscript in this
					 * interpreter's result field. */
    Tk_Canvas canvas;			/* Canvas on whose behalf Postscript
					 * is being generated. */
    double *coordPtr;			/* Pointer to first in array of
					 * 2*numPoints coordinates giving
					 * points for path. */
    int numPoints;			/* Number of points at *coordPtr. */
{
    TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
    char buffer[200];

    if (psInfoPtr->prepass) {
	return;
    }
    sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
	    Tk_CanvasPsY(canvas, coordPtr[1]));
    Tcl_AppendResult(interp, buffer, (char *) NULL);
    for (numPoints--, coordPtr += 2; numPoints > 0;
	    numPoints--, coordPtr += 2) {
	sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0],
		Tk_CanvasPsY(canvas, coordPtr[1]));
	Tcl_AppendResult(interp, buffer, (char *) NULL);
    }
}

/*
 *--------------------------------------------------------------
 *
 * GetPostscriptPoints --
 *
 *	Given a string, returns the number of Postscript points
 *	corresponding to that string.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	screen distance is stored at *doublePtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
GetPostscriptPoints(interp, string, doublePtr)
    Tcl_Interp *interp;		/* Use this for error reporting. */
    char *string;		/* String describing a screen distance. */
    double *doublePtr;		/* Place to store converted result. */
{
    char *end;
    double d;

    d = strtod(string, &end);
    if (end == string) {
	error:
	Tcl_AppendResult(interp, "bad distance \"", string,
		"\"", (char *) NULL);
	return TCL_ERROR;
    }
    while ((*end != '\0') && isspace(UCHAR(*end))) {
	end++;
    }
    switch (*end) {
	case 'c':
	    d *= 72.0/2.54;
	    end++;
	    break;
	case 'i':
	    d *= 72.0;
	    end++;
	    break;
	case 'm':
	    d *= 72.0/25.4;
	    end++;
	    break;
	case 0:
	    break;
	case 'p':
	    end++;
	    break;
	default:
	    goto error;
    }
    while ((*end != '\0') && isspace(UCHAR(*end))) {
	end++;
    }
    if (*end != 0) {
	goto error;
    }
    *doublePtr = d;
    return TCL_OK;
}