[HJG] Shows a [canvas]-window and a few [button]s to do some operations on it.
----
======
#!/bin/sh
# Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \
exec wish $0 ${1+"$@"}
# demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073
#: CanvasDemo: On button-click, draw something on the canvas
package require Tk
proc ClrCanvas {w} {
$w delete "all"
}
proc DrawAxis {w} {
set midX [expr { $::maxX / 2 }]
set midY [expr { $::maxY / 2 }]
$w create line 0 $midY $::maxX $midY -tags "axis"
$w create line $midX 0 $midX $::maxY -tags "axis"
}
proc PaintText {w Txt} {
global y
incr y 10
$w create text 20 $y -text $Txt -tags "text"
}
proc DrawBox {w} {
global x1 y1 x2 y2
$w create rect 50 10 100 60 -tags "box"
$w create rect $x1 $y1 $x2 $y2 -tags "box"
incr x1 15
incr x2 15
incr y1 10
incr y2 10
}
proc DrawFn1 {w} {
$w create line 0 100 50 200 100 50 150 70 200 155 250 50 300 111 350 222\
-tags "Fn1" -smooth bezier
}
proc DrawFn2 {w} {
set offY 0 ;# [expr { $::maxY / 2 }]
for { set x 0 } { $x <= $::maxX } { incr x 5 } {
set y [expr { rand() * $::maxY + $offY }]
#puts "$x $y"
if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2" }
set x0 $x
set y0 $y
}
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 320
set maxY 240
set y 0
set x1 120
set x2 150
set y1 50
set y2 80
canvas .cv -width $maxX -height $maxY -bg white
pack .cv -in .f1
button .b0 -text "Clear" -command { ClrCanvas .cv }
button .b1 -text "Text" -command { PaintText .cv "Canvas" }
button .b2 -text "Axis" -command { DrawAxis .cv }
button .b3 -text "Box" -command { DrawBox .cv }
button .b4 -text "Fn1" -command { DrawFn1 .cv }
button .b5 -text "Fn2" -command { DrawFn2 .cv }
pack .b0 .b1 .b2 .b3 .b4 .b5 -in .f2 -side left -padx 2
#catch {console show}
======
----
See also: [Widgets on a canvas] and [Minimal scrolling canvas] (if you need scrollbars)
----
***Screenshots***
[gold] added pix
<
>
[WikiDbImage TCL_wiki_Simple_Canvas_Demo.PNG]
<
>
[http://farm5.static.flickr.com/4013/4714847391_1dbce38be3.jpg]
----
***Auxiliary code***
[gold]
Here is some auxiliary code which will raise or lower a blue rectangular grid
on canvas objects.One can install two buttons which will raise or lower grid depending on state variable (`$state2`).
Used code from Canvas moving objects and toggle tags, mainly to put in a measuring ball and screen coords on a label.
Canvas moving objects and toggle tags is found on this wiki. [Canvas moving objects and toggle tags] Also added some exit buttons.
****Early Version*****
======
#!/bin/sh
# Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \
exec wish $0 ${1+"$@"}
# demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073
#: CanvasDemo: On button-click, draw something on the canvas
package require Tk
proc ClrCanvas {w} {
$w delete "all"
}
proc DrawAxis {w} {
set midX [expr { $::maxX / 2 }]
set midY [expr { $::maxY / 2 }]
$w create line 0 $midY $::maxX $midY -tags "axis" -width 2
$w create line $midX 0 $midX $::maxY -tags "axis" -width 2
}
proc PaintText {w Txt} {
global y
incr y 10
$w create text 20 $y -text $Txt -tags "text"
}
proc DrawBox {w} {
global x1 y1 x2 y2
$w create rect 50 10 100 60 -tags "box"
$w create rect $x1 $y1 $x2 $y2 -tags "box"
incr x1 15
incr x2 15
incr y1 10
incr y2 10
}
proc DrawFn1 {w} {
$w create line 0 100 50 200 100 50 150 70 200 155 250 50 300 111 350 222\
-tags "Fn1" -smooth bezier -width 4
}
proc DrawFn2 {w} {
set offY 0 ;# [expr { $::maxY / 2 }]
for { set x 0 } { $x <= $::maxX } { incr x 5 } {
set y [expr { rand() * $::maxY + $offY }]
#puts "$x $y"
if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2"-width 4 }
set x0 $x
set y0 $y
}
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 320
set maxY 240
set y 0
set state2 1
set x1 120
set x2 150
set y1 50
set y2 80
set colorite seashell3
#canvas .cv -width $maxX -height $maxY -bg white
set state2 1
#canvas .cv -width $maxX -height $maxY -bg white
set oscwidth 1000
set oschorizontal 500
canvas .cv -width 400 -height 200 -scrollregion "0 0 $oscwidth $oschorizontal" \
-xscrollcommand ".corpsx set" -yscrollcommand ".corpsy set" \
-background palegreen -highlightcolor DarkOliveGreen \
-relief raised -border 10
scrollbar .corpsx -command " .cv xview" -orient horizontal
scrollbar .corpsy -command " .cv yview" -orient vertical
focus .cv
proc refreshgrid { .cv state2} {
global oscwidth oschorizontal colorite
global grid
set colorite blue
for {set x 0} {$x<$oscwidth} {incr x 50} {.cv create line $x 0 $x $oschorizontal -tag grid -width 4}
for {set y 0} {$y<$oschorizontal} {incr y 50} {.cv create line 0 $y $oschorizontal $y -tag grid -width 4}
.cv itemconfigure grid -fill honeydew
if { $state2 == 1 } { .cv raise grid ;}
if { $state2 == 2 } { .cv lower grid ;}
}
pack .cv -in .f1
button .b0 -text "Clear" -command { ClrCanvas .cv }
button .b1 -text "Text" -command { PaintText .cv "Canvas" }
button .b2 -text "Axis" -command { DrawAxis .cv }
button .b3 -text "Box" -command { DrawBox .cv }
button .b4 -text "Fn1" -command { DrawFn1 .cv }
button .b5 -text "Fn2" -command { DrawFn2 .cv }
#pack .b0 .b1 .b2 .b3 .b4 .b5 .b6 .b7 -in .f2 -side left -padx 2
#catch {console show}
#if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} }
button .b6 -text "gridlower" -command { refreshgrid .cv 2 } -background $colorite
button .b7 -text "gridover" -command { refreshgrid .cv 1 } -background $colorite
button .b8 -text "exit" -command { exit }
pack .b0 .b1 .b2 .b3 .b4 .b5 .b6 .b7 .b8 -in .f2 -side left -padx 2
======
****Second Version****
======
#!/bin/sh
# Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \
exec wish $0 ${1+"$@"}
# demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073
#: CanvasDemo: On button-click, draw something on the canvas
# used code from Canvas moving objects and toggle tags
#mainly to put in a measuring ball and screen coords on a label.
package require Tk
set halo 2
proc item:upd {w} {
$w itemconfigure object -outline {}
$w itemconfigure hover -outline red -width 5
$w itemconfigure moveit -outline purple -width 5
}
proc item:move {w x y {init 0}} {
global oldx oldy
if $init {
set oldx $x; set oldy $y
$w addtag moveit closest $x $y $::halo
$w dtag !moveable moveit
$w raise moveit
} else {
$w move moveit [expr $x-$oldx] [expr $y-$oldy]
set oldx $x; set oldy $y
}
item:upd $w
}
proc item:endmove {w x y} {
$w dtag moveit
item:upd $w
}
proc item:hover {w x y st} {
if $st {
$w addtag hover closest $x $y $::halo
$w dtag !moveable hover
} else {
$w dtag hover
}
item:upd $w
}
proc item:toggletag {w x y tag} {
set ttt tagtotoggle
$w addtag $ttt closest $x $y $::halo $tag
if {[lsearch [$w gettags $ttt] $tag] >= 0} {
$w dtag ($ttt&&$tag) $tag
item:hover $w $x $y 0
} else {
$w addtag $tag withtag ($ttt&&!$tag)
item:hover $w $x $y 1
}
$w dtag $ttt
}
proc ClrCanvas {w} {
$w delete "all"
}
proc DrawAxis {w} {
#set midX [expr { $::maxX / 2 }]
#set midY [expr { $::maxY / 2 }]
set midX [expr { $::maxX / 2 }]
set midY [expr { $::maxY / 2 }]
$w create line 0 $midY [expr $::maxX+80] $midY -tags "axis" -width 2
$w create line $midX 0 $midX $::maxY -tags "axis" -width 2
}
proc PaintText {w Txt} {
global y
incr y 30
$w create text 40 $y -text $Txt -tags "text"
}
proc mint {w } {
catch {console show}
$w create oval 150 110 170 130 -width 2 -fill red -outline gray -tags {object moveable};
puts "test"
}
proc DrawBox {w} {
global x1 y1 x2 y2
$w create rect 50 200 100 80 -tags "box"
$w create rect $x1 $y1 $x2 $y2 -tags "box"
incr x1 15
incr x2 15
incr y1 10
incr y2 10
}
proc DrawFn1 {w} {
$w create line 0 100 50 200 100 50 150 70 200 155 250 50 300 111 350 222\
-tags "Fn1" -smooth bezier -width 4
}
proc DrawFn2 {w} {
set offY 0 ;# [expr { $::maxY / 2 }]
for { set x 0 } { $x <= $::maxX } { incr x 5 } {
set y [expr { rand() * $::maxY + $offY }]
#puts "$x $y"
if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2" }
set x0 $x
set y0 $y
}
}
#: Main :
frame .f1
frame .f2
frame .f3
pack .f1 .f2 .f3
set maxX 320
set maxY 240
set y 0
set state2 1
set x1 120
set x2 150
set y1 50
set y2 80
set colorite seashell3
#canvas .cv -width $maxX -height $maxY -bg white
set state2 1
#canvas .cv -width $maxX -height $maxY -bg white
set oscwidth 1000
set oschorizontal 500
canvas .cv -width 400 -height 240 -scrollregion "0 0 $oscwidth $oschorizontal" \
-xscrollcommand ".corpsx set" -yscrollcommand ".corpsy set" \
-background palegreen -highlightcolor DarkOliveGreen \
-relief raised -border 10
scrollbar .corpsx -command " .cv xview" -orient horizontal
scrollbar .corpsy -command " .cv yview" -orient vertical
focus .cv
proc refreshgrid { .cv state2} {
global oscwidth oschorizontal colorite
global grid
set colorite blue
for {set x 10} {$x<$oscwidth} {incr x 50} {.cv create line $x 0 $x $oschorizontal -fill blue -tag grid -width 4}
for {set y 20} {$y<$oschorizontal} {incr y 50} {.cv create line 0 $y $oschorizontal $y -fill blue -tag grid -width 4}
.cv itemconfigure grid -fill blue
if { $state2 == 1 } { .cv raise grid ;}
if { $state2 == 2 } { .cv lower grid ;}
}
pack .cv -in .f1
button .b0 -text "Clear" -command { ClrCanvas .cv }
button .b1 -text "Text" -command { PaintText .cv "Canvas" }
button .b2 -text "Axis" -command { DrawAxis .cv }
button .b3 -text "Box" -command { DrawBox .cv }
button .b4 -text "Fn1" -command { DrawFn1 .cv }
button .b5 -text "Fn2" -command { DrawFn2 .cv }
#pack .b0 .b1 .b2 .b3 .b4 .b5 .b6 .b7 -in .f2 -side left -padx 2
#catch {console show}
#if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} }
button .b6 -text "gridlower" -command { refreshgrid .cv 2 } -background $colorite
button .b7 -text "gridover" -command { refreshgrid .cv 1 } -background $colorite
button .b8 -text "exit" -command { exit }
button .b9 -text "exit" -command { exit }
button .b10 -text "scale^" -command {.cv scale all 0 0 1.1 1.1 }
button .b11 -text "unscale<" -command {.cv scale all 0 0 .9 .9 }
button .b12 -text "meas_ball" -command { .cv create oval 150 110 170 130 -width 2 -fill red -outline gray -tags {object moveable}; }
button .b13 -text "ball" -command { mint .cv; }
button .b14 -text "exit" -command { exit }
set info "0"
label .info -textvar info -just left
pack .b0 .b1 .b2 .b3 .b4 .b5 .b6 .b7 -in .f2 -side left -padx 2
pack .b8 .b9 .b10 .b11 .b12 .b13 .b14 .info -in .f3 -side left -padx 2
.cv bind moveable {item:move %W %x %y 1;set info " %x %y ";puts "%x %y"}
.cv bind moveable {item:endmove %W %x %y;puts "%x %y"}
.cv bind moveable {item:hover %W %x %y 1;set info " %x %y "}
.cv bind moveable {item:hover %W %x %y 0;set info " %x %y "}
.cv bind moveit {item:move %W %x %y;set info " %x %y "}
.cv bind all {item:toggletag %W %x %y moveable}
#set info [format "x=%.2f y=%.2f" $x $y]
# update item styles
item:upd .cv
======
<> Example | Graphics