tkgate-data 1.8.7-4 / usr / share / tkgate-1.8.7 / scripts / editnets.tcl

#   Copyright (C) 1987-2007 by Jeffery P. Hansen
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# Last edit by hansen on Mon Jan 19 14:23:17 2004
#
#
#

set ednet_oldName ""
set ednet_name ""
set ednet_hide 0
set ednet_nbits 1
set ednet_io 0

proc tkg_editNetUpdate {} {
  global ednet_oldName ednet_name ednet_hide ednet_nbits ednet_io

  gat_changeNet $ednet_oldName $ednet_name $ednet_hide $ednet_nbits $ednet_io

  destroy .ednet
}

proc tkg_editNet {x y net io} {
  global ednet_oldName ednet_name ednet_hide ednet_nbits ednet_io
  global ednet_result edgat_newPort

  set ednet_result 1

  if {[scan $net {%[^@]%s} net ednet_hide] == 2} {
    set ednet_hide 1
  } else {
    set ednet_hide 0
  }

  set geom [offsetgeometry . $x $y]

  if {[scan $net {%[^\[][%d:%d]} net msb lsb] == 3} {
    set ednet_name $net
    set ednet_nbits [expr $msb - $lsb + 1 ]
  } else {
    set ednet_name $net
    set ednet_nbits 1
  }

  set ednet_oldName $ednet_name

  set w .ednet
  toplevel $w
  wm resizable $w 0 0
  wm title $w "TkGate: Net Parameters"
  wm geometry $w $geom
  wm transient $w .

  frame $w.t
    label $w.t.ln -text "[m db.net.name]: "
  entry $w.t.en -textvariable ednet_name

    label $w.t.lh -text "[m db.net.hide]: "
  checkbutton $w.t.eh -variable ednet_hide

    label $w.t.ls -text "[m db.net.bits]: "
  entry $w.t.es -textvariable ednet_nbits -width 4

  grid $w.t.ln -row 0 -column 0 -sticky e -padx 3 -pady 3
  grid $w.t.en -row 0 -column 1 -sticky w -padx 3 -pady 3
  grid $w.t.lh -row 1 -column 0 -sticky e -padx 3 -pady 3
  grid $w.t.eh -row 1 -column 1 -sticky w -padx 3 -pady 3
  grid $w.t.ls -row 2 -column 0 -sticky e -padx 3 -pady 3
  grid $w.t.es -row 2 -column 1 -sticky w -padx 3 -pady 3

  if { $io != 0 } {
    label $w.t.lio -text "[m db.net.port]: "
    frame $w.t.fio
    set ednet_io $io
    #
    # The values here must match the definitins for LOGICIN,
    # LOGICOUT, LOGICTRI in the main program.
    # 
    radiobutton $w.t.fio.in -text [m db.net.in] -variable ednet_io -value 4102
    radiobutton $w.t.fio.out -text [m db.net.out] -variable ednet_io -value 4103
    radiobutton $w.t.fio.tri -text [m db.net.inout] -variable ednet_io -value 4104

    pack $w.t.fio.in $w.t.fio.out $w.t.fio.tri -side left

    grid $w.t.lio -row 3 -column 0 -sticky e -padx 3 -pady 3
    grid $w.t.fio -row 3 -column 1 -sticky e -padx 3 -pady 3
  }

  okcancel $w.b { tkg_editNetUpdate } { set ednet_result 0; destroy .ednet }
  pack $w.t -padx 10 -pady 10
  pack $w.b -fill x

  bind $w.t.en <Return> { tkg_editNetUpdate }
  bind $w.t.es <Return> { tkg_editNetUpdate }

  if { $edgat_newPort } {
      $w.t.en selection range 0 end
      focus $w.t.en
  }


  grab set $w
  tkwait window $w
  grab release $w

  return $ednet_result
}

##################################################
#
# Procedures for the net list
#
# To build initial list use:
#
#    tkg_makeNetList foo
#    tkg_netListAdd foo A 1 1
#    tkg_netListAdd foo B 1 4
#    tkg_netListAdd foo C 1 4
#    tkg_netListAdd foo w1 0 1
#    tkg_netListEnd foo
#
# To insert a new entry:
#
#    tkg_netListInsert foo D 1 8
#
# To delete an entry
#
#    tkg_netListRemove foo C

set edlist_nets {}

proc tkg_clearNetList {} {
  global edlist_nets
  set edlist_nets {}
  .sbar.netlst.f.l delete 0 end
}

proc tkg_makeNetList {w} {
  global edlist_nets

  set edlist_nets {}

#  frame $w -relief groove -bd 2
#  frame $w.f
#  label $w.f.lab -text "[m db.net.inets]:"

  labelframe $w "[m db.net.inets]"
  frame $w.pad
  pack  $w.pad -pady 3

  frame $w.f


  listbox $w.f.l -width 15 -height 1 -yscrollcommand "$w.f.sb set" -takefocus 0
  scrollbar $w.f.sb -command "$w.f.l yview" -takefocus 0

#  pack $w.f.lab -anchor w
  pack $w.f.l $w.f.sb -side left -padx 1 -pady 1 -fill y
  pack $w.f -padx 2 -pady 4 -fill y -expand 1

  bind $w.f.l <Double-ButtonRelease-1> {
    continueAction EditNet {
      set s [.sbar.netlst.f.l curselection]
      if { $s != "" } {
	gat_editNet [.sbar.netlst.f.l get $s]
      }
    }
  }

  bind .sbar.netlst.f.l <Double-ButtonPress-1> {}
  bind .sbar.netlst.f.l <ButtonPress-1> { action -NetSel { tkg_undoSelections nets } }

#  helpon $w.f.lab [m ho.netlist]
  helpon ${w}_label [m ho.netlist]
}

proc tkg_netListEntry {net show nbits} {
  set w ""
  if { $nbits == 1 } {
    set w $net
  } else {
    set x [expr $nbits - 1]
    set w "$net\[$x:0\]"
  }
  if { $show != 1 } {
    set w "${w}@"
  }
  return $w
}


proc tkg_netListRemove {net} {
  set nl ".sbar.netlst.f.l"

  set L [$nl size]
  for {set i 0} {$i < $L} {incr i} {
    set x [$nl get $i]
    set x [string trim $x "@"]
    set p [string first "\[" $x ]
      if { $p > 0 } { set x [string range $x 0 [expr $p - 1]] }
    if { $x == $net } {
      $nl delete $i
      break
    }
  }
}

proc tkg_netListAdd {net show nbits} {
  global edlist_nets
  set nl ".sbar.netlst.f.l"
  set w [tkg_netListEntry $net $show $nbits]
  lappend edlist_nets $w
}

proc tkg_netListEnd {} {
  global edlist_nets
  set nl ".sbar.netlst.f.l"

  set edlist_nets [lsort $edlist_nets]
  foreach n $edlist_nets {
     $nl insert end $n
  }
  set edlist_nets {}
}

proc netlstCompare {A B} {
  set tA [string trim $A "@"]
  set tB [string trim $B "@"]

  set p [string first "\[" $tA ]
  if { $p > 0 } { set tA [string range $tA 0 [expr $p - 1]] }

  set p [string first "\[" $tB ]
  if { $p > 0 } { set tB [string range $tB 0 [expr $p - 1]] }

  set lcA [string tolower $tA]
  set lcB [string tolower $tB]
  set c [string compare $lcA $lcB]
  if {$c == 0} {
    set c [string compare $tA $tB]
  }
  return $c
}

proc tkg_netListInsert {net show nbits} {
  set w [tkg_netListEntry $net $show $nbits]
  lbSortRInsert .sbar.netlst.f.l $w netlstCompare
}

proc tkg_netListUpdate {net show nbits} {
  set w [tkg_netListEntry $net $show $nbits]
  set nl ".sbar.netlst.f.l"

  set net [string tolower $net]
  set L [$nl size]
  for {set i 0} {$i < $L} {incr i} {
    set x [string tolower [string trim [$nl get $i] "@"]]
    set p [string first "\[" $x ]
    if { $p > 0 } { set x [string range $x 0 [expr $p - 1]] }
    if { $x == $net } {
      $nl delete $i
      $nl insert $i $w
      return
    }
  }
}

proc tkg_netSelect {n} {
  set nl ".sbar.netlst.f.l"
  set L [$nl size]
  for {set i 0} {$i < $L} {incr i} {
    set x [string trim [$nl get $i] "@"]
    set p [string first "\[" $x ]
    if { $p > 0 } { set x [string range $x 0 [expr $p - 1]] }

    if { $n  == $x } {
      $nl selection clear 0 end
      $nl selection set $i
      $nl see $i
      return
    }
  }
}

proc tkg_editModuleOrNet {} {
  set p [.sbar.netlst.f.l curselection]
  if { $p >= 0 } {
    gat_editNet [.sbar.netlst.f.l get $p]
    return
  }

  set p [.sbar.blklst.f.list curselection]
  if { $p >= 0 } {
    gat_openBox [string trim [.sbar.blklst.f.list get $p] "+"]
    return
  }

  errmsg "No selected gate, wire or module."
}

tkg_makeNetList .sbar.netlst
pack .sbar.netlst -fill both -expand 1 -padx 3 -pady 5