**Sumerian Counting Boards, multiplication operation placement strategy, and eTCL demo example, numerical analysis **

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]
----

<<TOC>>

**Introduction**

[gold] Here is some eTCL starter  code for a Sumerian counting board. Transforming some old chess displays into a Sumerian counting board, should have better counting pieces soon. 

If a token or coin is dropped on a square,  then total of the coins on the square or within certain range of the dropped coin is tallied. The columns were thought to represent powers of 60 and the addition operations were down the columns. There were several types of Sumerian counting boards and not limited to three columns. For three columns, the highest number was expr(59*60+5*10+9). A multiplication feature might have to group coins on square a and multiply times the group on square b. The Sumerian counted in base60, so each token or column should have a base60 value of 3600,60,10,1,plus possible fractions 1/60, 1/3600. In proto-cuneiform math, some tokens represented lamb, goat, or ox. The tokens are kept in a storage box and may be thrown away in a separate trash area. 2 "memory storage areas" have been considered, maybe group and grab to staging areas. Ref DeSegnac paper.

As a debug, a console window is opened and the various token motions and operations are posted to the console (for cut and paste to text editor). Info should have token name, numeric value, random object tag, and screen position. Additional info could include values and tallies of neighboring chips. As understood here, multiplication operations are the side panels operating on the center panel, which may include reciprocals of previous calculations.
----
**Pseudocode Section**
======
       # using pseudocode 
       # possible problem instances,  
      initialize algorithm_result = 1.
      assign value or storage array to various tokens.
      about 150 known tokens from various eras, loaded 5 or 6
      tally worth of picked tokens from storage box area.
      herd number of cows = N cow tokens
      herd number of bulls = N bull tokens     
      assign unique random tag to move items on canvas
      within square, add adjacent tokens from assigned values
      from squares above, add tally.
      from squares above, subtract square_a minus square_b for tally
      store to third square?
      from square a and square b on adjacent sides, multiply contents 
      put in square c in center
      how to reciprocate a stack of positive chips?
      are negative chips possible on counting board?
      # answer, yes on China stick numbers.
      save? tally to memory to one of 2 storage areas
      drag unwanted tokens to waste basket,
      but waste basket sticking and need extra brain power (from wiki ask?).
      check algorithm 
      check_sum = a+b+c+d+e  
      set answers and printout with resulting values 
      pseudocode: need test cases > small,medium, giant 
      pseudocode: need testcases within range of expected operation.
      pseudocode: are there any cases too small or large to be solved?
======
***Testcases Section***  

In planning any software, it is advisable to gather a number of testcases to check the results of the program. 


**** Testcase 1 ****
%|table 1|||printed in| tcl wiki format|% 
&| quantity| value| ||comment, if any|& 
&|worth= |3600. | tag = lamb | tally_total= |3600.0|&
&|worth= |60. | tag = jar_oil | tally_total= |3660.0|&
&|worth= |10. | tag = goat | tally_total= |3670.0|&
&|worth= |1. | tag = ingot | tally_total= |3671.0|&
&|worth= |.01666 | tag = garment | tally_total= |3671.016659|&
&|worth= |.0002777 | tag = cow_bull | tally_total= |3671.016937|&

**** Testcase 2 ****
%|table 2|||printed in| tcl wiki format|% 
&| quantity| value| ||comment, if any|& 
&|worth= |.0002777 | tag = cow_bull | tally_total= |0.0002776|&
&|worth= |.01666 | tag = garment | tally_total= |0.0169377|&
&|worth= |1. | tag = ingot | tally_total= |1.016937|&
&|worth= |10. | tag = goat | tally_total= |11.0169377|&
&|worth= |60. | tag = jar_oil | tally_total= |71.0169377|&
&|worth= |3600. | tag = lamb | tally_total= |3671.0169|&
&|worth= |3600. | tag = lamb | tally_total= |7271.0169|&
&|worth= |60. | tag = jar_oil | tally_total= |7331.01693|&
&|worth= |10. | tag = goat | tally_total= |7341.0169|&
&|worth= |1. | tag = ingot | tally_total= |7342.0169377|&
&|worth= |.01666 | tag = garment | tally_total= |7342.03359|&
&|worth= |.0002777 | tag = cow_bull | tally_total= |7342.0338|&


**** Testcase 3 ****
%|table 3|||printed in| tcl wiki format|% 
&| quantity| value| ||comment, if any|& 
&|worth= |.01666 | tag = garment | tally_total= |0.01666|&
&|worth= |1. | tag = ingot | tally_total= |1.016659|&
&|worth= |1. | tag = ingot | tally_total= |2.016659|&
&|worth= |10. | tag = goat | tally_total= |12.01666|&
&|worth= |60. | tag = jar_oil | tally_total= |72.01666|&
&|worth= |10. | tag = goat | tally_total= |82.01666|&
&|worth= |60. | tag = jar_oil | tally_total= |142.01666|&


----
***Screenshots Section***
****figure 1. trial counting board****
[Sumerian Counting Boards, multiplication operation placement strategy trial screen screenshot]
****figure 2.trial counting board 2****
[Sumerian Counting Boards, multiplication operation placement strategy trial screenshoot] 
****figure 3.trial counting board (2*2=4) ****
[Sumerian Counting Boards, multiplication operation placement strategy, and counting pieces]
---- 
***References:***
   * Possible old Babylonian  computing paths  some minor observations  
   * D. A. R. DeSegnac, 10Mar2017, shows possible counting boards 
   * [Oneliner's Pie in the Sky] 
   * [One Liners] 
   * [Category Algorithm]
   * see similar 1/(1/nth) terms method used in 
   * [Babylonian Combined Market Rates and eTCL demo example calculator, numerical analysis ] 
   * Proust, Christine "Du calcul flottant en Mésopotamie",
   * La Gazette des Mathématiciens2015-0910,” English version available, 2013  
   * Halloran, John Alan “Early Numeration – Tally Sticks,
   * Counting Boards, and Sumerian ProtoWriting,” August 10, 2009,   
   * Nissen et al.: Archaic Bookkeeping : Early Writing and
   * Techniques of Economic Administration in the Ancient Near East, Chicago and London, 1993  
   * Hoyrup, Jens: A Note on Old Babylonian Computational Techniques,
   * Historia Mathematica 29 (2002), 193–198 
   * Mathematical Treasure: Mesopotamian Accounting Tokens, Frank J. Swetz , Pennsylvania State University

----
**Appendix Code**

***appendix TCL programs and scripts ***
**Initial stable code**
======
                # pretty print from autoindent and ased editor
                # Sumerian counting board Strategy
                # working under TCL version 8.5.6 and eTCL 1.0.1
                # program written on Windows XP on eTCL
                # gold on TCL WIKI, 10Mar2017
                package require Tk
                package require math::numtheory
                namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory }
                set tcl_precision 17
                #! /bin/env tclsh
                console show
                global  xx1 yy2 xxx1 tally_picks
                set tally_picks 0 
                set grab 0
                set filex  ""
                set colorit blue
                set coloritx gold
                set xx 50
                set yy 50
                set xxx1 50
                set yyy1 50
                array set worth {lamb 3600. jar_oil 60. goat 10. ingot 1. garment .01666 cow_bull .0002777}
                set font9 { Helvetica 20}
                set font10 { Helvetica 40}
                proc wastebasket {w} {
                    set font9 { Helvetica 50}
                    $w  create rectangle 350 550 500 600 -fill beige -tag grid
                    $w  lower grid                    
                }                
                proc tokenize_lamb {tag} {
                    global font9 font10 colorit coloritx xx yy xxx1 yyy1
                .c create text [+ $xxx1 355 ] [+ $yyy1 35 ] -text "\u26AB" -font $font10  -fill $coloritx -tags $tag
                .c create text [+ $xxx1 355 ] [+ $yyy1 35 ] -text "\u2638" -font $font9  -fill $colorit -tags $tag
                }                
                proc tokenize_jar_oil {tag} {
                         global font9 font10 colorit coloritx xx yy xxx1 yyy1
 .c create text [+ $xxx1 355] [+ $yyy1 78 ] -text "\u26AB" -font $font10 -fill $coloritx -tags $tag
 .c create text [+ $xxx1 355] [+ $yyy1 78 ] -text "\u2617" -font $font9  -fill $colorit -tags $tag
                }                
                proc tokenize_goat {tag} {
                    global font9 font10 colorit coloritx xx yy xxx1 yyy1
                .c create text [+ $xxx1 355] [+ $yyy1 127] -text "\u26AB" -font $font10 -fill $coloritx -tags $tag
                .c create text [+ $xxx1 355] [+ $yyy1 127] -text "\u2744" -font $font9 -fill $colorit -tags $tag
                }                
                proc tokenize_ingot {tag} {
                                  global font9 font10 colorit coloritx xx yy xxx1 yyy1
                .c create text [+ $xxx1 355] [+ $yyy1 182] -text "\u26AB" -font $font10  -fill $coloritx  -tags $tag
                .c create text [+ $xxx1 355] [+ $yyy1 182] -text "\u26AB" -font $font9  -fill $colorit  -tags $tag
                }                
                proc tokenize_garment {tag} {
                          global font9 font10 colorit coloritx xx yy xxx1 yyy1
                .c create text [+ $xxx1 355] [+ $yyy1 243] -text "\u26AB" -font $font10  -fill $coloritx -tags $tag
                .c create text [+ $xxx1 355] [+ $yyy1 243] -text "\u2617" -font $font9  -fill $colorit -tags $tag
                }                
                proc tokenize_cow_bull {tag} {
                     global font9 font10 colorit coloritx xx yy xxx1 yyy1
                .c create text [+ $xxx1 355]  [+ $yyy1 303] -text "\u26AB" -font $font10  -fill $coloritx -tags $tag
                .c create text [+ $xxx1 355]  [+ $yyy1 303] -text "\u2735" -font $font9  -fill $colorit -tags $tag
                }                                
                set state2 1
                proc refreshgrid { w state2} {
                    global oscwidth oschorizontal colorite
                    global grid
                    global ind indx
                    set ind 0
                    set indx 0
                    set colorite blue
                    . configure -background orange -highlightcolor brown -relief raised -border 30
                    $w configure -bg tan
                    set dx 100    ;# pixels between adjacent vertical grid lines
                    set dy 100    ;# pixels between adjacent horizontal grid lines
                    set x0 50    ;# pixels between left of canvas and left of grid
                    set y0 50   ;# pixels between top of canvas and top of grid
                    #set win $w   ;# name of canvas widget
                    $w  create rectangle 350 50 500 500 -fill beige -tag grid
                    $w  lower grid
                    foreach i {0 3} {
                        $w create line [expr {$i * $dx + $x0}] $y0\
                                [expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] -width 2 -fill green -tag grid
                    }
                    for {set i 1} {$i < 4} {incr i} {
                        $w create line [expr {$i * $dx + $x0}] $y0\
                        [expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] -width 2 -fill blue -tag grid
                        }
                    for {set i 0} {$i < 10} {incr i} {
                        $w create line $x0 [expr {$i * $dy + $y0}]\
                        [expr {3 * $dx + $x0}] [expr {$i * $dy + $y0}] -width 2 -fill purple -tag grid
                        }
                        }                
                proc take_token {tag x y} {
                    global tokenx tokeny
                    set tokenx $x
                    set tokeny $y
                    tokenize_$tag token
                    .c raise token
                    .c bind $tag <B1-Motion> {drag_token %x %y}
                    .c bind $tag <ButtonRelease-1> "drop_token $tag %x %y"
                    }                
                proc drag_token {x y} {
                    global tokenx tokeny
                    .c move token [expr {$x - $tokenx}] [expr {$y - $tokeny}]
                    set tokenx $x
                    set tokeny $y
                    }                
                proc drop_token {tag x y} {
                    global grab worth numis xx1 yy2 xxx1 tally_picks
                    #.c delete token
                    set tally_picks [+ $tally_picks $worth($tag)]  
                    puts " &|worth= |$worth($tag) | tag = $tag | tally_total= |$tally_picks|&"
                    set tilename  [expr {int(rand()*1000000000.)}]
                    .c itemconfigure token  -tag [concat mv xdat_$x  ydat_$y obj_$tilename # $worth($tag) ]
                    }                
                wm withdraw .
                wm geometry . 600x800
                wm resizable . 0 0                
                pack [canvas .c -width 600 -height 800 -bg orange ]                
                tokenize_lamb lamb
                .c bind lamb <ButtonPress-1> {take_token lamb %x %y}
                tokenize_jar_oil jar_oil
                .c bind jar_oil <ButtonPress-1> {take_token jar_oil %x %y}
                tokenize_goat goat
                .c bind goat <ButtonPress-1> {take_token goat %x %y}
                tokenize_ingot ingot
                .c bind ingot  <ButtonPress-1> {take_token  ingot %x %y}
                tokenize_garment garment
                .c bind garment  <ButtonPress-1> {take_token  garment %x %y}                
                tokenize_cow_bull cow_bull
                .c bind cow_bull  <ButtonPress-1> {take_token  cow_bull %x %y}                
                .c bind all <1> {set p(X) [.c canvasx %x]; set p(Y) [.c canvasy %y];set info " %x %y "}
                set haloo 50
                .c bind mv <B1-Motion> {mv .c %x %y}
                .c bind mv <ButtonRelease-1> { crasher .c }
                proc crasher {w} {
                    foreach  item [$w  find overlapping  400 500 450 600 ] {
                        if {[$w type $item]=="oval"} {$w delete $item}
                        if {[$w type $item]=="text"} {$w delete $item}
                    }
                    }                
                proc mv {w x y} {
                    global p id
                    set x  [$w canvasx $x]
                    set y  [$w canvasy $y]
                    set id [$w find withtag current]
                    set numberx [$w  gettags current]
                    regexp {obj_(\d+)} $numberx -> tilex                    
                    puts "1"
                    puts $numberx
                    puts $tilex
                    puts " with tag [$w find withtag obj_$tilex ]"
                    foreach item [$w find withtag obj_$tilex ] {
                        $w move $item [expr {$x-$p(X)}] [expr {$y-$p(Y)}]
                        
                    }
                    puts " x y $x $y"
                    if { $y >= 20 && $y <= 70 } {
                        if { $x >= 20 && $x <= 70 } {$w delete obj_$tilex }
                    }                    
                    foreach  item [$w  find overlapping  400 500 550 600 ] {                        
                        if {[$w type $item]=="oval"} {$w delete $item}
                        if {[$w type $item]=="text"} {$w delete $item}
                    }                    
                    set p(X) $x; set p(Y) $y
                }
                wastebasket .c
                refreshgrid .c state2
                wm title . " Sumerian Counting Board Strategy "                
                after idle wm deiconify .
                .c configure -background orange -highlightcolor brown -relief raised -border 30
                .c configure -bg tan
======
**under test, many new features **
 using much of demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073
======
                # pretty print from autoindent and ased editor
                # Sumerian counting board Strategy
                # working under TCL version 8.5.6 and eTCL 1.0.1
                # program written on Windows XP on eTCL
                # gold on TCL WIKI, 10Mar2017
                package require Tk
                package require math::numtheory
                namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory }
            # demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073
            #: CanvasDemo: On button-click, draw something on the canvas
            package require Tk
            set halo 2
                global  xx1 yy2 xxx1 tally_picks infox
                set tally_picks 0 
                set tallysum 0.
                set grab 0
                set filex  ""
                set colorit blue
                set coloritx gold
                set xx 50
                set yy 50
                set xxx1 50
                set yyy1 50
                array set worth {lamb 3600. jar_oil 60. goat 10. ingot 1. garment .01666 cow_bull .0002777}
                set font9 { Helvetica 20}
                set font10 { Helvetica 40}
                set font12 { Helvetica 10 bold}
                proc wastebasket {w} {
                    set font9 { Helvetica 50}
                    $w  create rectangle 350 550 500 600 -fill beige -tag grid
                    $w  lower grid                    
                }                
            proc item:upd {w} {
                $w itemconfigure object -outline {}
                $w itemconfigure hover -outline red -width 5
                $w itemconfigure moveit -outline purple -width 5
            }
            proc item:move {w x y {init 0}} {
                global oldx oldy
                if $init {
                    set oldx $x; set oldy $y
                    $w addtag moveit closest $x $y $::halo
                    $w dtag !moveable moveit
                    $w raise moveit
                } else {
                    $w move moveit [expr $x-$oldx] [expr $y-$oldy]
                    set oldx $x; set oldy $y
                }
                item:upd $w
                }
            proc item:endmove {w x y} {
                $w dtag moveit
                item:upd $w
               }
            proc item:hover {w x y st} {
                if $st {
                    $w addtag hover closest $x $y $::halo
                    $w dtag !moveable hover
                } else {
                    $w dtag hover
                }
                item:upd $w
                }
            proc item:toggletag {w x y tag} {
                set ttt tagtotoggle
                $w addtag $ttt closest $x $y $::halo $tag
                if {[lsearch [$w gettags $ttt] $tag] >= 0} {
                    $w dtag ($ttt&&$tag) $tag
                    item:hover $w $x $y 0
                } else {
                    $w addtag $tag withtag ($ttt&&!$tag)
                    item:hover $w $x $y 1
                }
                $w dtag $ttt
                }
            proc ClrCanvas {w} {
                $w delete "all"
                }
            proc DrawAxis {w} {
                #set midX [expr { $::maxX / 2 }]
                #set midY [expr { $::maxY / 2 }]
                set midX [expr { $::maxX / 2 }]
                set midY [expr { $::maxY / 2 }]
                $w create line 0     $midY  [expr $::maxX+80]   $midY  -tags "axis" -width 2
                $w create line $midX 0 $midX $::maxY  -tags "axis" -width 2
                }
            proc PaintText {w Txt} {
                global y
                incr y 30
                $w create text 40 $y -text $Txt -tags "text"
                }
            proc mint {w } {
                catch {console show}
                $w create oval 150  110 170   130 -width 2 -fill red -outline gray -tags {object moveable};
                puts "test"
                }
            proc DrawBox {w} {
                global x1 y1 x2 y2
                $w create rect  50  200  100  80  -tags "box"
                $w create rect $x1 $y1  $x2 $y2  -tags "box"
                incr x1 15
                incr x2 15
                incr y1 10
                incr y2 10
                }
            proc lpick L {lindex $L [expr int(rand()*[llength $L])];
                #suchenwirth_subroutine;}
                set randomcolor  { AntiqueWhite3
                    Bisque1 Bisque2 Bisque3  Bisque4
                    SlateBlue3 RoyalBlue1 SteelBlue2
                    DeepSkyBlue3  LightBlue1 DarkSlateGray1
                    Aquamarine2 DarkSeaGreen2 SeaGreen1 Bisque
                    Yellow1 IndianRed1 IndianRed2 Tan1
                    Tan4 red} ;
                proc gamegrid {w} {
                    global x1 y1 x2 y2
                    global randomcolor board
                    populateCanvas $w 8 8
                    #$w create rect  50  200  100  80  -tags "box"
                    #$w create rect $x1 $y1  $x2 $y2  -tags "box"
                    incr x1 15
                    incr x2 15
                    incr y1 10
                    incr y2 10
                    $w create line  50  50 350  50 -width 2
                    $w create line 100 100 300 100 -width 2
                    $w create line 150 150 250 150 -width 2
                    $w create line  50 200 150 200 -width 2
                    $w create line 250 200 350 200 -width 2
                    $w create line 150 250 250 250 -width 2
                    $w create line 100 300 300 300 -width 2
                    $w create line  50 350 350 350 -width 2
                    $w create line  50  50  50 350 -width 2
                    $w create line 100 100 100 300 -width 2
                    $w create line 150 150 150 250 -width 2
                    $w create line 200  50 200 150 -width 2
                    $w create line 200 250 200 350 -width 2
                    $w create line 250 150 250 250 -width 2
                    $w create line 300 100 300 300 -width 2
                    $w create line 350  50 350 350 -width 2
                    set bee [ list $w create poly  -8 10  -8 7  -5 7  -2 -1  -4 -5  -2 -10  2 -10  4 -5 2 -1 5 7  8 

7  8 10 ]
                    set bee [ list    -8 10  -8 7  -5 7  -2 -1  -4 -5  -2 -10  2 -10  4 -5  2 -1  5 7  8 7  8  10 ]
                    set check "1"
                    foreach factor [list  10 12 14 16 18 20] {
                        set cat [list  ]
                        foreach item $bee {
                            #if {[string is alpha $item] == "1"} {lappend cat  $item }
                            if { 1 == "1" || 1 == "1" || 1 == "1" ||  1 == "1" } {lappend cat [ expr 200*$factor*.1 

+ $item * log($factor)  ]}
                        }
                        puts " $w create poly  $cat -outline gray -fill [lpick $randomcolor ] -tags {object 

moveable}"
                        $w create poly  $cat -outline gray -fill [lpick $randomcolor ] -tags {object moveable}
                }
                }
                proc wastebasket {w} {
                    set font9 { Helvetica 50}
                    $w  create rectangle 350 550 500 600 -fill beige -tag grid
                    $w  lower grid                    
                    }                
                proc tokenize_lamb {tag} {
                    global font9 font10 colorit coloritx xx yy xxx1 yyy1
                .cv create text [+ $xxx1 355 ] [+ $yyy1 35 ] -text "\u26AB" -font $font10  -fill $coloritx -tags 

$tag
             .cv create text [+ $xxx1 355 ] [+ $yyy1 35 ] -text "\u2638" -font $font9  -fill $colorit -tags $tag
                }                
                proc tokenize_jar_oil {tag} {
                         global font9 font10 colorit coloritx xx yy xxx1 yyy1
                .cv create text [+ $xxx1 355] [+ $yyy1 78 ] -text "\u26AB" -font $font10 -fill $coloritx -tags $tag
    .cv create text [+ $xxx1 355] [+ $yyy1 78 ] -text "\u2617" -font $font9  -fill $colorit -tags $tag
                }                
                proc tokenize_goat {tag} {
                    global font9 font10 colorit coloritx xx yy xxx1 yyy1
                .cv create text [+ $xxx1 355] [+ $yyy1 127] -text "\u26AB" -font $font10 -fill $coloritx -tags $tag
                .cv create text [+ $xxx1 355] [+ $yyy1 127] -text "\u2744" -font $font9 -fill $colorit -tags $tag
                }                
                proc tokenize_ingot {tag} {
                                  global font9 font10 colorit coloritx xx yy xxx1 yyy1
                .cv create text [+ $xxx1 355] [+ $yyy1 182] -text "\u26AB" -font $font10  -fill $coloritx -tags 

"$tag xxx"
                .cv create text [+ $xxx1 355] [+ $yyy1 182] -text "\u2745" -font $font9  -fill $colorit -tags $tag } 

               
                proc tokenize_garment {tag} {
                          global font9 font10 colorit coloritx xx yy xxx1 yyy1
             .cv create text [+ $xxx1 355] [+ $yyy1 243] -text "\u26AB" -font $font10  -fill $coloritx -tags $tag
          .cv create text [+ $xxx1 355] [+ $yyy1 243] -text "\u2618" -font $font9  -fill $colorit -tags $tag
                }                
                proc tokenize_cow_bull {tag} {
                     global font9 font10 colorit coloritx xx yy xxx1 yyy1 worth
                .cv create text [+ $xxx1 355]  [+ $yyy1 303] -text "\u26AB" -font $font10 -fill $coloritx -tags $tag
        .cv create text [+ $xxx1 355]  [+ $yyy1 303] -text "\u2735" -font $font9  -fill $colorit -tags "$tag "
                }                                
                set state2 1
                proc take_token {tag x y} {
                    global tokenx tokeny
                    set tokenx $x
                    set tokeny $y                    
                    tokenize_$tag token
                    .cv raise token
                    .cv bind $tag <B1-Motion> {drag_token %x %y}
                    .cv bind $tag <ButtonRelease-1> "drop_token $tag %x %y"
                    }                
                proc drag_token {x y} {
                    global tokenx tokeny
                    .cv move token [expr {$x - $tokenx}] [expr {$y - $tokeny}]
                    set tokenx $x
                    set tokeny $y
                    }                
                proc drop_token {tag x y} {
                    global grab worth numis xx1 yy2 xxx1 tally_picks
                    #.c delete token 
                    set tallyit {}
                    set valuex 0.
                    set tallysum 0.
                    foreach  item [.cv  find overlapping  $x $y [+ 25 $x] [+ 25 $y ]] {
                     set numberx [.cv  gettags $item ]
                    regexp {value_(\d+)} $numberx -> valuex  
                       lappend tallyit $valuex
                       set tallysum [+ $tallysum $valuex ]
                    }
                    puts   [.cv  gettags [.cv  find overlapping  $x $y [+ 25 $x] [+ 25 $y ] ]]
                    puts "tallyit= $tallyit  tallysum= $tallysum "
                    set tally_picks [+ $tally_picks $worth($tag)]  
                    puts " &|worth= |$worth($tag) | tag = $tag | tally_total= |$tally_picks|&"
                    set tilename  [expr {int(rand()*1000000000.)}]
   .cv itemconfigure token  -tag [concat mv xdat_$x  ydat_$y obj_$tilename # $worth($tag) value_$worth($tag) ]
                    }     
                proc refreshgridx { w } {
                    global oscwidth oschorizontal colorite
                    global grid
                    global ind indx
                    set ind 0
                    set indx 0
                    set colorite blue
                    . configure -background orange -highlightcolor brown -relief raised -border 30
                    $w configure -bg tan
                    set dx 100    ;# pixels between adjacent vertical grid lines
                    set dy 100    ;# pixels between adjacent horizontal grid lines
                    set x0 50    ;# pixels between left of canvas and left of grid
                    set y0 50   ;# pixels between top of canvas and top of grid
                    #set win $w   ;# name of canvas widget
                    $w  create rectangle 350 50 500 500 -fill beige -tag grid
                    $w  lower grid
                    foreach i {0 3} {
                        $w create line [expr {$i * $dx + $x0}] $y0\
                                [expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] -width 2 -fill green -tag grid
                        }
                    for {set i 1} {$i < 4} {incr i} {
                        $w create line [expr {$i * $dx + $x0}] $y0\
                                [expr {$i * $dx + $x0}] [expr {9 * $dy + $y0}] -width 2 -fill blue -tag grid
                        
                    }
                    for {set i 0} {$i < 10} {incr i} {
                        $w create line $x0 [expr {$i * $dy + $y0}] \
                                [expr {3 * $dx + $x0}] [expr {$i * $dy + $y0}] -width 2 -fill purple -tag grid
                    }
                    } 
                proc DrawFn1 {w} {
           $w create line 0 100  50 200  100 50  150 70  200 155  250 50  300 111  350 222 -tags "Fn1"  -smooth 

bezier -width 4
                    }
                proc DrawFn2 {w} {
                    set offY 0    ;# [expr { $::maxY / 2 }]
                    for { set x 0 } { $x <= $::maxX } { incr x 5 } {
                        set y [expr { rand() * $::maxY + $offY }]
                        #puts "$x $y"
                        if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2"  }
                        set x0 $x
                        set y0 $y
                    }
                    }
                #: Main :
                frame .f1
                frame .f2
                frame .f3
                pack  .f1 .f2 .f3
                set maxX 320
                set maxY 240
                set y      0
                set state2 1
                set x1 120
                set x2 150
                set y1  50
                set y2  80
                set colorite seashell3
                #canvas  .cv -width $maxX -height $maxY  -bg white
                set state2 1
                #canvas .cv -width $maxX -height $maxY -bg white
                set oscwidth 1000
                set oschorizontal 500
                canvas .cv -width 400 -height 500 -scrollregion "0 0 $oscwidth $oschorizontal" -xscrollcommand 

".corpsx set" -yscrollcommand ".corpsy set" -background palegreen -highlightcolor DarkOliveGreen -relief raised -

border 10
                scrollbar .corpsx -command " .cv xview" -orient horizontal
                scrollbar .corpsy -command " .cv yview" -orient vertical
                focus .cv
                proc pieces { .cv } {
                tokenize_lamb lamb
                .cv bind lamb <ButtonPress-1> {take_token lamb %x %y}
                tokenize_jar_oil jar_oil
                .cv bind jar_oil <ButtonPress-1> {take_token jar_oil %x %y}
                tokenize_goat goat
                .cv bind goat <ButtonPress-1> {take_token goat %x %y}
                tokenize_ingot ingot
                .cv bind ingot  <ButtonPress-1> {take_token  ingot %x %y}
                tokenize_garment garment
                .cv bind garment  <ButtonPress-1> {take_token  garment %x %y}                
                tokenize_cow_bull cow_bull
                .cv bind cow_bull  <ButtonPress-1> {take_token  cow_bull %x %y}                
                .cv bind all <1> {set p(X) [.cv canvasx %x]; set p(Y) [.cv canvasy %y];set info " %x %y "}
                set haloo 50
                .cv bind mv <B1-Motion> {mv .cv %x %y}
                .cv bind mv <ButtonRelease-1> { crasher .cv }
                    }
                proc crasher {w} {
                    foreach  item [$w  find overlapping  400 500 450 600 ] {
                        if {[$w type $item]=="oval"} {$w delete $item}
                        if {[$w type $item]=="text"} {$w delete $item}
                    }
                    }                
                proc refreshgrid { .cv state2} {
                    global oscwidth oschorizontal colorite
                    global grid
                    set colorite blue
                    for {set x 10} {$x<$oscwidth} {incr x 50} {.cv create line $x 0 $x $oschorizontal  -fill blue -

tag grid -width 4}
                    for {set y 20} {$y<$oschorizontal} {incr y 50} {.cv create line 0 $y $oschorizontal $y -fill 

blue  -tag grid -width 4}
                    .cv itemconfigure grid -fill blue
                    if { $state2 == 1 } { .cv raise grid ;}
                    if { $state2 == 2 } { .cv lower grid ;}
                    }
                pack    .cv -in .f1
                button  .b0 -text "Clear" -command { ClrCanvas .cv }
                button  .b1 -text "Text"  -command { PaintText .cv "Canvas" }
                button  .b2 -text "Axis"  -command { DrawAxis  .cv }
                button  .b3 -text "Box"   -command { DrawBox   .cv }
                button  .b4 -text "Fn1"   -command { DrawFn1   .cv }
                button  .b5 -text "Fn2"   -command { DrawFn2   .cv }
                #pack .b0 .b1 .b2 .b3 .b4 .b5  .b6 .b7 -in .f2  -side left -padx 2
                #catch {console show}
                #if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} }
                button  .b6 -text "gridlower"   -command { refreshgrid .cv 2 } -background   $colorite
                button  .b7 -text "gridover"   -command { refreshgrid .cv 1 } -background   $colorite
                button  .b8 -text "S.board"   -command { refreshgridx .cv  }
                button  .b9 -text "S.pieces"   -command { pieces .cv }
                button  .b10 -text "scale^"   -command {.cv scale all 0 0 1.1 1.1 }
                button  .b11 -text "unscale<"   -command {.cv scale all 0 0 .9 .9 }
         button  .b12 -text "meas_ball"   -command { .cv create oval 150  110 170   130 -width 2 -fill red -outline 

gray -tags {object moveable}; }
                button  .b13 -text "ball"   -command { mint .cv; }
                button  .b14 -text "exit"   -command { exit }
                set info "0"
                label  .info -textvar info -just left
                pack .b0 .b1 .b2 .b3 .b4 .b5  .b6 .b7  -in .f2  -side left -padx 2
                pack .b8 .b9 .b10 .b11 .b12 .b13 .b14 .info -in .f3  -side left -padx 2
                .cv bind moveable <ButtonPress-1> {item:move %W %x %y 1;set info " %x %y ";puts "%x     

                %y"}
                .cv bind moveable <ButtonRelease-1> {item:endmove %W %x %y;puts "%x %y"}
                .cv bind moveable <Enter> {item:hover %W %x %y 1;set info " %x %y "}
                .cv bind moveable <Leave> {item:hover %W %x %y 0;set info " %x %y "}
                .cv bind moveit <B1-Motion> {item:move %W %x %y;set info " %x %y "}
                .cv bind all <ButtonRelease-2> {item:toggletag %W %x %y moveable}
                #set info [format "x=%.2f y=%.2f" $x $y]
                # update item styles
                item:upd .cv
                proc mv {w x y} {
                    global p id
                    set x  [$w canvasx $x]
                    set y  [$w canvasy $y]
                    set id [$w find withtag current]
                    set numberx [$w  gettags current]
                    regexp {obj_(\d+)} $numberx -> tilex                    
                    puts "1"
                    puts $numberx
                    puts $tilex
                    puts " with tag [$w find withtag obj_$tilex ]"
                    foreach item [$w find withtag obj_$tilex ] {
                        $w move $item [expr {$x-$p(X)}] [expr {$y-$p(Y)}]
                        
                    }
                    puts " x y $x $y"
                    if { $y >= 20 && $y <= 70 } {
                        if { $x >= 20 && $x <= 70 } {$w delete obj_$tilex }
                    }                    
                    foreach  item [$w  find overlapping  400 500 550 600 ]                      {                    

    
                        if {[$w type $item]=="oval"} {$w delete $item}
                        if {[$w type $item]=="text"} {$w delete $item}
                    }                    
                    set p(X) $x; set p(Y) $y
                    }
                wastebasket .cv
                #refreshgrid .cv state2
                wm title . " Sumerian Counting Board Strategy "                
                after idle wm deiconify . 
======
----
[gold] This page is copyrighted under the TCL/TK license terms, [http://tcl.tk/software/tcltk/license.html%|%this license]. 

**Comments Section**

<<discussion>>
Please place any comments here, Thanks.

                              
<<categories>> Numerical Analysis | Toys | Calculator | Mathematics| Example| Toys and Games | Games | Application | GUI
----
<<categories>> Development | Concept| Algorithm