Tk Source Code

Artifact dbaf212550bbad4441b98be343bb0ec089742e9967a39ae77bf83bab491c3b4e:

Attachment "print_canvas.tcl" to ticket [e1081911] added by emiliano 2025-05-06 21:10:53.

---

package require Tk

proc lexpr {args} {
    lmap expr $args {uplevel 1 [list expr $expr]}
}

proc oval-coords {x y} {
    lexpr {$x-5} {$y-5} {$x+5} {$y+5}
}

proc move-node {c item idx x y} {
    set x [$c canvasx $x]
    set y [$c canvasy $y]
    $c coords $item [oval-coords $x $y]
    $c rchars line {*}[lexpr {$idx*2} {1+2*$idx}] [list $x $y]
}

canvas .c -xscrollcommand [list .sx set] -yscrollcommand [list .sy set]
ttk::scrollbar .sy -orient vertical -command [list .c yview]
ttk::scrollbar .sx -orient horizontal -command [list .c xview]
ttk::button .tkprint \
    -command [list after idle [list tk print .c]] \
    -text "Print"
grid .c .sy -sticky news
grid .sx -sticky ew
grid .tkprint - -pady 6
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1

set coords {50 150 100 250 150 50 200 150 250 250 300 50 350 150}
set idx 0
.c create line $coords -smooth raw -tags line -splinesteps 20 -arrow both
foreach {x y} $coords {
    set item [.c create oval [oval-coords $x $y] -fill red]
    .c bind $item <B1-Motion> [list move-node %W $item $idx %x %y]
    incr idx
}
bind .c <ButtonRelease-1> {%W configure -scrollregion [%W bbox all]}
.c configure -scrollregion [.c bbox all]