Training, Open Source computer languages
PerlPHPPythonMySQLApache / TomcatTclRubyJavaC and C++LinuxCSS 
Search for:
Home Accessibility Courses Diary The Mouth Forum Resources Site Map About Us Contact
 
For 2023 (and 2024 ...) - we are now fully retired from IT training.
We have made many, many friends over 25 years of teaching about Python, Tcl, Perl, PHP, Lua, Java, C and C++ - and MySQL, Linux and Solaris/SunOS too. Our training notes are now very much out of date, but due to upward compatability most of our examples remain operational and even relevant ad you are welcome to make us if them "as seen" and at your own risk.

Lisa and I (Graham) now live in what was our training centre in Melksham - happy to meet with former delegates here - but do check ahead before coming round. We are far from inactive - rather, enjoying the times that we are retired but still healthy enough in mind and body to be active!

I am also active in many other area and still look after a lot of web sites - you can find an index ((here))
tk canvas question

Posted by yoshi95 (yoshi95), 9 December 2003
so i have 2 boxes in my canvs, one with text and the other doesnt, and there is an aarow connecting them

          +-------+                 +-------+
          | yoshi |----->|                   |
          +-------+                 +-------+

the left box and the text 'yoshi' have the same tag, the right box have a different tag..........

i want to do something like moving the right box to a different location by clicking the left mouse button when the mouse is on top of the right box.......and move the left box with the text when the mouse is on top of the left box.........

the code that i use attempting to do that is:

bind $c <1> "itemStartDrag $c %x %y"
bind $c <B1-Motion> "itemDrag $c %x %y"

proc itemStartDrag {c x y} {
  global lastX lastY
  set lastX [$c canvasx $x]
  set lastY [$c canvasy $y]
}

proc itemDrag {c x y} {
  global name
  global lastX lastY
  set x [$c canvasx $x]
  set y [$c canvasy $y]
  $c move current [expr $x-$lastX] [expr $y-$lastY]
  set lastX $x
  set lastY $y
}

if i pass in the left or right box tag to the line
$c move $tag [expr $x-$lastX] [expr $y-$lastY]

only the left or the right box moves no matter what the mouse is on top over

if i use 'current', then the text and the box dont move together even if they have the same tag........

any ideas on how to do it? or am i confusing u guys?

thanks in advance.........

Posted by admin (Graham Ellis), 10 December 2003
I suspect that you have current set to the individual item that you've selected with the cursor rather than to the whole tag group ...

Posted by yoshi95 (yoshi95), 11 December 2003
then how do i make current apply to the whole tag group?

Posted by admin (Graham Ellis), 11 December 2003
Hmm; perhaps my comment was somewhat misleading.  If you bind to the tag group rather than to each piece of geometry in it, then the action proc should run on the whole tag group rather than on the geometry piece you happen to have selected.  I can't be more specific with your example, as you haven't provided the code that sets up the rectangles and text .... but your $c should be the tag group name.

Posted by yoshi95 (yoshi95), 11 December 2003
heres how i draw the box and text

     method drawNode { x1 y1 x2 y2 name window source_tag} {
           $window create rectangle $x1 $y1 $x2 $y2 -fill white -tags $source_tag
           set x_pos [ expr "$x1 + ( $x2 - $x1) / 2" ]
           set y_pos [ expr "$y1 + 8" ]
           $window create text $x_pos $y_pos -text $node_name -tags $source_tag
           
     }

Posted by admin (Graham Ellis), 12 December 2003
And does the source_tag variable in your creation code contain the same value as the c variable in your bind?

Posted by yoshi95 (yoshi95), 12 December 2003
i am not sure what u r talking about.....

i thot $c is the canvas.........? i copied the code from
the tcl code examples.............i didnt fully understand
what the code does, it just magically worked when i pasted the sample code in my code

my $c is defined as follow:

set c .c
canvas $c -relief raised -width 450 -height 300
pack .c -side top -fill x

bind $c <1> "itemStartDrag $c %x %y"
bind $c <B1-Motion> "itemDrag $c %x %y"

...............................................

if ur still confused.......plz tell me how u would write the code to make the text box movable

some code sample would help too......

i really thank you for ur advice and ur time

Posted by admin (Graham Ellis), 12 December 2003
Ah - you've bound to the canvas and not to a specific tag group on the canvas;  you've not posted any examples of your calls to drawNode as far as I can see, so I'm afraid I can't be specific in giving you a byte by byte fix.    I'll have a look at putting a sample toghether later - I'm giving a Perl course today and it's quite hard to switch back and forth during the intervals  

Posted by yoshi95 (yoshi95), 12 December 2003
basically heres how i can draw node

#################draws a sphere node
#####ObjSource constructor (obj_name, <--the tag
####################x,
####################y,
####################canvas)
proc SphereProc {} {
     ObjSource $name@Obj $name 10 [expr $i*10 + 10] $c
           ####draw the node, ObjSource has
           ##an internal function call draw
     $name@Obj draw    
}


here are the definition for ObjSource class
itcl::class Node {
     variable type
     variable x
     variable y
     variable window
     variable node_name
     variable tag
     
     constructor { n_name i_x i_y i_window i_type } {
           set type $i_type
           set x $i_x
           set y $i_y
           set window $i_window
           set node_name $n_name
           set tag $node_name
     }
     
     method draw {} {
           drawNode $x $y [expr "$x + 50"] \
                 [expr "$y + 15"] $type      
     method drawNode { x1 y1 x2 y2 name window source_tag} {
           $window create rectangle $x1 $y1 $x2 $y2 -fill white -tags $source_tag
           set x_pos [ expr "$x1 + ( $x2 - $x1) / 2" ]
           set y_pos [ expr "$y1 + 8" ]
           $window create text $x_pos $y_pos -text $node_name -tags $source_tag
           
     }
     
}

itcl::class ObjSource {
     inherit Node
     variable obj_source
     
     constructor { n_name i_x i_y i_window } {
           Node::constructor $n_name $i_x $i_y $i_window object } {
           set obj_source $n_name
     }

}

another problem is that i want to do the following:
when i right click the mouse on a specific tag group
i want a window to pop up
so i do

bind $c <2> "Attribute $c %x %y"

# Utility procedures to support dragging of items.
proc Popup_window { c x y } {
     window_pop;
}

but how do i specify the tag group ? right now all the code does is whenever i right click a window pops up

thanks again for taking time looking at my code


Posted by yoshi95 (yoshi95), 12 December 2003
basically i am trying to write a simple GUI for vtk,
so everytime a vtk object is created, i draw a node in the canvas, the nodes can be moved by left click dragging, right click on it  to change attributes of the vtk object......etc..............if u know any online source that would help me in writing a gui please tell me too..........

thanks in advance

Posted by admin (Graham Ellis), 13 December 2003
Yep, you have a fair amountg of code kicking around in one way and another there; I can't spot anything straight off, but then you're using the OO extensions which I don't get to very often.

I've had a chance to write a complete example.   The following code draws four filled boxed, and places two of them - the red one and the blue one - in tag group first.  When you click and hold down on either the red or the blue box, you drag both the red and blue boxes, which I think is what you've been trying to achieve:

Code:
#!/usr/bin/wish

proc note { x y } {
  global presentx presenty
  set presentx $x
  set presenty $y
}

proc drag { x y } {
  global presentx presenty
  set dx [expr $x - $presentx]
  set dy [expr $y - $presenty]
  .fred move first $dx $dy
  set presentx $x
  set presenty $y

}
canvas .fred -width 200 -height 200
pack .fred

.fred create rect 10 10 30 30 -fill red -tag first
.fred create rect 110 110 130 130 -fill blue -tag first

.fred create rect 110 10 130 30 -fill green -tag second
.fred create rect 10 110 30 130 -fill yellow -tag second

.fred bind first <Button-1> {note %x %y }
.fred bind first <B1-Motion> {drag %x %y }



I'm hoping you can look at this example and use it to help find / debug yours - if necessary by turning bits of code off until you get your example much reduced in size, but dragging correctly.

In the longer term, I would generalise my event handlers and store that so that I could use the same drag code to handle lots of different tag groups!

Posted by yoshi95 (yoshi95), 13 December 2003
ok.......thanks for the example............my code actually does that already........ .............what i am trying to do is..................using ur example................

if my mouse was over the red or blue box, both the red and blue box move, if my mouse was over the green or yellow box, both the green and yellow box move........

right now ur example only allow 1 tag group to move.............

my question is....is it possible to write code to allow tag groups, while still having the ability of using "current"..............meaning.....my mouse can move whatever tag group it is on top over............

thanks in advance.................



Posted by admin (Graham Ellis), 13 December 2003
Yes - I just simplified my example a bit too far for that to be possible in it.   I've done a quick mod - this code puts up 10 boxes in 5 tag groups, and drags them in pair

Code:
#!/usr/bin/wish

proc note { x y } {
  global presentx presenty
  set presentx $x
  set presenty $y
}

proc drag { x y which } {
  global presentx presenty
  set dx [expr $x - $presentx]
  set dy [expr $y - $presenty]
  .fred move $which $dx $dy
  set presentx $x
  set presenty $y

}
canvas .fred -width 200 -height 200
pack .fred

for {set i 10} {$i < 180} {incr i 40} {
.fred create rect $i 10 [expr $i + 20] 30 -fill red -tag tag_$i
.fred create rect $i 110 [expr $i + 20] 130 -fill blue -tag tag_$i
.fred bind tag_$i <Button-1> {note %x %y }
.fred bind tag_$i <B1-Motion> "drag %x %y tag_$i"
}


Posted by yoshi95 (yoshi95), 13 December 2003
maybe a picture would clear things up



i created a sphere object, this object has 2 nodes, the sphere1 is the data node, and sphere@Map is a mapper node

i want to be able to move the sphere1 box with the text in it together, or the sphere@Map box with the text in it................depending on which box my mouse is on top over

sorry for the confusion b4....

again thank you for ur time

Posted by yoshi95 (yoshi95), 13 December 2003
oh cool..................
sweeeet..........................
thanks a lot...................................................



Posted by admin (Graham Ellis), 13 December 2003
I think we're both working on this at the same time  

The example I posted a few seconds before your last addition moves boxes in pairs and could easilt be modified to move a box and a piece of text - so I think I have posted a relevant example now.  The trick is in the final bind to the drag proc, passing in the name of the tag group to be bound - and you'll notice that I had to use double quotes for $i to be evaluated at the time the binding was done, rather that curly braces for the evaluation to be deferred.

added at edit - and still we're both posting.  Glad it's sorted / solved

Posted by yoshi95 (yoshi95), 13 December 2003
i have 1 more request...............

i am really having problem implementing the aarow between the 2 box....................i have no idea how to update the aarows position after i have moved one of the box......................i was thinking keeping a global position variable for the aarows, but then there could be many box .........and things get complicated..........

any suggestions? or maybe add aarows, even lines, to ur example code?

AGAIN I THANK YOU MAN.....................

Posted by yoshi95 (yoshi95), 13 December 2003
any idea why the following doesnt work?

itcl::class ObjSource {
     inherit Node
     variable obj_source
     
     constructor { n_name i_x i_y i_window } {
           Node::constructor $n_name $i_x $i_y $i_window object } {
           set obj_source $n_name
           
           $window bind $tag <Button-3> "Update"
     }
     

     method Update {} {
           set buttons1 {
                 {"radius" "0.5"}
                   {"resolution" "10"}
                     {"center(x, y, z)" "0 0 0"}
           }

           set returnValues1 [inputBox $buttons1]
     }

}

the method Update is not recgonized when i right click my mouse

Posted by admin (Graham Ellis), 13 December 2003
No, I don't know ... I'm really not into the OO end of Tcl even though I'm very much into the OO aspects in Perl Java and PHP; I simply have to specialise in the subjects that there's a strong market for training in.

I'm about to post a follow up on the arrows, but then I'll have to head off and get on with other things today.

Posted by admin (Graham Ellis), 13 December 2003
Following up from earlier in the thread.  You want arrows that move too, the slight problem being that they can't move with either taggroup as one end moves with one group, and the other end moves with another.

Solution - draw all the arrows in a separate taggroup and keep a record of how each end is to move.  Also keep a record of how much you've moved each of the tag groups.   Sounds complex, but here is the code - I've added arrows in my example and then I have them jump when you release the drag button:

Code:
#!/usr/bin/wish

proc note { x y } {
  global presentx presenty
  set presentx $x
  set presenty $y
}

proc drag { x y which } {
  global presentx presenty offset
  set dx [expr $x - $presentx]
  set dy [expr $y - $presenty]
  .fred move $which $dx $dy
  set presentx $x
  set presenty $y
  set offset($which,x)  [expr $offset($which,x) + $dx]
  set offset($which,y)  [expr $offset($which,y) + $dy]
}

proc redraw_arrows {} {
       global offset arrows
       .fred delete tag_arrows
       foreach element [array names arrows] {
               set tag1 [lindex $arrows($element) 0]
               set tag2 [lindex $arrows($element) 1]
               set tagx1 [expr $offset(tag_$tag1,x) +[lindex $arrows($element) 2]]
               set tagy1 [expr $offset(tag_$tag1,y) +[lindex $arrows($element) 3]]
               set tagx2 [expr $offset(tag_$tag2,x) +[lindex $arrows($element) 4]]
               set tagy2 [expr $offset(tag_$tag2,y) +[lindex $arrows($element) 5]]
               .fred create line $tagx1 $tagy1 $tagx2 $tagy2 \
                               -fill black -arrow first -tag tag_arrows
               }
       }

canvas .fred -width 200 -height 200
pack .fred

for {set i 10} {$i < 180} {incr i 40} {
.fred create rect $i 10 [expr $i + 20] 30 -fill red -tag tag_$i
.fred create rect $i 110 [expr $i + 20] 130 -fill blue -tag tag_$i
if {$i > 10} {
       set arrows(tag_$i) \
               [list $i [expr $i - 40] $i 20 [expr $i-20] 20 ]
       }
.fred bind tag_$i <Button-1> {note %x %y }
.fred bind tag_$i <B1-Motion> "drag %x %y tag_$i"
.fred bind tag_$i <B1-ButtonRelease> redraw_arrows
set offset(tag_$i,x) 0
set offset(tag_$i,y) 0

}
redraw_arrows




This page is a thread posted to the opentalk forum at www.opentalk.org.uk and archived here for reference. To jump to the archive index please follow this link.

You can Add a comment or ranking to this page

© WELL HOUSE CONSULTANTS LTD., 2024: Well House Manor • 48 Spa Road • Melksham, Wiltshire • United Kingdom • SN12 7NY
PH: 01144 1225 708225 • FAX: 01144 1225 793803 • EMAIL: info@wellho.net • WEB: http://www.wellho.net • SKYPE: wellho