/* Hello, Emacs, this is -*-C-*-
 * $Id: tkcanvas.trm,v 1.28.8.2 2016/02/04 07:16:46 sfeam Exp $
 *
 */

/* GNUPLOT - tkcanvas.trm */

/*[
 * Copyright 1990 - 1993, 1998, 2004, 2014
 *
 * Permission to use, copy, and distribute this software and its
 * documentation for any purpose with or without fee is hereby granted,
 * provided that the above copyright notice appear in all copies and
 * that both that copyright notice and this permission notice appear
 * in supporting documentation.
 *
 * Permission to modify the software is granted, but not the right to
 * distribute the complete modified source code.  Modifications are to
 * be distributed as patches to the released version.  Permission to
 * distribute binaries produced by compiling modified sources is granted,
 * provided you
 *   1. distribute the corresponding source modifications from the
 *    released version in the form of a patch file along with the binaries,
 *   2. add special version identification to distinguish your version
 *    in addition to the base release version number,
 *   3. provide your name and address as the primary contact for the
 *    support of your modified version, and
 *   4. retain our contact information in regard to use of the base
 *    software.
 * Permission to distribute the released version of the source code along
 * with corresponding source modifications in the form of a patch file is
 * granted with same provisions 2 through 4 for binary distributions.
 *
 * This software is provided "as is" without express or implied warranty
 * to the extent permitted by applicable law.
]*/

/*
 * This file is included by ../term.c.
 *
 * This terminal driver supports:
 *  Tk canvas widgets under several scripting languages
 *  (currently Tcl, Perl/Tk, Perl/Tkx, Python, Ruby, Rexx)
 *
 * AUTHORS and HISTORY:
 *  original dxy.trm by Martin Yii, eln557h@monu3.OZ
 *  Further modified Jan 1990 by Russell Lang, rjl@monu1.cc.monash.oz
 *
 * port to the Tk/Tcl canvas widget
 *   D. Jeff Dionne, July 1995 jeff@ryeham.ee.ryerson.ca
 *   Alex Woo, woo@playfair.stanford.edu
 *
 * adapted to the new terminal layout by Alex Woo (Sept. 1996)
 *
 * extended interactive Tk/Tcl capabilities
 *   Thomas Sefzick, March 1999, t.sefzick@fz-juelich.de
 *
 * added the perltk.trm code written by Slaven Rezic <eserte@cs.tu-berlin.de>.
 * 'linewidth' and 'justify text' added, ends of plotted lines are now rounded.
 *   Thomas Sefzick, May 1999, t.sefzick@fz-juelich.de
 *
 * scale plot to fit into the actual size of the canvas as reported by
 * the window manager (the canvas itself doesn't report its real size).
 *   Matt Willis, October 1999, mattbwillis@my-deja.com
 *
 * cleaned up and generalized in order to accomodate an increasing
 * number of scripting languages; added support for Python and Ruby.
 * based on a patch dated October 2002.
 *   Joachim Wuttke, November 2014, jwuttke@users.sourceforge.net
 *
 * Add support for Perl/Tkx and Rexx.
 * Add support for rgb and palette color, filled boxes and polygons,
 * rotated text, (custom) dashed lines, background colour, closed paths,
 * rounded or butt line ends, Tk-arrows, optimized drawing of lines,
 * boxed text and bold and italic text. Add 'size' option to give the
 * code a hint of proper tic and font sizes. Add 'standalone' option to
 * create self-contained scripts. Add support for enhanced text and
 * external images for Tcl only.
 *   Bastian Maerkisch, December 2014, bmaerkisch@web.de
 *
 * BUGS or MISSING FEATURES:
 *  - enhanced text only for Tcl
 *  - option to change function name (multiple plots)
 *  - layer actions by adding tags to items
 *  - hypertext and image are missing
 *  - transparency is not possible
 *  - text encoding setting is ignored, we always use the system's default
 *  - The "interactive" mode has several issues:
 *    - The optimised line drawing, which merges adjacent segments into one
 *      path, renders the 'interactive mode' pretty useless.
 *    - It is not (yet) implemented at all for Python/Tkinter and Rexx/Tk.
 *    - Ruby/Tkinter: no support for user_gnuplot_coordinates().
 *  - gnuplot_xy:
 *      the definition (with 12 input and 4 output coordinates) is clumsy,
 *      and the implementation is unelegant.
 *  - we don't take advantage of object orientation; our Ruby code looks
 *      like an almost literal translation from Tcl (because that's what it is).
 *  - no support for Lua/Tk
 */

#include "driver.h"

#ifdef TERM_REGISTER
register_term(tkcanvas)
#endif

#ifdef TERM_PROTO
TERM_PUBLIC void TK_options __PROTO((void));
TERM_PUBLIC void TK_init __PROTO((void));
TERM_PUBLIC void TK_graphics __PROTO((void));
TERM_PUBLIC void TK_text __PROTO((void));
TERM_PUBLIC void TK_linetype __PROTO((int linetype));
TERM_PUBLIC void TK_move __PROTO((unsigned int x, unsigned int y));
TERM_PUBLIC void TK_vector __PROTO((unsigned int x, unsigned int y));
TERM_PUBLIC int  TK_text_angle(int ang);
TERM_PUBLIC void TK_put_text(unsigned int x, unsigned int y, const char *str);
TERM_PUBLIC void TK_reset(void);
TERM_PUBLIC int  TK_justify_text(enum JUSTIFY);
TERM_PUBLIC void TK_point(unsigned int, unsigned int, int);
TERM_PUBLIC void TK_arrow(unsigned int, unsigned int, unsigned int, unsigned int, int);
TERM_PUBLIC int  TK_set_font(const char *font);
TERM_PUBLIC void TK_enhanced_open(char * fontname, double fontsize,
				  double base, TBOOLEAN widthflag, TBOOLEAN showflag, int overprint);
TERM_PUBLIC void TK_enhanced_flush(void);
TERM_PUBLIC void TK_linewidth(double linewidth);
TERM_PUBLIC int  TK_make_palette(t_sm_palette *palette);
TERM_PUBLIC void TK_color(t_colorspec *colorspec);
TERM_PUBLIC void TK_fillbox(int style, unsigned int x, unsigned int y, unsigned int w, unsigned int h);
TERM_PUBLIC void TK_filled_polygon(int points, gpiPoint *corners);
#ifdef WRITE_PNG_IMAGE
TERM_PUBLIC void TK_image(unsigned m, unsigned n, coordval *image, gpiPoint *corner, t_imagecolor color_mode);
#endif
TERM_PUBLIC void TK_dashtype(int dt, t_dashtype *custom_dash_pattern);
#ifdef EAM_BOXED_TEXT
TERM_PUBLIC void TK_boxed_text(unsigned int x, unsigned int y, int option);
#endif

/* nominal canvas size */
#define TK_XMAX 1000
#define TK_YMAX 1000

/* char size and tic sizes in pixels */
#define TK_VCHAR        14	/* height of characters */
#define TK_HCHAR         6	/* width of characters including spacing */
#define TK_VTIC          8
#define TK_HTIC          8

#endif /* TERM_PROTO */

#ifndef TERM_PROTO_ONLY
#ifdef TERM_BODY

/* FIXME HBB 20000725: This needs to be fixed.  As is, this driver causes
 * the terminal layer to depend on several other core modules. Th is a 
 * design bug. "term" is supposed a 'frontier' layer: it should not be 
 * dependent on any other code inside gnuplot */

#include "axis.h" /* axis_array */
#include "gadgets.h" /* is_3d_plot, plot_bounds */

/* text, font */
static int tk_angle = 0;
static char tk_anchor[7] = "w";
static enum JUSTIFY tk_justify;
static TBOOLEAN tk_next_text_use_font = FALSE;
static TBOOLEAN tk_boxed = FALSE;

/* enhanced text */
static TBOOLEAN tk_enhanced_opened_string = FALSE;
static TBOOLEAN tk_enhanced_show = FALSE;
static int tk_enhanced_base = 0;
static int tk_enhanced_overprint = 0;
static TBOOLEAN tk_enhanced_widthflag = FALSE;

/* vectors, polygons, paths */
static TBOOLEAN tk_rounded = FALSE;
static double tk_linewidth = 1.0;
static int tk_lastx = 0;
static int tk_lasty = 0;
static TBOOLEAN tk_in_path = FALSE;
static int * tk_path_x = NULL;
static int * tk_path_y = NULL;
static int tk_maxpath = 0;
static int tk_polygon_points = 0;
static char tk_dashpattern[3*DASHPATTERN_LENGTH];
static const char * tk_dashtypes[] = {
    "", "1 1", "", "3 1", "2 2", "3 1 1 1", "3 1 1 1 1 1"
};

/* color */
static const char * tk_colors[] = {
    "black", "gray", "red", "green", "blue", "magenta", "cyan", "brown"
};
static char tk_color[20] = "black";
static char tk_background[20] = "";
static char * tk_background_opt = NULL;

/* other options */
static TBOOLEAN tk_interactive = FALSE;
static TBOOLEAN tk_standalone = FALSE;
static int tk_width  = 800;
static int tk_height = 600;

/* images */
static int tk_image_counter = 0;


/* prototypes of local functions */
static void TK_put_noenhanced_text(unsigned int x, unsigned int y, const char *str);
static void TK_put_enhanced_text(unsigned int x, unsigned int y, const char *str);
static void TK_rectangle(int x1, int y1, int x2, int y2, char * color, char * stipple);
static void TK_add_path_point(int x, int y); /* add a new point to current path or line */
static void TK_flush_line(); /* finish a poly-line */


enum TK_id {
    /* languages first (order is important as it is used as index!) */
    TK_LANG_TCL=0, TK_LANG_PERL, TK_LANG_PYTHON, TK_LANG_RUBY, TK_LANG_REXX,
    TK_LANG_PERLTKX, TK_LANG_MAX,
    /* other options */
    TK_INTERACTIVE, TK_STANDALONE, TK_INPUT,
    TK_NOROTTEXT, TK_ROTTEXT, TK_BACKGROUND, TK_NOBACKGROUND,
    TK_ROUNDED, TK_BUTT, TK_SIZE, TK_ENHANCED, TK_NOENHANCED,
    TK_PIXELS, TK_EXTERNALIMAGES, TK_INLINEIMAGES,
    TK_OTHER
};

static int tk_script_language = TK_LANG_TCL;
static char *tk_script_languages[TK_LANG_MAX] = {
    "tcl", "perl", "python", "ruby", "rexx", "perltkx"
};

static struct gen_table TK_opts[] =
{
    { "t$cl", TK_LANG_TCL },
    { "pe$rltk", TK_LANG_PERL },
    { "perltkx", TK_LANG_PERLTKX },
    { "tkx", TK_LANG_PERLTKX },
    { "py$thontkinter", TK_LANG_PYTHON },
    { "ru$bytkinter", TK_LANG_RUBY },
    { "re$xxtk", TK_LANG_REXX },
    { "int$eractive", TK_INTERACTIVE },
    { "inp$ut", TK_INPUT },
    { "stand$alone", TK_STANDALONE },
    { "nor$ottext", TK_NOROTTEXT },
    { "rot$text", TK_ROTTEXT },
    { "backg$round", TK_BACKGROUND },
    { "noback$ground", TK_NOBACKGROUND },
    { "round$ed", TK_ROUNDED },
    { "butt", TK_BUTT },
    { "size", TK_SIZE },
    { "enh$anced", TK_ENHANCED },
    { "noenh$anced", TK_NOENHANCED },
    { "pix$els", TK_PIXELS },
    { "inl$ineimages", TK_INLINEIMAGES },
    { "ext$ernalimages", TK_EXTERNALIMAGES },
    { NULL, TK_OTHER }
};

TERM_PUBLIC void
TK_options()
{
    int cmd;
    tk_interactive = FALSE;

    while (!END_OF_COMMAND) {
	switch (cmd = lookup_table(&TK_opts[0], c_token)) {
	case TK_LANG_TCL:
	case TK_LANG_PERL:
	case TK_LANG_PERLTKX:
	case TK_LANG_RUBY:
	case TK_LANG_PYTHON:
	case TK_LANG_REXX:
	    tk_script_language = cmd;
	    c_token++;
	    break;
	case TK_INTERACTIVE:
	    tk_interactive = TRUE;
	    c_token++;
	    break;
	case TK_INPUT:
	    tk_standalone = FALSE;
	    c_token++;
	    break;
	case TK_STANDALONE:
	    tk_standalone = TRUE;
	    c_token++;
	    break;
	case TK_NOROTTEXT:
	    term->text_angle = null_text_angle;
	    c_token++;
	    break;
	case TK_ROTTEXT:
	    term->text_angle = TK_text_angle;
	    c_token++;
	    break;
	case TK_BACKGROUND: {
	    long rgb;
	    int red, green, blue;

	    c_token++;
	    rgb = parse_color_name();
	    free(tk_background_opt);
	    tk_background_opt = NULL;
	    m_capture(&tk_background_opt, c_token-1, c_token);

	    red   = (rgb >> 16) & 0xff;
	    green = (rgb >>  8) & 0xff;
	    blue  = (rgb      ) & 0xff;
	    snprintf(tk_background, sizeof(tk_background), "#%02x%02x%02x", red, green, blue);
	    break;
	}
	case TK_NOBACKGROUND:
	    tk_background[0] = NUL;
	    free(tk_background_opt);
	    tk_background_opt = NULL;
	    c_token++;
	    break;
	case TK_ROUNDED:
	    tk_rounded = TRUE;
	    c_token++;
	    break;
	case TK_BUTT:
	    tk_rounded = FALSE;
	    c_token++;
	    break;
	case TK_SIZE: {
	    c_token++;
	    if (END_OF_COMMAND)
		int_error(c_token, "size requires 'width,heigth'");
	    tk_width = real_expression();
	    if (!equals(c_token++, ","))
		int_error(c_token, "size requires 'width,heigth'");
	    tk_height = real_expression();
	    if (tk_width < 1 || tk_height < 1)
		int_error(c_token, "size is out of range");
	    break;
	}
	case TK_ENHANCED:
	    c_token++;
	    term->flags |= TERM_ENHANCED_TEXT;
	    break;
	case TK_NOENHANCED:
	    c_token++;
	    term->flags &= ~TERM_ENHANCED_TEXT;
	    break;
	case TK_PIXELS:
	    c_token++;
	    term->image = NULL;
	    break;
	case TK_INLINEIMAGES:
	case TK_EXTERNALIMAGES:
	    c_token++;
	    term->image = TK_image;
	    break;
	case TK_OTHER:
	default:
	    c_token++;
	    int_error(c_token, "unknown option");
	    break;
	}
    }

    /* calculate the proper tic sizes and character size */
    term->h_char = TK_HCHAR * TK_XMAX / (double) tk_width + 0.5;
    term->h_tic  = TK_HTIC  * TK_XMAX / (double) tk_width + 0.5;
    term->v_char = TK_VCHAR * TK_YMAX / (double) tk_height + 0.5;
    term->v_tic  = TK_VTIC  * TK_YMAX / (double) tk_height + 0.5;

    /* FIXME: image support only available for Tcl */
    if ((term->image != NULL) && (tk_script_language != TK_LANG_TCL))
	term->image = NULL;

    /* FIXME: enhanced text only available for Tcl */
    if ((term->flags & TERM_ENHANCED_TEXT) && (tk_script_language != TK_LANG_TCL))
	term->flags &= ~TERM_ENHANCED_TEXT;

    sprintf(term_options, "%s%s %s %s%s %s %s %s size %d,%d",
	    tk_script_languages[tk_script_language],
	    tk_interactive ? " interactive" : "",
	    tk_standalone ? "standalone" : "input",
	    (tk_background[0] == NUL) ? "nobackground " : "background ",
	    (tk_background[0] == NUL) ? "" : tk_background_opt,
	    tk_rounded ? "rounded" : "butt",
	    term->text_angle == null_text_angle ? "norottext" : "rottext",
	    term->image == NULL ? "pixels" : "externalimages",
	    tk_width, tk_height);
}


TERM_PUBLIC void
TK_init()
{
    tk_image_counter = 0;
}


static char *tk_standalone_init[TK_LANG_MAX] = {
   /* Tcl */
    "canvas .c -width %d -height %d\n"
    "pack .c\n"
    "gnuplot .c\n\n",
  /* Perl */
    "use Tk;\n"
    "my $top = MainWindow->new;\n"
    "my $c = $top->Canvas(-width => %d, -height => %d)->pack;\n"
    "gnuplot($c);\n"
    "MainLoop;\n",
  /* Python */
    "from tkinter import *\n"
    "from tkinter import font\n"
    "root = Tk()\n"
    "c = Canvas(root, width=%d, height=%d)\n"
    "c.pack()\n"
    "gnuplot(c)\n"
    "root.mainloop()\n",
  /* Ruby */
    "require 'tk'\n"
    "root = TkRoot.new { title 'Ruby/Tk' }\n"
    "c = TkCanvas.new(root, 'width'=>%d, 'height'=>%d) { pack  { } }\n"
    "gnuplot(c)\n"
    "Tk.mainloop\n",
  /* Rexx */
    "/**/\n"
    "call RxFuncAdd 'TkLoadFuncs', 'rexxtk', 'TkLoadFuncs'\n"
    "call TkLoadFuncs\n"
    "cv = TkCanvas('.c', '-width', %d, '-height', %d)\n"
    "call TkPack cv\n"
    "call gnuplot cv\n"
    "do forever\n"
    "   interpret 'call' TkWait()\n"
    "end\n"
    "return 0\n\n"
    "exit:\nquit:\n"
    "call TkDropFuncs\n"
    "exit 0\n",
  /* Perl/Tkx */
    "use Tkx;\n"
    "my $top = Tkx::widget->new(\".\");\n"
    "my $c = $top->new_tk__canvas(-width => %d, -height => %d);\n"
    "$c->g_pack;\n"
    "gnuplot($c);\n"
    "Tkx::MainLoop();\n"
};


static char *tk_init_gnuplot[TK_LANG_MAX] = {
  /* Tcl */
    "proc %s cv {\n"
    "  $cv delete all\n"
    "  set cmx [expr\\\n"
    "    [winfo width $cv]-2*[$cv cget -border]"
    "-2*[$cv cget -highlightthickness]]\n"
    "  if {$cmx <= 1} {set cmx [$cv cget -width]}\n"
    "  set cmy [expr\\\n"
    "    [winfo height $cv]-2*[$cv cget -border]"
    "-2*[$cv cget -highlightthickness]]\n"
    "  if {$cmy <= 1} {set cmy [$cv cget -height]}\n",

  /* Perl */
    "sub %s {\n"
    "  my($cv) = @_;\n"
    "  $cv->delete('all');\n"
    "  my $cmx = $cv->width - 2 * $cv->cget(-border)\n"
    "            - 2 * $cv->cget(-highlightthickness);\n"
    "  if ($cmx <= 1) {\n"
    "    $cmx = ($cv->cget(-width));\n"
    "  }\n"
    "  my $cmy = $cv->height - 2 * $cv->cget(-border)\n"
    "            - 2 * $cv->cget(-highlightthickness);\n"
    "  if ($cmy <= 1) {\n"
    "    $cmy = ($cv->cget(-height));\n"
    "  }\n",

  /* Python */
    "def %s (cv):\n"
    "\tcv.delete('all')\n"
    "\tcmdelta = 2*(int(cv.cget('border'))+"
      "int(cv.cget('highlightthickness')))\n"
    "\tcmx = int(cv.cget('width'))-cmdelta\n"
    "\tif (cmx<=1):\n\t\tcmx = int(cv.cget('width'))\n"
    "\tcmy = int(cv.cget('height'))-cmdelta\n"
    "\tif (cmy<=1):\n\t\tcmy = int(cv.cget('height'))\n"
    "",

  /* Ruby (below, we NEED the blank in "- 2" !)*/
    "def %s(cv)\n"
    "  cv.delete('all')\n"
    "  cmx = cv.width - 2*cv.cget('border') - 2*cv.cget('highlightthickness')\n"
    "  cmx = cvcget.width  if (cmx <= 1)\n"
    "  cmy = cv.height - 2*cv.cget('border') - 2*cv.cget('highlightthickness')\n"
    "  cmy = cvcget.height if (cmy <= 1)\n"
    "",

  /* Rexx */
    "/**/\n"
    "call %s arg(1)\n"
    "return 0\n\n"
    "%s: procedure\n"
    "  cv = arg(1)\n"
    "  call TkCanvasDelete cv,'all'\n"
    "  cmx = TkCget(cv,'-width') - 2*TkCget(cv,'-border') - 2*TkCget(cv,'-highlightthickness')\n"
    "  if cmx <= 1 then; cmx = TkCget(cv,'-width')\n"
    "  cmy = TkCget(cv,'-height') - 2*TkCget(cv,'-border') - 2*TkCget(cv,'-highlightthickness')\n"
    "  if cmy <= 1 then; cmy = TkCget(cv,'-height')\n"
    "\n",

  /* Perl/Tkx */
    "sub %s {\n"
    "  my($cv) = @_;\n"
    "  $cv->delete('all');\n"
    "  my $cmx = $cv->get_width - 2 * $cv->cget(-border)\n"
    "            - 2 * $cv->cget(-highlightthickness);\n"
    "  if ($cmx <= 1) {\n"
    "    $cmx = ($cv->cget(-width));\n"
    "  }\n"
    "  my $cmy = $cv->get_height - 2 * $cv->cget(-border)\n"
    "            - 2 * $cv->cget(-highlightthickness);\n"
    "  if ($cmy <= 1) {\n"
    "    $cmy = ($cv->cget(-height));\n"
    "  }\n"
};


static char *tk_set_background[TK_LANG_MAX] = {
  /* Tcl */
    "  $cv configure -bg %s\n",
  /* Perl */
    "  $cv->configure(-bg => q{%s});\n",
  /* Python */
    "\tcv.configure(bg='%s')\n",
  /* Ruby */
    "  cv.configure('bg'=>'%s')\n",
  /* Rexx */
    "  call TkConfigure cv, '-bg', '%s'\n",
  /* Perl/Tkx */
    "  $cv->configure(-bg => q{%s});\n"
};

TERM_PUBLIC void
TK_graphics()
{
    /*
    * Here we start the definition of the `gnuplot` procedure.
    * The resulting script code takes the actual width and height
    * of the defined canvas and scales the plot to fit.
    * You can tune the output for a particular size of the canvas by
    * using the `size` option.
    */
    char * tk_function = "gnuplot";

    /* Reset to start of output file.  If the user mistakenly tries to	*/
    /* plot again into the same file, it will overwrite the original	*/
    /* rather than corrupting it.					*/
    fseek(gpoutfile, 0L, SEEK_SET);
    fflush(gpoutfile);
    ftruncate(fileno(gpoutfile), (off_t)0);

    if (!tk_standalone && 
	((tk_script_language == TK_LANG_PERL) || (tk_script_language == TK_LANG_PERLTKX)))
	tk_function = "";
    if (tk_standalone && (tk_script_language == TK_LANG_REXX))
	fprintf(gpoutfile, tk_standalone_init[tk_script_language], tk_width, tk_height);
    fprintf(gpoutfile, tk_init_gnuplot[tk_script_language], tk_function, tk_function);

    tk_angle = tk_lastx = tk_lasty = 0;
    safe_strncpy(tk_color, tk_colors[0], sizeof(tk_color));

    /* set background */
    if (tk_background[0] != NUL) {
	//TK_rectangle(0, 0, TK_XMAX, TK_YMAX, tk_background, "");
	fprintf(gpoutfile, tk_set_background[tk_script_language], tk_background);
    }
}


TERM_PUBLIC void
TK_reset()
{
    free(tk_path_x);
    free(tk_path_y);
    tk_path_x = tk_path_y = NULL;
    tk_polygon_points = tk_maxpath = 0;
}


TERM_PUBLIC void
TK_linetype(int linetype)
{
    t_colorspec colorspec;

    colorspec.type = TC_LT;
    colorspec.lt = linetype;
    TK_color(&colorspec);

    TK_dashtype(DASHTYPE_SOLID, NULL);
}


TERM_PUBLIC int
TK_make_palette(t_sm_palette *palette)
{
    return 0; /* we can do RGB colors */
}


TERM_PUBLIC void
TK_color(t_colorspec *colorspec)
{
    char tmp_color[20];

    safe_strncpy(tmp_color, tk_color, sizeof(tmp_color));

    switch (colorspec->type) {
    case TC_LT: {
	    int linetype = colorspec->lt;
	    char * color = NULL;

	    if (linetype == LT_BACKGROUND)
		color = (tk_background[0] != NUL) ? tk_background : "white";
	    if (linetype == LT_NODRAW)
		color = "";
	    if (color == NULL) {
		if (linetype < LT_BLACK)
		    linetype = LT_BLACK;
		color = (char *) tk_colors[(linetype + 2) % 8];
	    }
	    safe_strncpy(tmp_color, color, sizeof(tmp_color));
	    break;
	}
    case TC_FRAC: {
	    rgb255_color rgb255;

	    /* Immediately translate palette index to RGB colour */
	    rgb255maxcolors_from_gray(colorspec->value, &rgb255);
	    snprintf(tmp_color, sizeof(tmp_color), "#%02x%02x%02x", rgb255.r, rgb255.g, rgb255.b);
	    break;
	}
    case TC_RGB: {
	    int red, green, blue;

	    red = (colorspec->lt >> 16) & 0xff;
	    green = (colorspec->lt >> 8) & 0xff;
	    blue = (colorspec->lt) & 0xff;
	    snprintf(tmp_color, sizeof(tk_color), "#%02x%02x%02x", red, green, blue);
	    break;
	}
    }

    if (strcmp(tk_color, tmp_color) != 0) {
	TK_flush_line();
	safe_strncpy(tk_color, tmp_color, sizeof(tk_color));
    }
}


TERM_PUBLIC void
TK_linewidth(double linewidth)
{
    if (fabs(tk_linewidth - linewidth) > FLT_EPSILON)
	TK_flush_line();
    tk_linewidth = linewidth;
}


TERM_PUBLIC void
TK_dashtype(int dt, t_dashtype *custom_dash_pattern)
{
    int i;
    char tmp_dashpattern[3*DASHPATTERN_LENGTH];
    TBOOLEAN preserve = FALSE;

    if (dt >= 0) {
	// {PS_SOLID, PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT};
	dt %= 5;
	dt += 2;
	strcpy(tmp_dashpattern, tk_dashtypes[dt]);
    } else if (dt == DASHTYPE_SOLID) {
	tmp_dashpattern[0] = NUL;
    } else if (dt == DASHTYPE_AXIS) {
	strcpy(tmp_dashpattern, tk_dashtypes[1]);
    } else if (dt == DASHTYPE_CUSTOM) {
	if (custom_dash_pattern->dstring != NULL) {
	    /* Tk and gnuplot support the very same dash pattern syntax. */
	    strncpy(tmp_dashpattern, custom_dash_pattern->dstring, sizeof(tmp_dashpattern));
	    preserve = TRUE; /* do not change pattern */
	} else {
	    tmp_dashpattern[0] = NUL;
	    for (i = 0; (i < DASHPATTERN_LENGTH/2) && (fabs(custom_dash_pattern->pattern[2*i]) > FLT_EPSILON); i++) {
		char buf[32];
		snprintf(buf, sizeof(buf), "%d %d ", 
		    (int) (custom_dash_pattern->pattern[2*i] * tk_linewidth),
		    (int) (custom_dash_pattern->pattern[2*i + 1] * tk_linewidth));
		strncat(tmp_dashpattern, buf, sizeof(tmp_dashpattern) - strlen(tmp_dashpattern));
	    }
	    tmp_dashpattern[strlen(tmp_dashpattern) - 1] = NUL;
	}
    }

    if ((tk_script_language == TK_LANG_PYTHON) && !preserve) {
	for (i = 0; tmp_dashpattern[i] != NUL; i++)
	    if (tmp_dashpattern[i] == ' ')
		tmp_dashpattern[i] = ',';
    }

    if (strcmp(tk_dashpattern, tmp_dashpattern) != 0) {
	TK_flush_line();
	safe_strncpy(tk_dashpattern, tmp_dashpattern, sizeof(tk_dashpattern));
    }
}


TERM_PUBLIC void
TK_move(unsigned int x, unsigned int y)
{
    /* terminate current path if we move to a disconnected position */
    if (tk_polygon_points > 0) {
	if ((tk_path_x[tk_polygon_points - 1] != x) ||
	    (tk_path_y[tk_polygon_points - 1] != TK_YMAX - y))
	    TK_flush_line();
	else
	    return;
    }

    TK_add_path_point(x, TK_YMAX - y);
    tk_lastx = x;
    tk_lasty = TK_YMAX - y;
}


/* FIXME HBB 20000725: should use AXIS_UNDO_LOG() macro... */
#define TK_REAL_VALUE(value,axis)				\
(axis_array[axis].log)						\
    ? pow(axis_array[axis].base, axis_array[axis].min		\
	  + value*(axis_array[axis].max-axis_array[axis].min))	\
	: axis_array[axis].min					\
          + value*(axis_array[axis].max-axis_array[axis].min)

#define TK_X_VALUE(value) \
 (double)(value-plot_bounds.xleft)/(double)(plot_bounds.xright-plot_bounds.xleft)

#define TK_Y_VALUE(value) \
 (double)((TK_YMAX-value)-plot_bounds.ybot)/(double)(plot_bounds.ytop-plot_bounds.ybot)


static char *tk_bind_init[TK_LANG_MAX] = {
   /* Tcl */
    "  $cv bind [\n  ",
  /* Perl */
    "  $cv->bind(\n  ",
  /* Python */
    "",
  /* Ruby */
    "",
  /* Rexx */
    "",
  /* Perl/Tkx */
    "  $cv->bind(\n  "
};

static char *tk_line_segment_start[TK_LANG_MAX] = {
  /* Tcl */
    "  $cv create line\\\n",
  /* Perl */
    "  $cv->createLine(\n",
  /* Python */
    "\tcv.create_line(\\\n",
  /* Ruby */
    "  cl=TkcLine.new(cv,\\\n",
  /* Rexx */
    "  obj = TkCanvasLine(cv, ,\n",
  /* Perl/Tkx */
    "  $cv->create_line(\n"
};

static char *tk_poly_point[TK_LANG_MAX] = {
  /* Tcl */
    "    [expr $cmx*%d/1000] [expr $cmy*%d/1000]\\\n",
  /* Perl */
    "    $cmx*%d/1000, $cmy*%d/1000,\n",
  /* Python */
    "\t\tcmx*%d/1000, cmy*%d/1000,\\\n",
  /* Ruby */
    "    cmx*%d/1000, cmy*%d/1000,\\\n",
  /* Rexx */
    "\tcmx*%d/1000, cmy*%d/1000, ,\n",
  /* Perl/Tkx */
    "    $cmx*%d/1000, $cmy*%d/1000,\n"
};

static char *tk_line_segment_opt[TK_LANG_MAX] = {
  /* Tcl */
    "    -fill {%s} -width %.1f -capstyle %s -joinstyle %s",
  /* Perl */
    "    -fill => q{%s}, -width => %.1f, -capstyle => q{%s}, -joinstyle => q{%s}",
  /* Python */
    "\t\tfill='%s', width=%.1f, capstyle='%s', joinstyle='%s'",
  /* Ruby */
    "    'fill'=>'%s', 'width'=>%.1f, 'capstyle'=>'%s', 'joinstyle'=>'%s'",
  /* Rexx */
    "\t'-fill', '%s', '-width', '%.1f', '-capstyle', '%s', '-joinstyle', '%s'",
  /* Perl/Tkx */
    "    -fill => q{%s}, -width => %.1f, -capstyle => q{%s}, -joinstyle => q{%s}",
};

static char *tk_line_segment_dash[TK_LANG_MAX] = {
  /* Tcl */
    " -dash {%s}",
  /* Perl */
    ", -dash => q{%s}",
  /* Python */
    ", dash=(%s)",
  /* Ruby */
    ", 'dash'=>'%s'",
  /* Rexx */
    ", '-dash', '%s'",
  /* Perl/Tkx */
    ", -dash => q{%s}"
};

static char *tk_line_segment_end[TK_LANG_MAX] = {
  /* Tcl */
    "\n",
  /* Perl */
    ")",
  /* Python */
    ")\n",
  /* Ruby */
    ")\n",
  /* Rexx */
    ")\n",
  /* Perl/Tkx */
    ")"
};

static char *tk_bind_main[TK_LANG_MAX] = {
  /* Tcl */
    "    ] <Button> \"gnuplot_xy %%W %f %f %f %f\\\n"
    "       %f %f %f %f",
  /* Perl */
    ",\n    '<Button>' => "
    "[\\&gnuplot_xy, %f, %f, %f, %f,\n"
    "       %f, %f, %f, %f",
  /* Python */
    /* FIXME: how can one bind an event to a line segment in Python/TkCanvas ? */
    "",
  /* Ruby */
    "  cl.bind('Button', proc{ gnuplot_xy(%f, %f, %f, %f,\\\n"
    "    %f, %f, %f, %f",
  /* FIXME: Rexx interactive binding untested */
    "  call TkCanvasBind cv, obj, 'Button',  ,\n"
    "    'gnuplot_xy %f, %f, %f, %f,' ,\n"
    "    '%f, %f, %f, %f' ,\n"
    "    ",
  /* Perl/Tkx */
    ",\n    '<Button>' => "
    "[\\&gnuplot_xy, %f, %f, %f, %f,\n"
    "       %f, %f, %f, %f"
};

static char *tk_bind_f[TK_LANG_MAX] = {
   /* Tcl */
    " %f",
  /* Perl */
    ", %f",
  /* Python */
    "",
  /* Ruby */
    ", %f",
  /* Rexx */
    " || ', %f'",
  /* Perl/Tkx */
    ", %f",
};

static char *tk_bind_nil[TK_LANG_MAX] = {
   /* Tcl */
    " {}",
  /* Perl */
    ", \"\"",
  /* Python */
    "",
  /* Ruby */
    ", ''",
  /* Rexx */
    " || ', \'\''",
  /* Perl/Tkx */
    ", \"\""
};

static char *tk_bind_end[TK_LANG_MAX] = {
   /* Tcl */
    "\"\n",
  /* Perl */
    "]);\n",
  /* Python */
    "",
  /* Ruby */
    ") })\n",
  /* Rexx */
    "\n",
  /* Perl/Tkx */
    "]);\n"
};

static char *tk_nobind[TK_LANG_MAX] = {
   /* Tcl */
    "",
  /* Perl */
    ";\n",
  /* Python */
    "",
  /* Ruby */
    "",
  /* Rexx */
    "",
  /* Perl/Tkx */
    ";\n"
};

TERM_PUBLIC void
TK_vector(unsigned int x, unsigned int y)
{
    if ((x != tk_lastx) || (TK_YMAX - y != tk_lasty))
	TK_add_path_point(x, TK_YMAX - y);
    tk_lastx = x;
    tk_lasty = TK_YMAX - y;
    return;
}


static void
TK_flush_line(void)
{
    int x, y, i;

    if (tk_in_path)
	tk_in_path = FALSE;

    if (tk_polygon_points < 2) {
	tk_polygon_points = 0;
	return;
    }

    /*
    * this is the 1st part of the wrapper around the 'create line' command
    * used to bind some actions to a line segment:
    * bind {
    *      normal create line command
    *      } gnuplot_xy(some coordinates)
    */
    /* prepare the binding mechanism */
    if (tk_interactive && !is_3d_plot)
	fprintf(gpoutfile, "%s", tk_bind_init[tk_script_language]);

    /* draw a line segment */
    fprintf(gpoutfile,  "%s", tk_line_segment_start[tk_script_language]);
    for (i = 0; i < tk_polygon_points; i++)
	fprintf(gpoutfile, tk_poly_point[tk_script_language], tk_path_x[i], tk_path_y[i]);
    fprintf(gpoutfile, tk_line_segment_opt[tk_script_language], tk_color, tk_linewidth,
	tk_rounded ? "round" : "butt", tk_rounded ? "round" : "miter");
    if (tk_dashpattern[0] != NUL)
	fprintf(gpoutfile, tk_line_segment_dash[tk_script_language], tk_dashpattern);
    fprintf(gpoutfile,  "%s", tk_line_segment_end[tk_script_language]);

    /* finish the binding mechanism
	* (which calls 'gnuplot_xy' for the line segment pointed to by
	* the mouse cursor when a mouse button is pressed)
	*/
    x = tk_path_x[tk_polygon_points -1];
    y = tk_path_y[tk_polygon_points -1];
    if (tk_interactive && !is_3d_plot) {
	fprintf(gpoutfile, tk_bind_main[tk_script_language],
		TK_REAL_VALUE(TK_X_VALUE(tk_lastx), FIRST_X_AXIS),
		TK_REAL_VALUE(TK_Y_VALUE(tk_lasty), FIRST_Y_AXIS),
		TK_REAL_VALUE(TK_X_VALUE(tk_lastx), SECOND_X_AXIS),
		TK_REAL_VALUE(TK_Y_VALUE(tk_lasty), SECOND_Y_AXIS),
		TK_REAL_VALUE(TK_X_VALUE(x), FIRST_X_AXIS),
		TK_REAL_VALUE(TK_Y_VALUE(y), FIRST_Y_AXIS),
		TK_REAL_VALUE(TK_X_VALUE(x), SECOND_X_AXIS),
		TK_REAL_VALUE(TK_Y_VALUE(y), SECOND_Y_AXIS));
	    if (axis_array[FIRST_X_AXIS].log)
		fprintf(gpoutfile, tk_bind_f[tk_script_language],
			TK_REAL_VALUE(TK_X_VALUE(0.5 * (x + tk_lastx)),
			FIRST_X_AXIS));
	    else
		fprintf(gpoutfile, "%s", tk_bind_nil[tk_script_language]);
	    if (axis_array[FIRST_Y_AXIS].log)
		fprintf(gpoutfile, tk_bind_f[tk_script_language],
		    TK_REAL_VALUE(TK_Y_VALUE(0.5 * (y + tk_lasty)),
		    FIRST_Y_AXIS));
	    else
		fprintf(gpoutfile, "%s", tk_bind_nil[tk_script_language]);
	    if (axis_array[SECOND_X_AXIS].log)
		fprintf(gpoutfile, tk_bind_f[tk_script_language],
		    TK_REAL_VALUE(TK_X_VALUE(0.5 * (x + tk_lastx)),
		    SECOND_X_AXIS));
	    else
		fprintf(gpoutfile, "%s", tk_bind_nil[tk_script_language]);
	    if (axis_array[SECOND_Y_AXIS].log)
		fprintf(gpoutfile, tk_bind_f[tk_script_language],
		    TK_REAL_VALUE(TK_Y_VALUE(0.5 * (y + tk_lasty)),
		    SECOND_Y_AXIS));
	    else
		fprintf(gpoutfile, "%s", tk_bind_nil[tk_script_language]);
	    fprintf(gpoutfile, "%s", tk_bind_end[tk_script_language]);
    } else {
	fprintf(gpoutfile, "%s", tk_nobind[tk_script_language]);
    }
    tk_polygon_points = 0;
    tk_in_path = FALSE;
}

#undef TK_REAL_VALUE
#undef TK_X_VALUE
#undef TK_Y_VALUE


TERM_PUBLIC int
TK_text_angle(int ang)
{
    tk_angle = ang;
    return TRUE;
}


static char *tk_create_text_begin[TK_LANG_MAX] = {
  /* Tcl */
    "  $cv create text "
    "[expr $cmx * %d /1000] [expr $cmy * %d /1000]\\\n"
    "    -text {%s} -fill %s\\\n"
    "    -anchor %s",
  /* Perl */
    "  $cv->createText($cmx * %d / 1000, $cmy * %d / 1000,\n"
    "    -text => q{%s}, -fill => q{%s}, -anchor => '%s'",
  /* Python */
    "\tcv.create_text(cmx*%d/1000, cmy*%d/1000,\\\n"
    "\t\ttext='%s', fill='%s', anchor='%s'",
  /* Ruby */
    "  ct=TkcText.new(cv, cmx*%d/1000, cmy*%d/1000,\\\n"
    "    'text'=>'%s', 'fill'=>'%s', 'anchor'=>'%s'",
  /* Rexx */
    "  call TkCanvasText cv, cmx*%d/1000, cmy*%d/1000, ,\n"
    "\t'-text', '%s', '-fill', '%s', '-anchor', '%s'",
  /* Perl/Tkx */
    "  $cv->create_text($cmx * %d / 1000, $cmy * %d / 1000,\n"
    "    -text => q{%s}, -fill => q{%s}, -anchor => '%s'"
};

static char *tk_create_text_font[TK_LANG_MAX] = {
  /* Tcl */
    " -font $font",
  /* Perl */
    ",\n    -font => $font",
  /* Python */
    ", font=gfont",
  /* Ruby */
    ", 'font'=>font",
  /* Rexx */
    ", '-font', font",
  /* Perl/Tkx */
    ",\n    (defined $font ? (-font => $font) : ())"
};

static char *tk_create_text_angle[TK_LANG_MAX] = {
  /* Tcl */
    " -angle %d",
  /* Perl */
    ", -angle => %d",
  /* Python */
    ", angle=%d",
  /* Ruby */
    ", 'angle'=>%d",
  /* Rexx */
    ", '-angle', %d",
  /* Perl/Tkx */
    ", -angle => %d"
};

static char *tk_tag[TK_LANG_MAX] = {
  /* Tcl */
    " -tags %s",
  /* Perl */
    ", -tags => q{%s}",
  /* Python */
    ", tags='%s'",
  /* Ruby */
    ", 'tags'=>'%s'",
  /* Rexx */
    ", '-tags', '%s'",
  /* Perl/Tkx */
    ", -tags => q{%s}"
};

static char *tk_create_text_end[TK_LANG_MAX] = {
  /* Tcl */
    "\n",
  /* Perl */
    ");\n",
  /* Python */
    ")\n",
  /* Ruby */
    ")\n",
  /* Rexx */
    "\n",
  /* Perl/Tkx */
    ");\n"
};

static void
TK_put_noenhanced_text(unsigned int x, unsigned int y, const char *str)
{
    char *quoted_str = (char *) str;
    int i, newsize = 0;

    TK_flush_line();
    if (tk_script_language == TK_LANG_TCL) {
	/* Have to escape several characters: []{}"$; */
	for (i = 0; str[i] != '\0'; i++) {
	    if ((str[i] == '[') || (str[i] == ']') ||
		(str[i] == '{') || (str[i] == '}') ||
		(str[i] == '$') || (str[i] == ';'))
		newsize++;
	    newsize++;
	}
	quoted_str = (char *) gp_alloc(newsize + 1, "TK_put_text: quoted string");

	for (i = 0, newsize = 0; str[i] != '\0'; i++) {
	    if ((str[i] == '[') || (str[i] == ']') ||
		(str[i] == '{') || (str[i] == '}') ||
		(str[i] == '$') || (str[i] == ';'))
		quoted_str[newsize++] = '\\';
	    quoted_str[newsize++] = str[i];
	}
	quoted_str[newsize] = '\0';
    }
    if ((tk_script_language == TK_LANG_REXX) ||
	(tk_script_language == TK_LANG_RUBY) ||
	(tk_script_language == TK_LANG_PYTHON)) {
	/* Have to quote-protect "'" characters */
	for (i = 0; str[i] != '\0'; i++) {
	    if (str[i] == '\'')
		newsize ++;
	    newsize++;
	}
	quoted_str = (char *) gp_alloc(newsize + 1, "TK_put_text: quoted string");

	for (i = 0, newsize = 0; str[i] != '\0'; i++) {
	    if (str[i] == '\'')
		quoted_str[newsize++] = (tk_script_language == TK_LANG_REXX) ? '\'' : '\\';
	    quoted_str[newsize++] = str[i];
	}
	quoted_str[newsize] = '\0';
    }

    y = TK_YMAX - y;
    fprintf(gpoutfile, tk_create_text_begin[tk_script_language],
	    x, y, quoted_str, tk_color, tk_anchor);
    if (tk_next_text_use_font) {
	fprintf(gpoutfile, "%s", tk_create_text_font[tk_script_language]);
	tk_next_text_use_font = FALSE;
    }
    if (tk_angle != 0)
	fprintf(gpoutfile, tk_create_text_angle[tk_script_language], tk_angle);
    if (tk_boxed)
	fprintf(gpoutfile, tk_tag[tk_script_language], "boxedtext");
    fprintf(gpoutfile, "%s", tk_create_text_end[tk_script_language]);

    if (quoted_str != str)
	free(quoted_str);
}


static char *tk_undef_font[TK_LANG_MAX] = {
  /* Tcl */
    "  catch {unset font}\n",
  /* Perl */
    "  undef $font;\n",
  /* Python */
    "",
  /* Ruby */
    "",
  /* Rexx */
    "  drop font\n",
  /* Perl/Tkx */
    "  undef $font;\n"
};

static char *tk_set_font[TK_LANG_MAX] = {
  /* Tcl */
    "  set font [font create -family {%s}",
  /* Perl */
    "  $font = $cv->fontCreate(-family => q{%s}",
  /* Python */
    "\tgfont = font.Font(family='%s'",
  /* Ruby */
    "  font = TkFont.new :family => '%s'",
  /* Rexx */
    "  font = TkFontCreate( , '-family', '%s'",
  /* Perl/Tkx */
    "  $font = Tkx::font_create(-family => q{%s}"
};

static char *tk_set_fsize[TK_LANG_MAX] = {
   /* Tcl */
    " -size %d",
  /* Perl */
    ", -size => %d",
  /* Python */
    ", size=%d",
  /* Ruby */
    ", :size => %d",
  /* Rexx */
    ", '-size', '%d'",
  /* Perl/Tkx */
    ", -size => %d"
};

static char *tk_set_fbold[TK_LANG_MAX] = {
   /* Tcl */
    " -weight bold",
  /* Perl */
    ", -weight => q{bold}",
  /* Python */
    ", weight='bold'",
  /* Ruby */
    ", :weight => 'bold'",
  /* Rexx */
    ", '-weight', 'bold'",
  /* Perl/Tkx */
    ", -weight => q{bold}"
};

static char *tk_set_fitalic[TK_LANG_MAX] = {
   /* Tcl */
    " -slant italic",
  /* Perl */
    ", -slant => q{italic}",
  /* Python */
    ", slant='italic'",
  /* Ruby */
    ", :slant => 'italic'",
  /* Rexx */
    ", '-slant', 'italic'",
  /* Perl/Tkx */
    ", -slant => q{italic}"
};

static char *tk_font_end[TK_LANG_MAX] = {
   /* Tcl */
    "]\n",
  /* Perl */
    ");\n",
  /* Python */
    ")\n",
  /* Ruby */
    "\n",
  /* Rexx */
    ")\n",
  /* Perl/Tkx */
    ");\n"
};

TERM_PUBLIC int
TK_set_font(const char *font)
{
    if (!font || *font == NUL) {
	tk_next_text_use_font = FALSE;
	fputs(tk_undef_font[tk_script_language], gpoutfile);
    } else {
	char *name;
	int size = 0;
	size_t sep1 = strcspn(font, ",");
	size_t sep2 = strcspn(font, ":");
	size_t sep = GPMIN(sep1, sep2);
	TBOOLEAN isbold, isitalic;

	/* extract font name */
	name = (char *) gp_alloc(sep + 1, "TK_set_font");
	if (!name)
	    return FALSE;
	strncpy(name, font, sep);
	name[sep] = NUL;

	/* bold, italic */
	isbold = (strstr(font, ":Bold") != NULL);
	isitalic = (strstr(font, ":Italic") != NULL);

	/* font size */
	if (sep1 < strlen(font))
	    sscanf(&(font[sep1 + 1]), "%d", &size);

	fprintf(gpoutfile, tk_set_font[tk_script_language], name);
	if (size > 0)
	    fprintf(gpoutfile, tk_set_fsize[tk_script_language], size);
	if (isbold)
	    fprintf(gpoutfile, "%s", tk_set_fbold[tk_script_language]);
	if (isitalic)
	    fprintf(gpoutfile, "%s", tk_set_fitalic[tk_script_language]);
	fputs(tk_font_end[tk_script_language], gpoutfile);
	tk_next_text_use_font = TRUE;

	free(name);
    }
    return TRUE;
}


TERM_PUBLIC void
TK_enhanced_open(char *fontname, double fontsize, double base,
    TBOOLEAN widthflag, TBOOLEAN showflag, int overprint)
{
    if (overprint == 3) { /* save current position */
	fprintf(gpoutfile, "set xenh_save $xenh; set yenh_save $yenh;\n");
	return;
    } else if (overprint == 4) { /* restore saved position */
	fprintf(gpoutfile, "set xenh $xenh_save; set yenh $yenh_save;\n");
	return;
    }

    if (!tk_enhanced_opened_string) {
	TBOOLEAN isbold, isitalic;
	char * family, * sep;

	tk_enhanced_opened_string = TRUE;
	/* Start new text fragment */
	enhanced_cur_text = &enhanced_text[0];
	/* Scale fractional font height to vertical units of display */
	tk_enhanced_base = base * TK_HCHAR;
	/* Keep track of whether we are supposed to show this string */
	tk_enhanced_show = showflag;
	/* 0/1/2  no overprint / 1st pass / 2nd pass */
	tk_enhanced_overprint = overprint;
	/* widthflag FALSE means do not update text position after printing */
	tk_enhanced_widthflag = widthflag;

	/* set new font */
	family = gp_strdup(fontname);
	sep = strchr(family, ':');
	if (sep != NULL) *sep = NUL;
	isbold = (strstr(fontname, ":Bold") != NULL);
	isitalic = (strstr(fontname, ":Italic") != NULL);
	fprintf(gpoutfile, tk_set_font[tk_script_language], family);
	if (fontsize > 0)
	    fprintf(gpoutfile, tk_set_fsize[tk_script_language], (int) (fontsize));
	if (isbold)
	    fprintf(gpoutfile, "%s", tk_set_fbold[tk_script_language]);
	if (isitalic)
	    fprintf(gpoutfile, "%s", tk_set_fitalic[tk_script_language]);
	fputs(tk_font_end[tk_script_language], gpoutfile);
	tk_next_text_use_font = TRUE;
	free(family);
    }
}


static char *tk_enhanced_text_begin[TK_LANG_MAX] = {
  /* Tcl */
    "  set et [$cv create text $%s $%s\\\n"
    "    -text {%s} -fill %s\\\n"
    "    -anchor %s",
  /* Perl */
    "  $cv->createText($cmx * %d / 1000, $cmy * %d / 1000,\n"
    "    -text => q{%s}, -fill => q{%s}, -anchor => '%s'",
  /* Python */
    "\tcv.create_text(cmx*%d/1000, cmy*%d/1000,\\\n"
    "\t\ttext='%s', fill='%s', anchor='%s'",
  /* Ruby */
    "  ct=TkcText.new(cv, cmx*%d/1000, cmy*%d/1000,\\\n"
    "    'text'=>'%s', 'fill'=>'%s', 'anchor'=>'%s'",
  /* Rexx */
    "  call TkCanvasText cv, cmx*%d/1000, cmy*%d/1000, ,\n"
    "\t'-text', '%s', '-fill', '%s', '-anchor', '%s'",
  /* Perl/Tkx */
    "  $cv->create_text($cmx * %d / 1000, $cmy * %d / 1000,\n"
    "    -text => q{%s}, -fill => q{%s}, -anchor => '%s'"
};

static char *tk_enhanced_text_end[TK_LANG_MAX] = {
  /* Tcl */
    "]\n",
  /* Perl */
    ");\n",
  /* Python */
    ")\n",
  /* Ruby */
    ")\n",
  /* Rexx */
    "\n",
  /* Perl/Tkx */
    ");\n"
};

TERM_PUBLIC void
TK_enhanced_flush()
{
    char *str = enhanced_text;	/* The fragment to print */

    if (!tk_enhanced_opened_string)
	return;

    *enhanced_cur_text = NUL;

    /* print the string fragment in any case */
    /* NB: base expresses offset from current y pos */
    fprintf(gpoutfile, "set yenh [expr int($yenhb + %d)]\n",  (int) (-tk_enhanced_base/5 * cos(tk_angle * DEG2RAD)));
    fprintf(gpoutfile, "set xenh [expr int($xenhb + %d)]\n",  (int) (-tk_enhanced_base/5 * sin(tk_angle * DEG2RAD)));
    fprintf(gpoutfile, tk_enhanced_text_begin[tk_script_language],
			"xenh", "yenh", str, tk_color, tk_anchor);
    if (tk_next_text_use_font) {
	fprintf(gpoutfile, "%s", tk_create_text_font[tk_script_language]);
	tk_next_text_use_font = FALSE;
    }
    if (!tk_boxed)
	fprintf(gpoutfile, tk_tag[tk_script_language], "enhancedtext");
    else
	fprintf(gpoutfile, tk_tag[tk_script_language], "boxedtext");
    fprintf(gpoutfile, "%s", tk_enhanced_text_end[tk_script_language]);

    if (!tk_enhanced_widthflag)
	/* don't update position */
	;
    else if (tk_enhanced_overprint == 1) {
	/* First pass of overprint, leave position in center of fragment */
	//fprintf(gpoutfile, "incr xenh [expr ([lindex [$cv bbox $et] 2] - [lindex [$cv bbox $et] 0]) / 2]\n");
	fprintf(gpoutfile, "set width [expr ([lindex [$cv bbox $et] 2] - [lindex [$cv bbox $et] 0])]\n");
	fprintf(gpoutfile, "incr xenhb [expr int($width * %f)]\n", + cos(tk_angle * DEG2RAD) / 2);
	fprintf(gpoutfile, "incr yenhb [expr int($width * %f)]\n", - sin(tk_angle * DEG2RAD) / 2);
    } else {
	/* Normal case is to update position to end of fragment */
	//fprintf(gpoutfile, "set xenh [lindex [$cv bbox $et] 2]\n");
	fprintf(gpoutfile, "set width [expr ([lindex [$cv bbox $et] 2] - [lindex [$cv bbox $et] 0])]\n");
	fprintf(gpoutfile, "incr xenhb [expr int($width * %f)]\n", + cos(tk_angle * DEG2RAD));
	fprintf(gpoutfile, "incr yenhb [expr int($width * %f)]\n", - sin(tk_angle * DEG2RAD));
    }

    if (tk_angle != 0)
	fprintf(gpoutfile, "$cv itemconfigure $et -angle %d\n", tk_angle);

    if (!tk_enhanced_show)
	fprintf(gpoutfile, "$cv delete $et\n");

    tk_enhanced_opened_string = FALSE;
}


static void
TK_put_enhanced_text(unsigned int x, unsigned int y, const char *str)
{
    /* Set up global variables needed by enhanced_recursion() */
    enhanced_fontscale = 1.0;
    strncpy(enhanced_escape_format, "%c", sizeof(enhanced_escape_format));
    tk_enhanced_opened_string = FALSE;

    tk_lastx = x;
    tk_lasty = TK_YMAX - y;

    fprintf(gpoutfile, "set xenh0 [expr $cmx * %d /1000]; set yenh0 [expr $cmy * %d /1000];\n", x, TK_YMAX - y);
    fprintf(gpoutfile, "set xenh $xenh0; set yenh $yenh0;\n");
    fprintf(gpoutfile, "set xenhb $xenh0; set yenhb $yenh0;\n");
    strcpy(tk_anchor, "w");

    /* Set the recursion going. We say to keep going until a
	* closing brace, but we don't really expect to find one.
	* If the return value is not the nul-terminator of the
	* string, that can only mean that we did find an unmatched
	* closing brace in the string. We increment past it (else
	* we get stuck in an infinite loop) and try again.
	*/
    while (*(str = enhanced_recursion((char *)str, TRUE,
			    "" /* font */, 10 /* size */,
			    0.0, TRUE, TRUE, 0))) {
	    (term->enhanced_flush)();

	    /* I think we can only get here if *str == '}' */
	    enh_err_check(str);

	    if (!*++str)
		    break; /* end of string */

	    /* else carry on and process the rest of the string */
    }

    if (tk_justify == RIGHT)
	fprintf(gpoutfile, "$cv move enhancedtext [expr ($xenh0 - $xenhb)] [expr ($yenh0 - $yenhb)]\n");
    else if (tk_justify == CENTRE)
	fprintf(gpoutfile, "$cv move enhancedtext [expr ($xenh0 - $xenhb)/2] [expr ($yenh0 - $yenhb)/2]\n");
    fprintf(gpoutfile, "$cv dtag enhancedtext\n");
}


TERM_PUBLIC void
TK_put_text(unsigned int x, unsigned int y, const char *str)
{
    if ((str == NULL) || !strlen(str)) return;

    /* If no enhanced text processing is needed, we can use the plain  */
    /* vanilla put_text() routine instead of the fancy recursive one. */
    /* FIXME: enhanced text only implemented for Tcl */
    if (!(term->flags & TERM_ENHANCED_TEXT) || ignore_enhanced_text || !strpbrk(str, "{}^_@&~") ||
	(tk_script_language != TK_LANG_TCL))
	TK_put_noenhanced_text(x, y, str);
    else
	TK_put_enhanced_text(x, y, str);
}


TERM_PUBLIC int
TK_justify_text(enum JUSTIFY anchor)
{
    int return_value;

    switch (anchor) {
    case RIGHT:
	strcpy(tk_anchor, "e");
	return_value = TRUE;
	break;
    case CENTRE:
	strcpy(tk_anchor, "center");
	return_value = TRUE;
	break;
    case LEFT:
	strcpy(tk_anchor, "w");
	return_value = TRUE;
	break;
    default:
	strcpy(tk_anchor, "w");
	return_value = FALSE;
    }
    tk_justify = anchor;
    return return_value;
}


TERM_PUBLIC void 
TK_point(unsigned int x, unsigned int y, int point)
{
    TK_flush_line();

    if (point >= 0) {
	do_point(x, y, point);
    } else {
	/* Emulate dots by a line of length 1 */
	TK_dashtype(DASHTYPE_SOLID, NULL);
	TK_move(x, y);
	TK_vector(x, y+1);
	TK_flush_line();
    }
}


static char *tk_line_arrow[TK_LANG_MAX] = {
  /* Tcl */
    " -arrow %s",
  /* Perl */
    ", -arrow => q{%s}",
  /* Python */
    ", arrow='%s'",
  /* Ruby */
    ", 'arrow'=>'%s'",
  /* Rexx */
    ", '-arrow', '%s'",
  /* Perl/Tkx */
    ", -arrow => q{%s}"
};

static char *tk_line_arrowshape[TK_LANG_MAX] = {
  /* Tcl */
    " -arrowshape {%d %d %d}",
  /* Perl */
    ", -arrowshape => [%d, %d, %d]",
  /* Python */
    ", arrowshape=(%d, %d, %d)",
  /* Ruby */
    ", 'arrowshape'=>[%d, %d, %d]",
  /* Rexx */
    ", '-arrowshape', '%d %d %d'",
  /* Perl/Tkx */
    ", -arrowshape => [%d, %d, %d]"
};

TERM_PUBLIC
void TK_arrow(unsigned int usx, unsigned int usy, unsigned int uex, unsigned int uey, int head)
{
    /* NOHEAD = 0, END_HEAD = 1, BACKHEAD = 2, BOTH_HEADS = 3 */
    const char * arrow[BOTH_HEADS + 1] = { "none", "last", "first", "both" };
    /* NOTE: we really need integer arguments. Why are the arguments unsigned in the first place? */
    int sx = (int) usx;
    int sy = (int) usy;
    int ex = (int) uex;
    int ey = (int) uey;

    TK_flush_line();
    if (curr_arrow_headfilled >= AS_FILLED) { /* AS_FILLED, AS_NOBORDER */
	assert(abs(head) <= BOTH_HEADS);

	fprintf(gpoutfile, "%s", tk_line_segment_start[tk_script_language]);
	fprintf(gpoutfile, tk_poly_point[tk_script_language], sx, TK_YMAX - sy);
	fprintf(gpoutfile, tk_poly_point[tk_script_language], ex, TK_YMAX - ey);
	fprintf(gpoutfile, tk_line_segment_opt[tk_script_language], tk_color, tk_linewidth,
	    tk_rounded ? "round" : "butt", tk_rounded ? "round" : "miter");
	if (curr_arrow_headlength > 0) {
	    /* This should exactly mimic the behaviour of do_arrow() */
	    int width   = sin(curr_arrow_headangle * DEG2RAD) * curr_arrow_headlength;
	    int tiplen  = cos(curr_arrow_headangle * DEG2RAD) * curr_arrow_headlength;
	    int backlen = width / tan(curr_arrow_headbackangle * DEG2RAD);
	    int length  = tiplen - backlen;

	    /* impose lower limit on thickness of tips */
	    if (4 * length < tiplen) length = tiplen / 4;
	    if (length <= 1) length = 2;
	    if (tiplen < 1) tiplen = 1;

	    if (fabs(curr_arrow_headlength) < DBL_EPSILON)
		head = NOHEAD;
	    fprintf(gpoutfile, tk_line_arrow[tk_script_language], arrow[abs(head)]);
	    fprintf(gpoutfile, tk_line_arrowshape[tk_script_language], length, tiplen, width);
	} else if (head != NOHEAD) {
	    double dx = sx - ex;
	    double dy = sy - ey;
	    double len_arrow = sqrt(dx * dx + dy * dy);
	    double len_tic = ((double) (term->h_tic + term->v_tic)) / 2.0;
	    double head_coeff = GPMAX(len_tic * HEAD_SHORT_LIMIT, GPMIN(HEAD_COEFF * len_arrow, len_tic * HEAD_LONG_LIMIT));
	    int length = (int) (COS15 * head_coeff);
	    int width  = (int) (SIN15 * head_coeff);

	    fprintf(gpoutfile, tk_line_arrow[tk_script_language], arrow[abs(head)]);
	    fprintf(gpoutfile, tk_line_arrowshape[tk_script_language], length, length, width);
	}
	if (tk_dashpattern[0] != NUL)
	    fprintf(gpoutfile, tk_line_segment_dash[tk_script_language], tk_dashpattern);
	fprintf(gpoutfile, "%s", tk_line_segment_end[tk_script_language]);
	fprintf(gpoutfile, "%s", tk_nobind[tk_script_language]);
    } else { /* AS_NOFILL, AS_EMPTY */
	/* fall back to internal routine since we cannot do non-filled arrows */
	do_arrow(sx, sy, ex, ey, head);
    }
}


static char *tk_endblock[TK_LANG_MAX] = {
   /* Tcl */
    "}\n",
  /* Perl */
    "};\n",
  /* Python */
    "",
  /* Ruby */
    "end\n",
  /* Rexx */
    "return 0\n\n",
  /* Perl/Tkx */
    "};\n"
};

static char *tk_info_procs[TK_LANG_MAX] = {
  /* Tcl */
    "proc gnuplot_plotarea {} {\n"
    "  return {%d %d %d %d}\n"
    "}\n"
    "proc gnuplot_axisranges {} {\n"
    "  return {%f %f %f %f\n"
    "          %f %f %f %f}\n"
    "}\n",

  /* Perl */
    "sub gnuplot_plotarea {\n"
    "  return (%d, %d, %d, %d);\n"
    "};\n"
    "sub gnuplot_axisranges {\n"
    "  return (%f, %f, %f, %f,\n"
    "          %f, %f, %f, %f);\n"
    "};\n",

  /* Python */
    "def gnuplot_plotarea():\n"
    "\treturn (%d, %d, %d, %d)\n"
    "def gnuplot_axisranges():\n"
    "\treturn (%f, %f, %f, %f,\\\n"
    "\t        %f, %f, %f, %f)\n",
  
  /* Ruby */
    "def gnuplot_plotarea()\n"
    "  return [%d, %d, %d, %d]\n"
    "end\n"
    "def gnuplot_axisranges()\n"
    "  return [%f, %f, %f, %f,\\\n"
    "          %f, %f, %f, %f]\n"
    "end\n",

  /* Rexx */
    "gnuplot_plotarea: procedure\n"
    "return '%d %d %d %d'\n"
    "\n"
    "gnuplot_axisranges: procedure\n"
    "return '%f %f %f %f ' || ,\n"
    "       '%f %f %f %f'\n"
    "\n",

  /* Perl/Tkx */
    "sub gnuplot_plotarea {\n"
    "  return (%d, %d, %d, %d);\n"
    "};\n"
    "sub gnuplot_axisranges {\n"
    "  return (%f, %f, %f, %f,\n"
    "          %f, %f, %f, %f);\n"
    "};\n"
};

static char *tk_gnuplot_xy[] = {
  /* Tcl */
    "proc gnuplot_xy {win x1s y1s x2s y2s x1e y1e x2e y2e x1m y1m x2m y2m} {\n"
    "  if {([llength [info commands user_gnuplot_coordinates]])} {\n"
    "    set id [$win find withtag current]\n"
    "    user_gnuplot_coordinates $win $id \\\n"
    "      $x1s $y1s $x2s $y2s $x1e $y1e $x2e $y2e $x1m $y1m $x2m $y2m\n"
    "  } else {\n"
    "    if {[string length $x1m]>0} {puts -nonewline \" $x1m\"\n"
    "      } else {puts -nonewline \" [expr 0.5*($x1s+$x1e)]\"}\n"
    "    if {[string length $y1m]>0} {puts -nonewline \" $y1m\"\n"
    "      } else {puts -nonewline \" [expr 0.5*($y1s+$y1e)]\"}\n"
    "    if {[string length $x2m]>0} {puts -nonewline \" $x2m\"\n"
    "      } else {puts -nonewline \" [expr 0.5*($x2s+$x2e)]\"}\n"
    "    if {[string length $y2m]>0} {puts            \" $y2m\"\n"
    "      } else {puts            \" [expr 0.5*($y2s+$y2e)]\"}\n"
    "  }\n"
    "}\n",

  /* Perl */
    "sub gnuplot_xy {\n"
    "  my ($win, $x1s, $y1s, $x2s, $y2s, $x1e, $y1e, $x2e, $y2e,\n"
    "      $x1m, $y1m, $x2m, $y2m) = @_;\n"
    "  if (defined &user_gnuplot_coordinates) {\n"
    "    my $id = $win->find('withtag', 'current');\n"
    "    user_gnuplot_coordinates $win, $id, $x1s, $y1s, $x2s, $y2s,\n"
    "      $x1e, $y1e, $x2e, $y2e, $x1m, $y1m, $x2m, $y2m\n"
    "  } else {\n"
    "    print \" \", (length($x1m)>0 ? \"$x1m\": 0.5*($x1s+$x1e));\n"
    "    print \" \", (length($y1m)>0 ? \"$y1m\": 0.5*($y1s+$y1e));\n"
    "    print \" \", (length($x2m)>0 ? \"$x2m\": 0.5*($x2s+$x2e));\n"
    "    print \" \", (length($y2m)>0 ? \"$y2m\": 0.5*($y2s+$y2e));\n"
    "    print \"\\n\"\n"
    "  }\n"
    "};\n",
  /* Python */
    /* FIXME: how can one bind an event to a line segment in Python/TkCanvas ? */
    "",

  /* Ruby */
    "def gnuplot_xy(x1s, y1s, x2s, y2s, x1e, y1e, x2e, y2e,\n"
    "      x1m, y1m, x2m, y2m)\n"
//  "  if (defined &user_gnuplot_coordinates)\n"
//  "    id = win->find('withtag', 'current')\n"
//  "    user_gnuplot_coordinates (win, id, x1s, y1s, x2s, y2s,\\\n"
//  "      x1e, y1e, x2e, y2e, x1m, y1m, x2m, y2m)\n"
//  "  else\n"
    "    print \" \", x1m!='' ? x1m : 0.5*(x1s+x1e)\n"
    "    print \" \", y1m!='' ? y1m : 0.5*(y1s+y1e)\n"
    "    print \" \", x2m!='' ? x2m : 0.5*(x2s+x2e)\n"
    "    print \" \", y2m!='' ? y2m : 0.5*(y2s+y2e)\n"
    "    print \"\\n\""
//    "  end\n"
    "end\n",

  /* Rexx */
  /* FIXME: Rexx gnuplot_xy is untested */
    "gnuplot_xy: procedure\n"
    "  x1s=arg(1); y1s=arg(2); x2s=arg(3); y2s=arg(4);\n"
    "  x1e=arg(5); y1e=arg(6); x2e=arg(7); y2e=arg(8);\n"
    "  x1m=arg(9); y1m=arg(10); x2m=arg(11); y2m=arg(12);\n"
    "\n"
    "  outstr = ''\n"
    "  if (x1m\\='') then outstr = outstr x1m\n"
    "  else outstr = outstr (0.5*(x1s+x1e))\n"
    "  if (y1m\\='') then outstr = outstr y1m\n"
    "  else outstr = outstr (0.5*(y1s+y1e))\n"
    "  if (x2m\\='') then outstr = outstr x2m\n"
    "  else outstr = outstr (0.5*(x2s+x2e))\n"
    "  if (y2m\\='') then outstr = outstr y2m\n"
    "  else outstr = outstr (0.5*(y2s+y2e))\n"
    "\n"
    "  call lineout ,outstr\n"
    "return\n\n,"

  /* Perl/Tkx */
    "sub gnuplot_xy {\n"
    "  my ($win, $x1s, $y1s, $x2s, $y2s, $x1e, $y1e, $x2e, $y2e,\n"
    "      $x1m, $y1m, $x2m, $y2m) = @_;\n"
    "  if (defined &user_gnuplot_coordinates) {\n"
    "    my $id = $win->find('withtag', 'current');\n"
    "    user_gnuplot_coordinates $win, $id, $x1s, $y1s, $x2s, $y2s,\n"
    "      $x1e, $y1e, $x2e, $y2e, $x1m, $y1m, $x2m, $y2m\n"
    "  } else {\n"
    "    print \" \", (length($x1m)>0 ? \"$x1m\": 0.5*($x1s+$x1e));\n"
    "    print \" \", (length($y1m)>0 ? \"$y1m\": 0.5*($y1s+$y1e));\n"
    "    print \" \", (length($x2m)>0 ? \"$x2m\": 0.5*($x2s+$x2e));\n"
    "    print \" \", (length($y2m)>0 ? \"$y2m\": 0.5*($y2s+$y2e));\n"
    "    print \"\\n\"\n"
    "  }\n"
    "};\n"
};

TERM_PUBLIC void
TK_text()
{
    /*
    * when switching back to text mode some procedures are generated which
    * return important information about plotarea size and axis ranges:
    * 'gnuplot_plotarea'
    *     returns the plotarea size in tkcanvas units
    * 'gnuplot_axisranges'
    *     returns the min. and max. values of the axis
    *     (these are essentially needed to set the size of the canvas
    *     when the axis scaling is important.
    * 'gnuplot_xy'
    *     contains actions bound to line segments the mouse is pointing
    *     to (see the above 'TK_vector' code):
    *     if the user has defined a procedure named 'user_gnuplot_coordinates'
    *     then 'gnuplot_xy' calls this procedure, otherwise is writes the
    *     coordinates of the line segment the mouse cursor is pointing to
    *     to standard output.
    */

    TK_flush_line();
    fprintf(gpoutfile, "%s", tk_endblock[tk_script_language]);
    if (!is_3d_plot)
        fprintf(gpoutfile, tk_info_procs[tk_script_language],
                plot_bounds.xleft, plot_bounds.xright, TK_YMAX - plot_bounds.ytop, TK_YMAX - plot_bounds.ybot,
                axis_array[FIRST_X_AXIS].min,  axis_array[FIRST_X_AXIS].max,
                axis_array[FIRST_Y_AXIS].min,  axis_array[FIRST_Y_AXIS].max,
                axis_array[SECOND_X_AXIS].min, axis_array[SECOND_X_AXIS].max,
                axis_array[SECOND_Y_AXIS].min, axis_array[SECOND_Y_AXIS].max);
    if (tk_interactive)
        fputs(tk_gnuplot_xy[tk_script_language], gpoutfile);
    if (tk_standalone && (tk_script_language != TK_LANG_REXX))
	fprintf(gpoutfile, tk_standalone_init[tk_script_language], tk_width, tk_height);
    fflush(gpoutfile);
}


static char *tk_rectangle[TK_LANG_MAX] = {
  /* Tcl */
    "  $cv create rectangle\\\n"
    "    [expr $cmx*%d/1000] [expr $cmy*%d/1000]\\\n"
    "    [expr $cmx*%d/1000] [expr $cmy*%d/1000]\\\n"
    "    -fill %s -outline {} -stipple {%s}\n",
  /* Perl */
    "  $cv->createRectangle("
    "$cmx*%d/1000, $cmy*%d/1000, $cmx*%d/1000, $cmy*%d/1000,\n"
    "    -fill => q{%s}, -outline => q{}, -stipple => q{%s});\n",
  /* Python */
    "\tcv.create_rectangle(cmx*%d/1000, cmy*%d/1000, cmx*%d/1000, cmy*%d/1000,\\\n"
    "\t\tfill='%s', outline='', stipple='%s')\n",
  /* Ruby */
    "  cr=TkcRectangle.new("
    "cv, cmx*%d/1000, cmy*%d/1000, cmx*%d/1000, cmy*%d/1000,\\\n"
    "    'fill'=>'%s', 'outline'=>'', 'stipple'=>'%s')\n",
  /* Rexx */
    "  obj = TkCanvasRectangle("
    "cv, cmx*%d/1000, cmy*%d/1000, cmx*%d/1000, cmy*%d/1000, ,\n"
    "\t'-fill', '%s', '-outline', '', '-stipple', '%s')\n",
  /* Perl/Tkx */
    "  $cv->create_rectangle("
    "$cmx*%d/1000, $cmy*%d/1000, $cmx*%d/1000, $cmy*%d/1000,\n"
    "    -fill => q{%s}, -outline => q{}, -stipple => q{%s});\n"
};

static void
TK_rectangle(int x1, int y1, int x2, int y2, char * color, char * stipple)
{
    if (color == NULL) color = "";
    if (stipple == NULL) stipple = "";

    fprintf(gpoutfile, tk_rectangle[tk_script_language],
	x1, y1, x2, y2, color, stipple);
}


TERM_PUBLIC void
TK_fillbox(int style, unsigned int x, unsigned int y, unsigned int w, unsigned int h)
{
    char * stipple = "";
    char * color = tk_color;

    TK_flush_line();
    switch (style & 0x0f) {
	case FS_SOLID:
	case FS_TRANSPARENT_SOLID: {
	    int density = style >> 4;
	    if (density < 20)
		stipple = "gray12";
	    else if (density < 38)
		stipple = "gray25";
	    else if (density < 53)
		stipple = "gray50";
	    else if (density < 88)
		stipple = "gray75";
	    else
		stipple = "";
	    break;
	}
	case FS_PATTERN:
	case FS_TRANSPARENT_PATTERN: {
	    const char * patterns[] = {"gray50", "gray25", "gray12", "gray75", ""};
	    int pattern = style >> 4;
	    stipple = (char *) patterns[pattern % 5];
	    break;
	}
	case FS_EMPTY:
	    color = (tk_background[0] != NUL) ? tk_background : "white";
	    break;
	case FS_DEFAULT:
	default:
	    break;
    }
    TK_rectangle(x, TK_YMAX - y, x + w, TK_YMAX - y - h, color, stipple); 
}


static char *tk_poly_begin[TK_LANG_MAX] = {
  /* Tcl */
    "  $cv create polygon\\\n",
  /* Perl */
    "  $cv->createPolygon(\n",
  /* Python */
    "\tcv.create_polygon(\\\n",
  /* Ruby */
    "  cp=TkcPolygon.new(cv,\\\n",
  /* Rexx */
    "  obj = TkCanvasPolygon(cv, ,\n",
  /* Perl/Tkx */
    "  $cv->create_polygon(\n"
};

static char *tk_poly_end[TK_LANG_MAX] = {
  /* Tcl */
    "    -fill %s -outline {}\n",
  /* Perl */
    "    -fill => q{%s}, -outline => q{});\n",
  /* Python */
    "\t\tfill='%s', outline='')\n",
  /* Ruby */
    "    'fill'=>'%s', 'outline'=>'')\n",
  /* Rexx */
    "\t'-fill', '%s', '-outline', '')\n",
  /* Perl/Tkx */
    "    -fill => q{%s});\n",
};

TERM_PUBLIC void
TK_filled_polygon(int points, gpiPoint *corners)
{
    int i;

    TK_flush_line();
    /* avoid duplicate last point */
    if ((points > 2) && (corners[0].x == corners[points-1].x)  && (corners[0].y == corners[points-1].y))
	points--;

    fprintf(gpoutfile, "%s", tk_poly_begin[tk_script_language]); 
    for (i = 0; i < points; i++)
	fprintf(gpoutfile, tk_poly_point[tk_script_language], corners[i].x, TK_YMAX - corners[i].y); 
    fprintf(gpoutfile, tk_poly_end[tk_script_language], tk_color); 
}


TERM_PUBLIC void
TK_path(int p)
{
    if (p == 0) { /* start new path */
	TK_flush_line();
	tk_in_path = TRUE;
	tk_polygon_points = 0;
	FPRINTF((stderr, "tkcanvas: newpath\n"));
    } else if (p == 1) { /* close path */
	int i;

	FPRINTF((stderr, "tkcanvas: closepath: %i points\n", tk_polygon_points));
	if (tk_polygon_points > 1) {
	    fprintf(gpoutfile, "%s", tk_line_segment_start[tk_script_language]);
	    for (i = 0; i < tk_polygon_points; i++)
		fprintf(gpoutfile, tk_poly_point[tk_script_language], tk_path_x[i], tk_path_y[i]);
	    fprintf(gpoutfile, tk_line_segment_opt[tk_script_language], tk_color, tk_linewidth,
		tk_rounded ? "round" : "butt", tk_rounded ? "round" : "miter");
	    if (tk_dashpattern[0] != NUL)
		fprintf(gpoutfile, tk_line_segment_dash[tk_script_language], tk_dashpattern);
	    fprintf(gpoutfile, "%s", tk_line_segment_end[tk_script_language]);
	    fprintf(gpoutfile, "%s", tk_nobind[tk_script_language]);
	}
	tk_in_path = FALSE;
	tk_polygon_points = 0;
    }
}


static void
TK_add_path_point(int x, int y)
{
    if (tk_polygon_points >= tk_maxpath) {
	tk_maxpath += 10;
	tk_path_x = (int *) gp_realloc(tk_path_x, tk_maxpath * sizeof(int), "path_x");
	tk_path_y = (int *) gp_realloc(tk_path_y, tk_maxpath * sizeof(int), "path_y");
    }
    tk_path_x[tk_polygon_points] = x;
    tk_path_y[tk_polygon_points] = y;
    tk_polygon_points++;
    FPRINTF((stderr, "tkcanvas: new polygon point: %i %i\n", x, y));
}


#ifdef WRITE_PNG_IMAGE
TERM_PUBLIC void
TK_image(unsigned m, unsigned n, coordval * image, gpiPoint * corner, t_imagecolor color_mode) 
{
    int width  = ABS(corner[0].x - corner[1].x);
    int height = ABS(corner[0].y - corner[1].y);
    char * basename = "gp";
    char * fname;

    TK_flush_line();

    /* Write the image to a png file */
    fname = (char *) gp_alloc(strlen(basename) + 16, "TK_image");
    sprintf(fname, "%s_image_%02d.png", basename, ++tk_image_counter);
    write_png_image(m, n, image, color_mode, fname);

    /* FIXME: Only Tcl support, needs external `rescale` command. */
    fprintf(gpoutfile, "set image%d [image create photo -file {%s}]\n", tk_image_counter, fname);
    fprintf(gpoutfile, "set image%dr [resize $image%d [expr $cmx*%d/1000] [expr $cmy*%d/1000]]\n", tk_image_counter, tk_image_counter, width, height);
    fprintf(gpoutfile, "$cv create image [expr $cmx*%d/1000] [expr $cmy*%d/1000] -anchor nw -image $image%dr\n", corner[0].x, TK_YMAX - corner[0].y, tk_image_counter);
}
#endif

static char *tk_box[TK_LANG_MAX] = {
  /* Tcl */
    "  $cv raise boxedtext [$cv create rectangle [$cv bbox boxedtext] -fill {%s} -outline {%s}]\n",
  /* Perl */
    "  $cv->raise(q{boxedtext}, $cv->createRectangle($cv->bbox(q{boxedtext}),\n"
    "    -fill => q{%s}, -outline => q{%s}));\n",
  /* Python */
    "\tcv.tag_raise('boxedtext', cv.create_rectangle(cv.bbox('boxedtext'),\\\n"
    "\t\tfill='%s', outline='%s'))\n",
  /* Ruby */
    "  cr=cv.raise('boxedtext', TkcRectangle.new(cv, cv.bbox('boxedtext'),\\\n"
    "    'fill'=>'%s', 'outline'=>'%s'))\n",
  /* Rexx */
    "", /* TkCanvasRaise is not available */
/*
    "  obj = TkCanvasRaise(cv, 'boxedtext', TkCanvasRectangle(TkBbox(cv, 'boxedtext'), ,\n"
    "\t'-fill', '%s', '-outline', '%s'))\n",
*/
  /* Perl/Tkx */
    "  $cv->raise(q{boxedtext}, $cv->create_rectangle($cv->bbox(q{boxedtext}),\n"
    "    -fill => q{%s}, -outline => q{%s}));\n"
};

static char *tk_box_finish[TK_LANG_MAX] = {
  /* Tcl */
    "  $cv dtag boxedtext\n",
  /* Perl */
    "  $cv->dtag(q{boxedtext});\n",
  /* Python */
    "\tcv.dtag('boxedtext')\n",
  /* Ruby */
    "  cr=cv.dtag('boxedtext')\n",
  /* Rexx */
    "  obj = TkCanvasDTag(cv, 'boxedtext')\n",
  /* Perl/Tkx */
    "  $cv->dtag(q{boxedtext});\n"
};


#ifdef EAM_BOXED_TEXT
TERM_PUBLIC void
TK_boxed_text(unsigned int x, unsigned int y, int option)
{
    switch (option) {
    case TEXTBOX_INIT:
	tk_boxed = TRUE;
	break;
    case TEXTBOX_BACKGROUNDFILL:
	fprintf(gpoutfile, tk_box[tk_script_language], (tk_background[0] != NUL) ? tk_background : "white", "");
	break;
    case TEXTBOX_GREY:
	fprintf(gpoutfile, tk_box[tk_script_language], "grey75", "");
	break;
    case TEXTBOX_OUTLINE:
	fprintf(gpoutfile, tk_box[tk_script_language], "", "black");
	/* fall through, this also ends text box mode */
    case TEXTBOX_FINISH:
	fprintf(gpoutfile, "%s", tk_box_finish[tk_script_language]);
	tk_boxed = FALSE;
	break;
    case TEXTBOX_MARGINS:
	/* FIXME: cannot resize margins */
	break;
    }
}
#endif

#endif /* TERM_BODY */

#ifdef TERM_TABLE

TERM_TABLE_START(tkcanvas)
    "tkcanvas", "Tk canvas widget",
    TK_XMAX, TK_YMAX, TK_VCHAR, TK_HCHAR, TK_VTIC, TK_HTIC,
    TK_options, TK_init, TK_reset,
    TK_text, null_scale, TK_graphics, TK_move, TK_vector,
    TK_linetype, TK_put_text, null_text_angle,
    TK_justify_text, TK_point, TK_arrow, TK_set_font,
    NULL /* set_pointsize */,
    TERM_CAN_MULTIPLOT |  TERM_ENHANCED_TEXT,
    /* FIXME: Options not yet implemented */
    /* TERM_CAN_DASH | TERM_LINEWIDTH | TERM_FONTSCALE, */
    NULL /* suspend */, NULL /* resume */,
    TK_fillbox, TK_linewidth,
#ifdef USE_MOUSE
    NULL, NULL, NULL, NULL, NULL,
#endif
    TK_make_palette, NULL, TK_color,
    TK_filled_polygon, NULL /* image */,
    TK_enhanced_open, TK_enhanced_flush, do_enh_writec,
    NULL /* layer */, TK_path,
    0.0,
    NULL /* hypertext */,
#ifdef EAM_BOXED_TEXT
    TK_boxed_text, 
#endif
    NULL, TK_dashtype
TERM_TABLE_END(tkcanvas)
#undef LAST_TERM
#define LAST_TERM tkcanvas

#endif /* TERM_TABLE */
#endif /* TERM_PROTO_ONLY */

#ifdef TERM_HELP
START_HELP(tkcanvas)
"1 tkcanvas",
"?commands set terminal tkcanvas",
"?set terminal tkcanvas",
"?set term tkcanvas",
"?terminal tkcanvas",
"?term tkcanvas",
"?tkcanvas",
" This terminal driver generates Tk canvas widget commands in one of the",
" following scripting languages: Tcl (default), Perl, Python, Ruby, or REXX.",
"",
" Syntax:",
"       set terminal tkcanvas {tcl | perl | perltkx | python | ruby | rexx}",
"                             {standalone | input}",
"                             {interactive}",
"                             {rounded | butt}",
"                             {nobackground | background <rgb color>}",
"                             {{no}rottext}",
"                             {size <width>,<height>}",
"                             {{no}enhanced}",
"                             {externalimages | pixels}",
"",
" Execute the following sequence of Tcl/Tk commands to display the result:",
"",
"       package require Tk",
"       # the following two lines are only required to support external images",
"       package require img::png",
"       source resize.tcl",
"       source plot.tcl",
"       canvas .c -width 800 -height 600",
"       pack .c",
"       gnuplot .c",
"",
" Or, for Perl/Tk use a program like this:",
"",
"       use Tk;",
"       my $top = MainWindow->new;",
"       my $c = $top->Canvas(-width => 800, -height => 600)->pack;",
"       my $gnuplot = do \"plot.pl\";",
"       $gnuplot->($c);",
"       MainLoop;",
"",
" Or, for Perl/Tkx use a program like this:",
"",
"       use Tkx;",
"       my $top = Tkx::widget->new(\".\");",
"       my $c = $top->new_tk__canvas(-width => 800, -height => 600);",
"       $c->g_pack;",
"       my $gnuplot = do \"plot.pl\";",
"       $gnuplot->($c);",
"       Tkx::MainLoop();",
"",
" Or, for Python/Tkinter use a program like this:",
"",
"       from tkinter import *",
"       from tkinter import font",
"       root = Tk()",
"       c = Canvas(root, width=800, height=600)",
"       c.pack()",
"       exec(open('plot.py').read())",
"       gnuplot(c)",
"       root.mainloop()",
"",
" Or, for Ruby/Tk use a program like this:",
"",
"       require 'tk'",
"       root = TkRoot.new { title 'Ruby/Tk' }",
"       c = TkCanvas.new(root, 'width'=>800, 'height'=>600) { pack  { } }",
"       load('plot.rb')",
"       gnuplot(c)",
"       Tk.mainloop",
"",
" Or, for Rexx/Tk use a program like this:",
"",
"       /**/",
"       call RxFuncAdd 'TkLoadFuncs', 'rexxtk', 'TkLoadFuncs'",
"       call TkLoadFuncs",
"       cv = TkCanvas('.c', '-width', 800, '-height', 600)",
"       call TkPack cv",
"       call 'plot.rex' cv",
"       do forever",
"           cmd = TkWait()",
"           if cmd = 'AWinClose' then leave",
"           interpret 'call' cmd",
"       end",
"",
" The code generated by `gnuplot` (in the above examples, this code is",
" written to \"plot.<ext>\") contains the following procedures:",
"",
" gnuplot(canvas)",
"    takes the name of a canvas as its argument.",
"    When called, it clears the canvas, finds the size of the canvas and",
"    draws the plot in it, scaled to fit.",
"",
" gnuplot_plotarea()",
"    returns a list containing the borders of the plotting area",
"    (xleft, xright, ytop, ybot) in canvas screen coordinates."
"    It works only for 2-dimensional plotting (`plot`).",
"",
" gnuplot_axisranges()",
"    returns the ranges of the two axes in plot coordinates",
"    (x1min, x1max, y1min, y1max, x2min, x2max, y2min, y2max).",
"    It works only for 2-dimensional plotting (`plot`).",
"",
" You can create self-contained, minimal scripts using the `standalone`",
" option.  The default is `input` which creates scripts which have to be",
" source'd (or loaded or called or whatever the adequate term is for the",
" language selected.",
"",
" If the `interactive` option is specified, mouse clicking on a line segment",
" will print the coordinates of its midpoint to stdout.",
" The user can supersede this behavior by supplying a procedure",
" user_gnuplot_coordinates which takes the following arguments:",
"   win id x1s y1s x2s y2s x1e y1e x2e y2e x1m y1m x2m y2m,",
" i.e. the name of the canvas and the id of the line segment followed by the",
" coordinates of its start and end point in the two possible axis ranges; the",
" coordinates of the midpoint are only filled for logarithmic axes.",
"",
" By default the canvas is `transparent`, but an explicit background color",
" can be set with the `background `option.",
"",
" `rounded` sets line caps and line joins to be rounded;",
" `butt` is the default:  butt caps and mitered joins.",
"",
" Text at arbitrary angles can be activated with the `rottext` option,",
" which requires Tcl/Tk 8.6 or later. The default is `norottext`.",
"",
" The `size` option tries to optimize the tic and font sizes for the given",
" canvas size.  By default an output size of 800 x 600 pixels is assumed.",
"",
" `enhanced` selects `enhanced text` processing (default), but is currently",
" only available for Tcl.",
"",
" The `pixels` (default) option selects the failsafe pixel-by-pixel image",
" handler, see also `image pixels`.",
" The `externalimages` option saves images as external png images, which",
" are later loaded and scaled by the tkcanvas code.  This option is only",
" available for Tcl and display may be slow in some situations since the",
" Tk image handler does not provide arbitrary scaling.  Scripts need to source",
" the provided rescale.tcl.",
"",
" Interactive mode is not yet implemented for Python/Tk and Rexx/Tk.",
" Interactive mode for Ruby/Tk does not yet support user_gnuplot_coordinates."
END_HELP(tkcanvas)
#endif