**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  in your comment with the same courtesy that I will give you. Its very hard to reply intelligibly without some background of the correspondent. Thanks,[gold]
----
<<TOC>>
----
** Description **

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

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


====== 
            #! /bin/env tclsh
            # move the circle by dragging it
            #! /bin/env tclsh
            # program moving egg
            #! /bin/env tclsh 
            # tcl_wiki_moving_egg.tcl           
            # program moving egg  
                # 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
                # Sumerian counting board Strategy
                # 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"            
======
----
The original moving text in egg had alternate code to throw object position into title, but this may be 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 .                        
======    
----
It was found that a solid ball in text gave an easier and better appearing  background to the token (sic).
======
              .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 $tag
======
----
** 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