tkgate-data 1.8.7-4 / usr / share / tkgate-1.8.7 / scripts / commands.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 Tue Jun  8 13:31:33 2004
#
# Respond to 'File Open...'
#

trace variable mode w tkg_modeChanged
trace variable tkg_currentFile w tkg_curFileChanged

set old_mode 0

set tkg_bitWidth 1
set mw_char 0

set tkgnew_file ""
set tkgnew_module ""

bind .frame.cf.canvas <Any-KeyPress> { 
  global mw_char
  set mw_char %A
}

bind .frame.cf.canvas <Button> { focus .mbar }

proc tkg_curFileChanged args {
  set tkg_doBackupOnSave 1
}

proc tkg_confDelMods {} {
  global tkg_discardChanges

  if { $tkg_discardChanges } { set tkg_discardChanges 0; return "yes"; }

  set result [tk_messageBox -default no -type yesno -icon warning \
		  -message [m msg.reallynew]]
  return $result;
}

proc tkg_exit {} {
  global tkg_modifiedFlag tkg_discardChanges
    
  if { $tkg_modifiedFlag && ! $tkg_discardChanges} {
    set result [tk_messageBox -default no -type yesno -icon warning \
		    -message [m msg.reallyquit]]
    if { "$result" != "yes" } { 
     return
    }
  }
  exit
}

proc tkg_newConfirm {} {
  global tkgnew_file tkgnew_module

  destroy .tkgnew
  gat_new $tkgnew_file $tkgnew_module
}

#
# Create a new circuit
#
proc tkg_new {} {
  global tkgnew_file tkgnew_module tkg_modifiedFlag

  if { $tkg_modifiedFlag } {
    if { [tkg_confDelMods] != "yes" } {
      return;
    }
  }

 
  toplevel .tkgnew
	
  wm resizable .tkgnew 0 0
  wm title .tkgnew "TKGate: New Circuit"
  wm geometry .tkgnew [offsetgeometry . 50 50 ]
  wm transient .tkgnew .

  set tkgnew_file "new.v"
  set tkgnew_module "main"

  frame .tkgnew.t
  label .tkgnew.t.fnl -text "[m cmd.file]: "
  entry .tkgnew.t.fne -textvariable tkgnew_file
  grid .tkgnew.t.fnl -row 0 -column 0 -sticky e -padx 5 -pady 2
  grid .tkgnew.t.fne -row 0 -column 1 -sticky w -padx 5 -pady 2

  label .tkgnew.t.tml -text "[m cmd.topname]: "
  entry .tkgnew.t.tme  -textvariable tkgnew_module
  grid .tkgnew.t.tml -row 1 -column 0 -sticky e -padx 5 -pady 2
  grid .tkgnew.t.tme -row 1 -column 1 -sticky w -padx 5 -pady 2

  bind .tkgnew.t.fne <Return> tkg_newConfirm
  bind .tkgnew.t.tme <Return> tkg_newConfirm

  okcancel .tkgnew.b tkg_newConfirm { destroy .tkgnew }


  pack .tkgnew.t -padx 5 -pady 5
  pack .tkgnew.b -fill x

  grab set .tkgnew
  tkwait window .tkgnew
  grab release .tkgnew
}

#
# Open a file
#
proc tkg_load {} {
  global gf_filetypes gf_filter


  set load [tk_getOpenFile -defaultextension $gf_filter -filetypes $gf_filetypes ]
  if { $load != "" } {
    gat_load $load
  }
}

#
# Open a libray 
#
proc tkg_loadLibrary {} {
  global gf_filetypes gf_filter

  set load [tk_getOpenFile -defaultextension $gf_filter -filetypes $gf_filetypes ]
  if { $load != "" } {
    gat_loadLibrary $load
  }
}

proc tkg_save {} {
  global gf_filetypes gf_filter tkg_currentFile

  set save [tk_getSaveFile -defaultextension $gf_filter \
	  -filetypes $gf_filetypes -initialfile $tkg_currentFile]
  if { $save != "" } {
    gat_saveCircuit $save
    set tkg_currentFile $save
    tkg_setDisplayFile $save
  }
}

proc tkg_saveCurrent {} {
  global tkg_currentFile

  if { $tkg_currentFile != "" } {
    gat_saveCircuit $tkg_currentFile
  } else {
    tkg_save
  }
}

proc tkg_getMWChar {} {
  global mw_char
  tkwait variable mw_char
  return $mw_char
}

proc tkg_fixBitWidth {} {
   global tkg_bitWidth
   set n 1
   scan $tkg_bitWidth "%d" n
   if { $n < 1 } { set n 1 }
   if { $n > 32 } { set n 32 } 
   set tkg_bitWidth $n
}

proc tkg_setMode {n} {
  global mode simOn

  if { ! $simOn } {
    set mode $n
    gat_mode $n
  }
}

#
# Called whenever "mode" is changed
#
proc tkg_modeChanged args {
  global mode tkg_batMode tkg_batRate tkg_bitWidth old_mode

  if { $mode == 1 && $tkg_batMode } {
    after $tkg_batRate gat_batInc
  }

  if { $mode == 9 && $old_mode != 9 } {
    label .status.aux.l -text "[m ibits] "
    entry .status.aux.e -width 4 -textvariable tkg_bitWidth
    pack .status.aux.l .status.aux.e -side left
    helpon .status.aux.l [m ho.cmd.bitw]
    bind .status.aux.e <FocusOut> { tkg_fixBitWidth }
  }
  if { $old_mode == 9 && $mode != 9 } {
    helpon .status.aux ""
    destroy .status.aux.l
    destroy .status.aux.e
  }
  set old_mode $mode
}

proc tkg_cancel {} {
  global tkg_statusMessage
  set tkg_statusMessage ""
  updateStatus
}

#
# Undo selections for everything except 'sel' where 'sel'
# is one of 'blocks', 'nets', 'gate'
#
proc tkg_undoSelections {sel} {
   switch $sel {
     gate {
	 .sbar.netlst.f.l selection clear 0 end
	 .sbar.blklst.f.list selection clear 0 end
     }
     nets {
	 gat_unselectGates
	 .sbar.blklst.f.list selection clear 0 end
     }
     blocks {
	 gat_unselectGates
	 .sbar.netlst.f.l selection clear 0 end
     }
   }
}

proc tkg_loadNoviceCircuit {} {
  global tkg_gateHome tkgate_tutorialdir

  gat_load $tkgate_tutorialdir/welcome_tut.v
}