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

#
# Test all widgets with -variable and -command option, if variable
# always reflect the state of the widget and if command is always
# called once if variable is changed
#

load ../src/gnocl.so

set noCmd 0

set DEBUG 0

proc createWidgets { parent menu withCheck } {
   set widgets ""
   set variables ""
   set check "{}"

   # optionMenu
   if { $withCheck } {
      set check [gnocl::checkButton -sensitive 0]
   }
   set widg [gnocl::optionMenu -variable optionMenuVar \
         -command "cmd %w $check %v"]
   $widg add 0
   $widg add 1
   $widg add 2
   $parent addRow "$widg $check"
   lappend widgets $widg
   lappend variables optionMenuVar
   if { $::DEBUG } { puts "optionMenuWidget: $widg" }

   # checkButton
   if { $withCheck } {
      set check [gnocl::checkButton -sensitive 0]
   }
   set widg [gnocl::checkButton -variable checkButtonVar \
         -command "cmd %w $check %v"]
   $parent addRow "$widg $check"
   lappend widgets $widg
   lappend variables checkButtonVar
   if { $::DEBUG } { puts "checkButtonWidget: $widg" }

   # radioButton
   if { $withCheck } {
      set check [gnocl::checkButton -sensitive 0]
   }
   set widg1 [gnocl::radioButton -variable radioButtonVar -value 0 \
         -text "value: 0" -command "cmd %w $check %v"]
   set widg2 [gnocl::radioButton -variable radioButtonVar -value 1 \
         -text "value: 1" -command "cmd %w $check %v"]
   $parent addRow "$widg1 $check"
   $parent addRow $widg2 
   lappend widgets $widg1 $widg2
   lappend variables radioButtonVar radioButtonVar
   if { $::DEBUG } { puts "radioButtonWidgets: $widg1 $widg2" }

   # scale
   if { $withCheck } {
      set check [gnocl::checkButton -sensitive 0]
   }
   set widg [gnocl::scale -variable scaleVar -upper 10 \
         -command "cmd %w $check %v"]
   $parent addRow "$widg $check"
   lappend widgets $widg
   lappend variables scaleVar
   if { $::DEBUG } { puts "scaleWidget: $widg" }

   # spinButton
   if { $withCheck } {
      set check [gnocl::checkButton -sensitive 0]
   }
   set widg [gnocl::spinButton -variable spinButtonVar -upper 10 \
         -command "cmd %w $check %v"]
   $parent addRow "$widg $check"
   lappend widgets $widg
   lappend variables spinButtonVar
   if { $::DEBUG } { puts "spinButton: $widg" }

   # menuItem checkButton
   if { $withCheck } {
      set label [gnocl::label -text "menu checkbutton"]
      set check [gnocl::checkButton -sensitive 0]
      $parent addRow "$label $check"
   }
   set widg [gnocl::menuItem checkButton -variable menuCheckButtonVar \
         -accelerator "<control>C" \
         -text "%__Test checkbutton" -command "cmd %w $check %v"]
   $menu add $widg
   lappend widgets $widg
   lappend variables menuCheckButtonVar
   if { $::DEBUG } { puts "menuItem checkButton: $widg" }

   return [list $widgets $variables]
}

proc bgerror msg {
   puts -nonewline "in bgerror: "
   puts $msg
}

proc cmd { widg check val } {
   incr ::noCmd
   if { [string length $check] > 0 } {
      $check configure -text $val
      $check setValue 1
      after 500 "$check setValue 0"
   }
   if { abs( $val - [$widg getValue] ) > 1e-8 } {
      puts -nonewline "ERROR: in command $widg: "
      puts -nonewline $val
      puts -nonewline " != "
      puts [$widg getValue]
   }
}

set mainBox [gnocl::table -homogeneous 0]
set menu [gnocl::menu]
set menuBar [gnocl::menubar]
$menuBar add [gnocl::menuItem label -text "%__Menu" -submenu $menu]
$mainBox addRow $menuBar -columnSpan 2

set errMsg [gnocl::label -text "Test if commands are called and -variable\ncorresponds to the state of the widget."]
$mainBox addRow $errMsg -columnSpan 2

set noCmdEntry [gnocl::entry -variable noCmd -sensitive 0]
$mainBox addRow [list [gnocl::label -text "# of commands"] $noCmdEntry]

$mainBox addRow [gnocl::label -text "command called"] -start 1

# test with variables not set
puts "Test with variables not set"
foreach {widgets variables} [createWidgets $mainBox $menu 0] break
foreach widg $widgets var $variables {
   if { [set $var] != 0 && [set $var] != [$widg getValue] } {
      puts "ERROR: with empty variables: values are not identical"
      puts -nonewline "       $var = "
      puts -nonewline [set $var]
      puts -nonewline " != "
      puts [$widg getValue]
      # exit -1
   }
}

if { $noCmd  != 0 } {
   puts "ERROR: with empty variables: command proc should not yet be called ($noCmd)."
   # exit -1
}

puts -nonewline "Test if variable is changed"
foreach val {1 1 0 0 1} {
   puts -nonewline " $val"
   foreach var [lsort -unique $variables] {
      set $var $val
      if { $noCmd != 1 } {
         puts "ERROR: variables changed: command proc should have been called"
         puts "       $var = $val $noCmd."
      }
      set noCmd 0
   }
   foreach widg $widgets var $variables {
      if { [set $var] != $val || [set $var] != [$widg getValue] } {
         puts "ERROR: variables changed: values are not identical"
         puts -nonewline "       $var = "
         puts -nonewline [set $var]
         puts -nonewline " != "
         puts [$widg getValue]
         # exit -1
      }
   }
}

# test with variables set to second value before creation of widget
puts "\nTest with variables set to second value before creation"
foreach widg $widgets {
   $widg delete
}

foreach var $variables {
   set $var 1
}

foreach {widgets variables} [createWidgets $mainBox $menu 1] break
foreach widg $widgets var $variables {
   if { [set $var] != 1 || [set $var] != [$widg getValue] } {
      puts "ERROR: variable was second value: values are not identical"
      puts -nonewline "       $var = "
      puts -nonewline [set $var]
      puts -nonewline " != "
      puts [$widg getValue]
      # exit -1
   }
}
if { $noCmd  != 0 } {
   puts "ERROR: command proc should not yet be called $noCmd."
   # exit -1
}

# test if variable is changed
puts -nonewline "Test if variable is changed"
foreach val {1 1 0 0 1} {
   puts -nonewline " $val"
   foreach var [lsort -unique $variables] {
      set $var $val
      if { $noCmd != 1 } {
         puts "ERROR: variables changed: widget proc should have been called"
         puts "       $var = $val $noCmd."
      }
      set noCmd 0
   }
   foreach widg $widgets var $variables {
      if { [set $var] != $val || [set $var] != [$widg getValue] } {
         puts "ERROR: variables changed: values are not identical"
         puts -nonewline "       $var = "
         puts -nonewline [set $var]
         puts -nonewline " != "
         puts [$widg getValue]
         # exit -1
      }
   }
}

# test setValue
puts -nonewline "\nTesting setValue "
foreach val {1 1 0 0 1} {
   puts -nonewline " $val"
   foreach widg $widgets var $variables {
      $widg setValue $val
      if { $noCmd != 1 } {
         puts "\nERROR: setValue: widget command proc should have been called."
         puts "       $widg $noCmd."
      }
      set noCmd 0
      if { [set $var] != $val || [set $var] != [$widg getValue] } {
         puts "\nERROR: setValue: values are not identical"
         puts -nonewline "       $var = "
         puts -nonewline [set $var]
         puts -nonewline " !=  $val  != "
         puts [$widg getValue]
         # exit -1
      }
   }
}

puts "\n ******** End automatic test *********"

# TODO test invoke: 
#       - checkButton changes state
#       - radioButton is always selected
#       - optionMenu only calls command

if { $argc == 1 } {
   set win [gnocl::plug [lindex $argv 0] -child $mainBox]
} else {
   set win [gnocl::window -child $mainBox]
}

gnocl::mainLoop

