Slot_Calculator_Demo

Slot_Calculator_Demo

This page is under development. Comments are welcome, but please load any comments in the comments section at the bottom of the page. Please include your wiki MONIKER in your comment with the same courtesy that I will give you. Its very hard to reply intelligibly without some background of the correspondent. Thanks,gold


Introduction


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.


ScreenShot Section

Slot_Calculator_Demo testing screen.png

Slot_Calculator_Demo testing screen2.png


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
 



References

Programming References ( TCL & C# )


Appendices

Tables

Auxiliary Programs


       
        #!/usr/bin/env wish
        # 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
        # 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

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

Comments Section

Please place any comments here, Thanks.

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

Please place any comments here, Thanks.