Updated 2015-04-25 21:07:33 by pooryorick

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.