**Canvas Object Movement Example**

This page is under development. Comments are welcome, but please load any  comments in the comments section  at the middle of the page. Please sign your user-name  with the same courtesy that I will give you.  Thanks,[gold]
<<TOC>>
** Description **

Examples of moving items on a canvas, by [gold]
----
***Screenshots Section***
****figure 1.****
[Canvas Object Movement Example drag text.png%|% width=600 height=400]
****figure 2.****
[Canvas Object Movement Example moving egg.png%|% width=600 height=400]
****figure 3.****
[Canvas Object Movement Example trashcan.png%|% width=600 height=400]

----
*** Drag a Circle*** 


====== 
#! /bin/env tclsh

# move the circle by dragging it

#! /bin/env tclsh

# program moving egg
# pretty print from autoindent and ased editor
# written on Windows XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
# gold on TCL WIKI , 17Jul2010
package require Tk
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
======


** Example Two **  



======
#! /bin/env tclsh

# program moving with text tagged to object

package require Tk

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 }
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

package require Tk   
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
}
wastebasket .c
refreshgrid .c state2
after idle wm deiconify .
======    
----
** See Also **
   * [Simple Canvas Demo]
   * [Chinese Xiangqi Chessboard]

[gold] This page is copyrighted under the TCL/TK license terms, [http://tcl.tk/software/tcltk/license.html%|%this license]. 


Please place any comments here, Thanks.

[gold] Changes.

 
<<discussion>>



<<categories>> Toys | Example | Games | Canvas