Artifact
4070c7c7ad35900697032622315b24fea4094968:
Attachment "testcanvasitems.tcl" to
ticket [2874226f]
added by
fvogel
2017-08-21 12:42:47.
package require Tk
pack [canvas .c -width 1500 -height 1000]
set dx 120
set dy 80
set xpos [expr {-$dx}]
set doubleline 0
set ypos 0
set itemid 1
set doubleline 0
proc nextline {} {
global doubleline dx dy xpos
incr doubleline [expr {$dy * 3}]
set xpos [expr {-$dx}]
}
proc shiftcoord {co dx dy} {
set shifted [list]
for {set i 0} {$i < [llength $co]} {incr i 2} {
lappend shifted [expr {[lindex $co $i] + $dx}] [expr {[lindex $co [expr {$i + 1 }]] + $dy}]
}
return $shifted
}
proc drawpoly {itemtype co optstring} {
global dx dy itemid xpos ypos doubleline
if {[expr {$itemid % 2}] == 0} {
set ypos [expr {$doubleline + $dy}]
} else {
set ypos $doubleline
incr xpos $dx
set splitoptstring ""
for {set i 0} {$i < [llength $optstring]} {incr i 2} {
append splitoptstring [lrange $optstring $i [expr {$i + 1 }]] "\n"
}
.c create text [expr {$xpos + 0.5 * $dx}] [expr {$ypos + 2.7 * $dy}] -text $splitoptstring
}
.c create $itemtype [shiftcoord $co $xpos $ypos] {*}$optstring
if {$itemtype eq "line"} {
incr itemid
}
}
set points {20.0 20.0 50.0 50.0 30.0 80.0 20.0 50.0 20.0 40.0}
set closedpath $points
lappend closedpath [lindex $points 0] [lindex $points 1]
# LINE ITEM
.c create text 50 10 -text "LINE ITEMS" -fill green
drawpoly line $points {}
drawpoly line $closedpath {}
drawpoly line $points {-width 10}
drawpoly line $closedpath {-width 10}
drawpoly line $points {-width 10 -capstyle projecting}
drawpoly line $closedpath {-width 10 -capstyle projecting}
drawpoly line $points {-width 10 -capstyle round}
drawpoly line $closedpath {-width 10 -capstyle round}
drawpoly line $points {-width 10 -arrow both}
drawpoly line $closedpath {-width 10 -arrow both}
drawpoly line $points {-width 10 -joinstyle miter}
drawpoly line $closedpath {-width 10 -joinstyle miter}
drawpoly line $points {-width 10 -joinstyle bevel}
drawpoly line $closedpath {-width 10 -joinstyle bevel}
drawpoly line $points {-width 10 -dash -}
drawpoly line $closedpath {-width 10 -dash -}
drawpoly line $points {-width 10 -joinstyle miter -dash .}
drawpoly line $closedpath {-width 10 -joinstyle miter -dash .}
drawpoly line $points {-width 10 -joinstyle bevel -dash .}
drawpoly line $closedpath {-width 10 -joinstyle bevel -dash .}
nextline
drawpoly line $points {-stipple gray50}
drawpoly line $closedpath {-stipple gray50}
drawpoly line $points {-width 10 -stipple gray50}
drawpoly line $closedpath {-width 10 -stipple gray50}
drawpoly line $points {-width 10 -capstyle projecting -stipple gray50}
drawpoly line $closedpath {-width 10 -capstyle projecting -stipple gray50}
drawpoly line $points {-width 10 -capstyle round -stipple gray50}
drawpoly line $closedpath {-width 10 -capstyle round -stipple gray50}
drawpoly line $points {-width 10 -arrow both -stipple gray50}
drawpoly line $closedpath {-width 10 -arrow both -stipple gray50}
drawpoly line $points {-width 10 -joinstyle miter -stipple gray50}
drawpoly line $closedpath {-width 10 -joinstyle miter -stipple gray50}
drawpoly line $points {-width 10 -joinstyle bevel -stipple gray50}
drawpoly line $closedpath {-width 10 -joinstyle bevel -stipple gray50}
drawpoly line $points {-width 10 -dash - -stipple gray50}
drawpoly line $closedpath {-width 10 -dash - -stipple gray50}
drawpoly line $points {-width 10 -joinstyle miter -dash . -stipple gray50}
drawpoly line $closedpath {-width 10 -joinstyle miter -dash . -stipple gray50}
drawpoly line $points {-width 10 -joinstyle bevel -dash . -stipple gray50}
drawpoly line $closedpath {-width 10 -joinstyle bevel -dash . -stipple gray50}
nextline
# POLYGON ITEM
.c create text 50 [expr {$doubleline + 10}] -text "POLYGON ITEMS" -fill green
drawpoly polygon $points {}
drawpoly polygon $points {-stipple gray50}
drawpoly polygon $points {-fill red -outline black -width 10}
drawpoly polygon $points {-fill red -outline black -width 10 -stipple gray50}
drawpoly polygon $points {-fill red -outline black -width 10 -joinstyle miter}
drawpoly polygon $points {-fill red -outline black -width 10 -joinstyle miter -stipple gray50}
drawpoly polygon $points {-fill red -outline black -width 10 -joinstyle bevel}
drawpoly polygon $points {-fill red -outline black -width 10 -joinstyle bevel -stipple gray50}
drawpoly polygon $points {-fill red -outline black -width 10 -dash .}
drawpoly polygon $points {-fill red -outline black -width 10 -dash . -stipple gray50}
drawpoly polygon $points {-fill red -outline black -width 10 -dash -}
drawpoly polygon $points {-fill red -outline black -width 10 -dash - -stipple gray50}
nextline
drawpoly polygon $points {-fill red -outline black -width 10 -joinstyle miter -dash -}
drawpoly polygon $points {-fill red -outline black -width 10 -joinstyle miter -dash - -stipple gray50}
drawpoly polygon $points {-fill red -outline black -width 10 -joinstyle bevel -dash -}
drawpoly polygon $points {-fill red -outline black -width 10 -joinstyle bevel -dash - -stipple gray50}
drawpoly polygon $points {-fill red -outline black -width 10 -outlinestipple gray50}
drawpoly polygon $points {-fill red -outline black -width 10 -outlinestipple gray50 -stipple gray50}
drawpoly polygon $points {-fill red -outline black -width 10 -outlinestipple gray50 -joinstyle miter}
drawpoly polygon $points {-fill red -outline black -width 10 -outlinestipple gray50 -joinstyle miter -stipple gray50}
drawpoly polygon $points {-fill red -outline black -width 10 -outlinestipple gray50 -joinstyle bevel}
drawpoly polygon $points {-fill red -outline black -width 10 -outlinestipple gray50 -joinstyle bevel -stipple gray50}
