Some valentine postings from [comp.lang.tcl]. ---- The original, by mailto:salvasan@my-deja.com canvas .c -width 200 -height 200 -bg pink pack .c .c create polygon 100 55 75 33 35 45 20 100 100 170 100 170 180 100 165 45 125 33 100 55 100 55 -smooth true -fill red ---- Slightly modified by me ([Andreas Kupries]) to work with older versions of Tk. canvas .c -width 200 -height 200 -bg pink pack .c set i [.c create polygon 100 55 75 33 35 45 20 100 100 170 100 170 180 100 165 45 125 33 100 55 100 55] .c itemconfigure $i -smooth true -fill red ---- A throbbing heart, by [John Ellson] - mailto:ellson@lucent.com set shape {0 -47 -25 -69 -65 -57 -80 -2 0 68 0 68 80 -2 65 -57 25 -69 0 -47 0 -47} set throb {1.0 1.05 1.10 1.05} pack [canvas .c -width 200 -height 200 -bg pink] set i [eval .c create polygon $shape] .c itemconfigure $i -smooth true -fill red -tag heart set i 0 while {1} { if {!([incr i] % [llength $throb])} {set i 0} eval .c coords heart $shape set factor [lindex $throb $i] .c scale heart 0 0 $factor $factor .c move heart 100 100 update after 100 } ---- And now it's bumping ([Uwe Koloska] - mailto:uwe.koloska@mailbox.tu-dresden.de ) canvas .c -width 200 -height 200 -bg pink pack .c .c create polygon 100 55 75 33 35 45 20 100 100 170 100 170 180 100 165 45 125 33 100 55 100 55 -smooth true -fill red foreach {x1 y1 x2 y2} [.c bbox 1] {} set origx [expr $x1 + ($x2 - $x1) / 2] set origy [expr $y1 + ($y2 -$y1) / 2] proc bump {} { global factor origx origy pause .c scale 1 $origx $origy $factor $factor update idletasks after $pause {bump} set factor [expr 1.0 / $factor] if {$pause == 80} { set pause 300 } { set pause 80 } } set factor 1.1 set pause 80 bind . <1> {destroy .} bump ---- And [Ian Findleton] pierced it with an arrow: # Display a heart set points { 100 55 75 33 35 45 20 100 100 170 100 170 180 100 165 45 125 33 100 55 100 55 } # Get the centroid of the drawing proc FindCenter { points } { set xc 0 set yc 0 set count 0 foreach { x y } $points { incr xc $x incr yc $y incr count } return "[expr $xc / $count] [expr $yc / $count]" } # Get the offsets from the center of gravity proc GetOffsets { points origin } { set xc [lindex $origin 0] set yc [lindex $origin 1] set result {} foreach { x y } $points { lappend result [expr $x - $xc] lappend result [expr $y - $yc] } return $result } # Scale the points by a factor proc ScalePoints { factor points } { set result {} foreach val $points { lappend result [expr $val * $factor] } return $result } # Build the list of locations proc BuildLocationList { points origin } { set xc [lindex $origin 0] set yc [lindex $origin 1] set result {} foreach { x y } $points { lappend result [expr $x + $xc] lappend result [expr $y + $yc] } return $result } catch { destroy .c } canvas .c -width 200 -height 200 -bg pink pack .c set origin [FindCenter $points] set list [GetOffsets $points $origin] set factors { 1.0 0.95 1.0 1.05 } set layers { red4 1.0 red3 0.92 red2 0.88 red1 0.82 } # Draw the heart proc DrawHeart { list origin } { global layers foreach { color factor } $layers { set i [eval .c create polygon [BuildLocationList [ScalePoints $factor $list] $origin]] .c itemconfigure $i -smooth true -fill $color -tags heart } } # Draw the arrow proc DrawArrow { origin what } { set xc [lindex $origin 0] set yc [expr [lindex $origin 1] + 20] set color gold3 if { $what } { set xn [expr $xc + 85] set yn [expr $yc - 85] set xo [expr $xc + 15] set yo [expr $yc - 15] .c create line $xo $yo $xn $yn -width 7 -arrow last -fill $color -arrowshape { 20 24 5 } } else { set xo [expr $xc - 75] set yo [expr $yc + 75] set xn [expr $xo + 20] set yn [expr $yo - 20] .c create line $xo $yo $xn $yn -width 7 -arrow last -fill $color -arrowshape { 20 28 7 } .c create line $xo $yo $xc $yc -width 7 -fill $color } } # Display a beating heart! while { 1 } { foreach factor $factors { DrawArrow $origin 0 DrawHeart [ScalePoints $factor $list] $origin DrawArrow $origin 1 update after 250 .c delete heart } } ---- [Valentines heart and arrow] [gold] added pix ---- <> Toys | Example | Games | Characters | Canvas | Toys and Games | Graphics