net.tcl

一个用TCL/TK写的用于verilog的集成编辑环境.

namespace eval Net {
    global c
    variable var
    variable title
    variable vscroll
    variable hscroll
    variable commands_list
}
#==========================================================

proc Net::create {nb} {
  global c g_names p_names cmd_name sig_pattern draw_ready sbit
  set g_names {}
  set p_names {}

  set frame [$nb insert end Net -text "Netlist Viewer"]

  # Search Frame
  #==============
  set draw_ready 0
  set cmdframe [frame $frame.cmd]
  set types_list {"gates" "types" "inputs" "outputs" "nets"}
  set results_combo [ComboBox $cmdframe.results -textvariable sig_result -bd 1 \
        -label " Results:" -labelanchor w -modifycmd {set draw_ready 1} -width 40]
  set pattern_entry [LabelEntry $cmdframe.pattern -textvariable sig_pattern -bd 1 \
       -width 8 -label " Pattern:" -labelanchor w ] 
  set types_combo [ComboBox $cmdframe.types -textvariable type -bd 1 -label " Type:" \
      -labelanchor w -values $types_list -width 7]
  $types_combo setvalue first
  set run_button [button $cmdframe.button -text "Search" -bd 1 -command " \
      $results_combo configure -values \[Net::run_search \$sig_pattern \$type\]
      $results_combo setvalue @1"]
  set clrbutton [button $cmdframe.clr  -text "Clear" -bd 1 -command "Net::delete_all"]
  set prtbutton [button $cmdframe.prt  -text "Print" -bd 1 -command "Net::print_window"]

  pack $results_combo  $pattern_entry $types_combo -side right
  pack $clrbutton $prtbutton -side left
  pack $run_button -side left -fill x -expand yes
  pack $cmdframe -side bottom -anchor s -fill x

  # Canvas Creation
  #================
  set Net::title [TitleFrame $frame.tl]
  set subf  [$Net::title getframe]
  set c $subf.c
  set Net::vscroll [scrollbar $subf.vscroll -orient vert -command "$c yview" -width 10  -elementborderwidth 1]
  set Net::hscroll [scrollbar $subf.hscroll -orient horiz -command "$c xview" -width 10 -elementborderwidth 1]
  set c [canvas $subf.c -scrollregion {0 0 2400 1600} -width 600 -height 400 \
	-relief sunken -borderwidth 2 \
	-xscrollcommand "$Net::hscroll set" \
	-yscrollcommand "$Net::vscroll set"]
  $c xview moveto 0.35; $c yview moveto 0.4;

  grid $c -in $subf -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
  grid $Net::vscroll -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
  grid $Net::hscroll  -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
  grid rowconfig    $subf 0 -weight 1 -minsize 0
  grid columnconfig $subf 0 -weight 1 -minsize 0
  pack $Net::title -fill both -expand yes

  #==============================================================
  # Bindings
  #==============================================================
  
  bind $c  <Enter> {
    focus $c
    if {$draw_ready == 1} {
      set xc [expr round([$c canvasx %x])]
      set yc [expr round([$c canvasy %y])]
      Net::draw_item $sig_result $type $xc $yc
      set draw_ready 0
    }
    bind $c <Delete> {
      set in_nets ""; set out_nets ""
      set node [$c find withtag current]
      if {[array names nodetext $node] != ""} {
        set g_names [ldelete $g_names $inst_name($node)]
        set p_names [ldelete $p_names $inst_name($node)]
        $c delete $node
        $c delete $nodetext($node)
        foreach pin $inputs_list($node) {
          $c delete $pin
          foreach net $out_net($pin) {
            $c delete $net
            lappend out_nets $net
          }
        }
        foreach pin $outputs_list($node) {
          $c delete $pin
          foreach net $in_net($pin) {
            $c delete $net
            lappend in_nets $net
          }
        }
        set all_pins [concat $inputs($node) $outputs($node)]
        foreach pin $all_pins {$c delete $pin}
        foreach net $in_nets {
          foreach name [array names out_net] {
            set out_net($name) [ldelete $out_net($name) $net]
          }
        }
        foreach net $out_nets {
          foreach name [array names in_net] {
            set in_net($name) [ldelete $in_net($name) $net]
          }
        }
      }
    }
  }


  $c bind pin <Button-1> {
    set xc [expr round([$c canvasx %x])]
    set yc [expr round([$c canvasy %y])]
  
    set pin_text $pin_value([$c find withtag current])
    set sbit "no"
    if {[regexp {^([^\(]+)\(([^\:]+)\:([^\)]+)\)} $pin_text m pin n1 n2]} {
      set sbit [Net::get_bit $n1 $n2]
    }
    set n_name [get_cnet $pin_text $sbit]
    if {[regexp {([^ ]+)/([^/]+)$} $pin_text m g_name p_name]} {
      set gouts [get_pins $g_name -out]
      set gins [get_pins $g_name -in]
      if {[lsearch -exact $gouts $p_name] >= 0 && $n_name != ""} {
        set direction out
        set in_pins [get_cpins $n_name -in]
        set CY [expr $yc -10]
        foreach pin $in_pins {
          regexp {([^ ]+)/([^/]+)$} $pin m g_name p_name
          if {[lsearch -exact $g_names $g_name] < 0} {
            set g_type [get_mname $g_name];
            set g_inputs [get_pins $g_name -in];
            set g_outputs [get_pins $g_name -out];
            set g_height [expr ([max [llength $g_inputs] [llength $g_outputs]]+1)*10]
            Net::mkGate [expr $xc+20] $CY $g_name $g_type $g_inputs $g_outputs
            lappend g_names $g_name
            set CY [expr $CY+$g_height+15]
          }
          Net::mkNet $pin_text $g_name/$p_name $n_name
        } 
      } elseif {[lsearch -exact $gins $p_name] >= 0 } {
        set direction in
        set out_pins [get_cpins $n_name -out];
        foreach pin $out_pins {
          regexp {([^ ]+)/([^/]+)$} $pin m g_name p_name
          if {[lsearch -exact $g_names $g_name] < 0} {
            set g_type [get_mname $g_name];
            set g_inputs [get_pins $g_name -in];
            set g_outputs [get_pins $g_name -out];
            Net::mkGate [expr $xc-50] [expr $yc-10]   $g_name $g_type $g_inputs $g_outputs
            lappend g_names $g_name
          }
          Net::mkNet $g_name/$p_name $pin_text $n_name
        }    
      }
    } else {
      set inport [get_ports $pin_text -in]
      set outport [get_ports $pin_text -out]
      if {$inport != ""} {
        set direction out
        set in_pins [get_cpins $n_name -in]
        set CY [expr $yc -10]
        foreach pin $in_pins {
          regexp {([^ ]+)/([^/]+)$} $pin m g_name p_name
          if {[lsearch -exact $g_names $g_name] < 0} {
            set g_type [get_mname $g_name];
            set g_inputs [get_pins $g_name -in];
            set g_outputs [get_pins $g_name -out];
            set g_height [expr ([max [llength $g_inputs] [llength $g_outputs]]+1)*10]
            Net::mkGate [expr $xc+20] $CY $g_name $g_type $g_inputs $g_outputs
            lappend g_names $g_name
            set CY [expr $CY+$g_height+15]
          }
          Net::mkNet $pin_text $g_name/$p_name $n_name
        }
      } elseif {$outport != ""} {
        set direction in
        set out_pins [get_cpins $n_name -out]
        foreach pin $out_pins {
          regexp {([^ ]+)/([^/]+)$} $pin m g_name p_name
          if {[lsearch -exact $g_names $g_name] < 0} {
            set g_type [get_mname $g_name];
            set g_inputs [get_pins $g_name -in];
            set g_outputs [get_pins $g_name -out];
            Net::mkGate [expr $xc-50] [expr $yc-20]   $g_name $g_type $g_inputs $g_outputs
            lappend g_names $g_name
          }
          Net::mkNet $g_name/$p_name $pin_text $n_name
        }
      }    
    }
    if {$n_name != ""} {
      if {[regexp {^([^\(]+)\(} $n_name m n_short]} {
        set nports [get_ports ${n_short}*]
      } else {
        set nports [get_ports $n_name]
      }
      if {$nports != ""} {
        set port_name $nports
        switch -exact $direction {
          in {
            set inport [get_ports $port_name -in]
            if {$inport != ""} {
              if {[lsearch -exact $p_names $port_name] < 0 } {
                Net::mkPort [expr $xc-20] $yc $port_name in
                lappend p_names $port_name
              }
              Net::mkNet $port_name $pin_text $n_name
            }
          }
          out {
            set outport [get_ports $port_name -out]
            if {$outport != ""} {
              if {[lsearch -exact $p_names $port_name] < 0 } {
                if {[info exists CY]} {
                  Net::mkPort [expr $xc+20] $CY $port_name out
                } else {
                  Net::mkPort [expr $xc+20] $yc $port_name out
                }
                lappend p_names $port_name   
              }
              Net::mkNet $pin_text $port_name $n_name
            }
          }
        }
      }  
    }
    Net::resize_screen max
  }

  #==============================================================

  $c bind node <Double-2> {
    if {[lsearch -exact [$c itemconfigure current -outline] red] < 0} {
      $c itemconfigure current -outline red
    } else {
      $c itemconfigure current -outline black
    }
  }

  #==============================================================

  $c bind node <Double-1> {
    set mod_name [lindex [$c itemconfigure $nodetext([$c find withtag current]) -text] 4]
     if {[current $mod_name] != 0} {
       $Net::title configure -text $mod_name
       Net::delete_all
     }
  }

  #==============================================================
  $c bind pin <Any-Enter> {
    $c itemconfigure current -fill red
  }
  #==============================================================
  $c bind pin <Any-Leave> {
  	$c itemconfigure current -fill black
  }
  #==============================================================
  $c bind node <Any-Enter> {
    set Netman::instance_name $inst_name([$c find withtag current])
  }
  #==============================================================
  $c bind node <Any-Leave> {
    set Netman::instance_name ""
  }
  #==============================================================
  $c bind net <Any-Enter> {
    set Netman::instance_name [lindex [$c gettags [$c find withtag current]] 1]
  }
  #==============================================================
  $c bind net <Any-Leave> {
    set Netman::instance_name ""
  }
  #==============================================================
  $c bind node <Button-3> {
  	set curX [expr round([$c canvasx %x])]
  	set curY [expr round([$c canvasy %y])]
  }
  #==============================================================
  $c bind node <B3-Motion> {
  	Net::moveGate [$c find withtag current] [expr round([$c canvasx %x])-$curX] \
  			[expr round([$c canvasy %y])-$curY]
  	set curX [expr round([$c canvasx %x])]
  	set curY [expr round([$c canvasy %y])]
  }
  focus $c

  # ScrollView
  destroy .top
  toplevel .top -relief raised -borderwidth 2
  wm protocol .top WM_DELETE_WINDOW {
     # don't kill me
  }
  wm overrideredirect .top 1
  wm withdraw .top
  wm transient .top .
  ScrollView .top.sview -window $c -fill black
  pack .top.sview -fill both -expand yes