net.tcl

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

  $nb itemconfigure Net \
    -raisecmd  {
        regexp {[0-9]+x[0-9]+([+-][0-9]+)([+-][0-9]+)} [wm geom .] \
            global_foo global_w global_h
        BWidget::place .top 0 0 at [expr {$global_w-[winfo screenwidth .]}] $global_h
        wm deiconify .top
        bind . <Unmap> {wm withdraw .top}
        bind . <Map>   {wm deiconify .top}
        bind . <Configure> {
            if { ![string compare %W "."] } {
                regexp {[0-9]+x[0-9]+([+-][0-9]+)([+-][0-9]+)} [wm geom .] \
                    global_foo global_w global_h
                BWidget::place .top 0 0 at [expr {$global_w-[winfo screenwidth .]}] $global_h
            }
        }
    } \
    -leavecmd {
        wm withdraw .top
        bind . <Unmap> {}
        bind . <Map>   {}
        bind . <Configure> {}
        return 1
    }

}

#==============================================================
proc Net::mkPin {x y dir pin gate gate_name} {
  global c in_net out_net
  if {$dir == "in"} {
    set pin_line [$c create line [expr $x-6] $y $x $y -width 2 -tags [list pin $gate]]
    set pin_text [$c create text [expr $x-2] $y -text $pin -fill brown -anchor se -tags $gate]
    set out_net($gate_name/$pin) {}
    set out_net($gate_name) {}
  } else {
    set pin_line [$c create line $x $y [expr $x+6] $y -width 2 -tags [list pin $gate]]
    set pin_text [$c create text [expr $x+2] $y -text $pin  -fill brown -anchor sw -tags $gate]
    set in_net($gate_name/$pin) {}
    set in_net($gate_name) {}
  }
  $c lower $pin_text
  return [list $pin_line $pin_text]   
}

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

proc Net::mkGate {x y name type inpins outpins} {
	global nodeX nodeY edgeFirst edgeSecond nodetext  nodeptext c ipin opin inst_name
        global inputs outputs pin_name inputs_list outputs_list in_net out_net pin_value
        if {[llength $inpins] > [llength $outpins]} {
          set max_pins [llength $inpins]
        } else {set max_pins [llength $outpins]}
        
	set new [$c create rectangle $x $y [expr $x+30] [expr $y + (($max_pins+1)*10)] \
            -outline black -width 2 -fill white -tags node]
        set num 1
        set inst_name($new) $name
        foreach pin $inpins {
          set pin_list [mkPin $x [expr $y + ($num * 10)] in $pin $new $name]
          set pin_value([lindex $pin_list 0]) $name/$pin
          set pin_name($name/$pin) [lindex $pin_list 0]
          lappend inputs($new) [lindex $pin_list 0]
          lappend inputs($new) [lindex $pin_list 1]
          lappend inputs_list($new) $name/$pin
          incr num
        }
        set num 1
        foreach pin $outpins {
          set pin_list [mkPin [expr $x+30] [expr $y + ($num * 10)] out $pin $new $name]
          set pin_value([lindex $pin_list 0]) $name/$pin
          set pin_name($name/$pin) [lindex $pin_list 0]
          lappend outputs($new) [lindex $pin_list 0]
          lappend outputs($new) [lindex $pin_list 1]
          lappend outputs_list($new) $name/$pin          
          incr num
        }

        set text [$c create text [expr $x+15] [expr $y-7] -text $type -fill blue -tags $new]
        set nodetext($new) $text
	set nodeX($new) $x
	set nodeY($new) $y
}

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

proc Net::mkNet {first second net_name} {	;# Create edge between pins of Gates
	global nodeX nodeY c pin_name in_net out_net
        set c1 [lindex [$c coords $pin_name($first)] 2]
        set c2 [lindex [$c coords $pin_name($first)] 3]
        set c3 [lindex [$c coords $pin_name($second)] 0]
        set c4 [lindex [$c coords $pin_name($second)] 1]

        set new [$c create line $c1 $c2 $c3 $c4 -tags [list net "net $net_name"]]             

	$c lower $new
	lappend in_net($first) $new
	lappend out_net($second) $new
}
#==============================================================

proc Net::mkPort {x y name dir} {
        global c portX portY nodetext nodeX nodeY pin_value inst_name
        global inputs outputs inputs_list outputs_list pin_name
        if {$dir == "in"} {
          set new [$c create poly $x $y [expr $x-5] [expr $y+5] \
            [expr $x-25] [expr $y+5] [expr $x-25] [expr $y-5] [expr $x-5] [expr $y-5] \
              -outline black -fill white -width 2 -tags node]
          set text [$c create text [expr $x-5] [expr $y-5] -text $name -fill blue -anchor se]
          set pin_list [mkPin $x $y out "" $new $name]
          lappend outputs($new) [lindex $pin_list 0]
          lappend outputs($new) [lindex $pin_list 1]
          lappend outputs_list($new) $name
          set inputs_list($new) {}
          set inputs($new) {}
        } else {
          set new [$c create poly $x $y [expr $x+5] [expr $y+5] [expr $x+25] [expr $y+5] \
            [expr $x+25] [expr $y-5] [expr $x+5] [expr $y-5] -outline black -fill white \
            -width 2 -tags node]
          set text [$c create text [expr $x+5] [expr $y-5] -text $name -fill blue -anchor sw]
          set pin_list [mkPin $x $y in "" $new $name]
          lappend inputs($new) [lindex $pin_list 0]
          lappend inputs($new) [lindex $pin_list 1]
          lappend inputs_list($new) $name
          set outputs_list($new) {}
          set outputs($new) {}      
        }
        set inst_name($new) $name
        set pin_value([lindex $pin_list 0]) $name
        set pin_name($name) [lindex $pin_list 0]
        set nodeX($new) $x
        set nodeY($new) $y
        set nodetext($new) $text
}     


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

proc Net::moveGate {node xDist yDist} {
	global nodeX nodeY edgeFirst edgeSecond nodetext c ipin opin
        global inputs outputs in_net out_net inputs_list outputs_list
	$c move $node $xDist $yDist
        $c move $nodetext($node) $xDist $yDist
	incr nodeX($node) $xDist
	incr nodeY($node) $yDist

        if {[info exists inputs_list($node)]} {
	  foreach pin $inputs_list($node) {
            $c move $pin  $xDist $yDist
            if {$out_net($pin) != {}} {
              foreach net $out_net($pin) {
                $c coords $net [lindex [$c coords $net] 0] [lindex [$c coords $net] 1] \
                             [expr $xDist+[lindex [$c coords $net] 2]]  \
                             [expr $yDist+[lindex [$c coords $net] 3]]  
              }
            }
	  }
        } else {
          set inputs_list($node) ""
        }
	foreach pin $outputs_list($node) {
          $c move $pin  $xDist $yDist
          if {$in_net($pin) != {}} {
            foreach net $in_net($pin) {
              $c coords $net [expr $xDist+[lindex [$c coords $net] 0]]  \
                           [expr $yDist+[lindex [$c coords $net] 1]]  \
                [lindex [$c coords $net] 2] [lindex [$c coords $net] 3]
            }
          }
	}
        set all_pins [concat $inputs($node) $outputs($node)]
        foreach pin $all_pins {
          $c move $pin $xDist $yDist
        }
}
#==============================================================

proc Net::delete_all {} {
  global c p_names g_names
  set p_names {} ; set g_names {} 
  $c delete all
  $c configure -scrollregion {0 0 2400 1600}
  $c xview moveto 0.35; $c yview moveto 0.4; 
}
   
#==============================================================
proc Net::run_search {pattern type_sel} {
  switch -exact -- $type_sel {
    gates   {set command "get_cells $pattern"}
    types   {set command "get_submodules $pattern\* -lib"}
    inputs  {set command "get_ports $pattern\* -in"}
    outputs {set command "get_ports $pattern\* -out"}
    nets    {set command "get_nets $pattern"}
  }
  return [lsort [eval $command]]
}

#=====================================================
proc Net::draw_item {name type xcoord ycoord} {
  global p_names g_names command
  set gx [expr $xcoord-10]; set gy [expr $ycoord -30]
  set px $xcoord; set py [expr $ycoord -10]
  if {$type == "gates" || $type == "types" } {
    if {[lsearch -exact $g_names $name] < 0} {
      set gtype [get_mname $name];
      set gins [get_pins $name -in];
      set gouts [get_pins $name -out];
      Net::mkGate $gx $gy $name $gtype $gins $gouts
      lappend g_names $name
    }
  } elseif {$type == "inputs"} {
    if {[lsearch -exact $p_names $name] < 0} {
      Net::mkPort $px $py $name in
      lappend p_names $name
    }
  } elseif {$type == "outputs"} {
    if {[lsearch -exact $p_names $name] < 0} {
      Net::mkPort $px $py $name out
      lappend p_names $name
    }
  } elseif {$type == "nets"} {
    set gate [get_parent_cell [get_cpins $name -out]]; 
    if {[lsearch -exact $g_names $gate] < 0} {
      set gtype [get_mname $gate];
      set gins [get_pins $gate -in];
      set gouts [get_pins $gate -out];
      Net::mkGate $gx $gy $gate $gtype $gins $gouts  
      lappend g_names $gate
    }
  }
  Net::resize_screen max
}

#=====================================================
proc Net::resize_screen {resize_mode} {
  global c
  if {$resize_mode == "default"} {
    $c configure -scrollregion [list 0 0 2400 1600]
  } elseif {$resize_mode == "max"} {
    set coords [$c bbox all]
    if {[lindex $coords 2] > 2400 && [lindex $coords 3] < 1600} {
      $c configure -scrollregion [list 0 0 [lindex $coords 2] 1600]
    }
    if {[lindex $coords 2] > 2400 && [lindex $coords 3] > 1600} {
      $c configure -scrollregion [list 0 0 [lindex $coords 2] [lindex $coords 3]]
    }
    if {[lindex $coords 2] < 2400 && [lindex $coords 3] > 1600} {
      $c configure -scrollregion [list 0 0 2400 [lindex $coords 3]]
    }
  }
}


#=====================================================
proc Net::print_window {} {
  global c 
  if {![winfo exists .sdlg]} {
    toplevel .sdlg
    wm title .sdlg "Print Screen"
    set frame1 [frame .sdlg.1 -bd 1 -relief flat]
    set label1 [label $frame1.label -text "Printer Name: " -anchor w]
    set entry1 [entry $frame1.entry -width 12 -relief sunken -textvariable pname -bd 1]
    pack $label1 -side left
    pack $entry1 -side right -fill x -expand true
    pack $frame1 -side top -fill x -expand true -padx 1m -pady 1m

    set frame2 [frame .sdlg.cmd -bd 1 -relief flat]
    button $frame2.cancel -text "Cancel" -bd 1 -command {
      destroy .sdlg
    }
    button $frame2.ok -text "  OK  " -bd 1 -command {
      $c postscript -file "netman.ps" -rotate true
      exec lpr -P$pname netman.ps
      after 1000 exec rm netman.ps
      destroy .sdlg
    }
    pack $frame2.ok -side left -fill x -expand true
    pack $frame2.cancel -side right -fill x -expand true
    pack $frame2  -side bottom -fill x 
  }
}


#=====================================================
proc Net::get_bit {n1 n2} {
  if {![winfo exists .bdlg]} {
    toplevel .bdlg
    wm title .bdlg "Bits"
    regexp {^(.+)x(.+)\+(.+)\+(.+)$} [wm geometry .] m sx sy cx cy 
    wm geometry .bdlg +[expr $cx+32]+[expr $cy+112]
    set sw    [ScrolledWindow .bdlg.sw]
    set ::lb    [listbox $sw.lb -height 4 -width 10 -highlightthickness 0]
    for {set i [min $n1 $n2]} {$i <= [max $n1 $n2]} {incr i} {$::lb insert end $i}
    $sw setwidget $::lb
    pack $sw -fill both -expand yes
    bind $::lb <1> {set ::sbit [$::lb get [$::lb nearest %y]]; destroy .bdlg;}
    tkwait window .bdlg
  }
  return $::sbit
}