#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

#/usr/local/bin/wish
#######################################################################################
#
# IBCONF a little configuration and bus-test utility
#
# (c) 1995 by C.Schroeter (clausi@chemie.fu-berlin.de)
#
#######################################################################################

#
# set here the path for ibdump utility program
#
if { [ file exists /usr/local/bin/ibdump ] } {
set ibdump /usr/local/bin/ibdump 
} else {
set ibdump ../../util/ibdump 
}
#
# set here the path of the configuration file
#

set default_config /etc/gpib.conf

#
# change here the path for bitmaps
#
#
if { [ file exists /usr/include/X11/bitmaps/Up ] } {
   set bitmap_path /usr/include/X11/bitmaps 
} else {
   set bitmap_path .
}
#
# The program will run with plain wish and ibsh as well
# if loading is enabled load the gpib library
#
#

if { [ file exists [info library]/libgpib.so ] } {  
  load [info library]/libgpib.so
} elseif { [ file exists ../../language/tcl/libgpib.so ] } {  
  load ../../language/tcl/libgpib.so
} else {
  puts "Warning: can't load GPIB tcl-library, falling down to normal wish mode"	
}

if { [llength [info commands gpib]] > 0 } {
  set is_ibsh 1
} else {
  set is_ibsh 0
}




######### END configurable parameters #################################################

########################################################################################
#
# get settings from configuration
#
#
catch "exec rm /tmp/ibdump"
catch "exec $ibdump tcl >/tmp/ibdump" 
catch "source /tmp/ibdump"


set status "LINUX-GPIB Configuration and Bus-Test Utility (c)1995 C.Schroeter"

set board 0
set changed_state 0
#
# if not found fall back to defaults
#

if !$ibBoard(boards) { 

set ibBoard(boards) 1 

set ibBoard(0,devices) {}
set ibBoard(0,pad) 0
set ibBoard(0,sad) 0
set ibBoard(0,timeout) 3s
set ibBoard(0,base) 0x2e1
set ibBoard(0,irq)  5
set ibBoard(0,dma)  1
set ibBoard(0,eos) 0x0a
set ibBoard(0,reos) 1
set ibBoard(0,xeos) 0
set ibBoard(0,bin)  0
set ibBoard(0,ifc)  1
set ibBoard(0,debug)  0
set ibBoard(0,dmabuf)  0
set ibBoard(0,errlog)  /dev/console



}


###############################################################################################

frame .menu -borderwidth 2 -relief raised



menubutton .menu.file -text "File" -underline 0 -menu .menu.file.m
menu       .menu.file.m 
	   .menu.file.m add command -label "Save.." -command "save_parameter $default_config"
	   .menu.file.m add command -label "Quit" -command "exit_program"


menubutton .menu.board -text "Board" -underline 0 -menu .menu.board.m
menu       .menu.board.m
	   .menu.board.m add command -label "Configure" -command "configure_board"

menubutton .menu.driver -text "Driver" -underline 0 -menu .menu.driver.m
menu       .menu.driver.m
	   .menu.driver.m add command -label "Configure" -command "configure_driver"


pack  .menu.file   -side left
pack  .menu.board  -side left
#pack  .menu.driver -side left

pack  .menu -side top -fill x


######################################################################

frame .statusbar -background grey90 -relief sunken -borderwidth 2
label .statusbar.l -textvariable status -background grey90 -relief flat

pack  .statusbar.l -side left -fill x
pack  .statusbar -side bottom -fill x 
#-expand yes


###############################################################################################

frame .buttonbar -relief ridge -borderwidth 2 

button .buttonbar.b1 -text "Delete" -command {delete_entrys} -borderwidth 2 -background grey60
button .buttonbar.b2 -text "New" -command {add_new} -borderwidth 2 -background grey60
button .buttonbar.b3 -text "Configure" -command {add_new [.list.l get [.list.l curselection]]} \
                                       -borderwidth 2 -background grey60
if { $is_ibsh } {
button .buttonbar.b4 -text "Test Functions" -command {test_device [.list.l get [.list.l curselection]]} \
                                       -borderwidth 2 -background grey60
}

pack  .buttonbar      -side right -fill y -padx 20 -pady 10
pack  .buttonbar.b1   -side top -fill x -pady 5 -padx 8 
pack  .buttonbar.b2   -side top -fill x -pady 5 -padx 8 
pack  .buttonbar.b3   -side top -fill x -pady 5 -padx 8 
if { $is_ibsh } {
pack  .buttonbar.b4   -side top -fill x -pady 5 -padx 8 
}
###############################################################################################

frame      .list   -borderwidth 2 -relief ridge
listbox    .list.l -relief sunken -background grey90 -yscroll ".list.s set"
scrollbar  .list.s -relief sunken -command ".list.l yview"

pack .list.s -side right -fill y 
pack .list.l -side left -fill both


bind .list.l <Double-1> { add_new [.list.l get [.list.l curselection] ] }


pack .list -padx 20 -pady 10

######################################################################




foreach i $ibBoard(0,devices) { 
	.list.l insert end $i
}

######################################################################
proc add_new { {aname Unknown} } {
   global name init pad sad eos reos xeos bin init_flags network master new_device changed_state
   global tk_version autopoll

   set name     $aname
   if { ! [ string compare $aname Unknown ] } { 
   set new_device 1
   set init     ""
   set pad      0
   set sad      0
   set eos      0x0d
   set reos 1
   set xeos 0
   set bin  0
   set init_flags     ""
   set master    0
   set autopoll  0
   set network  ""	   
   } else {
   upvar $name Device
   set new_device 0
   set init       $Device(init)
   set pad        $Device(pad)
   set sad        $Device(sad)
   set eos        $Device(eos)
   set reos       $Device(reos)
   set xeos       $Device(xeos)
   set bin        $Device(bin)
   set init_flags      $Device(init_flags)
   set network    $Device(network)	   
   set master     $Device(master)
   set autopoll   $Device(autopoll)
   }
   toplevel .new
   focus .new	

   wm title .new "Configure Device Entry"



if { $tk_version >= 4.0 } {
set scrolloption -xscrollcommand
} else {
set scrolloption -scroll
}


   #####
   ## the name entry
   #####
   frame    .new.name      -relief ridge -borderwidth 2
   if { $new_device } {
   entry    .new.name.e    -relief sunken -background grey90 -textvariable name -width 30
   } else {
   label    .new.name.e    -relief flat -textvariable name -width 30
   }
   label    .new.name.l    -text "Device Name" 

   pack     .new.name.e    -fill both -side left
   pack     .new.name.l    -fill both -side left 
   pack     .new.name      -side top -fill both -expand yes -padx 8 -pady 5 
	
   #####
   ## the pad and sad entry
   #####
   frame    .new.pad  
   selector .new.pad pad "Primary GPIB Address"
   pack     .new.pad  -side top -fill both -expand yes    	

   frame    .new.sad
   selector .new.sad sad "Secondary GPIB Address"
   pack     .new.sad  -side top -fill both -expand yes 


   #####
   ## the eos entry
   #####
   frame    .new.eos      -relief ridge -borderwidth 2
   entry    .new.eos.e    -relief sunken -background grey90 -textvariable eos -width 4
   label    .new.eos.l    -text "Default EOS Byte" 

   pack     .new.eos.e    -fill both -side left
   pack     .new.eos.l    -fill both -side left 
   pack     .new.eos      -side top -fill both -expand yes -padx 8 -pady 5 


   #####
   ## the eos entry
   #####
   frame       .new.eosflags      -relief ridge -borderwidth 2
   label       .new.eosflags.l    -text "EOS Handling Modes" -relief groove -borderwidth 2
   checkbutton .new.eosflags.c1   -text "Terminate read on EOS (REOS)" -variable reos \
                                  -relief flat		
   checkbutton .new.eosflags.c2   -text "Send EOS with EOI (XEOS)"     -variable xeos \
                                  -relief flat		
   checkbutton .new.eosflags.c3   -text "Compare EOS 8-bit (BIN)"      -variable bin \
                                  -relief flat		


   pack     .new.eosflags.l    -side top -fill x -expand yes -padx 8 -pady 10 -expand yes 
   pack     .new.eosflags.c1   -side top -expand yes -anchor w -padx 10
   pack     .new.eosflags.c2   -side top -expand yes -anchor w -padx 10
   pack     .new.eosflags.c3   -side top -expand yes -anchor w -padx 10
   pack     .new.eosflags      -side top -fill both -expand yes -padx 8 -pady 5 

   ####
   # the autopoll entry        
   ####
#   frame     .new.misc     -relief ridge -borderwidth 2  
#   label     .new.misc.l   -text "Miscelaneous" -relief groove -borderwidth 2
#   checkbutton .new.misc.c1   -text "Automatic Serial Poll on SRQ" -variable autopoll \
#                                  -relief flat		
#
#   pack      .new.misc.l    -side top -fill x -expand yes -padx 8 -pady 10 -expand yes 
#   pack      .new.misc.c1   -side top -expand yes -anchor w -padx 10
#   pack      .new.misc      -side top -fill both -expand yes -padx 8 -pady 5 


   #####
   ## the busmaster entry
   #####
   frame       .new.master      -relief ridge -borderwidth 2
   label       .new.master.l    -text "Bus Master Configuration" -relief ridge -borderwidth 2
   checkbutton .new.master.c    -text "Device is Bus Master" -variable master \
                                  -relief flat
   label       .new.master.l2   -text "Export Bus to Host(s):"
   entry       .new.master.e    -relief sunken -background grey90 -textvariable network -width 50 \
                                $scrolloption ".new.master.s set"
   scrollbar   .new.master.s    -relief sunken -orient horiz -command \
                                ".new.master.e view"

   pack     .new.master.l       -side top -fill x -padx 8 -pady 10 -expand yes 
   pack     .new.master.c       -side top  -anchor w -expand yes  -padx 10
   pack     .new.master.l2      -side top -fill x -expand yes   
   pack     .new.master.e       -side top -fill x -expand yes -padx 8  
   pack     .new.master.s       -side top -fill x -expand yes -padx 8  
   pack     .new.master         -side top -fill both -expand yes -padx 8 -pady 5 

   #####
   ## the action buttons
   #####

   frame    .new.actions -borderwidth 2 -relief groove
   button   .new.actions.cancel -text "Cancel" -command "destroy .new"  
   button   .new.actions.apply  -text "Apply"  -command "update_struct;destroy .new"  

   pack     .new.actions.cancel -side left -fill y -padx 20 -pady 10 
   pack     .new.actions.apply  -side right -fill y -padx 20 -pady 10 
   pack     .new.actions -side top -fill x


   grab set .new

}

######################################################################
proc update_struct {  } {
   global ibBoard changed_state
   global name init pad sad eos reos xeos bin init_flags network master new_device
   global $name autopoll

   set changed_state 1

#   eval "puts Update$name"
   eval "set $name\(init\)       \{$init\}"
   eval "set $name\(pad\)        $pad"
   eval "set $name\(sad\)        $sad"
   eval "set $name\(eos\)        $eos"
   eval "set $name\(reos\)       $reos"
   eval "set $name\(xeos\)       $xeos"
   eval "set $name\(bin\)        $bin"
   eval "set $name\(init_flags\) \{$init_flags\}"
   eval "set $name\(network\)    \{$network\}"	   
   eval "set $name\(master\)     $master"
   eval "set $name\(autopoll\)   $autopoll"

   if { $new_device } {
	.list.l insert end $name
	lappend ibBoard(0,devices) $name
        #puts $ibBoard(0,devices)
   }
}

######################################################################
proc selector { w var label } {
global $var bitmap_path


frame  $w.frame$var  -relief ridge -borderwidth 2 
button $w.frame$var.up     -bitmap @$bitmap_path/Up -command "incr $var 1"
button $w.frame$var.down   -bitmap @$bitmap_path/Down -command "incr $var -1"
label  $w.frame$var.disp   -background grey90 -textvariable $var -width 2 -relief sunken
label  $w.frame$var.label  -text $label 

pack   $w.frame$var -padx 8 -pady 5 -side left -fill x -expand yes
pack   $w.frame$var.down   -side left -padx 8 -pady 8
pack   $w.frame$var.disp   -side left  -pady 8
pack   $w.frame$var.up     -side left -padx 8 -pady 8
pack   $w.frame$var.label  -side left  -expand yes -padx 5


}

######################################################################
proc delete_entrys { } {
	global ibBoard
        set selct [.list.l curselection]
	set first [lindex $selct 0]
	set last  [lindex $selct [expr [llength $selct] - 1] ]
        .list.l delete $first $last

	for { set i 0 } { $i < [.list.l size] } { incr i } {
		lappend devlist [.list.l get $i ]
	}
	set ibBoard(0,devices) $devlist
}
######################################################################
proc save_parameter { filename } {
global ibBoard status changed_state
set outfile [open $filename "w"]
set status "Saving Setup to $filename..."
update idletasks
  for { set bd 0 } { $bd < $ibBoard(boards) } { incr bd } {
        set devices [ eval "set ibBoard($bd,devices)" ]
        
        puts $outfile "config \{ "
	 puts $outfile "      pad     = $ibBoard($bd,pad)"	
	 puts $outfile "      sad     = $ibBoard($bd,sad)"	
	 puts $outfile "      timeout = $ibBoard($bd,timeout)"	
	 puts $outfile "      base    = $ibBoard($bd,base)"	
	 puts $outfile "      irq     = $ibBoard($bd,irq)"	
	 puts $outfile "      dma     = $ibBoard($bd,dma)"	
         puts $outfile ""
	 puts $outfile "      eos     = $ibBoard($bd,eos)"	
	 puts $outfile "      debug   = $ibBoard($bd,debug)"	
	 puts $outfile "      dma-bufsize   = $ibBoard($bd,dmabuf) "	

	 vput_bool $outfile ibBoard "      set-reos " $bd,reos	
	 vput_bool $outfile ibBoard "      set-xeos " $bd,xeos	
	 vput_bool $outfile ibBoard "      set-bin  " $bd,bin	
	 vput_bool $outfile ibBoard "      set-ifc  " $bd,ifc	
         puts $outfile ""
	 puts $outfile "      errlog  = $ibBoard($bd,errlog)"	
         puts $outfile "\}"

	 foreach i  $devices  {
	  puts $outfile "device \{  name = $i"
          vput_s     $outfile "$i" "        pad =  " pad
          vput_s     $outfile "$i" "        sad =  " sad
          vput_s     $outfile "$i" "        eos =  " eos
          vput_bool  $outfile "$i" "        set-reos   " reos
          vput_bool  $outfile "$i" "        set-xeos   " xeos
          vput_bool  $outfile "$i" "        set-bin    " bin
          vput_s     $outfile "$i" "        init-flags    =  " init_flags
          vput_s     $outfile "$i" "        init-string   =  " init

          set masterflag  [eval "global $i;set $i\(master\)"]
          if  $masterflag {
             puts $outfile        "        master"
             vput_s $outfile "$i" "        network " network	
          }

          set pollflag  [eval "global $i;set $i\(autopoll\)"]
          if $pollflag {
             puts $outfile        "        autopoll"
          }
          puts $outfile "\}\n"
        }
  }

close $outfile
set status "Setup Saved to $filename"

set changed_state 0

}

######################################################################
proc vput_s { ofile dev s val } {
global $dev
set tval [ eval  "set $dev\($val\)" ]

if "[ string length $tval ] > 0" {
	 puts $ofile $s$tval
}
}

proc vput_bool { ofile dev s val } {
global $dev
set tval [ eval  "set $dev\($val\)" ]

if "$tval > 0" {
	 set yesorno yes
} else {
	 set yesorno no
}
	 puts $ofile $s$yesorno
}


######################################################################
proc configure_board {} {
global ibBoard
global bpad bsad timo beos breos bxeos bbin base irq dma ifc errlog changed_state debug dmabuf

toplevel .board
wm title .board "Configure Board Characteristics"

if "$ibBoard(boards) > 0" {

set bpad   $ibBoard(0,pad)
set bsad   $ibBoard(0,sad)
set timo   $ibBoard(0,timeout)
set beos   $ibBoard(0,eos)
set breos  $ibBoard(0,reos)
set bxeos  $ibBoard(0,xeos)
set bbin   $ibBoard(0,bin)
set base   $ibBoard(0,base)
set irq    $ibBoard(0,irq)
set dma    $ibBoard(0,dma)
set ifc    $ibBoard(0,ifc)
set debug  $ibBoard(0,debug)
set errlog $ibBoard(0,errlog)
set dmabuf [ expr $ibBoard(0,dmabuf) / 1024 ]
}


   label    .board.title -text "Board Options for Board(0)" -relief ridge -borderwidth 3
   pack     .board.title -side top -fill x	


   #####
   ## the action buttons
   #####

   frame    .board.actions -borderwidth 2 -relief groove
   button   .board.actions.cancel -text "Cancel" -command "destroy .board"  
   button   .board.actions.apply  -text "Apply"  -command "accept_boardopts;destroy .board"  

   pack     .board.actions.cancel -side left -fill y -padx 20 -pady 10 
   pack     .board.actions.apply  -side right -fill y -padx 20 -pady 10 
   pack     .board.actions -side bottom -fill x




   #####
   #  the characteristics
   #####

   frame     .board.chr -relief ridge -borderwidth 2
   label     .board.chr.l -text "Hardware Settings" -relief ridge -borderwidth 2 

   frame     .board.chr.f1 
   label     .board.chr.f1.l -text "Base Address"
   entry     .board.chr.f1.e -relief sunken -background grey90 -width 6 -textvariable base
   pack      .board.chr.f1.e -side right 
   pack      .board.chr.f1.l -side left 

   frame     .board.chr.f2 
   label     .board.chr.f2.l -text "IRQ Level"
   entry     .board.chr.f2.e -relief sunken -background grey90 -width 6 -textvariable irq
   pack      .board.chr.f2.e -side right  
   pack      .board.chr.f2.l -side left  

   frame     .board.chr.f3 
   label     .board.chr.f3.l -text "DMA Channel"
   entry     .board.chr.f3.e -relief sunken -background grey90 -width 6 -textvariable dma
   pack      .board.chr.f3.e -side right 
   pack      .board.chr.f3.l -side left 

   frame     .board.chr.f4 
   label     .board.chr.f4.l -text "Debug Level"
   entry     .board.chr.f4.e -relief sunken -background grey90 -width 6 -textvariable debug
   pack      .board.chr.f4.e -side right 
   pack      .board.chr.f4.l -side left 


   pack      .board.chr.l -fill x -side top -padx 4 -pady 4
   pack      .board.chr.f1 -side top -padx 4 -pady 4 -fill x
   pack      .board.chr.f2 -side top -padx 4 -pady 4 -fill x
   pack      .board.chr.f3 -side top -padx 4 -pady 4 -fill x
   pack      .board.chr.f4 -side top -padx 4 -pady 4 -fill x
   pack      .board.chr -side left -padx 8 -pady 5 -fill both


   #####
   ## the pad and sad entry
   #####
   frame    .board.chr.pad  
   selector .board.chr.pad bpad "Primary GPIB Address"
   pack     .board.chr.pad  -side top -fill x   	

   frame    .board.chr.sad
   selector .board.chr.sad bsad "Secondary GPIB Address"
   pack     .board.chr.sad  -side top -fill x


   #####
   ## dma buffer size
   #####
   frame    .board.chr.dmabuf
   selector .board.chr.dmabuf dmabuf "DMA Buffer Size (kB)"
   pack     .board.chr.dmabuf  -side top -fill x




   #####
   ## the eos entry
   #####
   frame       .board.eosflags      -relief ridge -borderwidth 2
   label       .board.eosflags.l    -text "EOS Handling Modes" -relief groove -borderwidth 2
   checkbutton .board.eosflags.c1   -text "Terminate read on EOS (REOS)" -variable breos \
                                  -relief flat		
   checkbutton .board.eosflags.c2   -text "Send EOS with EOI (XEOS)"     -variable bxeos \
                                  -relief flat		
   checkbutton .board.eosflags.c3   -text "Compare EOS 8-bit (BIN)"      -variable bbin \
                                  -relief flat		


   pack     .board.eosflags.l    -side top -fill x -expand yes -padx 8 -pady 10 -expand yes 
   pack     .board.eosflags.c1   -side top -expand yes -anchor w -padx 10
   pack     .board.eosflags.c2   -side top -expand yes -anchor w -padx 10
   pack     .board.eosflags.c3   -side top -expand yes -anchor w -padx 10
   pack     .board.eosflags      -side top -fill both -expand yes -padx 8 -pady 5 



   #####
   #  the eos settings
   #####

   frame    .board.eosflags.eos      -relief ridge -borderwidth 2
   entry    .board.eosflags.eos.e    -relief sunken -background grey90 -textvariable beos -width 4
   label    .board.eosflags.eos.l    -text "Default EOS Byte" 

   pack     .board.eosflags.eos.e    -fill both -side left
   pack     .board.eosflags.eos.l    -fill both -side left 
   pack     .board.eosflags.eos      -side top -fill both -expand yes -padx 8 -pady 5 

   ####
   #  timeout
   ####

   frame      .board.timeout   -relief ridge -borderwidth 2
   label      .board.timeout.l -relief ridge -borderwidth 2 -text "Default Timeout" 
   menubutton .board.timeout.mb -relief raised -borderwidth 2 -menu .board.timeout.mb.m -textvariable timo
	menu  .board.timeout.mb.m
              .board.timeout.mb.m add radiobutton -value none -variable timo -label "No Timeout"
              .board.timeout.mb.m add radiobutton -value 10us -variable timo -label "10 us"
              .board.timeout.mb.m add radiobutton -value 30us -variable timo -label "30 us"
              .board.timeout.mb.m add radiobutton -value 100us -variable timo -label "100 us"
              .board.timeout.mb.m add radiobutton -value 300us -variable timo -label "300 us"
              .board.timeout.mb.m add radiobutton -value 1ms -variable timo -label "1 ms"
              .board.timeout.mb.m add radiobutton -value 3ms -variable timo -label "3 ms"
              .board.timeout.mb.m add radiobutton -value 10ms -variable timo -label "10 ms"
              .board.timeout.mb.m add radiobutton -value 30ms -variable timo -label "30 ms"
              .board.timeout.mb.m add radiobutton -value 100ms -variable timo -label "100 ms"
              .board.timeout.mb.m add radiobutton -value 300ms -variable timo -label "300 ms"
              .board.timeout.mb.m add radiobutton -value 1s -variable timo -label "1 s"
              .board.timeout.mb.m add radiobutton -value 3s -variable timo -label "3 s"
              .board.timeout.mb.m add radiobutton -value 10s -variable timo -label "10 s"
              .board.timeout.mb.m add radiobutton -value 30s -variable timo -label "30 s"
              .board.timeout.mb.m add radiobutton -value 100s -variable timo -label "100 s"
              .board.timeout.mb.m add radiobutton -value 300s -variable timo -label "300 s"
              .board.timeout.mb.m add radiobutton -value 1000s -variable timo -label "1000 s"

#   bind .board.timeout.mb <ButtonRelease-1> {.board.timeout.mb configure -text [global timo;set timo]}

   pack .board.timeout.l -fill x -padx 8 -pady 5
   pack .board.timeout.mb -fill x -padx 8 -pady 5

   pack .board.timeout -side top -fill both -expand yes -padx 8 -pady 5

   ###
   #  set-ifc
   ###

   frame       .board.ifc -relief ridge -borderwidth 2
   checkbutton .board.ifc.c -text "Send IFC on init" -variable ifc -relief flat

   pack .board.ifc.c -anchor w -padx 8 -pady 5
   pack .board.ifc -side top -fill both -expand yes -padx 8 -pady 5



   ###
   #  errlog
   ###

   frame       .board.errlog -relief ridge -borderwidth 2
   label       .board.errlog.l -relief ridge -borderwidth 2 -text "Error Logging Path"
   entry       .board.errlog.e -relief sunken -background grey90 -textvariable errlog

   pack .board.errlog.l -padx 8 -pady 5 -fill x
   pack .board.errlog.e -padx 8 -pady 5 -fill x
   pack .board.errlog -side top -fill both -expand yes -padx 8 -pady 5
   


   grab set .board	

}

proc accept_boardopts {} {
global ibBoard changed_state
global bpad bsad timo beos breos bxeos bbin base irq dma ifc errlog debug dmabuf

set changed_state 1

set ibBoard(0,pad) $bpad
set ibBoard(0,sad) $bsad
set ibBoard(0,timeout) $timo
set ibBoard(0,eos) $beos
set ibBoard(0,reos) $breos
set ibBoard(0,xeos) $bxeos
set ibBoard(0,bin) $bbin
set ibBoard(0,base) $base
set ibBoard(0,irq) $irq
set ibBoard(0,dma) $dma
set ibBoard(0,ifc) $ifc
set ibBoard(0,debug) $debug
set ibBoard(0,errlog) $errlog
set ibBoard(0,dmabuf) [ expr $dmabuf * 1024 ]


}

######################################################################


set spb(0) 0
set spb(1) 0
set spb(2) 0
set spb(3) 0
set spb(4) 0
set spb(5) 0
set spb(6) 0
set spb(7) 0

proc test_device { name } {
global ibBoard spb

set dev [gpib find $name]
set sstring ""

toplevel .t$name
wm title .t$name "Test Basic Device Functions"

####
# status frame
####
frame .t$name.stat -borderwidth 2 -relief ridge 
label .t$name.stat.l1 -text "Device: " 
label .t$name.stat.l2 -text $name -width 30 -relief sunken -borderwidth 2 -justify left
label .t$name.stat.l3 -text "ID: "
label .t$name.stat.l4 -text $dev -width 3 -relief sunken -borderwidth 2

pack .t$name.stat.l1 -side left -expand yes
pack .t$name.stat.l2 -side left -expand yes
pack .t$name.stat.l3 -side left -expand yes
pack .t$name.stat.l4 -side left -expand yes
pack .t$name.stat -fill x -fill x -padx 5 -pady 2

####
# if master
####
global $name
set ismaster [eval set $name\(master\)]
#puts "ismaster=$ismaster"

if { $ismaster } {

gpib online $dev 1
gpib sic $dev 
gpib ren $dev 1


frame  .t$name.ms -borderwidth 2 -relief ridge

frame  .t$name.ms.f2  
label  .t$name.ms.f2.l1 -text "Raw Bus Controls (Experts Only)" -relief groove -borderwidth 2
button .t$name.ms.f2.c  -text Send -command "Send_Bus $dev $name"
global atnstate
checkbutton .t$name.ms.f2.c1 -text ATN  -variable atnstate
entry  .t$name.ms.f2.s -width 60 -relief sunken -borderwidth 2 -background grey 

pack   .t$name.ms.f2.l1 -side top -padx 5 -pady 5 -fill x
pack   .t$name.ms.f2.c  -side left -padx 5 -pady 5
pack   .t$name.ms.f2.c1 -side left -padx 5 -pady 5
pack   .t$name.ms.f2.s  -side left -padx 5 -pady 5 -fill x
pack   .t$name.ms.f2    -fill x -padx 2

label  .t$name.ms.l1   -text "Multiline Messages:" -relief groove
pack   .t$name.ms.l1   -padx 5 -pady 5 -fill x

frame  .t$name.ms.f 
button .t$name.ms.f.ul   -text UNL -command "gpib cmd $dev ?"
button .t$name.ms.f.ut   -text UNT -command "gpib cmd $dev _"

button .t$name.ms.f.dcl  -text DCL -command "gpib cmd $dev \x14"
button .t$name.ms.f.get  -text GET -command "gpib cmd $dev \x08"

button .t$name.ms.f.llo  -text LLO -command "gpib cmd $dev \x11"
button .t$name.ms.f.gtl  -text GTL -command "gpib cmd $dev \x01"

button .t$name.ms.f.spe  -text SPE -command "gpib cmd $dev \x18"
button .t$name.ms.f.spd  -text SPD -command "gpib cmd $dev \x19"

button .t$name.ms.f.ppc  -text PPC -command "gpib cmd $dev \x05"
button .t$name.ms.f.ppu  -text PPU -command "gpib cmd $dev \x15"


pack   .t$name.ms.f.ul   -side left -padx 2
pack   .t$name.ms.f.ut   -side left -padx 2
pack   .t$name.ms.f.dcl  -side left -padx 2
pack   .t$name.ms.f.get  -side left -padx 2
pack   .t$name.ms.f.llo  -side left -padx 2
pack   .t$name.ms.f.gtl  -side left -padx 2
pack   .t$name.ms.f.spe  -side left -padx 2
pack   .t$name.ms.f.spd  -side left -padx 2
pack   .t$name.ms.f.ppc  -side left -padx 2
pack   .t$name.ms.f.ppu  -side left -padx 2

pack   .t$name.ms.f -expand yes -fill x -padx 2

frame   .t$name.ms.f3 -relief ridge -borderwidth 2
label   .t$name.ms.f3.l1 -relief groove -text "Talker/Litener Adress Group" 
listbox .t$name.ms.f3.list -relief sunken -width 60 -height 8 -yscroll ".t$name.ms.f3.scroll set" \
			-background grey90 -font fixed
scrollbar .t$name.ms.f3.scroll -orient vertical -command ".t$name.ms.f3.list yview "
button  .t$name.ms.f3.b1 -text Send -command "Send_Selection $dev $name"

bind .t$name.ms.f3.list <Double-1> "Send_Selection $dev $name"

for { set i 32 } { $i < 63 } { incr i } {
        .t$name.ms.f3.list insert end "\"[format "%c" $i]\"                                    MLA[expr $i-32]"                   
}
for { set i 64 } { $i < 95 } { incr i } {
        .t$name.ms.f3.list insert end "\"[format "%c" $i]\"                                    MTA[expr $i-64]"                   
}

pack   .t$name.ms.f3.l1 -fill x -padx 5 -pady 5
pack   .t$name.ms.f3.b1 -side left -fill x -padx 5 -pady 5 -anchor ne
pack   .t$name.ms.f3.scroll -side right -fill y
pack   .t$name.ms.f3.list -side right -fill both
pack   .t$name.ms.f3 -side top -fill x

pack   .t$name.ms -fill x -fill x -padx 5 -pady 2
}


if { ! $ismaster } {
####
# send field
####
frame .t$name.send -borderwidth 2 -relief ridge 
entry  .t$name.send.s  -width 60 -relief sunken -borderwidth 2 -background grey 
button .t$name.send.b  -text Send -command "Send_Dev $dev $name"

pack .t$name.send.b -side left -padx 5 -pady 5
pack .t$name.send.s -side left -padx 5 -pady 5
pack .t$name.send -fill x -padx 5 -pady 2

bind .t$name.send.s <KeyPress-Return> "Send_Dev $dev $name"
focus .t$name 

}



####
# receive field
####
frame  .t$name.rec -borderwidth 2 -relief ridge 
label  .t$name.rec.s  -width 60 -relief flat  
button .t$name.rec.b  -text Read -command "Get_Dev $dev $name"

pack .t$name.rec.b -side left -padx 5 -pady 5
pack .t$name.rec.s -side left -padx 5 -pady 5
pack .t$name.rec -fill x -padx 5 -pady 2

####
# spoll byte
####
if { ! $ismaster } {
frame   .t$name.spoll -relief groove -borderwidth 2
frame   .t$name.spoll.f
label   .t$name.spoll.f.l1 -text "MSB>" -relief flat
pack    .t$name.spoll.f.l1 -side left -padx 2
for {set i 7} { $i>=0 } { incr i -1 } {
  label .t$name.spoll.f.r$i -textvariable spb($i) -relief raised -width 3 
  pack  .t$name.spoll.f.r$i -side left -padx 2
}
label   .t$name.spoll.f.l2 -text "<LSB" -relief flat
pack    .t$name.spoll.f.l2 -side left -padx 2
.t$name.spoll.f.r6 configure -background peachpuff

button  .t$name.spoll.b -text "Spoll" -command "Get_Spoll $dev $name"
pack    .t$name.spoll.b -side left -padx 5 -pady 5
pack    .t$name.spoll.f -side left -padx 5 -pady 5
pack    .t$name.spoll -fill x -padx 5 -pady 2
}
####
# button bar
####
frame   .t$name.btns -relief groove -borderwidth 2
button  .t$name.btns.b1 -text "Quit" -command "gpib close $dev ;destroy .t$name "

pack    .t$name.btns.b1 -side right -padx 10 -pady 5
pack    .t$name.btns -fill x  -padx 5 -pady 2


}



proc Send_Dev { dev name } {
  gpib write $dev [string trimright [.t$name.send.s get]]
#  puts \"[string trimright [.t$name.send.s get]]\"
}

proc Send_Bus { dev name } {
   global atnstate
   if { $atnstate } {
      gpib cmd $dev [.t$name.ms.f2.s get]
      .t$name.ms.f2.c1 flash
   } else {
      gpib write $dev [string trimright [.t$name.ms.f2.s get]]
   }
}

proc Send_Selection { dev name } {
   set selection [.t$name.ms.f3.list get [.t$name.ms.f3.list curselection ]]
   set cmd "gpib cmd $dev \"[lindex $selection 0]\""
   eval $cmd
   .t$name.ms.f2.c1 flash 
}

proc Get_Dev { dev name } {
   set res [gpib read $dev 60]
   .t$name.rec.s configure -text "$res"
}

proc Get_Spoll { dev name } {
  global spb
  set resp [gpib rsp $dev]
  #puts $resp

  for { set i 0 } { $i<8 } {incr i } {
    set spb($i) [expr $resp>>$i & 1 ]
  }

}

######################################################################
proc exit_program {} {
global changed_state default_config

if $changed_state { 

 if { [ tk_dialog .save_dialog "Save?" "Configuration not saved !\n Do it now ?" error 0 "OK" "Cancel" ] == 0 } {
  save_parameter $default_config
  exit
 } else {
  exit	
 }

 } else {
 exit
 }
}
