# LATER transfer the `standard' toxy setup definitions into a tcl package # LATER think about using a slave interpreter, and a toxy-specific connection # LATER ask for adding something of the sort to pd.tk: bind Canvas <1> {+focus %W} # In order to keep the state after our canvas has been destroyed # (i.e. our subpatch closed) -- use 'store' and 'restore' handlers, # if defined, otherwise try setting -variable and -textvariable traces. proc ::toxy::itemdotrace {target varname ndxname op} { if {[catch {set v [set $varname]}] == 0} { if {$v != [set $varname.last]} { # FIXME activate this on demand (for explicit traces) # pd $target.rp _value $v \; set $varname.last $v } } else { puts stderr [concat failed ::toxy::itemdotrace] } } proc ::toxy::itembindtrace {varname mastername ndxname op} { set $varname [set $mastername] } proc ::toxy::itemsettrace {op path target varname} { if {[catch {$path cget $op} res] == 0} { if {$res == ""} { if {[catch {$path config $op $varname} err]} { error $err } } else { if {[info tclversion] < 8.4} { trace variable $res w "::toxy::itembindtrace $varname" } else { trace add variable $res write "::toxy::itembindtrace $varname" } } if {![info exists $varname.last]} { set $varname.last "" } if {[info tclversion] < 8.4} { trace variable $varname w "::toxy::itemdotrace $target" } else { trace add variable $varname write "::toxy::itemdotrace $target" } return } else { return 0 } } # LATER revisit -- seems clumsy and fragile proc ::toxy::itemremovetrace {op path varname} { if {[catch {$path cget $op} res] == 0} { if {$res == $varname} { if {[catch {$path config $op ""} err]} { error $err } } elseif {$res != ""} { if {[info tclversion] < 8.4} { catch { trace vdelete $res w "::toxy::itembindtrace $varname" } } else { catch { trace remove variable \ $res write "::toxy::itembindtrace $varname" } } } } } proc ::toxy::itemdestroy {path varname} { ::toxy::itemremovetrace -variable $path $varname.var ::toxy::itemremovetrace -textvariable $path $varname.txt if {[info tclversion] < 8.4} { catch { unset $varname.last $varname.var $varname.txt $varname } } else { unset -nocomplain $varname.last $varname.var $varname.txt $varname } catch {destroy $path} } proc ::toxy::itemgetconfig {path target} { pd $target.rp _config $target.rp [$path cget -bg] \ [winfo reqwidth $path] [winfo reqheight $path] \ [catch {$path config -state normal}]\; } proc ::toxy::itemvisconfig {path target name varname cvpath px py} { if {[info exists ::toxy::itemoptions]} { catch {eval $path config $::toxy::itemoptions} unset ::toxy::itemoptions } $cvpath create window $px $py \ -anchor nw -window $path -tags [concat toxy$name $target] # FIXME if {[info exists ::toxy::storethispath]} { # FIXME explicit traces set needtraces 0 } else { set needtraces 1 } if {$needtraces != 0} { if {[catch {::toxy::itemsettrace -variable \ $path $target $varname.var} res1]} { error $res1 } if {[catch {::toxy::itemsettrace -textvariable \ $path $target $varname.txt} res2]} { error $res2 } # puts stderr [concat traces: ($res1) ($res2)] if {$res1 == 0 && $res2 == 0} { # puts stderr [concat toxy warning: $path untraceable] } } if {[info exists ::toxy::masterinits]} { catch {eval $::toxy::masterinits} unset ::toxy::masterinits } if {[info exists ::toxy::typeinits]} { catch {eval $::toxy::typeinits} unset ::toxy::typeinits } if {[info exists ::toxy::iteminits]} { catch {eval $::toxy::iteminits} unset ::toxy::iteminits } ::toxy::itemgetconfig $path $target return } proc ::toxy::itemvis {tkclass path target name varname cvpath px py} { if {[winfo exists $path]} { # puts [concat $path exists] set ::toxy::itemfailure 0 } else { set ::toxy::itemfailure [catch {$tkclass $path} ::toxy::itemerrmess] } if {$::toxy::itemfailure == 0} { set ::toxy::itemfailure [catch {::toxy::itemvisconfig \ $path $target $name $varname $cvpath $px $py} \ ::toxy::itemerrmess] } if {$::toxy::itemfailure} { if {[winfo exists $path]} {destroy $path} pd $target.rp _failure $::toxy::itemerrmess \; } } proc ::toxy::itemclick {target cvpath x y b f} { pd $target.rp _click \ [$cvpath canvasx [expr $x - [winfo rootx $cvpath]]] \ [$cvpath canvasy [expr $y - [winfo rooty $cvpath]]] $b $f\; } # FIXME proc ::toxy::scalecommand {target sel v} { pd [concat $target $sel $v \;] } proc ::toxy::popupcommand {path target remote i text} { set [$path cget -textvariable] $text pd [concat $target _cb $i \;] pd [concat $remote $i \;] } proc ::toxy::popup {path target remote entries args} { eval {menu $path.pop} $args set i 1 foreach e $entries { $path.pop add command -label [lindex $e 0] \ -command [concat ::toxy::popupcommand $path $target $remote $i \ [lindex $e [expr {[llength $e] > 1}]]] incr i } } # the default initializer #> default # empirically, binding event coords as %X - [winfo rootx .^.c] works better, # than %x + [winfo x %W], or %x + t->te_xpix, LATER investigate # pdtk_canvas_mouseup is a hack, which we must call anyway bind .- { eval .<|_inout 3.> pdtk_canvas_mouseup .^.c \ [expr %X - [winfo rootx .^.c]] [expr %Y - [winfo rooty .^.c]] %b } bind .- <1> {::toxy::itemclick .| .^.c %X %Y %b 0} bind .- {::toxy::itemclick .| .^.c %X %Y %b 1} bind .- {::toxy::itemclick .| .^.c %X %Y %b 2} bind .- {::toxy::itemclick .| .^.c %X %Y %b 3} bind .- {::toxy::itemclick .| .^.c %X %Y %b 4} bind .- {::toxy::itemclick .| .^.c %X %Y %b 5} bind .- {::toxy::itemclick .| .^.c %X %Y %b 6} bind .- {::toxy::itemclick .| .^.c %X %Y %b 7} bind .- <3> {::toxy::itemclick .| .^.c %X %Y %b 8} bind .- .<|_motion \ [.^.c canvasx [expr %X - [winfo rootx .^.c]]] \ [.^.c canvasy [expr %Y - [winfo rooty .^.c]]] 0.> bind .- .<|_inout 1.> bind .- .<|_inout 0.> # standard widget types #> bang button #. -image ::toxy::img::empty -command .<.> #. -bg pink -activebackground red -width 50 -height 50 #. @bang .- flash .: .- invoke #> float scale #. -command [concat ::toxy::scalecommand .| _cb] #. -bg pink -activebackground red -length 200 #. @float .- set .#1 #> symbol entry #. -bg pink -font .(helvetica 24.) -width 16 #. @symbol .- delete 0 end .: .- insert 0 .#1 bind .- {eval .<[.- get].>; focus .^.c}