Round Polygons
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.
KBK 2006-01-29: The approach taken here is to draw line segments and then connect the ends with arcs. There is another approach that is often simpler, which uses the -smooth option of [$canvas create polygon] together with a little bit of math. You can find it by comparing this code with Drawing Rounded Rectangles and Drawing Rounded Polygons. One advantage of -smooth is that the resulting polygon is a single canvas item, which sometimes eases manipulation.
AMG: I knew of -smooth, but I couldn't figure out how to make it work the way I wanted (specifically, I couldn't intermingle straight edges and round corners). Mind you, I only spent fifteen minutes or so playing with it, I didn't have Wiki access at that moment, all I had intended was rounded rectangles, and I had previously (several years ago) written good, working pseudo-rectangular speech balloon code. So I gave up on -smooth in favor of arc'ed corners; the code for the upright rectangle case is far, far simpler than the stuff I first posted. (I add it now; scroll down.) And it wasn't until later that I thought to generalize my code for arbitrary polygons; maybe I should have revisited my original "no -smooth" decision.
The script:
# 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 {*}$opts -style pie -tags [list $tag pie]
$win create arc {*}$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 {*}$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.
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 {*}$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) {*}$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 {*}$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.
CJL - Very, very nicely done. There are a couple of glitches I've noticed though. Concave vertices end up with a fillet arc outside the polygon (as in your second screen shot), and three vertices on (or close to) a straight line produce a 360° fillet (inside or outside, depending on which side of 'straight' the line is).
Here's code for the case of upright rectangles. It's what I originally wrote for drawing playing cards. It only draws standard 5:7 cards, but you can surely modify it to draw any size rectangle.
proc card_draw {win xcoord ycoord scale} {
# Determine the tag to use.
if {![info exists ::card_next_id]} {
set ::card_next_id 1
}
set tag card#$::card_next_id
incr ::card_next_id
# Constants.
set corner 1.5
set width 5
set height 7
# Create a rectangle with clipped corners.
set coords [list]
foreach xs {+1 +1 -1 -1 -1 -1 +1 +1} ys {+1 +1 +1 +1 -1 -1 -1 -1}\
xc { 0 1 1 0 0 1 1 0} yc { 1 0 0 1 1 0 0 1} {
lappend coords [expr {$xs * ($width - $xc * $corner)}]
lappend coords [expr {$ys * ($height - $yc * $corner)}]
}
$win create polygon {*}$coords -tags [list $tag poly]
# Create round corners.
foreach deg {0 90 180 270} xs {+1 -1 -1 +1} ys {-1 -1 +1 +1} {
set coords [list [expr {$xs * $width }] \
[expr {$ys * $height}] \
[expr {$xs * ($width - 2 * $corner)}]\
[expr {$ys * ($height - 2 * $corner)}]]
$win create arc {*}$coords -tags [list $tag arc] -start $deg
$win create arc {*}$coords -tags [list $tag pie] -start $deg
}
# Move and scale things into position.
$win move $tag $width $height
$win scale $tag 0 0 $scale $scale
$win move $tag $xcoord $ycoord
# Configure the newly created canvas items.
$win itemconfigure $tag&&(arc||pie) -extent 90
$win itemconfigure $tag&&arc -style arc
$win itemconfigure $tag&&(pie||poly) -fill white
$win itemconfigure $tag&&pie -outline ""
$win itemconfigure $tag&&(arc||poly) -outline black
# Ensure proper stacking order.
$win raise $tag&&pie
$win raise $tag&&arc
# Done.
return $tag
}I guess it's time I looked at the Drawing Rounded Rectangles and Drawing Rounded Polygons pages myself. :^)