Version 37 of Slot_Calculator

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

        # pretty print from autoindent and ased editor
        #!/usr/bin/env wish
        # finding inner diagonal of rectangular box
        # Slot_Calculator_Demo
        # 5Jan2009, [gold]
        package require Tk
        package require tile
        set reportcard "ready"
        set reportcard2 "zero entry detected !!! "
        set w .form
        catch {destroy $w}
        toplevel $w
        wm title $w "Sum Geometric Series"
        wm iconname $w "form"
        label .title -text "Calculator" -font {Times 32 bold} -relief raised -fg blue -bg seashell3
        frame .puzzle -bg aquamarine4
        frame .f1
        frame .f2
        frame .f3
        frame .f4
        frame .f5
        set colorgrd seashell4
        set colorback bisque
        set colorwarning tomato1
        label .l1 -text "side 1" -background seashell1 -width 25 -anchor w
        entry .e1 -textvariable side1  -background $colorback
        pack .l1 .e1 -in .f1 -side left
        label .l2 -text "side 2" -background seashell2  -width 25 -anchor w
        entry .e2 -textvariable side2  -background $colorback
        pack .l2 .e2 -in .f2 -side left
        label .l3 -text "side 3 " -background seashell3 -width 25 -anchor w
        entry .e3 -textvariable side3  -background $colorback
        pack .l3 .e3 -in .f3 -side left
        label .l4 -text "inner diagonal, rectangular box  " -background seashell2 -width 25 -anchor w
        entry .e4 -textvariable answer2  -background $colorback
        pack .l4 .e4 -in .f5 -side left
        pack .f1 .f2 .f3 .f5 -in .puzzle -side top -expand 1
        frame .answer -bd 2 -relief ridge -bg aquamarine4
        proc Scrolled_Text { f args } {
            frame $f
eval {text $f.text -wrap word -xscrollcommand [list $f.xscroll set] -yscrollcommand [list $f.yscroll set]} $args
 scrollbar $f.xscroll -orient horizontal -command [list $f.text xview]
 scrollbar $f.yscroll -orient vertical -command [list $f.text yview]
            grid $f.text $f.yscroll -sticky news
            grid $f.xscroll -sticky news
            grid rowconfigure $f 0 -weight 1
            grid columnconfigure $f 0 -weight 1
            return $f.text
        }
        global t x
        set t [Scrolled_Text .eval -width 20 -height 5 -bg bisque]
        set x [Scrolled_Text .eval2 -width 20 -height 5 -bg bisque]
        pack .eval .eval2 -fill both -expand true -side left -in .answer
        $t insert end  " identified1 !!![ winfo children . ]"  ;
        $x insert end  " identified2 !!! [ winfo children . ]"  ;
        pack .answer  -in .puzzle -side bottom -pady {10 0}
        frame .buttons -bg aquamarine4
        ::ttk::button .calculater -text "Solve" -command { calculate  side1 side2 side3 }
        ::ttk::button .test2 -text "Testcase1" -command {testcasexxxx 1 2 3 3.74}
        ::ttk::button .test3 -text "Testcase2" -command {testcasexxxx 3 5 9 10.72}
        ::ttk::button .test4 -text "Testcase3" -command {testcasexxxx 20 30 40 53.85}
        ::ttk::button .clearallx -text clear -command {clearall $w }
        ::ttk::button .about -text About -command About
        ::ttk::button .exit -text exit -command {exit}
        pack .calculater  -in .buttons -side top -padx 10 -pady 5
        pack  .clearallx .about .exit .test4 .test3  .test2   -side bottom -in .buttons
        grid .title - -pady 10 -padx 10 -ipadx 10
        grid .puzzle .buttons -sticky ns -pady {0 10}
        proc testcasexxxx { de1 de2 de3 wer } {
            # testcase is side of 5 units and 30 units
            # result or product is 150 units
            global side1 side2 side3 answer2 x t
            set answer2 ""
            set answer5 ""
            set side1 $de1
            set side2 $de2
            set side3 $de3
            set answer2 " testcase, ans=$wer "
            $x insert 1.0 " testcase entered, answer = $wer "
            $t insert 1.0 " testcase entered, answer = $wer "
        }
        proc clearall { w } {
            global colorwarning
            global colorback
            global side1 side2 side3 answer2 x t
            set side1 ""
            set side2 ""
            set side3 ""
            set answer2 ""
        }
        proc sumsquares { args } {
            set sum 0
            foreach item  $args  {
                incr sum [ expr { $item * $item } ]
            }
            return [ expr { sqrt($sum) }   ]
        }
        proc fac x {expr {$x<2? 1: $x*[fac [incr x -1]]}}
        proc calculate {  ide1  ide2  ide3  } {
            global colorwarning
            global colorback
            global answer2 x t
            global side1 side2 side3
            set answer2 ""
            set xside1 $side1
            set xside2 $side2
            set xside3 $side3
            set answer2 [ sumsquares $side1 $side2 $side3 ]
            $x insert 1.0 "$side1 $side2 $side3, answer = $answer2 "
            $t insert 1.0 "$side1 $side2 $side3, answer = $answer2 "
        }
        proc About {} {
            set msg "Calculator for inner diagonal of rectangular box.
            square root of sum of squares."
            tk_messageBox -title "About" -message $msg
        }
        . configure -borderwidth 10 -highlightthickness 2 -relief raised -highlightcolor DarkOliveGreen -background aquamarine4
        console hide

Screenshots

WikiDbImage Slot_Calculator_Demo.PNG

Comments

Please place any comments here, Thanks.

gold 25Jun2010, Change: Found out how to do a color blanket.

 . configure -borderwidth 10 -highlightthickness 2 -relief raised -highlightcolor DarkOliveGreen -background aquamarine4

References

http://en.wikipedia.org/wiki/calculators
Search on google.com for "counting rods"

Programming References ( TCL & C# )

Appendices

Tables

Auxiliary Programs

       #!/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

      #!/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

Category Numerical Analysis