tkgate-data 1.8.7-4 / usr / share / tkgate-1.8.7 / scripts / scope.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 13:22:59 2004
#
 
proc tkg_scopeMenu {w} {
  frame $w -relief raised -bd 2

  menubutton $w.file -text [m file] -menu $w.file.menu -underline [ul 0]
  menu $w.file.menu
  $w.file.menu add command -label [m menu.sc.prtrace] -underline [ul 0] -accelerator "Ctl-S p" -command tkg_scopePrintDlg
  $w.file.menu add command -label [m menu.sc.close] -underline [ul 0] -accelerator "Ctl-S e" -command { gat_setMajorMode edit }

  menubutton $w.simulate -text [m simulate] -menu $w.simulate.menu -underline [ul 0]
  tkg_makeSimMenu $w.simulate.menu normal

  $w.simulate.menu entryconfigure 1 -label [m simend] -underline [ul 0] -command { gat_setMajorMode edit } -accelerator "Ctl-S e"

  menubutton $w.trace -text [m menu.sc.trace] -menu $w.trace.menu -underline [ul 0]
  menu $w.trace.menu
  $w.trace.menu add command -label [m menu.sc.zoomin] -underline [ul 5] -accelerator "<" -command { .scope.main.frame.canvas zoom -1 }
  $w.trace.menu add command -label [m menu.sc.zoomout] -underline [ul 5] -accelerator ">"  -command { .scope.main.frame.canvas zoom 1 }

  menubutton $w.help -text [m help]

  pack $w.file -side left
  pack $w.simulate -side left
  pack $w.trace -side left
  pack $w.help -side right 
}

proc tkg_scopeToolbar {w} {
  global bd tkg_showXHair

  frame $w

  frame $w.f
  button $w.f.print -image [gifI "$bd/file_print.gif"] -command tkg_scopePrintDlg -takefocus 0
  pack $w.f.print -side left -pady 5

  frame $w.z
  button $w.z.zoomin -image [gifI "$bd/zoom_in.gif"] -command { .scope.main.frame.canvas zoom -1 } -takefocus 0
  button $w.z.zoomout -image [gifI "$bd/zoom_out.gif"] -command { .scope.main.frame.canvas zoom 1 } -takefocus 0
  pack $w.z.zoomin $w.z.zoomout  -side left -pady 5

  frame $w.s
  button $w.s.simgo -image [gifI "$bd/sim_go.gif"] -command tkg_simRun -takefocus 0
  button $w.s.simpause -image [gifI "$bd/sim_pause.gif"] -command tkg_simStop -takefocus 0
  button $w.s.simstep -image [gifI "$bd/sim_step.gif"] -command tkg_simStep -takefocus 0
  button $w.s.simclock -image [gifI "$bd/sim_clock.gif"] -command tkg_simCycle -takefocus 0
  button $w.s.simstop -image [gifI "$bd/sim_stop.gif"] -command { gat_setMajorMode edit } -takefocus 0
  pack $w.s.simgo $w.s.simpause $w.s.simstep $w.s.simclock $w.s.simstop -side left -pady 5

  frame $w.sc
  button $w.sc.simbreak -image [gifI "$bd/sim_break.gif"] -takefocus 0 -command { tkg_editBreakpoints -parent .scope }
  button $w.sc.simscript -image [gifI "$bd/sim_script.gif"] -takefocus 0 -command { tkg_doSimScript -parent .scope } 
  button $w.sc.simload -image [gifI "$bd/sim_load.gif"] -takefocus 0 -command { tkg_simLoadMem -parent .scope }
  button $w.sc.simdump -image [gifI "$bd/sim_dump.gif"] -takefocus 0 -command { tkg_simDumpMem -parent .scope }
  pack $w.sc.simbreak $w.sc.simscript $w.sc.simload $w.sc.simdump -side left -pady 5

  frame $w.extra
  set tkg_showXHair 1
  checkbutton $w.extra.showxhair -indicatoron 0 -image [gifI "$bd/show_xhair.gif"] -variable tkg_showXHair -takefocus 0 -command { gat_setShowXHairState $tkg_showXHair } -selectcolor "\#b9b9b9"

  pack $w.extra.showxhair -side left -pady 5

  pack $w.f $w.z $w.s $w.sc $w.extra -side left -padx 5
#  pack $w.f $w.z $w.s $w.sc  -side left -padx 5

  helpon $w.f.print [m ho.traceprint]

  helpon $w.z.zoomin [m zoomin]
  helpon $w.z.zoomout [m zoomout]

  helpon $w.s.simgo [m ho.simgo]
  helpon $w.s.simpause [m ho.simpause]
  helpon $w.s.simstep [m ho.simstep]
  helpon $w.s.simclock [m ho.simclock]
  helpon $w.s.simstop [m ho.simstop]

  helpon $w.sc.simbreak [m ho.simbreak]
  helpon $w.sc.simscript [m ho.simexec]
  helpon $w.sc.simload [m ho.simload]
  helpon $w.sc.simdump [m ho.simdump]

  helpon $w.extra.showxhair [m ho.showxhair]
}

proc tkg_makeScope {} {
  toplevel .scope
  wm geometry .scope +70+0

  wm minsize .scope 500 300

  tkg_scopeMenu .scope.mbar
  tkg_scopeToolbar .scope.tbar

  frame .scope.main
  frame .scope.main.frame -relief sunken -bd 2


  bind .scope <Destroy> { gat_setMajorMode edit }

  gat_scope .scope.main.frame.canvas -width 600 -height 400 -bg white
  scrollbar .scope.main.vert -command ".scope.main.frame.canvas yview" -takefocus 0
  scrollbar .scope.main.horz -orient horizontal  -command ".scope.main.frame.canvas xview" -takefocus 0
  pack .scope.main.vert -side right -fill y
  pack .scope.main.horz -side bottom -fill x
  pack .scope.main.frame -side top -fill both -expand 1 -padx 5 -pady 5
  pack .scope.main.frame.canvas -fill both -expand 1

  pack .scope.mbar -fill x
  pack .scope.tbar -fill x
  pack .scope.main -fill both -expand 1

  tkg_setBindings .scope

  bind .scope.main.frame.canvas <Button-1> 	{ gat_scopeButton %x %y 1 %s }
  bind .scope.main.frame.canvas <Button-3> 	{ gat_scopeButton %x %y 3 %s }
  bind .scope.main.frame.canvas <Motion> 	{ gat_scopeMotion %x %y 0 %s }
  bind .scope.main.frame.canvas <ButtonRelease-1> { gat_scopeRelease %x %y 1 %s }
  bind .scope.main.frame.canvas <ButtonRelease-3> { gat_scopeRelease %x %y 3 %s }
}

proc tkg_destroyScope {} {
  catch { destroy .scope }

}

proc scope_test {} {
  button .make -text Scope -command makeScope
  button .print -text Print -command printDlg
  pack .make .print -fill x
  wm geometry . +0+0
}