Canvas Object Movement Example
Canvas Object Movement Example
This page is under development. Comments are welcome, but please load any comments in the comments section at the bottom of the page. Please include your wiki MONIKER and date in your comment with the same courtesy that I will give you. Aside from your courtesy, your wiki MONIKER and date as a signature and minimal good faith of any internet post are the rules of this TCL-WIKI. Its very hard to reply reasonably without some background of the correspondent on his WIKI bio page. Thanks, gold 12Dec2018
Description
Examples of moving items on a canvas, by gold
Screenshots Section
figure 1.
figure 2.
figure 3.
Drag a Circle
#! /bin/env tclsh
# move the circle by dragging it
# program moving egg
# tcl_wiki_moving_egg.tcl
# pretty print from autoindent and ased editor
# working under TCL version 8.5.6 and eTCL 1.0.1
# program written on Windows XP on eTCL
# gold on TCL WIKI, 24Mar2017
package require Tk
package require math::numtheory
namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory }
set tcl_precision 17
proc moveobject {object x y} {
variable radius
.c coords $object [expr {$x-$radius}] [expr {$y-$radius}] [expr {$x+$radius}] [expr {$y+ $radius}]
}
set width 400
set height 400
canvas .c -width $width -height $height
set radius 25
set x [expr {$width / 2}]
set y [expr {$height / 2}]
set egg [.c create oval [expr {$x - $radius}] [expr {$y - $radius}] \
[expr {$x + $radius}] [expr {$y + $radius}] -fill bisque]
.c bind $egg <B1-Motion> {moveobject $egg %x %y}
grid .c -row 0 -column 0
wm title . "Canvas Demo Moving Egg" Example Two
#! /bin/env tclsh
# tcl_wiki_moving_text_egg.tcl
# program moving with text tagged to object
# pretty print from autoindent and ased editor
# moving with text tagged to object
# working under TCL version 8.5.6 and eTCL 1.0.1
# program written on Windows XP on eTCL
# gold on TCL WIKI, 24Mar2017
package require Tk
package require math::numtheory
namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory }
set tcl_precision 17
proc grab { xx yy } {
global currentx currenty
set currentx $xx
set currenty $yy
}
proc drag {w xx yy } {
global currentx currenty
set dx [expr {$xx - $currentx}]
set dy [expr {$yy - $currenty}]
.cv move first $dx $dy
$w raise first
set currentx $xx
set currenty $yy
}
canvas .cv -width 200 -height 200 -bg bisque
pack .cv
.cv create oval 10 10 30 30 -fill red -tag first
.cv create text 20 20 -text @ -fill blue -tag first
.cv create rect 110 10 130 30 -fill green -tag second
.cv create rect 10 110 30 130 -fill yellow -tag second
.cv bind first <Button-1> {grab %x %y }
.cv bind first <B1-Motion> {drag .cv %x %y }
.cv bind drag <B1-Motion> {drag .cv %x %y}
wm title . "Canvas Demo Moving Text & Egg" gold 24mar2017. The original moving text in egg had alternate code to throw object position into title, but this may lead to extensive calls.
bind .cv <Motion> {wm title . "Canvas Demo [ expr int( [%W canvasx %x])],[ expr int ([%W canvasy %y])]"}Objects and a Trashcan
Object movement and wastebasket/trashcan on a TCL canvas
Trashcan Sticking a little
#! /bin/env tclsh
# tcl_wiki_wastebasket.tcl
# program wastebasket and moving with text tagged to object
# pretty print from autoindent and ased editor
# tokens and wastebasket
# working under TCL version 8.5.6 and eTCL 1.0.1
# program written on Windows XP on eTCL
# gold on TCL WIKI, 24Mar2017
# wastebasket is sticking a little
package require Tk
package require math::numtheory
namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory }
set tcl_precision 17
set grab 0
set filex ""
set colorit red
array set worth {king 0.1 queen 0.2 rook 0.5 bishop 1 knight 2 pawn 1}
set font9 { Helvetica 20}
#\u265A \u265B \u265C \u265C \u265D \u265D \u265E \u265E \u265F \u265F \u265F
proc wastebasket {w} {
set font9 { Helvetica 50}
$w create rect 10 50 100 60 -fill blue
$w create rect 50 10 60 100 -fill blue
}
proc tokenize_king {tag} {
global font9 colorit
.c create oval 335 10 380 55 -fill gold -tags $tag
.c create text 355 35 -text "\u265A" -font $font9 -fill $colorit -tags $tag
}
proc tokenize_queen {tag} {
global font9 colorit
.c create oval 337 60 373 96 -fill gold -tags $tag
.c create text 355 78 -text "\u265B" -font $font9 -fill $colorit -tags $tag
}
proc tokenize_rook {tag} {
global font9 colorit
.c create oval 334 106 376 148 -fill gold -tags $tag
.c create text 355 127 -text "\u265C" -font $font9 -fill $colorit -tags $tag
}
proc tokenize_bishop {tag} {
global font9 colorit
.c create oval 338 160 374 204 -fill gold -tags $tag
.c create text 355 182 -text "\u265D" -font $font9 -fill $colorit -tags $tag
}
proc tokenize_knight {tag} {
global font9 colorit
.c create oval 336 224 374 262 -fill gold -tags $tag
.c create text 355 243 -text "\u265E" -font $font9 -fill $colorit -tags $tag
}
proc tokenize_pawn {tag} {
global font9 colorit
.c create oval 336 280 377 322 -fill gold -tags $tag
.c create text 355 303 -text "\u265F" -font $font9 -fill $colorit -tags $tag
}
set state2 1
proc refreshgrid { w state2} {
global oscwidth oschorizontal colorite
global grid
global ind indx
set ind 0
set indx 0
set colorite blue
set dx 40 ;# pixels between adjacent vertical grid lines
set dy 40 ;# pixels between adjacent horizontal grid lines
set x0 10 ;# pixels between left of canvas and left of grid
set y0 150 ;# pixels between top of canvas and top of grid
#set win $w ;# name of canvas widget
foreach i {0 8} {
$w create line [expr {$i * $dx + $x0}] $y0\
[expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] -width 2 -fill blue -tag grid
}
for {set i 1} {$i < 8} {incr i} {
$w create line [expr {$i * $dx + $x0}] $y0\
[expr {$i * $dx + $x0}] [expr {4 * $dy + $y0}] -width 2 -fill blue -tag grid
$w create line [expr {$i * $dx + $x0}] [expr {5 * $dy + $y0}]\
[expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] -width 2 -fill blue -tag grid
}
for {set i 0} {$i < 10} {incr i} {
$w create line $x0 [expr {$i * $dy + $y0}]\
[expr {8 * $dx + $x0}] [expr {$i * $dy + $y0}] -width 2 -fill blue -tag grid
}
}
proc take_token {tag x y} {
global tokenx tokeny
set tokenx $x
set tokeny $y
tokenize_$tag token
.c raise token
.c bind $tag <B1-Motion> {drag_token %x %y}
.c bind $tag <ButtonRelease-1> "drop_token $tag %x %y"
}
proc drag_token {x y} {
global tokenx tokeny
.c move token [expr {$x - $tokenx}] [expr {$y - $tokeny}]
set tokenx $x
set tokeny $y
}
proc drop_token {tag x y} {
global grab worth numis
#.c delete token
set tilename [expr {int(rand()*1000000000.)}]
.c itemconfigure token -tag [concat mv xdat_$x ydat_$y obj_$tilename ]
}
wm withdraw .
wm geometry . 400x600
wm resizable . 0 0
pack [canvas .c -width 400 -height 600 -bg bisque ]
tokenize_king king
.c bind king <ButtonPress-1> {take_token king %x %y}
tokenize_queen queen
.c bind queen <ButtonPress-1> {take_token queen %x %y}
tokenize_rook rook
.c bind rook <ButtonPress-1> {take_token rook %x %y}
tokenize_bishop bishop
.c bind bishop <ButtonPress-1> {take_token bishop %x %y}
tokenize_knight knight
.c bind knight <ButtonPress-1> {take_token knight %x %y}
tokenize_pawn pawn
.c bind pawn <ButtonPress-1> {take_token pawn %x %y}
.c bind all <1> {set p(X) [.c canvasx %x]; set p(Y) [.c canvasy %y];set info " %x %y "}
set haloo 50
.c bind mv <B1-Motion> {mv .c %x %y}
.c bind mv <ButtonRelease-1> { crasher .c }
proc crasher {w} {
foreach item [$w find overlapping 0 50 50 50 ] {
if {[$w type $item]=="oval"} {$w delete $item}
if {[$w type $item]=="text"} {$w delete $item}
}
}
proc mv {w x y} {
global p id
set x [$w canvasx $x]
set y [$w canvasy $y]
set id [$w find withtag current]
set numberx [$w gettags current]
regexp {obj_(\d+)} $numberx -> tilex
puts "1"
puts $numberx
puts $tilex
puts " with tag [$w find withtag obj_$tilex ]"
foreach item [$w find withtag obj_$tilex ] {
$w move $item [expr {$x-$p(X)}] [expr {$y-$p(Y)}]
}
puts " x y $x $y"
if { $y >= 20 && $y <= 70 } {
if { $x >= 20 && $x <= 70 } {$w delete obj_$tilex }
}
foreach item [$w find overlapping 0 50 50 50 ] {
if {[$w type $item]=="oval"} {$w delete $item}
if {[$w type $item]=="text"} {$w delete $item}
}
set p(X) $x; set p(Y) $y
}
wm title . "Canvas Demo Wastebasket and Tokens"
wastebasket .c
refreshgrid .c state2
after idle wm deiconify . gold 24mar2017.It was found that a solid ball in text gave an easier and better appearing background to the token (ref following code).
.cv create text [+ $xxx1 355] [+ $yyy1 223] -text "\u26AB" -font $font10 -fill $coloritx -tags $tag
.cv create text [+ $xxx1 355] [+ $yyy1 223] -text "\u2618" -font $font9 -fill $colorit -tags $tagSee Also
- Simple Canvas Demo
- Chinese Xiangqi Chessboard
- wastebasket and tokens used in
Please place any comments here, Thanks.
Q: What is your purpose in binding the motion event on your main window to execute the wm title command. I.e., this line:
bind . <Motion> {wm title . "Title"}The result of that binding is that every time you move the mouse, the "wm title" subcommand is called repeatedly. To set the window title, you just need to call "wm title . title" once, not on every event update upon mouse pointer motion
gold Thanks for feedback.
gold Changes. 24mar2017. too many extensive calls, removed motion command in wm title.
| Category Numerical Analysis | Category Toys | Category Calculator | Category Mathematics | Category Example | Toys and Games | Category Games | Category Application | Category GUI |