source ~/tcl/unixconsole.tcl
console eval {.console conf -font {courier 21}}
console eval { wm geom . 80x26+10+708 }
update
source ~/tcl/bwiseprocs0343.tcl

bwise
update

wm geom . 1149x653+9+4

# comment out when no more need..
welcome

# package require Img
# is there a Linux version ?
procs_window
update
wm geom .f 514x450+1168+25
.f.fu.lr conf -font {{MS Sans Serif} 13}
.f.fu.l conf -font {{MS Sans Serif} 13}
.f.ft.t conf -font {{MS Sans Serif} 14}

.f.fe.ffargs.e conf -font {{MS Sans Serif} 13}
.f.fe.ffcom.e conf -font {{MS Sans Serif} 13}
.f.fe.ffargs.b conf -font {{MS Sans Serif} 13}
.f.fe.ffcom.b conf -font {{MS Sans Serif} 13}

proc canmenu { } {
    global rmbut
    global mc
    catch "destroy $mc.pm"
    catch "destroy $mc.pm.c1"
    menu $mc.pm -tearoff 0
    menu $mc.pm.c1 -tearoff 0
    $mc.pm insert 1 command  -label {none} -state disabled
    $mc.pm insert 2 command -label "Eval" -command {global mc; set t "[$mc.pm entrycget 0 -label]" ; uplevel #0 eval $\{[blockfunc $t]\}  }
    $mc.pm insert 3 command -label "Data" -command {global mc; set t "[$mc.pm entrycget 0 -label]" ; canbwin $t }
    $mc.pm insert 4 command -label "Propagate" -command {global mc; set t "[$mc.pm entrycget 0 -label]" ; run $t}
    $mc.pm insert 5 command -label "Transfer" -command {global mc; set t "[$mc.pm entrycget 0 -label]" ; transfer $t}
    $mc.pm insert 6 command -label "Run" -command {global mc; set t "[$mc.pm entrycget 0 -label]" ;uplevel #0 eval $\{[blockfunc $t]\}; run $t}
    $mc.pm insert 7 command -label "Init" -command {global mc; set t "[$mc.pm entrycget 0 -label]" ;uplevel #0 eval $\{[blockfunc $t]_init\}; }
    $mc.pm insert 8 command -label "Funprop" -command {global mc; set t "[$mc.pm entrycget 0 -label]" ; net_funprop $t}
    $mc.pm insert 9 command -label "Selectallleft" -command {
        global mc; set t "[$mc.pm entrycget 0 -label]" ;
        foreach i [net_allleft $t] {
            if { [llength  [
                         listunion  [ $mc find withtag  $i ] \
                                        [ $mc find withtag bbox  ]
                  ]  ] == 0 } \
            {
              cbbox $i selection0
            }  {
              eval $mc del  [listunion [$mc find withtag bbox]  [$mc find withtag $i ]]
            } ;
        }
    }
 
    $mc.pm.c1 insert 1 command  -label Clear -command {
         global mc; set t "[$mc.pm entrycget 0 -label]" ; puts "Unfunctional Clear selected on $t"}
 
    $mc.pm insert 9 cascade -label "New" -menu $mc.pm.c1
 #   $mc.pm insert 5 command -label "Info" -command {global mc; set t "[$mc.pm entrycget 0 -label]" ; set infoline "$t [block_get_pinnames $t]"; eval set befunc "\${$t.bfunc}" } 
    $mc bind all $rmbut {global mc; $mc.pm entryco 0 -label [block_name_fromid current]; tk_popup $mc.pm [expr %X-0] %Y 1}
}

canmenu

proc mnewmenu { {X} {Y} {x} {y} } {
    global mc
    set x [$mc canvasx $x]
    set y [$mc canvasy $y]
    if {[llength [$mc find overlapping [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2] ] ] < 1}  {
        set pp [$mc find overlapping [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2] ]
#  puts $x,$y,$pp,
        catch {destroy $mc.m}; menu $mc.m; $mc.m del 0 end
        catch {destroy $mc.m.c}; menu $mc.m.c; $mc.m.c del 0 end
        foreach i [lsort -dict [info proc new*]] {$mc.m add command -label [string range $i 3 end] -command "mnewinst $i $x $y"}
        foreach i [lsort -dict [uplevel #0 "info var nnewmax*"] ] {
            global $i
            eval "$mc.m.c add command -label [string range $i 4 end] -command \"maxtoblock [set $i] 9 [expr int($x)] [expr int($y)]\""
        }
         $mc.m add cascade -label 'nnewmax*' -menu $mc.m.c
        tk_popup $mc.m $X $Y
    }
}


proc canbwin { {b} } {
  global tt
  set bn {} ; append bn ".$b" "info" ; set bn [string tolower $bn]
  catch "destroy $bn"
  toplevel $bn
  # here's the change:
  set bs $b.*
  uplevel #0 "eval {set tt \[info var $bs*\]} "
  set j 0
  foreach i [lsort -dict $tt]  {
      set il [string tolower $i]
      frame $bn.n$j ; pack $bn.n$j -side top -expand n -fill x
      label $bn.n$j.l -text $i -width 8 -anchor e
      pack $bn.n$j.l -side left -expand n -fill x
      entry $bn.n$j.e -textvar $i
      pack $bn.n$j.e -side left -expand y -fill x
      incr j
  }
    frame $bn.n$j ; pack $bn.n$j -side bottom -expand n -fill none
    button $bn.n$j.c -text Close -command "destroy $bn"
    pack $bn.n$j.c -side left  -expand n -fill none
    button $bn.n$j.e -text Eval -command "uplevel #0 eval \$\\{[blockfunc $b]\\}"
    pack $bn.n$j.e -side left  -expand n -fill none
    incr j
}


proc block_del { {n} } {
    global mc;

 # remove proc window
  set bn {} ; append bn ".$n" "info" ; set bn [string tolower $bn]
  catch "destroy $bn"

 # kill all blockvars
 # It would be possible to also kill all other vars with blockname.* as name
      set v [blockfunc $n init];
      global $v ; unset $v
      set v [blockfunc $n];
      global $v ; unset $v
      foreach pin [block_get_pinnames $n] {
          set p [pinvar $n $pin]
          global $p
          unset $p
      }
 # delete all graphics elements
    foreach i [$mc find withtag $n] {
        if {[lindex [ $mc itemcget $i -tag ] 0] == $n}  {$mc del $i}
    }
}


proc maxtoblock { {a} {rec {8}} {x {850}} {y {50}} } {
    incr rec
    # this version will return formulas, not variables at pins as it reaches recursion limit, which is 1 deep per default
    if {$rec > 10} {return end}
    set r [maxcompo1 $a]
    if [string equal $r end] {return end}
    set op [lindex $r 0]
    set r [lrange $r 1 end]
    set name [newop $op [llength $r] {} in out 40 {} {} $x $y]
 update
    if {[llength $r] == 1} {
        set name2 [maxtoblock $r $rec [expr $x-95] $y]
            if ![string equal $name2 end] {
                connect {} $name in $name2 out
                incr y 85
            } {
                uplevel #0 set $name.in $r
            }
    } {
        set j 0
        foreach i $r {
            set name2 [maxtoblock $i $rec [expr $x-95] $y]
            if ![string equal $name2 end] {
                connect {} $name in$j $name2 out
                incr y 85
            } {
                uplevel #0 set $name.in$j [lindex $r $j]
            }
            incr j
        }
    }
    return $name
}