Version 29 of Slot_Calculator_Demo

Updated 2009-02-04 14:34:00 by gold

Slot_Calculator_Demo


       Comments are welcome,
       but please load any comments 
       at the bottom of the page. Thanks,[gold]

This page uses Tcl8/Expect 5.2 for windows to develop Slot_Calculator_Demo. (note: file is working in Expect5.2, but i did not put in statement "require Expect5.2" since lock with report error on some ports.)

In developing a computer program or application, it is helpful to develop analogs for the individual tasks of the application.

 This program is  finding inner diagonal of rectangular box,
 a subroutine was written for finding the square root of the sum of

the squares for three sides, or successive numbers.


Program Listing

       #!/usr/bin/env wish
        #start of deck
        #start of deck
        #start of deck
        #start of deck
        # finding inner diagonal of rectangular box
        # Slot_Calculator_Demo
        # 5Jan2009, [gold]

set w .form
catch {destroy $w}
toplevel $w
wm title $w "Slot Calculator Demo"
wm iconname $w "form"
set colorgrd seashell4
set colorback bisque
set colorwarning tomato1
set reportcard "ready"
set reportcard2 "zero entry detected !!! "
set side1 3
set side2 50
set side3 5
proc testcasexxxx { w side1 side2 side3 answer } {
  # testcase is side of 5 units and 30 units
  # result or product is 150 units
     foreach i {f1 f2 f3 f4 f5} {

    $w.$i.entry delete 0 end }
    $w.f1.entry insert end $side1
    $w.f2.entry insert end $side2
    $w.f3.entry insert end $side3
    $w.f4.entry insert end ""
    $w.f5.entry insert end "testcase, ans=$answer"
} 
  proc clearall { w } {
    global colorwarning
    global colorback
    foreach i {f1 f2 f3 f4 f5} {

    $w.$i.entry delete 0 end
}}




  proc sumsquares { args } {
   set sum 0
   
   foreach item  $args  {
    incr sum [ expr { $item * $item } ]
  }
   return [ expr { sqrt($sum) }   ]

   }



proc calculate { w side1 side2 side3 } {
    global colorwarning
    global colorback
    global answer2
    $w.f4.entry delete 0 end 
    $w.f5.entry delete 0 end
     set side1  [ $w.f1.entry get ] 
     set side2  [ $w.f2.entry get ] 
     set side3  [ $w.f3.entry get ] 
      $w.f5.entry configure -background $colorback 
 
   
 # set answer2 [ expr { $side1  *  $side2 } ]
    set answer2 [ sumsquares $side1 $side2 $side3 ]
        $w.f4.entry insert end $answer2
     if {$answer2 <= 0.0000001} {
      $w.f5.entry delete 0 end
      $w.f5.entry configure -background $colorwarning 
      $w.f5.entry insert end "warning, negative or near zero detected in answer"  
   }
    if {$side1 <= 0.0000001} {
        $w.f5.entry delete 0 end
      $w.f5.entry configure -background $colorwarning
      $w.f5.entry insert end "warning, negative or near zero detected in entry"  
   } 
   if {$side2 <= 0.0000001} {
      $w.f5.entry delete 0 end
      $w.f5.entry configure -background $colorwarning 
      $w.f5.entry insert end "warning, negative or near zero detected in entry"  
   }
    
    if {$answer2 <= 0.0000001} {
     
      $w.f5.entry configure -background $colorwarning 
      $w.f5.entry insert end " !!! extra warning, negative or near zero detected in answer"  
   
}
}
 proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \
  #suchenwirth_subroutine;}
  proc colorpicker jill {
  set jill [lpick { seashell1 seashell2 seashell3}]
 
  return $jill;
  }
label $w.msg -wraplength 4i -justify left -text "Slot Calculator Demo."
pack $w.msg -side top

#frame $w.buttons
#pack $w.buttons -side bottom -fill x -pady 2m
#button $w.buttons.dismiss -background $colorgrd -text exit -command "destroy $w"
#button $w.buttons.clear -background $colorgrd -text "clear" -command { clearall $w }
#button $w.buttons.testcase2 -background $colorgrd -text "testcase" -command { testcasexxxx $w 3 50 4 50}
#button $w.buttons.calculate -text calculate -background $colorgrd -command {calculate $w $side1 $side2 $side3 }

#pack $w.buttons.calculate  $w.buttons.clear $w.buttons.dismiss $w.buttons.testcase2 -side left -expand 1
frame $w.buttons
pack $w.buttons -side bottom -fill x -pady 2m

foreach i {x1 x2 x3 x4 x5 x6} {
    frame $w.$i -bd 5
 
    button $w.$i.button -background $colorgrd -width 15 -text exit -command "destroy $w"

    pack $w.$i.button -side left
}





pack  $w.x1 $w.x2 $w.x3 $w.x4 $w.x5 $w.x6 -side bottom -fill x  -expand 1
$w.x5.button config -text "testcase3" -command { testcasexxxx $w 1 3 5 5.92 }
$w.x3.button config -text "clear" -command { clearall $w }
$w.x6.button config -text calculate -background $colorgrd -command {calculate $w $side1 $side2 $side3}
$w.x1.button config -text "testcase2" -command { testcasexxxx $w 1 2  3 3.74 }
$w.x2.button config -text "testcase1" -command { testcasexxxx $w 1 1 1 1.73 }

$w.x4.button config -text "exit"






foreach i {f1 f2 f3 f4 f5} {
    frame $w.$i -bd 2
    entry $w.$i.entry -relief sunken -width 20 -background $colorback
    label $w.$i.label -background [ colorpicker $colorback]
    pack $w.$i.entry -side right
    pack $w.$i.label -side left
}
$w.f1.label config -text side1:
$w.f2.label config -text side2:

$w.f3.label config -text side3:
$w.f4.label config -text answer:

$w.f5.label config -text report:

pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 -side top -fill x
console hide
bind $w <Return> "destroy $w"
focus $w.f1.entry

      #end of deck
    #end of deck
      #end of deck
      #end of deck      
      #end of deck
    #end of deck

Screenshots

WikiDbImage Slot_Calculator_Demo.PNG http://img504.imageshack.us/img504/2060/slotcalculatordemoxgy9.png

Comments

Please place any comments here, Thanks.

gold Change:Redundant procedure ? deleted.


References

   *Programming References ( TCL & C# )***
    http://wiki.tcl.tk/20813
    http://wiki.tcl.tk/20367

Appendices

Tables

Auxiliary Programs


    Auxilary Program
  ***early Program Listing***
-----
       #!/usr/bin/env wish
        #start of deck
        #start of deck
        #start of deck
        #start of deck

        # Slot_Calculator_Demo
        # 5Jan2009, [gold]

set w .form
catch {destroy $w}
toplevel $w
wm title $w "Slot Calculator Demo"
wm iconname $w "form"
set colorgrd seashell4
set colorback bisque
set colorwarning tomato1
set reportcard "ready"
set reportcard2 "zero entry detected !!! "
set side1 3
set side2 50
proc testcasexxxx { w side1 side2 answer } {
  # testcase is side of 5 units and 30 units
  # result or product is 150 units
     foreach i {f1 f2 f3 f4 f5} {

    $w.$i.entry delete 0 end }
    $w.f2.entry insert end $side1
    $w.f3.entry insert end $side2
    $w.f4.entry insert end ""
    $w.f5.entry insert end "testcase entered, ans=$answer"
} 
  proc clearall { w } {
    global colorwarning
    global colorback
    foreach i {f1 f2 f3 f4 f5} {

    $w.$i.entry delete 0 end
}}
proc calculate { w side1 side2  } {
    global colorwarning
    global colorback
    global answer2
    $w.f4.entry delete 0 end 
    $w.f5.entry delete 0 end
     set side1  [ $w.f2.entry get ] 
     set side2  [ $w.f3.entry get ]  
      $w.f5.entry configure -background $colorback 
 
   
   set answer2 [ expr { $side1  *  $side2 } ]
        $w.f4.entry insert end $answer2
     if {$answer2 <= 0.0000001} {
      $w.f5.entry delete 0 end
      $w.f5.entry configure -background $colorwarning 
      $w.f5.entry insert end "warning, negative or near zero detected in answer"  
   }
    if {$side1 <= 0.0000001} {
        $w.f5.entry delete 0 end
      $w.f5.entry configure -background $colorwarning
      $w.f5.entry insert end "warning, negative or near zero detected in entry"  
   } 
   if {$side2 <= 0.0000001} {
      $w.f5.entry delete 0 end
      $w.f5.entry configure -background $colorwarning 
      $w.f5.entry insert end "warning, negative or near zero detected in entry"  
   }
    
    if {$answer2 <= 0.0000001} {
     
      $w.f5.entry configure -background $colorwarning 
      $w.f5.entry insert end " !!! extra warning, negative or near zero detected in answer"  
   
}
}
 proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \
  #suchenwirth_subroutine;}
  proc colorpicker jill {
  set jill [lpick { seashell1 seashell2 seashell3}]
 
  return $jill;
  }
label $w.msg -wraplength 4i -justify left -text "Slot Calculator Demo."
pack $w.msg -side top

#frame $w.buttons
#pack $w.buttons -side bottom -fill x -pady 2m
#button $w.buttons.dismiss -background $colorgrd -text exit -command "destroy $w"
#button $w.buttons.clear -background $colorgrd -text "clear" -command { clearall $w }
#button $w.buttons.testcase2 -background $colorgrd -text "testcase" -command { testcasexxxx $w 3 50 150}
#button $w.buttons.calculate -text calculate -background $colorgrd -command {calculate $w $side1 $side2}

#pack $w.buttons.calculate  $w.buttons.clear $w.buttons.dismiss $w.buttons.testcase2 -side left -expand 1
frame $w.buttons
pack $w.buttons -side bottom -fill x -pady 2m

foreach i {x1 x2 x3 x4 x5 x6} {
    frame $w.$i -bd 5
 
    button $w.$i.button -background $colorgrd -width 15 -text exit -command "destroy $w"

    pack $w.$i.button -side left
}





pack  $w.x1 $w.x2 $w.x3 $w.x4 $w.x5 $w.x6 -side bottom -fill x  -expand 1
$w.x5.button config -text "testcase3" -command { testcasexxxx $w 4 3 12}
$w.x3.button config -text "clear" -command { clearall $w }
$w.x6.button config -text calculate -background $colorgrd -command {calculate $w $side1 $side2}
$w.x1.button config -text "testcase2" -command { testcasexxxx $w 3 50 150}
$w.x2.button config -text "testcase1" -command { testcasexxxx $w 5 6 30}

$w.x4.button config -text "exit"






foreach i {f1 f2 f3 f4 f5} {
    frame $w.$i -bd 2
    entry $w.$i.entry -relief sunken -width 20 -background $colorback
    label $w.$i.label -background [ colorpicker $colorback]
    pack $w.$i.entry -side right
    pack $w.$i.label -side left
}
$w.f1.label config -text factor1:
$w.f2.label config -text side1:

$w.f3.label config -text side2:
$w.f4.label config -text answer:

$w.f5.label config -text report:

pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 -side top -fill x
console hide
bind $w <Return> "destroy $w"
focus $w.f1.entry
----
*** Earlier Version***
 
      #!/usr/bin/env wish
      ####finding area of rectangle from length of  two sides
        #start of deck
        #start of deck
        #start of deck
        #start of deck

        # Slot_Calculator_Demo
        # 5Jan2009, [gold]

set w .form
catch {destroy $w}
toplevel $w
wm title $w "Slot Calculator Demo"
wm iconname $w "form"
set colorgrd seashell4
set colorback bisque
set colorwarning tomato1
set reportcard "ready"
set reportcard2 "zero entry detected !!! "
set reportcard3 "stinker null entered !!! "
set side1 3
set side2 50
proc testcasexxxx { w side1 side2 answer } {
  # testcase is side of 5 units and 30 units
  # result or product is 150 units
     foreach i {f1 f2 f3 f4 f5} {

    $w.$i.entry delete 0 end
     }
    $w.f2.entry insert end $side1
    $w.f3.entry insert end $side2
    $w.f4.entry insert end ""
    $w.f5.entry insert end "testcase entered, ans=$answer"

} 
  proc clearall { w } {
    global colorwarning
    global colorback
    foreach i {f1 f2 f3 f4 f5} {
    $w.$i.entry configure -background $colorback
    $w.$i.entry delete 0 end

}}
proc calculate { w side1 side2  } {
    global colorwarning
    global colorback
    global answer2
    global reportcard3 
    $w.f4.entry delete 0 end 
    $w.f5.entry delete 0 end
     set side1  [ $w.f2.entry get ] 
     set side2  [ $w.f3.entry get ] 
      
    
    if {[ $w.f2.entry get]==""} {  $w.f2.entry configure -background $colorwarning } 
    if {[ $w.f3.entry get]==""} {  $w.f3.entry configure -background $colorwarning  }

    if {[ $w.f2.entry get]==0} {  $w.f2.entry configure -background $colorwarning } 
    if {[ $w.f3.entry get]==0} {  $w.f3.entry configure -background $colorwarning  }
     set side1  [ $w.f2.entry get ] 
     set side2  [ $w.f3.entry get ] 
    
      if {  $side1 == ""   } { set side1 0 } 
      if {   $side2 == ""   } { set side2 0 }  

    $w.f5.entry configure -background $colorback 
   
   
   set answer2 [ expr { $side1  *  $side2 } ]
        $w.f4.entry insert end $answer2
     if {$answer2 <= 0.0000001} {
      $w.f5.entry delete 0 end
      $w.f5.entry configure -background $colorwarning 
      $w.f5.entry insert end "warning, negative or near zero detected in answer"  
   }
    if {$side1 <= 0.0000001} {
        $w.f5.entry delete 0 end
      $w.f5.entry configure -background $colorwarning
      $w.f5.entry insert end "warning, negative or near zero detected in entry"  
   } 
   if {$side2 <= 0.0000001} {
      $w.f5.entry delete 0 end
      $w.f5.entry configure -background $colorwarning 
      $w.f5.entry insert end "warning, negative or near zero detected in entry"  
   }
    
    if {$answer2 <= 0.0000001} {
     
      $w.f5.entry configure -background $colorwarning 
      $w.f5.entry insert end " !!! extra warning, negative or near zero detected in answer"  
   
}
       if {[ $w.f5.entry get]==""}  { 

    foreach i {f1 f2 f3 f4 f5} {
    $w.$i.entry configure -background $colorback
    }
      
}
}
 proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \
  #suchenwirth_subroutine;}
  proc colorpicker jill {
  set jill [lpick { seashell1 seashell2 seashell3}]
 
  return $jill;
  }
label $w.msg -wraplength 4i -justify left -text "Slot Calculator Demo."
pack $w.msg -side top

#frame $w.buttons
#pack $w.buttons -side bottom -fill x -pady 2m
#button $w.buttons.dismiss -background $colorgrd -text exit -command "destroy $w"
#button $w.buttons.clear -background $colorgrd -text "clear" -command { clearall $w }
#button $w.buttons.testcase2 -background $colorgrd -text "testcase" -command { testcasexxxx $w 3 50 150}
#button $w.buttons.calculate -text calculate -background $colorgrd -command {calculate $w $side1 $side2}

#pack $w.buttons.calculate  $w.buttons.clear $w.buttons.dismiss $w.buttons.testcase2 -side left -expand 1
frame $w.buttons
pack $w.buttons -side bottom -fill x -pady 2m

foreach i {x1 x2 x3 x4 x5 x6 x7} {
    frame $w.$i -bd 5
 
    button $w.$i.button -background $colorgrd -width 15 -text exit -command "destroy $w"

    pack $w.$i.button -side left
}





pack  $w.x1 $w.x2 $w.x3 $w.x4 $w.x5 $w.x6 $w.x7 -side bottom -fill x  -expand 1
$w.x5.button config -text "testcase3" -command { clearall $w; testcasexxxx $w 4 3 12}
$w.x3.button config -text "clear" -command { clearall $w }
$w.x7.button config -text calculate -background $colorgrd -command {calculate $w $side1 $side2}
$w.x1.button config -text "testcase2" -command { clearall $w;testcasexxxx $w 3 50 150}
$w.x2.button config -text "testcase1" -command { clearall $w; testcasexxxx $w 5 6 30}

$w.x4.button config -text "exit"
$w.x6.button config -text "testcase4" -command { clearall $w;testcasexxxx $w 4 "" 12;  }






foreach i {f1 f2 f3 f4 f5} {
    frame $w.$i -bd 2
    entry $w.$i.entry -relief sunken -width 20 -background $colorback
    label $w.$i.label -background [ colorpicker $colorback]
    pack $w.$i.entry -side right
    pack $w.$i.label -side left
}
$w.f1.label config -text factor1:
$w.f2.label config -text side1:

$w.f3.label config -text side2:
$w.f4.label config -text answer:

$w.f5.label config -text report:

pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 -side top -fill x
console hide
bind $w <Return> "destroy $w"
focus $w.f1.entry

      #end of deck
      #end of deck      
      #end of deck
    #end of deck
      #end of deck
      #end of deck      
      #end of deck
    #end of deck


Category Toys Category Calculator

There is no "[Category Demos]"; demos are covered by Category Toys.