[AMG]: One fine Christmas I wrote some code to draw playing cards, complete with rounded corners.  Then I thought, why stop at rectangles?  With straightedge, compass, calculator, graph paper, and http://mathworld.wolfram.com/ in hand, I figured out how to do nifty polygons with rounded vertices.  It took me several days to get all the math right.  I now present a Tcl implementation:

 # poly.tcl

 proc poly_round {win outline fill args} {
     if {[llength $args] % 3 != 0 || [llength $args] < 9} {
         error "wrong # args: should be \"poly_round\
                 win outline fill x1 y1 d1 x2 y2 d2 x3 y3 d3 ?...?\""
     }

     # Determine the tag to use.
     if {![info exists ::poly_next_id]} {
         set ::poly_next_id 1
     }
     set tag poly#$::poly_next_id
     incr ::poly_next_id

     # Filter out illegal circles and collinear points.
     set pts [list]
     lassign [lrange $args 0 4] Ux Uy d Vx Vy
     foreach {d Wx Wy} [concat [lrange $args 5 end] [lrange $args 0 4]] {
         set test [expr {$Ux * ($Vy - $Wy) - $Vx * ($Uy - $Wy) +
                 $Wx * ($Uy - $Vy)}]
         if {($d > 0) && $test != 0} {
             lappend pts $Vx $Vy $d $test
             lassign [list $Wx $Wy $Vx $Vy] Vx Vy Ux Uy
         } else {
             lassign [list $Wx $Wy] Vx Vy
         }
     }

     # V    C    T   W
     #  *---*----*-+-*-- Given: U, V, W, d
     #  |\ /    /|_|     Find:  S, E, T
     #  | *B   / |
     #  |/ \  /  |       The length of ES and ET each is d.
     # A*   \/   |
     #  |   /\   |       VB bisects angle UVW.  SE _|_ VU; TE _|_ VW.
     #  |  /  \  |       B is halfway between A and C.
     #  | /    \ |       Angles UVW and SET are not necessarily right.
     #  |/      \|       The length of AV and CV each is 1.
     # S*-+------*E
     #  |_|       \      The new polygon is along USTW. 
     # U*          \     The new arc has center E, radius d, and angle SET, and
     #  |           \    it is tangential to VU at S and VW at T.

     # Calculate new polygon vertices and create arcs.
     set coords [list]
     lassign [lrange $pts 0 5] Ux Uy d test Vx Vy
     foreach {d test Wx Wy} [concat [lrange $pts 6 end] [lrange $pts 0 5]] {
         # Find A and C.
         foreach {pt x y} [list A $Ux $Uy C $Wx $Wy] {
             set      k [expr {sqrt(($Vx - $x) ** 2 + ($Vy - $y) ** 2)}]
             set ${pt}x [expr {($x - $Vx) / $k + $Vx}]
             set ${pt}y [expr {($y - $Vy) / $k + $Vy}]
         }

         # Find B.
         set Bx [expr {($Ax + $Cx) / 2.0}]
         set By [expr {($Ay + $Cy) / 2.0}]

         # Find the parameters for lines VB and VW.
         foreach {pt x y} [list B $Bx $By W $Wx $Wy] {
             set       k [expr {sqrt(($Vx - $x) ** 2 + ($Vy - $y) ** 2)}]
             set V${pt}a [expr {+($Vy - $y) / $k}]
             set V${pt}b [expr {-($Vx - $x) / $k}]
             set V${pt}c [expr {($Vx * $y - $Vy * $x) / $k}]
         }

         # Find point E.
         set sign [expr {$test < 0 ? -1 : +1}]
         set  k [expr {$VWa * $VBb - $VWb * $VBa}]
         set Ex [expr {(+$VWb * $VBc - ($VWc - $d * $sign) * $VBb) / $k}]
         set Ey [expr {(-$VWa * $VBc + ($VWc - $d * $sign) * $VBa) / $k}]

         # Find tangent points S and T.
         foreach {pt x y} [list S $Ux $Uy T $Wx $Wy] {
             set      k [expr {($Vx - $x) ** 2 + ($Vy - $y) ** 2}]
             set ${pt}x [expr {($Ex * ($Vx - $x) ** 2 + ($Vy - $y) *
                               ($Ey * ($Vx - $x) - $Vx * $y + $Vy * $x)) / $k}]
             set ${pt}y [expr {($Ex * ($Vx - $x) * ($Vy - $y) +
                               ($Ey * ($Vy - $y) ** 2 + ($Vx - $x) *
                               ($Vx * $y - $Vy * $x))) / $k}]
         }

         # Find directions for lines ES and ET.
         foreach {pt x y} [list S $Sx $Sy T $Tx $Ty] {
             set E${pt}d [expr {atan2($Ey - $y, $x - $Ex)}]
         }

         # Find start and extent directions.
         if {$ESd < 0 && $ETd > 0} {
             set start  [expr {180 / acos(-1) * $ETd}]
             set extent [expr {180 / acos(-1) * ($ESd - $ETd)}]
             if {$sign > 0} {
                 set extent [expr {$extent + 360}]
             }
         } else {
             set start  [expr {180 / acos(-1) * $ESd}]
             set extent [expr {180 / acos(-1) * ($ETd - $ESd)}]
             if {$sign < 0 && $ESd > 0 && $ETd < 0} {
                 set extent [expr {$extent + 360}]
             }
         }

         # Draw arc.
         set opts [list                             \
                 [expr {$Ex - $d}] [expr {$Ey - $d}]\
                 [expr {$Ex + $d}] [expr {$Ey + $d}]\
                 -start $start -extent $extent]
         $win create arc {expand}$opts -style pie -tags [list $tag pie]
         $win create arc {expand}$opts -style arc -tags [list $tag arc]

         # Draw border line.
         if {[info exists prevx]} {
             $win create line $prevx $prevy $Sx $Sy -tags [list $tag line]
         } else {
             lassign [list $Sx $Sy] firstx firsty
         }
         lassign [list $Tx $Ty] prevx prevy

         # Remember coordinates for polygon.
         lappend coords $Sx $Sy $Tx $Ty

         # Rotate vertices.
         lassign [list $Wx $Wy $Vx $Vy] Vx Vy Ux Uy
     }

     # Draw final border line.
     $win create line $prevx $prevy $firstx $firsty -tags [list $tag line]

     # Draw fill polygon.
     $win create polygon {expand}$coords -tags [list $tag poly]

     # Configure colors.
     $win itemconfigure $tag&&(poly||pie) -fill $fill
     $win itemconfigure $tag&&pie         -outline ""
     $win itemconfigure $tag&&line        -fill $outline -capstyle round
     $win itemconfigure $tag&&arc         -outline $outline

     # Set proper stacking order.
     $win raise $tag&&poly
     $win raise $tag&&pie
     $win raise $tag&&(line||arc)

     return $tag
 }

 # vim: set ts=4 sts=4 sw=4 tw=80 et ft=tcl:

The code works (quite well!), but it has a few limitations mostly stemming from the [canvas] itself.

The main problem is handling concave vertices: I can't draw an arc filled on the "outside".  If anyone has any suggestions, I'd be glad to hear 'em.  For now the workarounds are: (1) don't worry about it, or (2) when drawing concave polygons, set the fill to "".

Next, the round polygon is built up of several different types of [canvas] objects with different interpretations of -fill, -outline, etc.  You can scale and move the round polygon just fine, but repositioning using absolute coordinates won't work.  Setting the -fill or -outline won't work quite right.  And so on.  I wonder how (or even if) we can fix this, maybe in a way similar to how we do megawidgets.

Lastly, this code can't recognize impossible situations, so it draws them anyway, resulting in very weird displays.  By "impossible situation" I mean a case where the radius of the rounded vertex is larger than the available space.  This makes the polygon intersect itself in very strange ways.  Even if I could detect such a problem, what would I do about it?  (1) Bail?  (2) Draw anyway?  (3) Reduce the radius?  (By how much?)  Again, suggestions are welcome.

It's unlikely you can visualize what this code does just by reading its sources, so I made a demo.  And since most of you won't be able to visualize by reading the demo's sources, I also made screenshots.  '''And''' since all you really care about (deep down) is pretty pictures, I'm putting the screenshots first.  Here we go.

[http://ioioio.net/screenshots/app/poly.tcl.1.png] [http://ioioio.net/screenshots/app/poly.tcl.2.png]

And the source:

 #!/bin/sh
 # The next line restarts with tclsh.\
 exec tclsh "$0" ${1+"$@"}

 package require Tcl 8.5
 package require Tk

 source [file join [file dirname [info script]] poly.tcl]

 proc draw {win} {
     global demo

     set sharp_pts [list]
     set round_pts [list]
     for {set id 0} {$id < $demo(num_pts)} {incr id} {
         set x [expr {([lindex [$win coords vtx#$id] 0] +
                       [lindex [$win coords vtx#$id] 2]) / 2}]
         set y [expr {([lindex [$win coords vtx#$id] 1] +
                       [lindex [$win coords vtx#$id] 3]) / 2}]
         lappend sharp_pts $x $y
         lappend round_pts $x $y $demo(radius)
     }

     .c delete sharp_poly
     .c create polygon {expand}$sharp_pts -outline gray50 -fill ""\
             -dash {6 5} -tags {sharp_poly}

     if {[info exists demo(tag)]} {
         .c delete $demo(tag)
     }
     set demo(tag) [poly_round .c $demo(outline) $demo(fill) {expand}$round_pts]
     .c itemconfigure $demo(tag) -width $demo(thickness)

     .c raise vtx
 }

 proc down {win x y} {
     global demo

     $win dtag selected
     $win addtag selected withtag current
     $win raise current
     set demo(last_x) $x
     set demo(last_y) $y
 }
 
 proc move {win x y} {
     global demo

     if {[info exists demo(last_x)]} {
         $win move selected\
                 [expr {$x - $demo(last_x)}]\
                 [expr {$y - $demo(last_y)}]
         set demo(last_x) $x
         set demo(last_y) $y

         draw $win
     }
 }

 proc main {args} {
     global demo

     array set demo {
         num_pts 3       radius 20      thickness 1
         outline black   fill   white   background gray
         width   400     height 400
     }
     foreach {option value} $args {
         set option [regsub {^-} $option ""]
         if {![info exists demo($option)]} {
             puts "Options: -[join [array names demo] " -"]"
             exit
         } else {
             set demo([regsub {^-} $option ""]) $value
         }
     }

     canvas .c -width $demo(width) -height $demo(height) -highlightthickness 0\
             -background $demo(background)
     pack .c
     wm title . "Round Polygon Demo"
     wm resizable . 0 0

     set 2pi [expr {2 * acos(-1)}]
     set cx [expr {$demo(width)  / 2}]; set sx [expr {$demo(width)  * 3 / 8}]
     set cy [expr {$demo(height) / 2}]; set sy [expr {$demo(height) * 3 / 8}]
     for {set id 0} {$id < $demo(num_pts)} {incr id} {
         set x [expr {$cx + $sx * cos(($id + 0.5) * $2pi / $demo(num_pts))}]
         set y [expr {$cy - $sy * sin(($id + 0.5) * $2pi / $demo(num_pts))}]
         .c create oval [expr {$x - 3}] [expr {$y - 3}]\
                        [expr {$x + 3}] [expr {$y + 3}]\
                        -tags [list vtx vtx#$id] -fill brown
     }

     .c bind vtx <Any-Enter> {.c itemconfigure current -fill red}
     .c bind vtx <Any-Leave> {.c itemconfigure current -fill brown}
     .c bind vtx <ButtonPress-1> {down .c %x %y}
     .c bind vtx <ButtonRelease-1> {.c dtag selected}
     bind .c <B1-Motion> {move .c %x %y}

     focus .c
     draw .c
 }

 main {expand}$argv

 # vim: set ts=4 sts=4 sw=4 tw=80 et ft=tcl:

This program accepts several options:

   -num_pts:   Number of vertices.  Initially the demo arranges them in a circle, but you can click and drag the control points to do any shape you want.
   -radius:   Radius in pixels of rounded vertices.  The actual polygon draw code allows each vertex to have a different radius, but for the demo I just made them all the same.
   -thickness:   Thickness in pixels of lines and arcs.  This can be a floating-point value.
   -outline:   Outline color of the rounded polygon.  Use "" to disable the contour.
   -fill:   Fill color of the rounded polygon.  Use "" for a hollow polygon.
   -background:   Background color of the canvas.
   -width:   Width of the canvas.
   -height:   Height of the canvas.

If you give an unrecognized option, it'll list the supported options.  All options have defaults.

Oh, and you have to put the polygon draw code in a file called poly.tcl.

Have fun.

----
[[
[Category Graphics]
]]