tk/generic/tkCanvUtil.c

   1 /*
   2  * tkCanvUtil.c --
   3  *
   4  *      This procedure contains a collection of utility procedures
   5  *      used by the implementations of various canvas item types.
   6  *
   7  * Copyright (c) 1994 Sun Microsystems, Inc.
   8  * Copyright (c) 1994 Sun Microsystems, Inc.
   9  *
  10  * See the file "license.terms" for information on usage and redistribution
  11  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12  *
  13  * RCS: @(#) $Id$
  14  */
  15
  16 #include "tkInt.h"
  17 #include "tkCanvas.h"
  18 #include "tkPort.h"
  19
  20 \f
  21 /*
  22  *----------------------------------------------------------------------
  23  *
  24  * Tk_CanvasTkwin --
  25  *
  26  *      Given a token for a canvas, this procedure returns the
  27  *      widget that represents the canvas.
  28  *
  29  * Results:
  30  *      The return value is a handle for the widget.
  31  *
  32  * Side effects:
  33  *      None.
  34  *
  35  *----------------------------------------------------------------------
  36  */
  37
  38 Tk_Window
  39 Tk_CanvasTkwin(canvas)
  40     Tk_Canvas canvas;                   /* Token for the canvas. */
  41 {
  42     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  43     return canvasPtr->tkwin;
  44 }
  45 \f
  46 /*
  47  *----------------------------------------------------------------------
  48  *
  49  * Tk_CanvasDrawableCoords --
  50  *
  51  *      Given an (x,y) coordinate pair within a canvas, this procedure
  52  *      returns the corresponding coordinates at which the point should
  53  *      be drawn in the drawable used for display.
  54  *
  55  * Results:
  56  *      There is no return value.  The values at *drawableXPtr and
  57  *      *drawableYPtr are filled in with the coordinates at which
  58  *      x and y should be drawn.  These coordinates are clipped
  59  *      to fit within a "short", since this is what X uses in
  60  *      most cases for drawing.
  61  *
  62  * Side effects:
  63  *      None.
  64  *
  65  *----------------------------------------------------------------------
  66  */
  67
  68 void
  69 Tk_CanvasDrawableCoords(canvas, x, y, drawableXPtr, drawableYPtr)
  70     Tk_Canvas canvas;                   /* Token for the canvas. */
  71     double x, y;                        /* Coordinates in canvas space. */
  72     short *drawableXPtr, *drawableYPtr; /* Screen coordinates are stored
  73                                          * here. */
  74 {
  75     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  76     double tmp;
  77
  78     tmp = x - canvasPtr->drawableXOrigin;
  79     if (tmp > 0) {
  80         tmp += 0.5;
  81     } else {
  82         tmp -= 0.5;
  83     }
  84     if (tmp > 32767) {
  85         *drawableXPtr = 32767;
  86     } else if (tmp < -32768) {
  87         *drawableXPtr = -32768;
  88     } else {
  89         *drawableXPtr = (short) tmp;
  90     }
  91
  92     tmp = y  - canvasPtr->drawableYOrigin;
  93     if (tmp > 0) {
  94         tmp += 0.5;
  95     } else {
  96         tmp -= 0.5;
  97     }
  98     if (tmp > 32767) {
  99         *drawableYPtr = 32767;
 100     } else if (tmp < -32768) {
 101         *drawableYPtr = -32768;
 102     } else {
 103         *drawableYPtr = (short) tmp;
 104     }
 105 }
 106 \f
 107 /*
 108  *----------------------------------------------------------------------
 109  *
 110  * Tk_CanvasWindowCoords --
 111  *
 112  *      Given an (x,y) coordinate pair within a canvas, this procedure
 113  *      returns the corresponding coordinates in the canvas's window.
 114  *
 115  * Results:
 116  *      There is no return value.  The values at *screenXPtr and
 117  *      *screenYPtr are filled in with the coordinates at which
 118  *      (x,y) appears in the canvas's window.  These coordinates
 119  *      are clipped to fit within a "short", since this is what X
 120  *      uses in most cases for drawing.
 121  *
 122  * Side effects:
 123  *      None.
 124  *
 125  *----------------------------------------------------------------------
 126  */
 127
 128 void
 129 Tk_CanvasWindowCoords(canvas, x, y, screenXPtr, screenYPtr)
 130     Tk_Canvas canvas;                   /* Token for the canvas. */
 131     double x, y;                        /* Coordinates in canvas space. */
 132     short *screenXPtr, *screenYPtr;     /* Screen coordinates are stored
 133                                          * here. */
 134 {
 135     TkCanvas *canvasPtr = (TkCanvas *) canvas;
 136     double tmp;
 137
 138     tmp = x - canvasPtr->xOrigin;
 139     if (tmp > 0) {
 140         tmp += 0.5;
 141     } else {
 142         tmp -= 0.5;
 143     }
 144     if (tmp > 32767) {
 145         *screenXPtr = 32767;
 146     } else if (tmp < -32768) {
 147         *screenXPtr = -32768;
 148     } else {
 149         *screenXPtr = (short) tmp;
 150     }
 151
 152     tmp = y  - canvasPtr->yOrigin;
 153     if (tmp > 0) {
 154         tmp += 0.5;
 155     } else {
 156         tmp -= 0.5;
 157     }
 158     if (tmp > 32767) {
 159         *screenYPtr = 32767;
 160     } else if (tmp < -32768) {
 161         *screenYPtr = -32768;
 162     } else {
 163         *screenYPtr = (short) tmp;
 164     }
 165 }
 166 \f
 167 /*
 168  *--------------------------------------------------------------
 169  *
 170  * Tk_CanvasGetCoord --
 171  *
 172  *      Given a string, returns a floating-point canvas coordinate
 173  *      corresponding to that string.
 174  *
 175  * Results:
 176  *      The return value is a standard Tcl return result.  If
 177  *      TCL_OK is returned, then everything went well and the
 178  *      canvas coordinate is stored at *doublePtr;  otherwise
 179  *      TCL_ERROR is returned and an error message is left in
 180  *      the interp's result.
 181  *
 182  * Side effects:
 183  *      None.
 184  *
 185  *--------------------------------------------------------------
 186  */
 187
 188 int
 189 Tk_CanvasGetCoord(interp, canvas, string, doublePtr)
 190     Tcl_Interp *interp;         /* Interpreter for error reporting. */
 191     Tk_Canvas canvas;           /* Canvas to which coordinate applies. */
 192     CONST char *string;         /* Describes coordinate (any screen
 193                                  * coordinate form may be used here). */
 194     double *doublePtr;          /* Place to store converted coordinate. */
 195 {
 196     TkCanvas *canvasPtr = (TkCanvas *) canvas;
 197     if (Tk_GetScreenMM(canvasPtr->interp, canvasPtr->tkwin, string,
 198             doublePtr) != TCL_OK) {
 199         return TCL_ERROR;
 200     }
 201     *doublePtr *= canvasPtr->pixelsPerMM;
 202     return TCL_OK;
 203 }
 204
 205 /*
 206  *--------------------------------------------------------------
 207  *
 208  * Tk_CanvasGetCoordFromObj --
 209  *
 210  *      Given a string, returns a floating-point canvas coordinate
 211  *      corresponding to that string.
 212  *
 213  * Results:
 214  *      The return value is a standard Tcl return result.  If
 215  *      TCL_OK is returned, then everything went well and the
 216  *      canvas coordinate is stored at *doublePtr;  otherwise
 217  *      TCL_ERROR is returned and an error message is left in
 218  *      interp->result.
 219  *
 220  * Side effects:
 221  *      None.
 222  *
 223  *--------------------------------------------------------------
 224  */
 225
 226 int
 227 Tk_CanvasGetCoordFromObj(interp, canvas, obj, doublePtr)
 228     Tcl_Interp *interp;         /* Interpreter for error reporting. */
 229     Tk_Canvas canvas;           /* Canvas to which coordinate applies. */
 230     Tcl_Obj *obj;               /* Describes coordinate (any screen
 231                                  * coordinate form may be used here). */
 232     double *doublePtr;          /* Place to store converted coordinate. */
 233 {
 234     TkCanvas *canvasPtr = (TkCanvas *) canvas;
 235     if (Tk_GetMMFromObj(canvasPtr->interp, canvasPtr->tkwin, obj,
 236             doublePtr) != TCL_OK) {
 237         return TCL_ERROR;
 238     }
 239     *doublePtr *= canvasPtr->pixelsPerMM;
 240     return TCL_OK;
 241 }
 242 \f
 243 /*
 244  *----------------------------------------------------------------------
 245  *
 246  * Tk_CanvasSetStippleOrigin --
 247  *
 248  *      This procedure sets the stipple origin in a graphics context
 249  *      so that stipples drawn with the GC will line up with other
 250  *      stipples previously drawn in the canvas.
 251  *
 252  * Results:
 253  *      None.
 254  *
 255  * Side effects:
 256  *      The graphics context is modified.
 257  *
 258  *----------------------------------------------------------------------
 259  */
 260
 261 void
 262 Tk_CanvasSetStippleOrigin(canvas, gc)
 263     Tk_Canvas canvas;           /* Token for a canvas. */
 264     GC gc;                      /* Graphics context that is about to be
 265                                  * used to draw a stippled pattern as
 266                                  * part of redisplaying the canvas. */
 267
 268 {
 269     TkCanvas *canvasPtr = (TkCanvas *) canvas;
 270
 271     XSetTSOrigin(canvasPtr->display, gc, -canvasPtr->drawableXOrigin,
 272             -canvasPtr->drawableYOrigin);
 273 }
 274 \f
 275 /*
 276  *----------------------------------------------------------------------
 277  *
 278  * Tk_CanvasSetOffset--
 279  *
 280  *      This procedure sets the stipple offset in a graphics
 281  *      context so that stipples drawn with the GC will
 282  *      line up with other stipples with the same offset.
 283  *
 284  * Results:
 285  *      None.
 286  *
 287  * Side effects:
 288  *      The graphics context is modified.
 289  *
 290  *----------------------------------------------------------------------
 291  */
 292
 293 void
 294 Tk_CanvasSetOffset(canvas, gc, offset)
 295     Tk_Canvas canvas;           /* Token for a canvas. */
 296     GC gc;                      /* Graphics context that is about to be
 297                                  * used to draw a stippled pattern as
 298                                  * part of redisplaying the canvas. */
 299     Tk_TSOffset *offset;        /* offset (may be NULL pointer)*/
 300 {
 301     TkCanvas *canvasPtr = (TkCanvas *) canvas;
 302     int flags = 0;
 303     int x = - canvasPtr->drawableXOrigin;
 304     int y = - canvasPtr->drawableYOrigin;
 305
 306     if (offset != NULL) {
 307         flags = offset->flags;
 308         x += offset->xoffset;
 309         y += offset->yoffset;
 310     }
 311     if ((flags & TK_OFFSET_RELATIVE) && !(flags & TK_OFFSET_INDEX)) {
 312         Tk_SetTSOrigin(canvasPtr->tkwin, gc, x - canvasPtr->xOrigin,
 313                 y - canvasPtr->yOrigin);
 314     } else {
 315         XSetTSOrigin(canvasPtr->display, gc, x, y);
 316     }
 317 }
 318 \f
 319 /*
 320  *----------------------------------------------------------------------
 321  *
 322  * Tk_CanvasGetTextInfo --
 323  *
 324  *      This procedure returns a pointer to a structure containing
 325  *      information about the selection and insertion cursor for
 326  *      a canvas widget.  Items such as text items save the pointer
 327  *      and use it to share access to the information with the generic
 328  *      canvas code.
 329  *
 330  * Results:
 331  *      The return value is a pointer to the structure holding text
 332  *      information for the canvas.  Most of the fields should not
 333  *      be modified outside the generic canvas code;  see the user
 334  *      documentation for details.
 335  *
 336  * Side effects:
 337  *      None.
 338  *
 339  *----------------------------------------------------------------------
 340  */
 341
 342 Tk_CanvasTextInfo *
 343 Tk_CanvasGetTextInfo(canvas)
 344     Tk_Canvas canvas;                   /* Token for the canvas widget. */
 345 {
 346     return &((TkCanvas *) canvas)->textInfo;
 347 }
 348 \f
 349 /*
 350  *--------------------------------------------------------------
 351  *
 352  * Tk_CanvasTagsParseProc --
 353  *
 354  *      This procedure is invoked during option processing to handle
 355  *      "-tags" options for canvas items.
 356  *
 357  * Results:
 358  *      A standard Tcl return value.
 359  *
 360  * Side effects:
 361  *      The tags for a given item get replaced by those indicated
 362  *      in the value argument.
 363  *
 364  *--------------------------------------------------------------
 365  */
 366
 367 int
 368 Tk_CanvasTagsParseProc(clientData, interp, tkwin, value, widgRec, offset)
 369     ClientData clientData;              /* Not used.*/
 370     Tcl_Interp *interp;                 /* Used for reporting errors. */
 371     Tk_Window tkwin;                    /* Window containing canvas widget. */
 372     CONST char *value;                  /* Value of option (list of tag
 373                                          * names). */
 374     char *widgRec;                      /* Pointer to record for item. */
 375     int offset;                         /* Offset into item (ignored). */
 376 {
 377     register Tk_Item *itemPtr = (Tk_Item *) widgRec;
 378     int argc, i;
 379     CONST char **argv;
 380     Tk_Uid *newPtr;
 381
 382     /*
 383      * Break the value up into the individual tag names.
 384      */
 385
 386     if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) {
 387         return TCL_ERROR;
 388     }
 389
 390     /*
 391      * Make sure that there's enough space in the item to hold the
 392      * tag names.
 393      */
 394
 395     if (itemPtr->tagSpace < argc) {
 396         newPtr = (Tk_Uid *) ckalloc((unsigned) (argc * sizeof(Tk_Uid)));
 397         for (i = itemPtr->numTags-1; i >= 0; i--) {
 398             newPtr[i] = itemPtr->tagPtr[i];
 399         }
 400         if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
 401             ckfree((char *) itemPtr->tagPtr);
 402         }
 403         itemPtr->tagPtr = newPtr;
 404         itemPtr->tagSpace = argc;
 405     }
 406     itemPtr->numTags = argc;
 407     for (i = 0; i < argc; i++) {
 408         itemPtr->tagPtr[i] = Tk_GetUid(argv[i]);
 409     }
 410     ckfree((char *) argv);
 411     return TCL_OK;
 412 }
 413 \f
 414 /*
 415  *--------------------------------------------------------------
 416  *
 417  * Tk_CanvasTagsPrintProc --
 418  *
 419  *      This procedure is invoked by the Tk configuration code
 420  *      to produce a printable string for the "-tags" configuration
 421  *      option for canvas items.
 422  *
 423  * Results:
 424  *      The return value is a string describing all the tags for
 425  *      the item referred to by "widgRec".  In addition, *freeProcPtr
 426  *      is filled in with the address of a procedure to call to free
 427  *      the result string when it's no longer needed (or NULL to
 428  *      indicate that the string doesn't need to be freed).
 429  *
 430  * Side effects:
 431  *      None.
 432  *
 433  *--------------------------------------------------------------
 434  */
 435
 436 char *
 437 Tk_CanvasTagsPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
 438     ClientData clientData;              /* Ignored. */
 439     Tk_Window tkwin;                    /* Window containing canvas widget. */
 440     char *widgRec;                      /* Pointer to record for item. */
 441     int offset;                         /* Ignored. */
 442     Tcl_FreeProc **freeProcPtr;         /* Pointer to variable to fill in with
 443                                          * information about how to reclaim
 444                                          * storage for return string. */
 445 {
 446     register Tk_Item *itemPtr = (Tk_Item *) widgRec;
 447
 448     if (itemPtr->numTags == 0) {
 449         *freeProcPtr = (Tcl_FreeProc *) NULL;
 450         return "";
 451     }
 452     if (itemPtr->numTags == 1) {
 453         *freeProcPtr = (Tcl_FreeProc *) NULL;
 454         return (char *) itemPtr->tagPtr[0];
 455     }
 456     *freeProcPtr = TCL_DYNAMIC;
 457     return Tcl_Merge(itemPtr->numTags, (CONST char **) itemPtr->tagPtr);
 458 }
 459 \f
 460
 461 static int      DashConvert _ANSI_ARGS_((char *l, CONST char *p,
 462                         int n, double width));
 463 #define ABS(a) ((a>=0)?(a):(-(a)))
 464
 465 /*
 466  *--------------------------------------------------------------
 467  *
 468  * TkCanvasDashParseProc --
 469  *
 470  *      This procedure is invoked during option processing to handle
 471  *      "-dash", "-activedash" and "-disableddash" options for canvas
 472  *      objects.
 473  *
 474  * Results:
 475  *      A standard Tcl return value.
 476  *
 477  * Side effects:
 478  *      The dash list for a given canvas object gets replaced by
 479  *      those indicated in the value argument.
 480  *
 481  *--------------------------------------------------------------
 482  */
 483
 484 int
 485 TkCanvasDashParseProc(clientData, interp, tkwin, value, widgRec, offset)
 486     ClientData clientData;              /* Not used.*/
 487     Tcl_Interp *interp;                 /* Used for reporting errors. */
 488     Tk_Window tkwin;                    /* Window containing canvas widget. */
 489     CONST char *value;                  /* Value of option. */
 490     char *widgRec;                      /* Pointer to record for item. */
 491     int offset;                         /* Offset into item. */
 492 {
 493     return Tk_GetDash(interp, value, (Tk_Dash *)(widgRec+offset));
 494 }
 495 \f
 496 /*
 497  *--------------------------------------------------------------
 498  *
 499  * TkCanvasDashPrintProc --
 500  *
 501  *      This procedure is invoked by the Tk configuration code
 502  *      to produce a printable string for the "-dash", "-activedash"
 503  *      and "-disableddash" configuration options for canvas items.
 504  *
 505  * Results:
 506  *      The return value is a string describing all the dash list for
 507  *      the item referred to by "widgRec"and "offset".  In addition,
 508  *      *freeProcPtr is filled in with the address of a procedure to
 509  *      call to free the result string when it's no longer needed (or
 510  *      NULL to indicate that the string doesn't need to be freed).
 511  *
 512  * Side effects:
 513  *      None.
 514  *
 515  *--------------------------------------------------------------
 516  */
 517
 518 char *
 519 TkCanvasDashPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
 520     ClientData clientData;              /* Ignored. */
 521     Tk_Window tkwin;                    /* Window containing canvas widget. */
 522     char *widgRec;                      /* Pointer to record for item. */
 523     int offset;                         /* Offset in record for item. */
 524     Tcl_FreeProc **freeProcPtr;         /* Pointer to variable to fill in with
 525                                          * information about how to reclaim
 526                                          * storage for return string. */
 527 {
 528     Tk_Dash *dash = (Tk_Dash *) (widgRec+offset);
 529     char *buffer;
 530     char *p;
 531     int i = dash->number;
 532
 533     if (i < 0) {
 534         i = -i;
 535         *freeProcPtr = TCL_DYNAMIC;
 536         buffer = (char *) ckalloc((unsigned int) (i+1));
 537         p = (i > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
 538         memcpy(buffer, p, (unsigned int) i);
 539         buffer[i] = 0;
 540         return buffer;
 541     } else if (!i) {
 542         *freeProcPtr = (Tcl_FreeProc *) NULL;
 543         return "";
 544     }
 545     buffer = (char *)ckalloc((unsigned int) (4*i));
 546     *freeProcPtr = TCL_DYNAMIC;
 547
 548     p = (i > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
 549     sprintf(buffer, "%d", *p++ & 0xff);
 550     while(--i) {
 551         sprintf(buffer+strlen(buffer), " %d", *p++ & 0xff);
 552     }
 553     return buffer;
 554 }
 555 \f
 556 /*
 557  *--------------------------------------------------------------
 558  *
 559  * Tk_CreateSmoothMethod --
 560  *
 561  *      This procedure is invoked to add additional values
 562  *      for the "-smooth" option to the list.
 563  *
 564  * Results:
 565  *      A standard Tcl return value.
 566  *
 567  * Side effects:
 568  *      In the future "-smooth <name>" will be accepted as
 569  *      smooth method for the line and polygon.
 570  *
 571  *--------------------------------------------------------------
 572  */
 573
 574 Tk_SmoothMethod tkBezierSmoothMethod = {
 575     "bezier",
 576     TkMakeBezierCurve,
 577     (void (*) _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas,
 578             double *coordPtr, int numPoints, int numSteps)))
 579                 TkMakeBezierPostscript,
 580 };
 581
 582 static void SmoothMethodCleanupProc _ANSI_ARGS_((ClientData clientData,
 583                 Tcl_Interp *interp));
 584
 585 typedef struct SmoothAssocData {
 586     struct SmoothAssocData *nextPtr;    /* pointer to next SmoothAssocData */
 587     Tk_SmoothMethod smooth;             /* name and functions associated with this
 588                                          * option */
 589 } SmoothAssocData;
 590
 591 void
 592 Tk_CreateSmoothMethod(interp, smooth)
 593     Tcl_Interp *interp;
 594     Tk_SmoothMethod *smooth;
 595 {
 596     SmoothAssocData *methods, *typePtr2, *prevPtr, *ptr;
 597     methods = (SmoothAssocData *) Tcl_GetAssocData(interp, "smoothMethod",
 598             (Tcl_InterpDeleteProc **) NULL);
 599
 600     /*
 601      * If there's already a smooth method with the given name, remove it.
 602      */
 603
 604     for (typePtr2 = methods, prevPtr = NULL; typePtr2 != NULL;
 605             prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) {
 606         if (!strcmp(typePtr2->smooth.name, smooth->name)) {
 607             if (prevPtr == NULL) {
 608                 methods = typePtr2->nextPtr;
 609             } else {
 610                 prevPtr->nextPtr = typePtr2->nextPtr;
 611             }
 612             ckfree((char *) typePtr2);
 613             break;
 614         }
 615     }
 616     ptr = (SmoothAssocData *) ckalloc(sizeof(SmoothAssocData));
 617     ptr->smooth.name = smooth->name;
 618     ptr->smooth.coordProc = smooth->coordProc;
 619     ptr->smooth.postscriptProc = smooth->postscriptProc;
 620     ptr->nextPtr = methods;
 621     Tcl_SetAssocData(interp, "smoothMethod", SmoothMethodCleanupProc,
 622                 (ClientData) ptr);
 623 }
 624 /*
 625  *----------------------------------------------------------------------
 626  *
 627  * SmoothMethodCleanupProc --
 628  *
 629  *      This procedure is invoked whenever an interpreter is deleted
 630  *      to cleanup the smooth methods.
 631  *
 632  * Results:
 633  *      None.
 634  *
 635  * Side effects:
 636  *      Smooth methods are removed.
 637  *
 638  *----------------------------------------------------------------------
 639  */
 640
 641 static void
 642 SmoothMethodCleanupProc(clientData, interp)
 643     ClientData clientData;      /* Points to "smoothMethod" AssocData
 644                                  * for the interpreter. */
 645     Tcl_Interp *interp;         /* Interpreter that is being deleted. */
 646 {
 647     SmoothAssocData *ptr, *methods = (SmoothAssocData *) clientData;
 648
 649     while (methods != NULL) {
 650         methods = (ptr = methods)->nextPtr;
 651         ckfree((char *) ptr);
 652     }
 653 }
 654 /*
 655  *--------------------------------------------------------------
 656  *
 657  * TkSmoothParseProc --
 658  *
 659  *      This procedure is invoked during option processing to handle
 660  *      the "-smooth" option.
 661  *
 662  * Results:
 663  *      A standard Tcl return value.
 664  *
 665  * Side effects:
 666  *      The smooth option for a given item gets replaced by the value
 667  *      indicated in the value argument.
 668  *
 669  *--------------------------------------------------------------
 670  */
 671
 672 int
 673 TkSmoothParseProc(clientData, interp, tkwin, value, widgRec, offset)
 674     ClientData clientData;              /* some flags.*/
 675     Tcl_Interp *interp;                 /* Used for reporting errors. */
 676     Tk_Window tkwin;                    /* Window containing canvas widget. */
 677     CONST char *value;                  /* Value of option. */
 678     char *widgRec;                      /* Pointer to record for item. */
 679     int offset;                         /* Offset into item. */
 680 {
 681     register Tk_SmoothMethod **smoothPtr =
 682         (Tk_SmoothMethod **) (widgRec + offset);
 683     Tk_SmoothMethod *smooth = NULL;
 684     int b;
 685     size_t length;
 686     SmoothAssocData *methods;
 687
 688     if (value == NULL || *value == 0) {
 689         *smoothPtr = (Tk_SmoothMethod *) NULL;
 690         return TCL_OK;
 691     }
 692     length = strlen(value);
 693     methods = (SmoothAssocData *) Tcl_GetAssocData(interp, "smoothMethod",
 694             (Tcl_InterpDeleteProc **) NULL);
 695     while (methods != (SmoothAssocData *) NULL) {
 696         if (strncmp(value, methods->smooth.name, length) == 0) {
 697             if (smooth != (Tk_SmoothMethod *) NULL) {
 698                 Tcl_AppendResult(interp, "ambigeous smooth method \"", value,
 699                         "\"", (char *) NULL);
 700                 return TCL_ERROR;
 701             }
 702             smooth = &methods->smooth;
 703         }
 704         methods = methods->nextPtr;
 705     }
 706     if (smooth) {
 707         *smoothPtr = smooth;
 708         return TCL_OK;
 709     } else if (strncmp(value, tkBezierSmoothMethod.name, length) == 0) {
 710         /*
 711          * We need to do handle the built-in bezier method.
 712          */
 713         *smoothPtr = &tkBezierSmoothMethod;
 714         return TCL_OK;
 715     }
 716
 717
 718     if (Tcl_GetBoolean(interp, (char *) value, &b) != TCL_OK) {
 719         return TCL_ERROR;
 720     }
 721     *smoothPtr = b ? &tkBezierSmoothMethod : (Tk_SmoothMethod*) NULL;
 722     return TCL_OK;
 723 }
 724 /*
 725  *--------------------------------------------------------------
 726  *
 727  * TkSmoothPrintProc --
 728  *
 729  *      This procedure is invoked by the Tk configuration code
 730  *      to produce a printable string for the "-smooth"
 731  *      configuration option.
 732  *
 733  * Results:
 734  *      The return value is a string describing the smooth option for
 735  *      the item referred to by "widgRec".  In addition, *freeProcPtr
 736  *      is filled in with the address of a procedure to call to free
 737  *      the result string when it's no longer needed (or NULL to
 738  *      indicate that the string doesn't need to be freed).
 739  *
 740  * Side effects:
 741  *      None.
 742  *
 743  *--------------------------------------------------------------
 744  */
 745
 746 char *
 747 TkSmoothPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
 748     ClientData clientData;              /* Ignored. */
 749     Tk_Window tkwin;                    /* Window containing canvas widget. */
 750     char *widgRec;                      /* Pointer to record for item. */
 751     int offset;                         /* Offset into item. */
 752     Tcl_FreeProc **freeProcPtr;         /* Pointer to variable to fill in with
 753                                          * information about how to reclaim
 754                                          * storage for return string. */
 755 {
 756     register Tk_SmoothMethod **smoothPtr = (Tk_SmoothMethod **) (widgRec + offset);
 757
 758     return (*smoothPtr) ? (*smoothPtr)->name : "0";
 759 }
 760 /*
 761  *--------------------------------------------------------------
 762  *
 763  * Tk_GetDash
 764  *
 765  *      This procedure is used to parse a string, assuming
 766  *      it is dash information.
 767  *
 768  * Results:
 769  *      The return value is a standard Tcl result:  TCL_OK means
 770  *      that the dash information was parsed ok, and
 771  *      TCL_ERROR means it couldn't be parsed.
 772  *
 773  * Side effects:
 774  *      Dash information in the dash structure is updated.
 775  *
 776  *--------------------------------------------------------------
 777  */
 778
 779 int
 780 Tk_GetDash(interp, value, dash)
 781     Tcl_Interp *interp;         /* Used for error reporting. */
 782     CONST char *value;          /* Textual specification of dash list. */
 783     Tk_Dash *dash;              /* Pointer to record in which to
 784                                  * store dash information. */
 785 {
 786     int argc, i;
 787     CONST char **largv, **argv = NULL;
 788     char *pt;
 789
 790     if ((value==(char *) NULL) || (*value==0) ) {
 791         dash->number = 0;
 792         return TCL_OK;
 793     }
 794     if ((*value == '.') || (*value == ',') ||
 795             (*value == '-') || (*value == '_')) {
 796         i = DashConvert((char *) NULL, value, -1, 0.0);
 797         if (i>0) {
 798             i = strlen(value);
 799         } else {
 800             goto badDashList;
 801         }
 802         if (i > sizeof(char *)) {
 803             dash->pattern.pt = pt = (char *) ckalloc(strlen(value));
 804         } else {
 805             pt = dash->pattern.array;
 806         }
 807         memcpy(pt,value, (unsigned int) i);
 808         dash->number = -i;
 809         return TCL_OK;
 810     }
 811     if (Tcl_SplitList(interp, (char *) value, &argc, &argv) != TCL_OK) {
 812         Tcl_ResetResult(interp);
 813     badDashList:
 814         Tcl_AppendResult(interp, "bad dash list \"", value,
 815                 "\": must be a list of integers or a format like \"-..\"",
 816                 (char *) NULL);
 817     syntaxError:
 818         if (argv != NULL) {
 819             ckfree((char *) argv);
 820         }
 821         if (ABS(dash->number) > sizeof(char *))
 822             ckfree((char *) dash->pattern.pt);
 823         dash->number = 0;
 824         return TCL_ERROR;
 825     }
 826
 827     if (ABS(dash->number) > sizeof(char *)) {
 828         ckfree((char *) dash->pattern.pt);
 829     }
 830     if (argc > sizeof(char *)) {
 831         dash->pattern.pt = pt = (char *) ckalloc((unsigned int) argc);
 832     } else {
 833         pt = dash->pattern.array;
 834     }
 835     dash->number = argc;
 836
 837     largv = argv;
 838     while(argc>0) {
 839         if (Tcl_GetInt(interp, *largv, &i) != TCL_OK ||
 840             i < 1 || i>255) {
 841             Tcl_ResetResult(interp);
 842             Tcl_AppendResult(interp, "expected integer in the range 1..255 but got \"",
 843                          *largv, "\"", (char *) NULL);
 844             goto syntaxError;
 845         }
 846         *pt++ = i;
 847         argc--; largv++;
 848     }
 849
 850     if (argv != NULL) {
 851         ckfree((char *) argv);
 852     }
 853
 854     return TCL_OK;
 855 }
 856 \f
 857 /*
 858  *--------------------------------------------------------------
 859  *
 860  * Tk_CreateOutline
 861  *
 862  *      This procedure initializes the Tk_Outline structure
 863  *      with default values.
 864  *
 865  * Results:
 866  *      None
 867  *
 868  * Side effects:
 869  *      None
 870  *
 871  *--------------------------------------------------------------
 872  */
 873
 874 void Tk_CreateOutline(outline)
 875     Tk_Outline *outline;
 876 {
 877     outline->gc = None;
 878     outline->width = 1.0;
 879     outline->activeWidth = 0.0;
 880     outline->disabledWidth = 0.0;
 881     outline->offset = 0;
 882     outline->dash.number = 0;
 883     outline->activeDash.number = 0;
 884     outline->disabledDash.number = 0;
 885     outline->tsoffset.flags = 0;
 886     outline->tsoffset.xoffset = 0;
 887     outline->tsoffset.yoffset = 0;
 888     outline->color = NULL;
 889     outline->activeColor = NULL;
 890     outline->disabledColor = NULL;
 891     outline->stipple = None;
 892     outline->activeStipple = None;
 893     outline->disabledStipple = None;
 894 }
 895 \f
 896 /*
 897  *--------------------------------------------------------------
 898  *
 899  * Tk_DeleteOutline
 900  *
 901  *      This procedure frees all memory that might be
 902  *      allocated and referenced in the Tk_Outline structure.
 903  *
 904  * Results:
 905  *      None
 906  *
 907  * Side effects:
 908  *      None
 909  *
 910  *--------------------------------------------------------------
 911  */
 912
 913 void Tk_DeleteOutline(display, outline)
 914     Display *display;                   /* Display containing window */
 915     Tk_Outline *outline;
 916 {
 917     if (outline->gc != None) {
 918         Tk_FreeGC(display, outline->gc);
 919     }
 920     if (ABS(outline->dash.number) > sizeof(char *)) {
 921         ckfree((char *) outline->dash.pattern.pt);
 922     }
 923     if (ABS(outline->activeDash.number) > sizeof(char *)) {
 924         ckfree((char *) outline->activeDash.pattern.pt);
 925     }
 926     if (ABS(outline->disabledDash.number) > sizeof(char *)) {
 927         ckfree((char *) outline->disabledDash.pattern.pt);
 928     }
 929     if (outline->color != NULL) {
 930         Tk_FreeColor(outline->color);
 931     }
 932     if (outline->activeColor != NULL) {
 933         Tk_FreeColor(outline->activeColor);
 934     }
 935     if (outline->disabledColor != NULL) {
 936         Tk_FreeColor(outline->disabledColor);
 937     }
 938     if (outline->stipple != None) {
 939         Tk_FreeBitmap(display, outline->stipple);
 940     }
 941     if (outline->activeStipple != None) {
 942         Tk_FreeBitmap(display, outline->activeStipple);
 943     }
 944     if (outline->disabledStipple != None) {
 945         Tk_FreeBitmap(display, outline->disabledStipple);
 946     }
 947 }
 948 \f
 949 /*
 950  *--------------------------------------------------------------
 951  *
 952  * Tk_ConfigOutlineGC
 953  *
 954  *      This procedure should be called in the canvas object
 955  *      during the configure command. The graphics context
 956  *      description in gcValues is updated according to the
 957  *      information in the dash structure, as far as possible.
 958  *
 959  * Results:
 960  *      The return-value is a mask, indicating which
 961  *      elements of gcValues have been updated.
 962  *      0 means there is no outline.
 963  *
 964  * Side effects:
 965  *      GC information in gcValues is updated.
 966  *
 967  *--------------------------------------------------------------
 968  */
 969
 970 int Tk_ConfigOutlineGC(gcValues, canvas, item, outline)
 971     XGCValues *gcValues;
 972     Tk_Canvas canvas;
 973     Tk_Item *item;
 974     Tk_Outline *outline;
 975 {
 976     int mask = 0;
 977     double width;
 978     Tk_Dash *dash;
 979     XColor *color;
 980     Pixmap stipple;
 981     Tk_State state = item->state;
 982
 983     if (outline->width < 0.0) {
 984         outline->width = 0.0;
 985     }
 986     if (outline->activeWidth < 0.0) {
 987         outline->activeWidth = 0.0;
 988     }
 989     if (outline->disabledWidth < 0) {
 990         outline->disabledWidth = 0.0;
 991     }
 992     if (state==TK_STATE_HIDDEN) {
 993         return 0;
 994     }
 995
 996     width = outline->width;
 997     if (width < 1.0) {
 998         width = 1.0;
 999     }
1000     dash = &(outline->dash);
1001     color = outline->color;
1002     stipple = outline->stipple;
1003     if (state == TK_STATE_NULL) {
1004         state = ((TkCanvas *)canvas)->canvas_state;
1005     }
1006     if (((TkCanvas *)canvas)->currentItemPtr == item) {
1007         if (outline->activeWidth>width) {
1008             width = outline->activeWidth;
1009         }
1010         if (outline->activeDash.number != 0) {
1011             dash = &(outline->activeDash);
1012         }
1013         if (outline->activeColor!=NULL) {
1014             color = outline->activeColor;
1015         }
1016         if (outline->activeStipple!=None) {
1017             stipple = outline->activeStipple;
1018         }
1019     } else if (state==TK_STATE_DISABLED) {
1020         if (outline->disabledWidth>0) {
1021             width = outline->disabledWidth;
1022         }
1023         if (outline->disabledDash.number != 0) {
1024             dash = &(outline->disabledDash);
1025         }
1026         if (outline->disabledColor!=NULL) {
1027             color = outline->disabledColor;
1028         }
1029         if (outline->disabledStipple!=None) {
1030             stipple = outline->disabledStipple;
1031         }
1032     }
1033
1034     if (color==NULL) {
1035         return 0;
1036     }
1037
1038     gcValues->line_width = (int) (width + 0.5);
1039     if (color != NULL) {
1040         gcValues->foreground = color->pixel;
1041         mask = GCForeground|GCLineWidth;
1042         if (stipple != None) {
1043             gcValues->stipple = stipple;
1044             gcValues->fill_style = FillStippled;
1045             mask |= GCStipple|GCFillStyle;
1046         }
1047     }
1048     if (mask && (dash->number != 0)) {
1049         gcValues->line_style = LineOnOffDash;
1050         gcValues->dash_offset = outline->offset;
1051         if (dash->number >= 2) {
1052             gcValues->dashes = 4;
1053         } else if (dash->number > 0) {
1054             gcValues->dashes = dash->pattern.array[0];
1055         } else {
1056             gcValues->dashes = (char) (4 * width);
1057         }
1058         mask |= GCLineStyle|GCDashList|GCDashOffset;
1059     }
1060     return mask;
1061 }
1062 \f
1063 /*
1064  *--------------------------------------------------------------
1065  *
1066  * Tk_ChangeOutlineGC
1067  *
1068  *      Updates the GC to represent the full information of
1069  *      the dash structure. Partly this is already done in
1070  *      Tk_ConfigOutlineGC().
1071  *      This function should be called just before drawing
1072  *      the dashed item.
1073  *
1074  * Results:
1075  *      1 if there is a stipple pattern.
1076  *      0 otherwise.
1077  *
1078  * Side effects:
1079  *      GC is updated.
1080  *
1081  *--------------------------------------------------------------
1082  */
1083
1084 int
1085 Tk_ChangeOutlineGC(canvas, item, outline)
1086     Tk_Canvas canvas;
1087     Tk_Item *item;
1088     Tk_Outline *outline;
1089 {
1090     CONST char *p;
1091     double width;
1092     Tk_Dash *dash;
1093     XColor *color;
1094     Pixmap stipple;
1095     Tk_State state = item->state;
1096
1097     width = outline->width;
1098     if (width < 1.0) {
1099         width = 1.0;
1100     }
1101     dash = &(outline->dash);
1102     color = outline->color;
1103     stipple = outline->stipple;
1104     if (state == TK_STATE_NULL) {
1105         state = ((TkCanvas *)canvas)->canvas_state;
1106     }
1107     if (((TkCanvas *)canvas)->currentItemPtr == item) {
1108         if (outline->activeWidth > width) {
1109             width = outline->activeWidth;
1110         }
1111         if (outline->activeDash.number != 0) {
1112             dash = &(outline->activeDash);
1113         }
1114         if (outline->activeColor != NULL) {
1115             color = outline->activeColor;
1116         }
1117         if (outline->activeStipple != None) {
1118             stipple = outline->activeStipple;
1119         }
1120     } else if (state == TK_STATE_DISABLED) {
1121         if (outline->disabledWidth > width) {
1122             width = outline->disabledWidth;
1123         }
1124         if (outline->disabledDash.number != 0) {
1125             dash = &(outline->disabledDash);
1126         }
1127         if (outline->disabledColor != NULL) {
1128             color = outline->disabledColor;
1129         }
1130         if (outline->disabledStipple != None) {
1131             stipple = outline->disabledStipple;
1132         }
1133     }
1134     if (color==NULL) {
1135         return 0;
1136     }
1137
1138     if ((dash->number<-1) || ((dash->number == -1) && (dash->pattern.array[1]!=','))) {
1139         char *q;
1140         int i = -dash->number;
1141
1142         p = (i > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
1143         q = (char *) ckalloc(2*(unsigned int)i);
1144         i = DashConvert(q, p, i, width);
1145         XSetDashes(((TkCanvas *)canvas)->display, outline->gc, outline->offset, q, i);
1146         ckfree(q);
1147     } else if ( dash->number>2 || (dash->number==2 &&
1148                 (dash->pattern.array[0]!=dash->pattern.array[1]))) {
1149         p = (char *) (dash->number > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
1150         XSetDashes(((TkCanvas *)canvas)->display, outline->gc, outline->offset, p, dash->number);
1151     }
1152     if (stipple!=None) {
1153         int w=0; int h=0;
1154         Tk_TSOffset *tsoffset = &outline->tsoffset;
1155         int flags = tsoffset->flags;
1156         if (!(flags & TK_OFFSET_INDEX) && (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE))) {
1157             Tk_SizeOfBitmap(((TkCanvas *)canvas)->display, stipple, &w, &h);
1158             if (flags & TK_OFFSET_CENTER) {
1159                 w /= 2;
1160             } else {
1161                 w = 0;
1162             }
1163             if (flags & TK_OFFSET_MIDDLE) {
1164                 h /= 2;
1165             } else {
1166                 h = 0;
1167             }
1168         }
1169         tsoffset->xoffset -= w;
1170         tsoffset->yoffset -= h;
1171         Tk_CanvasSetOffset(canvas, outline->gc, tsoffset);
1172         tsoffset->xoffset += w;
1173         tsoffset->yoffset += h;
1174         return 1;
1175     }
1176     return 0;
1177 }
1178
1179 \f
1180 /*
1181  *--------------------------------------------------------------
1182  *
1183  * Tk_ResetOutlineGC
1184  *
1185  *      Restores the GC to the situation before
1186  *      Tk_ChangeDashGC() was called.
1187  *      This function should be called just after the dashed
1188  *      item is drawn, because the GC is supposed to be
1189  *      read-only.
1190  *
1191  * Results:
1192  *      1 if there is a stipple pattern.
1193  *      0 otherwise.
1194  *
1195  * Side effects:
1196  *      GC is updated.
1197  *
1198  *--------------------------------------------------------------
1199  */
1200 int
1201 Tk_ResetOutlineGC(canvas, item, outline)
1202     Tk_Canvas canvas;
1203     Tk_Item *item;
1204     Tk_Outline *outline;
1205 {
1206     char dashList;
1207     double width;
1208     Tk_Dash *dash;
1209     XColor *color;
1210     Pixmap stipple;
1211     Tk_State state = item->state;
1212
1213     width = outline->width;
1214     if (width < 1.0) {
1215         width = 1.0;
1216     }
1217     dash = &(outline->dash);
1218     color = outline->color;
1219     stipple = outline->stipple;
1220     if (state == TK_STATE_NULL) {
1221         state = ((TkCanvas *)canvas)->canvas_state;
1222     }
1223     if (((TkCanvas *)canvas)->currentItemPtr == item) {
1224         if (outline->activeWidth>width) {
1225             width = outline->activeWidth;
1226         }
1227         if (outline->activeDash.number != 0) {
1228             dash = &(outline->activeDash);
1229         }
1230         if (outline->activeColor!=NULL) {
1231             color = outline->activeColor;
1232         }
1233         if (outline->activeStipple!=None) {
1234             stipple = outline->activeStipple;
1235         }
1236     } else if (state==TK_STATE_DISABLED) {
1237         if (outline->disabledWidth>width) {
1238             width = outline->disabledWidth;
1239         }
1240         if (outline->disabledDash.number != 0) {
1241             dash = &(outline->disabledDash);
1242         }
1243         if (outline->disabledColor!=NULL) {
1244             color = outline->disabledColor;
1245         }
1246         if (outline->disabledStipple!=None) {
1247             stipple = outline->disabledStipple;
1248         }
1249     }
1250     if (color==NULL) {
1251         return 0;
1252     }
1253
1254     if ((dash->number > 2) || (dash->number < -1) || (dash->number==2 &&
1255                 (dash->pattern.array[0] != dash->pattern.array[1])) ||
1256                 ((dash->number == -1) && (dash->pattern.array[1] != ','))) {
1257         if (dash->number < 0) {
1258             dashList = (int) (4 * width + 0.5);
1259         } else if (dash->number<3) {
1260             dashList = dash->pattern.array[0];
1261         } else {
1262             dashList = 4;
1263         }
1264         XSetDashes(((TkCanvas *)canvas)->display, outline->gc,
1265                 outline->offset, &dashList , 1);
1266     }
1267     if (stipple != None) {
1268         XSetTSOrigin(((TkCanvas *)canvas)->display, outline->gc, 0, 0);
1269         return 1;
1270     }
1271     return 0;
1272 }
1273
1274 \f
1275 /*
1276  *--------------------------------------------------------------
1277  *
1278  * Tk_CanvasPsOutline
1279  *
1280  *      Creates the postscript command for the correct
1281  *      Outline-information (width, dash, color and stipple).
1282  *
1283  * Results:
1284  *      TCL_OK if succeeded, otherwise TCL_ERROR.
1285  *
1286  * Side effects:
1287  *      canvas->interp->result contains the postscript string,
1288  *      or an error message if the result was TCL_ERROR.
1289  *
1290  *--------------------------------------------------------------
1291  */
1292 int
1293 Tk_CanvasPsOutline(canvas, item, outline)
1294     Tk_Canvas canvas;
1295     Tk_Item *item;
1296     Tk_Outline *outline;
1297 {
1298     char string[41];
1299     char pattern[11];
1300     int i;
1301     char *ptr;
1302     char *str = string;
1303     char *lptr = pattern;
1304     Tcl_Interp *interp = ((TkCanvas *)canvas)->interp;
1305     double width;
1306     Tk_Dash *dash;
1307     XColor *color;
1308     Pixmap stipple;
1309     Tk_State state = item->state;
1310
1311     width = outline->width;
1312     dash = &(outline->dash);
1313     color = outline->color;
1314     stipple = outline->stipple;
1315     if (state == TK_STATE_NULL) {
1316         state = ((TkCanvas *)canvas)->canvas_state;
1317     }
1318     if (((TkCanvas *)canvas)->currentItemPtr == item) {
1319         if (outline->activeWidth > width) {
1320             width = outline->activeWidth;
1321         }
1322         if (outline->activeDash.number > 0) {
1323             dash = &(outline->activeDash);
1324         }
1325         if (outline->activeColor != NULL) {
1326             color = outline->activeColor;
1327         }
1328         if (outline->activeStipple != None) {
1329             stipple = outline->activeStipple;
1330         }
1331     } else if (state == TK_STATE_DISABLED) {
1332         if (outline->disabledWidth > 0) {
1333             width = outline->disabledWidth;
1334         }
1335         if (outline->disabledDash.number > 0) {
1336             dash = &(outline->disabledDash);
1337         }
1338         if (outline->disabledColor != NULL) {
1339             color = outline->disabledColor;
1340         }
1341         if (outline->disabledStipple != None) {
1342             stipple = outline->disabledStipple;
1343         }
1344     }
1345     sprintf(string, "%.15g setlinewidth\n", width);
1346     Tcl_AppendResult(interp, string, (char *) NULL);
1347
1348     if (dash->number > 10) {
1349         str = (char *)ckalloc((unsigned int) (1 + 4*dash->number));
1350     } else if (dash->number < -5) {
1351         str = (char *)ckalloc((unsigned int) (1 - 8*dash->number));
1352         lptr = (char *)ckalloc((unsigned int) (1 - 2*dash->number));
1353     }
1354     ptr = (char *) ((ABS(dash->number) > sizeof(char *)) ) ?
1355         dash->pattern.pt : dash->pattern.array;
1356     if (dash->number > 0) {
1357         char *ptr0 = ptr;
1358         sprintf(str, "[%d", *ptr++ & 0xff);
1359         i = dash->number-1;
1360         while (i--) {
1361             sprintf(str+strlen(str), " %d", *ptr++ & 0xff);
1362         }
1363         Tcl_AppendResult(interp, str, (char *)NULL);
1364         if (dash->number&1) {
1365             Tcl_AppendResult(interp, " ", str+1, (char *)NULL);
1366         }
1367         sprintf(str, "] %d setdash\n", outline->offset);
1368         Tcl_AppendResult(interp, str, (char *)NULL);
1369         ptr = ptr0;
1370     } else if (dash->number < 0) {
1371         if ((i = DashConvert(lptr, ptr, -dash->number, width)) != 0) {
1372             char *lptr0 = lptr;
1373             sprintf(str, "[%d", *lptr++ & 0xff);
1374             while (--i) {
1375                 sprintf(str+strlen(str), " %d", *lptr++ & 0xff);
1376             }
1377             Tcl_AppendResult(interp, str, (char *)NULL);
1378             sprintf(str, "] %d setdash\n", outline->offset);
1379             Tcl_AppendResult(interp, str, (char *)NULL);
1380             lptr = lptr0;
1381         } else {
1382             Tcl_AppendResult(interp, "[] 0 setdash\n", (char *)NULL);
1383         }
1384     } else {
1385         Tcl_AppendResult(interp, "[] 0 setdash\n", (char *)NULL);
1386     }
1387     if (str != string) {
1388         ckfree(str);
1389     }
1390     if (lptr != pattern) {
1391         ckfree(lptr);
1392     }
1393     if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
1394         return TCL_ERROR;
1395     }
1396     if (stipple != None) {
1397         Tcl_AppendResult(interp, "StrokeClip ", (char *) NULL);
1398         if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
1399             return TCL_ERROR;
1400         }
1401     } else {
1402         Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
1403     }
1404
1405     return TCL_OK;
1406 }
1407
1408 \f
1409 /*
1410  *--------------------------------------------------------------
1411  *
1412  * DashConvert
1413  *
1414  *      Converts a character-like dash-list (e.g. "-..")
1415  *      into an X11-style. l must point to a string that
1416  *      holds room to at least 2*n characters. if
1417  *      l == NULL, this function can be used for
1418  *      syntax checking only.
1419  *
1420  * Results:
1421  *      The length of the resulting X11 compatible
1422  *      dash-list. -1 if failed.
1423  *
1424  * Side effects:
1425  *      None
1426  *
1427  *--------------------------------------------------------------
1428  */
1429
1430 static int
1431 DashConvert (l, p, n, width)
1432     char *l;
1433     CONST char *p;
1434     int n;
1435     double width;
1436 {
1437     int result = 0;
1438     int size, intWidth;
1439
1440     if (n<0) {
1441         n = strlen(p);
1442     }
1443     intWidth = (int) (width + 0.5);
1444     if (intWidth < 1) {
1445         intWidth = 1;
1446     }
1447     while (n-- && *p) {
1448         switch (*p++) {
1449             case ' ':
1450                 if (result) {
1451                     if (l) {
1452                         l[-1] += intWidth + 1;
1453                     }
1454                     continue;
1455                 } else {
1456                     return 0;
1457                 }
1458                 break;
1459             case '_':
1460                 size = 8;
1461                 break;
1462             case '-':
1463                 size = 6;
1464                 break;
1465             case ',':
1466                 size = 4;
1467                 break;
1468             case '.':
1469                 size = 2;
1470                 break;
1471             default:
1472                 return -1;
1473         }
1474         if (l) {
1475             *l++ = size * intWidth;
1476             *l++ = 4 * intWidth;
1477         }
1478         result += 2;
1479     }
1480     return result;
1481 }