## Introduction edit

gold Here is some eTCL starter code for a Sumerian counting board. For the display of a Sumerian counting board, some old chess displays were transformed.

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. Using double-click to calculate value of tokens on squares and output same on opened console window. not sure how to initiate operations on screen but automatic operations per square*square on double-click seem possible.

The token symbol and token background are created with canvas text, then the tokens are retagged both with rand number tag and token worth tag to move jointly. With the logic on color (gold color), I trying to drop the worth_token ( value eg, 3600,60,1,1/60) on the background token. I only want to count value tokens, otherwise get twice the value. The logic on the fill color is sticking or evaled as zero.

### Token Replica project at the ceramics studio

White clay product is easily worked in small hand sized lumps. As might be expected, the moist clay dries pretty fast. Handy to dip lump in water before molding. Flat lump with palms and used half inch pipe as cookie cutter. Teacher fired small quarter sized discs at cone 5 bisque ( my project of Sumerian counting token replicas). Clay tokens were piled inside a pottery bowl for firing ( procedure for unknown clays to protect kiln shelf, and no need to stack unfired tokens on pins). Tokens turned pure white in firing and appear consistent without inside specks.

### Concepts for Tokens

The earliest counting tokens were about 10000 BP. The heyday of counting tokens was about 5500 years BP, ref. Schmandt-Besserat. While the tokens preceded the development of writing, there are several Sumerian expressions or figures of speech that appear related to tokens. The historians do not consider counting with tokens to be an unbroken tradition in Sumer over the various eras or are careful not to make the assertion without proof. Sumerian kab...dug4: (literally 'string' ? + subject + 'to do'): Counting heads on a string to represent counting people. Counting taxes on a string to represent taxes in accounting. Sumerian gu-dili(-a)...è: 'string {heads} (rare) for expression for counting people. The Akkadian word for token was abnatu or abnati (pl) from Sumerian for stone (na). A related Sumerian concept was the ki-la (literally earth lift) for the stone weights used in commerce. The Sumerian words for counting board was ges uttaku (wood ten token touch } or tub uttaku (cloth ten token touch ). The word uttaku appears to be a complex word (noun-verb) phrase, not a simple noun. It is possible that a ceramic counting board, possibly imturuna, was available, but the analysis is still searching the texts. The Sumerian word for bag of tokens was kus dug gan (Akkadian = tukkuunu). In some excavations, the tokens were held in small bowls. Also, some of the alternate and early pictographs for sanga (scribe) had cross hatched fields, which way indicate cloth boards, as different from wooden boards. Materials used in the tokens were raw clay, fired clay, bitumen and limestone powder composite, and carved stone. Conjecture is that Sumerians used clay tokens in accounting, including record keeping of taxes received or due at the Uruk temples.

## Pseudocode Section edit

```       # using pseudocode
# possible problem instances,
initialize algorithm_result = 1.
assign value or storage array to various tokens.
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
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 1printed 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 2printed 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 3printed 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

#### Testcase 4

Product of selected doubleclick point and nearest point should be associative. Here p1*p2 = 12960000 and p2*p1 = 12960000, recorded in output from console window. Terms in canvas tags for value_ regular expressions seem to be working.
```&|worth= |3600. | tag = lamb | tally_total= |3600.0|&
&|worth= |3600. | tag = lamb | tally_total= |7200.0|&
selected double click point mv xdat_81 ydat_205 obj_98569283 # value_3600. current
nearest entity 33 mv xdat_81 ydat_205 obj_98569283 # value_3600. current
product of adjacent tokens 3600 X 3600 12960000
1
mv xdat_169 ydat_199 obj_674367737 # value_3600. current
674367737
with tag 30 31
x y 176.0 204.0
selected double click point mv xdat_169 ydat_199 obj_674367737 # value_3600. current
nearest entity 31 mv xdat_169 ydat_199 obj_674367737 # value_3600. current
product of adjacent tokens 3600 X 3600 12960000 ```

### 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
• Canvas item selection by mouse click [brusch] used here,
• Category Algorithm
• Simple Canvas Demo by HJG used here
• canvas -highlightcolor Used here. Robert Heller
• provided sample of how to use the canvas's -highlightcolor option
• slightly corrected by Jeff Hobbs
• Canvas lasso selection by RLE, under consideration
• 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
• Reckoning Before Writing by Denise Schmandt-Besserat
• (Archaeology. May/June 1979, Vol. 32, No. 3, p. 22-31).
• Numbers and Measures in the Earliest Written Records, Jöran Friberg.
• Scientific American. February 1984. Volume 250. Number 2. Pages 110-118
• Schmandt-Besserat, Denise. The Earliest Precursor of Writing ,
• in Scientific American, June 1977, Vol. 238, No. 6, p. 50-58.
• Schmandt-Besserat, Denise. Reckoning Before Writing,
• in Archaeology. May/June 1979, Vol. 32, No. 3, p. 22-31.
• Schmandt-Besserat, Denise. Two Precursors of Writing:
• Plain and Complex Tokens», in The Origins of Writing
• edited by Wayne M. Senner. 1991: 27-41.
• Ancient Computers Part I - Rediscovery, Stephen Kent Stephenson
• A little Go board
• Mancala
• Nine Men Morris
• TkPente

## Initial code edit

```                # 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}
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 "\u2616" -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 # value_\$worth(\$tag) ]
}
proc onDblClick {x y} {
set x [.c canvasx \$x] ; set y [.c canvasy \$y]
set i [.c find closest \$x \$y]
set t [.c gettags \$i]
set u [.c gettags current]
puts "selected double click point \$u "
puts "nearest entity \$i \$t"
set number1 1.
set number2 1.
set numberx \$t
regexp {value_(\d+)} \$u -> number1
regexp {value_(\d+)} \$numberx -> number2
puts "product of adjacent tokens \$number1 X \$number2 [* \$number1 \$number2 ] "
set cumulative_product 1.
set cumulative_sum 0.
set numero 1.
puts "selected double click point \$u "
puts "nearest entity \$i \$t"
puts " rectangular enclosure  [ .c find enclosed \$x \$y [+ \$x 100 ] [+ \$y 100 ] ]  "
puts " rectangular enclosure split [split [ .c find enclosed \$x \$y [+ \$x 100 ] [+ \$y 100 ] ] ] "
foreach item [split [ .c find enclosed \$x \$y [+ \$x 100 ] [+ \$y 100 ] ] ]   {
puts " .c gettags \$item [.c gettags \$item ]"
set tx ""
set tx \$item
regexp {value_(\d+)} [.c gettags \$item ] -> numero
puts " numero \$numero "
set cumulative_product [* \$cumulative_product \$numero]
set cumulative_sum [+ \$cumulative_sum \$numero]
puts "cumulative_sum \$cumulative_sum"
puts "cumulative_product \$cumulative_product"
}
set number1 1.
set number2 1.
set numberx \$t
regexp {value_(\d+)} \$u -> number1
regexp {value_(\d+)} \$numberx -> number2
puts " number1 number1 \$number1 \$number2"
puts "product of adjacent tokens \$number1 X \$number2 [* \$number1 \$number2 ] "
}
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}
bind .c <Double-1> { onDblClick %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
}
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
#end of file```

```                # 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
# 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 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 {
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"
\$w create text 384 426 -text "trash" -tags "green wastebasket"
\$w create text 384 41 -text "token storage"
\$w create text 111 41 -text "3600" -tags "column label 3600"
\$w create text 216 41 -text "60" -tags "column label 60"
\$w create text 313 41 -text "1" -tags "column label 1"
#\$w create text 384 450 -text "memory storage area 1 "
#\$w create text 384 480 -text "memory storage area 2 "
}
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 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}
}
}
set font9 { Helvetica 50}
\$w  create rectangle 350 400 500 450 -fill green -tag wastebasket
}
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 170] -text "\u26AB" -font \$font10  -fill \$coloritx -tags "\$tag xxx"
.cv create text [+ \$xxx1 355] [+ \$yyy1 170] -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 223] -text "\u26AB" -font \$font10  -fill \$coloritx -tags \$tag
.cv create text [+ \$xxx1 355] [+ \$yyy1 223] -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 270] -text "\u26AB" -font \$font10  -fill \$coloritx -tags \$tag
.cv create text [+ \$xxx1 355]  [+ \$yyy1 270] -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 cxmax cymax dx dy x0 y0
global ind indx
set cxmax 500
set cymax 400
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 350 -fill beige -tag grider
\$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
}
}
proc onDblClick {x y} {
set x [.cv canvasx \$x] ; set y [.cv canvasy \$y]
set i [.cv find closest \$x \$y]
set t [.cv gettags \$i]
set u [.cv gettags current]
puts "selected double click point \$u "
puts "nearest entity \$i \$t"
set number1 1.
set number2 1.
set numberx \$t
regexp {value_(\d+)} \$u -> number1
regexp {value_(\d+)} \$numberx -> number2
puts "product of adjacent tokens \$number1 X \$number2 [* \$number1 \$number2 ] "
set cumulative_product 1.
set cumulative_sum 0.
set numero 1.
puts "selected double click point \$u "
puts "nearest entity \$i \$t"
puts " rectangular enclosure  [ .cv find enclosed \$x \$y [+ \$x 100 ] [+ \$y 100 ] ]  "
puts " rectangular enclosure split [split [ .cv find enclosed \$x \$y [+ \$x 100 ] [+ \$y 100 ] ] ] "
foreach item [split [ .cv find enclosed \$x \$y [+ \$x 100 ] [+ \$y 100 ] ] ]   {
puts " .cv gettags \$item [.cv gettags \$item ]"
set tx ""
set tx \$item
regexp {value_(\d+)} [.cv gettags \$item ] -> numero
puts " numero \$numero "
set cumulative_product [* \$cumulative_product \$numero]
set cumulative_sum [+ \$cumulative_sum \$numero]
puts "cumulative_sum \$cumulative_sum"
puts "cumulative_product \$cumulative_product"
estimate_squares \$x \$y
}
set number1 1.
set number2 1.
set numberx \$t
regexp {value_(\d+)} \$u -> number1
regexp {value_(\d+)} \$numberx -> number2
puts " number1 number1 \$number1 \$number2"
puts "product of adjacent tokens \$number1 X \$number2 [* \$number1 \$number2 ] "
}
proc estimate_squares { x y } {
global .cv dx dy
global grid cxmax cymax dx dy x0 y0
puts " rectangular enclosure  [ .cv find enclosed \$x \$y [+ \$x 100 ] [+ \$y 100 ] ]  "
foreach item  {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15}  {
foreach item2  {1 2 3 4 5 6 7 8 9 10  }  {
set cx0 [expr { \$dx*\$item2/4. + \$dx/4.}]
set cy0 [expr { \$dy*\$item/4.  + \$dy/4.}]
set cx1 [expr { \$dx*\$item2/4. + \$dx + 5  }]
set cy1 [expr { \$dy*\$item/4. +  \$dy + 5  }]
puts " enclosed squares \$cx0 \$cy0 \$cx1 \$cy1 [ .cv find enclosed \$cx0 \$cy0 \$cx1 \$cy1 ] "
} }
}
#: 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 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 gridx -width 4}
for {set y 20} {\$y<\$oschorizontal} {incr y 50} {.cv create line 0 \$y \$oschorizontal \$y -fill blue  -tag gridx -width 4}
.cv itemconfigure gridx -fill blue
if { \$state2 == 1 } { .cv raise gridx ;}
if { \$state2 == 2 } { .cv lower grider ;.cv lower grid; .cv delete gridx }
}
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 "console"   -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}
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 }
bind .cv <Double-1> { onDblClick %x %y }
}
proc crasher {w} {
foreach  item [\$w  find overlapping  350 400 500 450 ] {
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  350 400 500 450 ] {
if {[\$w type \$item]=="oval"} {\$w delete \$item}
if {[\$w type \$item]=="text"} {\$w delete \$item}
}
set p(X) \$x; set p(Y) \$y
}