Automatically generate Bwise blocks from procedures
by Theo Verelst
I've recently made interactive command composer, which contains rudimentary, but working routines to take the list of procedures from the bwise procs_window -generated dialog window to select a procedure name, and extends dialog window with the possiblity to automatically present the list of a (double) clicked procedures' arguments, which in turn can be (double) clicked to be added to an editable list of argument-value pairs, from which with one button-push, an executable command can be generated.
On the bottom of that page, I've examplified a routine to generate a block on the bwise canvas based on a procedure, for which a further version is presented here.
The procedures on this page make little sense without the bwise package loaded first. See Bwise page for pointer to latest (one file, txt or tcl extension, prepend https:// for secure download) version which can be downloaded from the tclhttpd server I run, and distributed linked bwise for a list of bwise pages.
You'll either need to edit (a copy of) the bwise source file, to make sure the 'procs_window' procedure isn't called before the new one on this page is sourced, or use destroy .f to get rid of the old procedure window. The latter can (as I did) also be done from a script which automatically loads the standard bwise source file, destroys the .f window, loads the new stuff, calls procs_window again, and resizes some fonts when desired.
# Generate a unique name for a bwise block with given basename
# It checks for existing number-extended blocks, and generates
# an incremented number
proc block_genname { {blockname {a}} } {
set l {};
# find all basic block rectangles (third tag = block), find out the name (by the first tag)
# and list those names
foreach i [tag_and {block}] {lappend l "[block_name_fromid $i]"}
# find all blocks starting with given name, and sort results
set b [lsort -int -dict -decr [lsearch -all $l $blockname*]]
# get names from sorted indices
set m {};
foreach i $b {lappend m [lindex $l $i]}
#puts $b,$m
# when one or more existing block with same basename exists
if {$m != {}} {
# extract highest extension
set mm [string range [lindex $m 0] [string length $blockname] end]
#puts $mm
# if non-existing yet, but basename exists, extend with 1
if {$mm == {}} {set mm 0}
incr mm
set blockname "$blockname$mm"
}
return $blockname
}
# The actual generate a bwise canvas 'block' from a procedure name proc.
# extracts arguments and defaults, can generate a non conflicting block name
# or be given one, and can have certain arguments set to specified value
proc proc_toblock { {procname} {args {}} {blockname {}} } {
if {$blockname== ""} {set blockname $procname}
set blockname [block_genname $blockname]
set c "$procname"
# generate a list of arguments, based on the block base name, postpended by .argname
foreach i [info args $procname] {
append c " \$\{$blockname.[list $i]\}"
}
# prepare the invokation of the general bwise function block generator function 'newproc'
# using pro_args to deal with argument order and default control
set ret [eval pro_args newproc "{{f {set $blockname.out \[$c\] }} {in {[info args $procname]}} {out {out}} {x {300}} {y {200}} {name $blockname} } " ]
puts $ret
# and execute it
eval $ret
# set block input pin variables to default corresponding argument values
foreach i [info args $procname] {
uplevel #0 "info default $procname $i $procname.$i"
}
# override pin variable initial values by gives specific argument-value pairs
foreach i $args {
# puts $i
uplevel #0 "set $blockname.[lindex $i 0] [lindex $i 1 end]"
}
return $blockname
}
# augmented toplevel procedure window .f generator proc
# this one has an argument list, entries for 2 step command generating
# and a 'generate bwise block for current procedure' button added.
proc procs_window { } {
global defaultprocs
# The procedures which are listed in this list are not shown
if {[info exists defaultprocs] != 1} {
set defaultprocs {bgerror history loadvfs unknown}
}
# get_procvanilla
toplevel .f
wm title .f "Procedure Window"
frame .f.fu ; pack .f.fu -expand n -fill x; # top frame with two scrollable lists
listbox .f.fu.l -height 5 -yscroll ".f.fu.s set"; # left list
pack .f.fu.l -expand y -fill x -side left
scrollbar .f.fu.s -command ".f.fu.l yview"
pack .f.fu.s -side left -expand n -fill y
listbox .f.fu.lr -height 5 -yscroll ".f.fu.sr set"; # right list
pack .f.fu.lr -expand y -fill x -side left
scrollbar .f.fu.sr -command ".f.fu.lr yview"
pack .f.fu.sr -side left -expand n -fill y
frame .f.fe ; pack .f.fe -expand n -fill x ; # Entries
proc_entry fargs {set fcom [pro_args [lindex $fcom 0] $fargs]} "Form Command"
proc_entry fcom {} Execute
frame .f.ft ; pack .f.ft -expand y -fill both ; # Text area
pack .f.ft -expand y -fill both
text .f.ft.t -width 20 -height 4 -wrap none -yscroll ".f.ft.s set";;
pack .f.ft.t -expand y -fill both -side left
scrollbar .f.ft.s -command ".f.ft.t yview"
pack .f.ft.s -side right -expand n -fill y
frame .f.f; pack .f.f -expand n -fill x
button .f.f.b -text {Update Proc} -command {
global procs;
set p [.f.ft.t get 0.0 end];
eval $p;
set procs([lindex $p 1]) $p
}
pack .f.f.b -side right
bind .f.fu.l <Double-Button-1> {
global cf; set cf [selection get];
.f.ft.t del 0.0 end;
.f.ft.t insert end "proc $cf \{"
.f.fu.lr del 0 end;
foreach i [info args $cf] {
.f.fu.lr insert end $i
}
foreach a [info args $cf] {
if { [info default $cf $a b] == 1} {
.f.ft.t insert end " {$a {$b}}" } {
.f.ft.t insert end " {$a}"
}
}
.f.ft.t insert end " \} \{[info body $cf]\} "
global fargs fcom
set fcom $cf
set fargs "pro_args "
}
button .f.f.b2 -text "Refresh List" -command {
set o {};
# Don't list certain procs
foreach i [info procs] {
if {[string match {tk*} $i] == 0 &&
[string match {tcl*} $i] == 0 &&
[string match {pkg_*} $i] == 0 &&
[string match {auto_*} $i] == 0 &&
[lsearch $defaultprocs $i] == -1 } {
lappend o $i
}
};
.f.fu.l del 0 end;
foreach i [lsort $o] {.f.fu.l insert end $i}
};
pack .f.f.b2 -side right
entry .f.f.f -width 15 -textvar procsfile
pack .f.f.f -side left
button .f.f.bs -text {Save Procs} -command {
global procsfile procs
set o {}
foreach i [lsort [array names procs]] {
eval append o { $procs($i) } \n
}
set f [open $procsfile w];
puts $f $o;
close $f
}
pack .f.f.bs -side left
bind .f.fu.lr <Double-Button-1> {
append fargs " \{" [selection get] " \{"
.f.fe.ffargs.e icursor end
append fargs "\}\} "
}
button .f.f.b3 -text Block -command { proc_toblock [lindex $fcom 0] [lrange $fargs 1 end] }
pack .f.f.b3 -side right -expand n -fill none
bind .f.fu.l <F1> [bind .f.fu.l [bind .f.fu.l ]]
.f.f.b2 invoke
.f.ft.t insert end "Use refresh list when you made a new procedure.\n"
.f.ft.t insert end "Double click a procedure name to make it appear \n"
.f.ft.t insert end "in the bottom window.\n\n"
.f.ft.t insert end "After editing it, press Update to resource the proc.\n\n"
.f.ft.t insert end "There is no extra storage except regular tcl procs,\n"
.f.ft.t insert end "loading another proc destroys you edits: \nUPDATE FIRST.\n\n"
.f.ft.t insert end "Save button saves EDITED procs, \nsee filebox entry on the left.\n"
.f.ft.t insert end "Most Bwise regular windows can be resized."
} How can the thus upgraged bwise be used?
In short, we can make a (or take an existing) procedure by typing or adapting one in the text edit window and pressing 'update proc', which basically sources the typed/edited tcl in, and press the 'block' button to automatically make a bwise block appear which has pins for the arguments of that procedure, calls the procedure correctly as eval-associated function variable script-line, and places the result on the output pin.
The function can also simply be clicked from the left upper list, and the arguments be set by double clicking them and filling them in by setting the cursor in the upper entry, executed after forming the command, and then blockified with the selected arguments initialized as typed by pressing 'block'.
The approach allows repeated pressing if block, which will generate more than one blocks, with numbered names, executing the same procedure.
Of course the blocks can be connected together à la Bwise, and 'run' or (net_)funprop-ed (which makes sure blocks are fired when their inputs are all available), or values can be passed one by one by hand (bwise block popup) transfering them, and the blocks can be examined by using the popup 'data' option, which opens a small window listing all its pins, and the value of the associated variables, and allowing an 'eval' of the block function, setting the output variable.