Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

how to copy a canvas

124 views
Skip to first unread message

Matthias Keppler

unread,
Sep 22, 2015, 4:09:12 AM9/22/15
to
hi,
i have this snipped

pack [canvas .c]
.c create line 10 10 100 100 -width 12 -fill blue
.c create line -10 10 80 100 -width 12 -fill red

on the window you can see the canvas

now i want to copy the canvas .c to a new canvas .c1

how to to this?

canvas .c1
.c1 = .c
get an error bad option "=": ....

thanks and greeting - kmatze

Arjen Markus

unread,
Sep 22, 2015, 5:29:09 AM9/22/15
to
Op dinsdag 22 september 2015 10:09:12 UTC+2 schreef Matthias Keppler:
Have a look at http://wiki.tcl.tk/9168 - it "serializes" the contents of the canvas, so that you can reuse it.

Regards,

Arjen

Uwe Klein

unread,
Sep 22, 2015, 5:50:07 AM9/22/15
to
IMU you would have to copy the canvas by

set configuration [ .c configure ]

<massage that list into a set of options>
-$option $value ....

set clone [ canvas .clone ]

$clone configure {*}$massaged_options

The iterate over all items on the canvas

foreach item [.c find withtag all ] {
set itemtype [ .c type $item ]
set itemcoords [ .c coords $item ]
set itemproperties [ .c itemconfigure $item ]
}

Then recreate the items in the new canvas.

Obviously a [clone] command would be nicer ;-)

uwe

Matthias Keppler

unread,
Sep 22, 2015, 5:17:29 PM9/22/15
to
Hi, thanks for your answer. your tipps are fine end in my function:

proc copyCanvas { cSOURCE cTARGET} {
if { [ catch { $cTARGET configure } err ] } {
return -code error $err
}
# Canvas-Properties
#
foreach cCPROP [$cSOURCE configure] {
set cCITEMname [lindex $cCPROP 0]
set cCITEMval [$cSOURCE cget $cCITEMname]
if {[llength $cCITEMval] > 0} {eval $cTARGET configure $cCITEMname [list $cCITEMval]}
}
# Item-Properties
#
foreach cITEM [$cSOURCE find withtag all] {
set cTYPE [$cSOURCE type $cITEM]
set cCOORD [$cSOURCE coord $cITEM]
set cTARGETITEM [eval $cTARGET create $cTYPE [list $cCOORD]]
foreach cITEMPROP [$cSOURCE itemconfigure $cITEM] {
set cITEMname [lindex $cITEMPROP 0]
set cITEMval [$cSOURCE itemcget $cITEM $cITEMname]
if {[llength $cITEMval] > 0} {eval $cTARGET itemconfigure $cTARGETITEM $cITEMname [list $cITEMval]}
}
}
return 1
}
------------------
it works!

simple to use:

pack [canvas .c]
... define lines, ovals etc.

pack [canvas .new]

copyCanvas .c .new

greetings - kmatze

Ralf Fassel

unread,
Sep 23, 2015, 4:57:37 AM9/23/15
to
* Matthias Keppler <make....@gmail.com>
| proc copyCanvas { cSOURCE cTARGET} {
| if { [ catch { $cTARGET configure } err ] } {
| return -code error $err
| }

What's that 'catch' supposed to achieve if you're immediately re-raise
the error it caught? You could simply go
$cTARGET configure
if you want to err-out in case $cTARGET does not support the 'configure'
subcommand.


| # Canvas-Properties
...
| if {[llength $cCITEMval] > 0} {eval $cTARGET configure $cCITEMname [list $cCITEMval]}
...
| if {[llength $cITEMval] > 0} {eval $cTARGET itemconfigure $cTARGETITEM $cITEMname [list $cITEMval]}

If either $cTARGET, $cTARGETITEM or $cITEMname contain TCL-sensitiy
chars, you're in for surprises here with 'eval'.

Why not simply
$cTARGET configure $cCITEMname $cCITEMval
$cTARGET itemconfigure $cTARGETITEM $cITEMname $cITEMval
?

HTH
R'

Matthias Keppler

unread,
Sep 23, 2015, 12:59:16 PM9/23/15
to
Am Mittwoch, 23. September 2015 10:57:37 UTC+2 schrieb Ralf Fassel:
> * Matthias Keppler
> | proc copyCanvas { cSOURCE cTARGET} {
> | if { [ catch { $cTARGET configure } err ] } {
> | return -code error $err
> | }
>
> What's that 'catch' supposed to achieve if you're immediately re-raise
> the error it caught? You could simply go
> $cTARGET configure
> if you want to err-out in case $cTARGET does not support the 'configure'
> subcommand.
>

the catch is to probe if the canvas exist. i've not found a commeand to test the exist like es "info exist VarName"



> Why not simply
> $cTARGET configure $cCITEMname $cCITEMval
> $cTARGET itemconfigure $cTARGETITEM $cITEMname $cITEMval
> ?

right, your code works ;-)

>
> HTH
> R'

Gerry Snyder

unread,
Sep 23, 2015, 1:17:15 PM9/23/15
to
On 9/23/2015 9:59 AM, Matthias Keppler wrote:
> Am Mittwoch, 23. September 2015 10:57:37 UTC+2 schrieb Ralf Fassel:
>> * Matthias Keppler
>> | proc copyCanvas { cSOURCE cTARGET} {
>> | if { [ catch { $cTARGET configure } err ] } {
>> | return -code error $err
>> | }
>>
>> What's that 'catch' supposed to achieve if you're immediately re-raise
>> the error it caught? You could simply go
>> $cTARGET configure
>> if you want to err-out in case $cTARGET does not support the 'configure'
>> subcommand.
>>
>
> the catch is to probe if the canvas exist. i've not found a commeand to test the exist like es "info exist VarName"
>

What you want is [winfo exists $cTarget]


Gerry

Rich

unread,
Sep 23, 2015, 1:17:43 PM9/23/15
to
Matthias Keppler <make....@gmail.com> wrote:
> Am Mittwoch, 23. September 2015 10:57:37 UTC+2 schrieb Ralf Fassel:
> > * Matthias Keppler
> > | proc copyCanvas { cSOURCE cTARGET} {
> > | if { [ catch { $cTARGET configure } err ] } {
> > | return -code error $err
> > | }
> >
> > What's that 'catch' supposed to achieve if you're immediately re-raise
> > the error it caught? You could simply go
> > $cTARGET configure
> > if you want to err-out in case $cTARGET does not support the 'configure'
> > subcommand.
> >

> the catch is to probe if the canvas exist. i've not found a commeand
> to test the exist like es "info exist VarName"

You mean like [info commands ?pattern?] with a pattern argument?

Note that Ralf's comment was that you are not doing anything special
due to catching the error. You are simply returning it up the stack as
an error.

In which case (return the error as an error) you can leave off the
catch, the if, and the return, and just let the error from "$cTARGET
configure" propagate up to the caller.

Matthias Keppler

unread,
Sep 23, 2015, 2:40:33 PM9/23/15
to
thank you to all!

now i have finalized the function with your feedback, it works fine:

------------------------------------------------------
proc canvas2canvas { cSOURCE cTARGET} {
# probe if canvas exists
if { ! [winfo exist $cSOURCE] } { return "$cSOURCE unkwown" }
if { ! [winfo exist $cTARGET] } { return "$cTARGET unkwown" }
#
# delete all items of cTARGET wihtout destroy the canvas
foreach cITEM [$cTARGET find withtag all] { eval $cTARGET delete $cITEM }
#
# Canvas-Properties (read and write)
#
foreach cCPROP [$cSOURCE configure] {
set cCITEMname [lindex $cCPROP 0]
set cCITEMval [$cSOURCE cget $cCITEMname]
if {[llength $cCITEMval] > 0} {$cTARGET configure $cCITEMname $cCITEMval}
}
#
# Item-Properties (read and write)
#
foreach cITEM [$cSOURCE find withtag all] {
set cTYPE [$cSOURCE type $cITEM]
set cCOORD [$cSOURCE coord $cITEM]
set cTARGETITEM [eval $cTARGET create $cTYPE [list $cCOORD]]
foreach cITEMPROP [$cSOURCE itemconfigure $cITEM] {
set cITEMname [lindex $cITEMPROP 0]
set cITEMval [$cSOURCE itemcget $cITEM $cITEMname]
if {[llength $cITEMval] > 0} {$cTARGET itemconfigure $cTARGETITEM $cITEMname $cITEMval}
}
}
return 1
}
------------------------------------------------------

greetings - kmatze

Ralf Fassel

unread,
Sep 24, 2015, 4:27:46 AM9/24/15
to
* Matthias Keppler <make....@gmail.com>
| # delete all items of cTARGET wihtout destroy the canvas
| foreach cITEM [$cTARGET find withtag all] { eval $cTARGET delete $cITEM }

Instead of the foreach loop, why not simply

$cTARGET delete all?

Or at least, if you insist on the loop:

foreach cITEM [$cTARGET find withtag all] { $cTARGET delete $cITEM }

The canvas subcommand 'find' gives you single items, so you can (should)
delete them as single items. You don't need 'eval' to expand anything here.

A further note about 'eval': consider what
eval $cTARGET delete $cITEM
does: in simple terms, it expands the values of $cTARGET and $cITEM and
then calls the TCL parser again on the result. *All* functionality of
the TCL parser is available in that second round.

Now imagine someone has created the canvas with name
.c;[exec rm -rf $::env(HOME)]

Then you pass the following command to the TCL parser:
.c;[exec rm -rf $::env(HOME)] delete 1

Question #1: what will this do?

Yes that's a silly name for a canvas, but it is (a) possible to do, and
(b) serves only as example that when you use eval, you completely rely
on nothing evil sitting in each of the variables.

=> You don't need eval.
=> If you think you do, consider using {*} first.
=> If you don't have {*}, upgrade your TCL :-)

Check http://wiki.tcl.tk/14069 and the articles it refers to.

HTH
R'

Andreas Kupries

unread,
Sep 26, 2015, 8:08:32 PM9/26/15
to
See also
http://wiki.tcl.tk/26859

canvas to MVG, and internally does the same data extraction needed for
serialization.

This code also exists in [Tklib](http://core.tcl.tk/tklib), documentation at

http://core.tcl.tk/tklib/doc/trunk/embedded/www/tklib/files/modules/canvas/canvas_mvg.html

--
So long,
Andreas Kupries <akup...@shaw.ca>
<http://core.tcl.tk/akupries/>
Developer @ HP Enterprise

Tcl'2015, Oct 19-23, Manassas, VA, USA, http://www.tcl.tk/community/tcl2015/
-------------------------------------------------------------------------------
0 new messages