Error processing request
Parameters
| CONTENT_LENGTH | 0 |
| REQUEST_METHOD | GET |
| REQUEST_URI | /revision/Chinese+Iching+Hexagrams+on+Chou+Bronzes+%3A+TCL+Example?V=63 |
| QUERY_STRING | V=63 |
| CONTENT_TYPE | |
| DOCUMENT_URI | /revision/Chinese+Iching+Hexagrams+on+Chou+Bronzes+:+TCL+Example |
| DOCUMENT_ROOT | /var/www/nikit/nikit/nginx/../docroot |
| SCGI | 1 |
| SERVER_PROTOCOL | HTTP/1.1 |
| HTTPS | on |
| REMOTE_ADDR | 172.70.130.238 |
| REMOTE_PORT | 43572 |
| SERVER_PORT | 4443 |
| SERVER_NAME | wiki.tcl-lang.org |
| HTTP_HOST | wiki.tcl-lang.org |
| HTTP_CONNECTION | Keep-Alive |
| HTTP_ACCEPT_ENCODING | gzip, br |
| HTTP_X_FORWARDED_FOR | 3.145.184.113 |
| HTTP_CF_RAY | 883931f9a9de2bff-ORD |
| HTTP_X_FORWARDED_PROTO | https |
| HTTP_CF_VISITOR | {"scheme":"https"} |
| HTTP_ACCEPT | */* |
| HTTP_USER_AGENT | Mozilla/5.0 AppleWebKit/537.36 (KHTML, like Gecko; compatible; ClaudeBot/1.0; [email protected]) |
| HTTP_CF_CONNECTING_IP | 3.145.184.113 |
| HTTP_CDN_LOOP | cloudflare |
| HTTP_CF_IPCOUNTRY | US |
Body
Error
Unknow state transition: LINE -> END
-code
1
-level
0
-errorstack
INNER {returnImm {Unknow state transition: LINE -> END} {}} CALL {my render_wikit {Chinese Iching Hexagrams on Chou Bronzes : TCL Example} {
**Chinese Iching Hexagrams on Chou Bronzes: TCL Example**
This page is under development. Comments are welcome,
but please load any comments in the comments section
at the middle of the page. Thanks, [gold]
----
Here is some starter code for Chinese Iching Hexagrams on Chou Bronzes. The Iching is the ancient fortune telling book of China. The Iching literature mentions various methods for casting fortune patterns.
----
The canvas and buttons presented here are largely based on the [Simple Canvas Demo] by [HJG].
The random pick algorithm was posted by Suchenworth [RS] on [Horseracing in Tcl]
Other dice pages are [Throwing Two Dice] [GWM] and [Dice] by Keith Vetter.
Several Dr. Math emails are in the references, which reduce some dice issues to simple paths.
----
In the West, Leibniz recognized that the whole and broken lines in the hexagram patterns could be counted as ones and zeros, respectively in a binary number system. For example, a cast or list of { 6,7,8,9,6,7 } could be expressed as a binary number, 010101. For computer procedures, the patterns are effectively a horizontal bar code of 6 lines. The probability of each line by the yarrow stick method or coin casting method is different.
* The probability of the yarrow stick method is 1,3,5,7 over 16.
* The number 6 or old yin is 1/16 or 0.0625
* The number 7 or young yang is 3/16 or 0.1875.
* The number 8 or young yin is 5/16 or 0.3125.
* The number 9 or old yang is 7/16 or .4375.
* For the yarrow sticks, the combined probability of any throw is .0625 + .1875 + .3125 + .4375 = 1
For the iching dice pictured below, the three sticks read 2,3,and 3 which totals 8. The combined probability of casting 2,3, and 3 is 0.3125 (with the sticks).
For the coins,the probability of the coin casting method is 2,2,6,6 over 16. The number 6 or old yin is 2/6 or 0.125.
* The number 7 or young yang is 2/16 or 0.125.
* The number 8 or young yin is 6/16 or 0.375.
* The number 9 or old yang is 6/16 or .375.
* For the coins, the combined probability of any throw is .125 + .125 + .375 + .375 = 1
----
On about 28 pieces of Chou bronzes, there were several series of numbers possibly representing divinatory numbers. These series were described in a thesis by Chang Cheng Land, called Interpretation of Divinatory Inscriptions on Early Chou Bronzes.The numbers in ancient Chou script are not completely understood, but have the following number space { 1:36,2:0,3:0,4:0,5:11,6:64,7:33,8:24}. The puzzle is that ones and fives are not normally generated in the modern I Ching practice, meaning after 1100 AD. Part of the problem is that the Chinese scripts for one, two,three, and four were normally horizontal slashes in those times. So numbers 2,3,and 4 could be confused with marks for the number one. Also some of the numbers seem to be archaic or oracle bone script versions of modern chinese numbers, like X for 5.
It seems reasonable that a TCL procedure might be able to reproduce the same generating odds with dice or coins, even the Chou generating procedures are lost but for a few peg points.
----
Here are the peg points.
1. One generating method involves 36 counters, lacking four. Apparently the counters are taken/divided away by four and the remainders laid in three piles, upper on side, middle upright, and lower on side.
1. The number 36 makes one think of the 36 chessboard squares, which are 8 by 8 on a side. ([RLE] Note, 8 times 8 is 64, not 36)
1. The Chou regarded the odd numbers as "lucky" yang and the even numbers as "unlucky" yin.
From the probability of 6-sided double dice, the number space of the bronze method guesstimates at 23. The bronze method sample space is likely between the sample space of 4 coins (sp16) and 5 coins (sp32).
The probabilities from 4 2-sided sticks are a 40 to 60 percent off the estimated bronze figures. But the number 6 has highest frequency in both sticks and bronzes. In the 5 2-sided sticks, its number 7 with the highest frequency.
Kind of hokey math, but if you assess 6 has 6 combos, then x= 6/.264 or 22.72 eg. nearest whole number space is 23.
Pseudocode. llength { 6 6 6 6 6 6 etc } = 23
1's = 0.1487 * 23 =3.42 > 4
5's = .0454 *23 or 1.04 > 2
6's =.264*23 or 6.02 > 6
7's = .136*23 or 3.128 > 4
8's = .0625 *23 or 1.43 > 2
Pseudocode. llength { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 etc } = 23
Pseudocode. llength { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 etc. } = 23
Since 1's in bronzes are poorly understood, don't mind filling up rest ( to 23) with ones. So now the Suchenworth random pick procedure lpick will deliever the same frequency of characters on the bronzes.
Pseudocode. lpick { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
With a text translation scheme and suitable unicode, the TCL procedure can mimic the appearence of Chou horizontal script on the bronzes.
----
space of 4 2-sided sticks marked 1 and 2
space was { 4 5 5 6 5 6 5 7 5 6 6 7 6 7 7 8},size of 16
%| |sticks prob. |prob. |est. bronze prob. |5 sticks prob. |%
|4 |1/16 |0.04625 |unk | |
|5 |5/16 |0.3125 |0.0454545454545 | |
|6 |5/16 |0.3125 |0.264462809 |.1875 |
|7 |4/16 |0.250 |0.13636363636 |.3125 |
|8 |1/16 |0.0625 |0.0991735537 |.2815 |
5 stick prob's are multiples/fractions of bronze values
----
After checking, an lpick(sequence2) was found that better matched the reported bronze values. Here, we are at most 10 to 15 percent off. lpick { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1} #s2 The extra program at the bottom of the page will solve for the probabilities in the bronze sequence (or any sequence loaded in the $lister).
%| |est. bronze prob. |lpick(sequence2) |%
| 1 | .4347 | 0.45454545454545453 |
| 2 | n/a | 0.0 |
| 3 | n/a | 0.0 |
| 4 | n/a | 0.0 |
| 5 | 0.0454545454545 | 0.045454545454545456 |
| 6 | 0.264462809 | 0.2727272727272727 |
| 7 | 0.13636363636 | 0.13636363636363635 |
| 8 | 0.0991735537 | 0.09090909090909091 |
----
**Screenshots Section**
[http://farm5.static.flickr.com/4133/4837907275_4863aa5764.jpg]
[http://farm5.static.flickr.com/4136/4812522943_33727ff8ec.jpg]
[http://farm5.static.flickr.com/4114/4812413403_e697523a46.jpg]
[http://farm5.static.flickr.com/4098/4818003683_be9dddea77.jpg]
[http://farm5.static.flickr.com/4123/4821292691_35da154995.jpg]
Oracle bone script numbers ,1600 BC–1046 BC, attributed to Gisling,commons.wikimedia.org
[http://upload.wikimedia.org/wikipedia/commons/3/31/Oracle_numeral.jpg]
----
**Comments Section**
Please place any comments here, Thanks.
[gold] Changes.
----
**References**
* [Simple Canvas Demo]
* [Clock and daylight saving time corrections]
* [timezone]
* http://www-groups.dcs.st-and.ac.uk/~history/HistTopics/Chinese_numerals.html
* In iching, there is a solar eclipse of June 20, 1070 BCE. www.ejournal.unam.mx/atm/Vol04-3/ATM04302.pdf
* http://rishida.net/tools/conversion/, outstanding unicode conversion online!!!
* [Throwing Two Dice]
* [throw a dice]
* [Dice]
* http://pinyin.info/tools/converter/chars2uninumbers.html
* http://en.wikipedia.org/wiki/Miscellaneous_Symbols_Unicode_block
* http://www.dennismerrittjungiananalyst.com/China_paper.htm
* http://www.openexchange.org/archives/AMJ04/gordon.html
* http://www.superiching.com/guanature.htm
* http://news.bbc.co.uk/2/hi/sci/tech/146120.stm
* http://nasgem.rpi.edu/files/1686
* http://www.biroco.com/yijing/Shih-chuan_Chen.pdf
* Early Bronzes, chen lang [http://www.biroco.com/yijing/Chang_Cheng-lang.pdf]
* http://www.nature.com/nature/journal/v256/n5515/abs/256296a0.ht
* http://mysite.du.edu/~jcalvert/math/chinum.htm
* Doctor Syd, The Math Forum, 2/25/96 on probability of 6 choose 2
* http://www.chineseastrologyonline.com/OracleBone.htm
* http://www.chinavista.com/experience/oracle/oracle.html
* http://www.lib.cuhk.edu.hk/uclib/bones/bones.htm
* http://www.chinapage.com/oracle/oracle.html
* http://www.chinapage.com/archeology/030411.pdf
* http://www.chinapage.com/oracle/news.html
* http://www.chinesefortunecalendar.com/CLC/Default.htm
* http://www.chinesefortunecalendar.com/CLC/LunarCalendar.htm
**appendix TCL programs**
***Pretty Print VERSION***
======
# test of autoindent from ased editor
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
# gold on TCL WIKI , 17Jul2010
package require Tk
proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
#proc poly args {eval .cv create polygon $args}
set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
proc ding {w} {
$w create polygon 22.3130151863 79.8724065423 22.3130151863 79.8724065423 15.3037864986 115.329182243
8.29455781096 150.785957943 6.89271207343 189.079275699 12.5000950236 221.699509343 26.5185523989
242.973574763 43.3407012492 257.156285043 48.9480841993 262.829369155 47.5462384618 271.338995324
60.1628500996 349.343901864 64.3683873122 379.127593452 61.5646958371 406.074742984 57.3591586245
434.440163545 50.3499299369 450.041144853 67.1720787872 452.877686909 98.0126850129 454.295957937
119.040371076 454.295957937 127.451445501 454.295957937 120.442216813 421.675724292 119.040371076
403.238200928 114.834833863 383.382406536 114.834833863 364.944883172 117.638525338 328.069836444
119.040371076 305.377499996 124.647754026 292.613060744 141.469902876 292.613060744 149.880977301
292.613060744 154.086514514 350.762172892 156.890205989 381.964135508 152.684668777 411.747827096
148.479131564 433.021892517 145.675440089 444.368060741 145.675440089 450.041144853 149.880977301
451.459415881 163.899434677 450.041144853 176.516046315 451.459415881 196.14188664 451.459415881
242.402795978 451.459415881 256.421253354 450.041144853 270.439710729 451.459415881 276.047093679
448.622873825 281.654476629 448.622873825 285.860013842 448.622873825 274.645247942 416.00264018
266.234173516 381.964135508 266.234173516 360.690070088 269.037864992 340.834275696 276.047093679
320.978481304 281.654476629 301.122686912 285.860013842 289.776518688 299.878471217 289.776518688
305.485854167 335.161191584 308.289545642 364.944883172 309.69139138 389.055490648 309.69139138
417.420911208 299.878471217 437.276705601 299.878471217 444.368060741 311.093237117 442.949789713
333.522768918 445.786331769 360.157837931 447.204602797 372.774449569 450.041144853 362.961529406
428.767079433 354.550454981 391.892032704 357.354146456 362.108341116 364.363375144 345.08908878
371.372603831 268.502453268 371.372603831 257.156285043 395.203981369 238.718761679 402.213210057
207.516799063 407.820593007 176.314836447 406.418747269 152.204228971 399.409518582 123.838808411
398.007672844 105.401285047 393.802135632 88.3820327104 393.802135632 78.4541355143 390.998444157
69.9445093463 405.016901532 69.9445093463 400.811364319 60.0166121502 400.811364319 31.6511915901
400.811364319 10.3771261699 376.979986781 8.95885514191 378.381832519 20.305023366 382.587369731
50.0887149542 344.737534818 55.7617990662 95.2089935378 58.5983411222 30.7240896114 57.1800700942
36.3314725616 31.6511915901 34.929626824 4.70404205788 25.1167066613 11.7953971979 13.9019407611
11.7953971979 2.68717486084 11.7953971979 6.89271207343 23.141565422 8.29455781096 47.2521728981
8.29455781096 62.8531542062 9.69640354849 74.1993224303 16.7056322361 75.6175934583 19.5093237112
79.8724065423 19.5093237112 92.6368457944 -fill #e9e796 -outline black -smooth 1 -tags {Polygon obj utag3}
}
proc transnumber {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext u4E00}
if { $item == 5 } {lappend choutext u3024}
if { $item == 6 } {lappend choutext u516D}
if { $item == 7 } {lappend choutext u4E03}
if { $item == 8 } {lappend choutext u516B}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transarabic {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext 1}
if { $item == 5 } {lappend choutext 5}
if { $item == 6 } {lappend choutext 6}
if { $item == 7 } {lappend choutext 7}
if { $item == 8 } {lappend choutext 8}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transodd {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext u4e00 }
if { $item == 5 } {lappend choutext u4e00 }
if { $item == 6 } {lappend choutext "- -"}
if { $item == 7 } {lappend choutext u4e00 }
if { $item == 8 } {lappend choutext "- -"}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
set listx [ transnumber $lister ]
proc chou_bronzes {w state3} {
global listx lister
if { $state3 == 1 } {set listx [ transnumber $lister ]}
if { $state3 == 2 } {set listx [ transarabic $lister ]}
if { $state3 == 3 } {set listx [ transodd $lister ]}
set yy 100
set font3 {Hevetica 35}
set font5 {Hevetica 150}
set lister { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1 1}
$w create rect 165 70 260 420 -fill gold
$w create poly 445 60 475 65 475 100 445 120 -fill tan
# $w create text 200 400 -text u2617 -tags "text" -fill tan -font $font5
foreach i {1 2 3 4 5 6 } {
$w create text 210 $yy -text [lpick $listx ] -tags "text" -font $font3
incr yy 50
}
}
proc clrcanvas {w} {
$w delete "all"
}
proc leave {w} {
exit
}
proc board {w} {
#set state3 1
#set state2 1
clrcanvas $w
. configure -background orange -highlightcolor brown -relief raised -border 30
$w configure -bg tan
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 450
set maxY 500
set y 0
set x1 120
set x2 180
set y1 50
set y2 80
canvas .cv -width $maxX -height $maxY -bg tan
pack .cv -in .f1
button .b0 -text "clear" -command { clrcanvas .cv }
button .b5 -text "chou_bronzes" -command {clrcanvas .cv;ding .cv; chou_bronzes .cv 1 }
button .b6 -text "arabic" -command { clrcanvas .cv; ding .cv; chou_bronzes .cv 2 }
button .b7 -text "regular" -command { clrcanvas .cv; ding .cv;chou_bronzes .cv 3}
button .b8 -text "ding" -command { clrcanvas .cv; ding .cv}
button .b9 -text "exit" -command {leave .cv }
pack .b0 .b5 .b6 .b7 .b7 .b8 .b9 -in .f2 -side left -padx 2
board .cv
#catch {console show}
bind . <Motion> {wm title . " Chinese Iching Hexagrams on Chou Bronzes "}
#end of deck
#end of deck*
#end of deck
#end of deck
#end of deck
#end of deck
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
# gold on TCL WIKI , 17Jul2010
package require Tk
proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
#proc poly args {eval .cv create polygon $args}
set lister { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1 1}
proc diagramx {w} {
set TextInfo(utag9) arabic
set TextInfo(utag19) {bronze m.}
set TextInfo(utag20) {}
set TextInfo(utag21) {canvas }
set TextInfo(utag10) regular
set TextInfo(utag11) exit
set TextInfo(utag12) clear
set TextInfo(utag13) {chou_bronzes 1 }
set TextInfo(utag14) {chou_bronzes 2}
set TextInfo(utag15) {chou_bronzes 3}
$w create polygon 331.0 326.0 331.0 326.0 376.0 326.0 376.0 326.0 395.0 326.0 395.0 345.0 395.0 345.0 395.0
354.0 395.0 354.0 395.0 373.0 376.0 373.0 376.0 373.0 331.0 373.0 331.0 373.0 312.0 373.0 312.0 354.0 312.0
354.0 312.0 345.0 312.0 345.0 312.0 326.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag1}
$w create polygon 327.0 249.0 327.0 249.0 372.0 249.0 372.0 249.0 391.0 249.0 391.0 268.0 391.0 268.0 391.0
277.0 391.0 277.0 391.0 296.0 372.0 296.0 372.0 296.0 327.0 296.0 327.0 296.0 308.0 296.0 308.0 277.0 308.0
277.0 308.0 268.0 308.0 268.0 308.0 249.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag6}
$w create polygon 80.0 187.0 80.0 187.0 125.0 187.0 125.0 187.0 144.0 187.0 144.0 206.0 144.0 206.0 144.0
215.0 144.0 215.0 144.0 234.0 125.0 234.0 125.0 234.0 80.0 234.0 80.0 234.0 61.0 234.0 61.0 215.0 61.0 215.0
61.0 206.0 61.0 206.0 61.0 187.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag2}
$w create polygon 330.0 389.039215686 330.0 389.039215686 375.0 389.039215686 375.0 389.039215686 394.0
389.039215686 394.0 408.411764706 394.0 408.411764706 394.0 417.588235294 394.0 417.588235294 394.0
436.960784314 375.0 436.960784314 375.0 436.960784314 330.0 436.960784314 330.0 436.960784314 311.0
436.960784314 311.0 417.588235294 311.0 417.588235294 311.0 408.411764706 311.0 408.411764706 311.0
389.039215686 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag7}
$w create polygon 102.224826735 254.679389889 102.224826735 254.679389889 202.911166651 254.679389889
202.911166651 254.679389889 245.423176837 254.679389889 245.423176837 271.049593559 245.423176837
271.049593559 245.423176837 278.803900561 245.423176837 278.803900561 245.423176837 295.174104231
202.911166651 295.174104231 202.911166651 295.174104231 102.224826735 295.174104231 102.224826735
295.174104231 59.7128165488 295.174104231 59.7128165488 278.803900561 59.7128165488 278.803900561
59.7128165488 271.049593559 59.7128165488 271.049593559 59.7128165488 254.679389889 -fill {} -outline black
-smooth 1 -tags {RoundRect obj utag4}
$w create polygon 485.0 248.0 485.0 248.0 530.0 248.0 530.0 248.0 549.0 248.0 549.0 267.0 549.0 267.0 549.0
276.0 549.0 276.0 549.0 295.0 530.0 295.0 530.0 295.0 485.0 295.0 485.0 295.0 466.0 295.0 466.0 276.0 466.0
276.0 466.0 267.0 466.0 267.0 466.0 248.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag3}
$w create polygon 87.0 460.0 87.0 460.0 132.0 460.0 132.0 460.0 151.0 460.0 151.0 479.0 151.0 479.0 151.0
488.0 151.0 488.0 151.0 507.0 132.0 507.0 132.0 507.0 87.0 507.0 87.0 507.0 68.0 507.0 68.0 488.0 68.0 488.0
68.0 479.0 68.0 479.0 68.0 460.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag5}
$w create text 356.0 345.0 -font {Arial 10 bold} -text arabic -tags {text obj utag9}
$w create text 355.0 411.0 -font {Arial 10 bold} -text regular -tags {text obj utag10}
$w create text 106.0 481.0 -font {Arial 10 bold} -text exit -tags {text obj utag11}
$w create text 98.0 211.0 -font {Arial 10 bold} -text clear -tags {text obj utag12}
$w create text 154.0 275.0 -font {Arial 10 bold} -text {chou_bronzes $wv 1 } -tags {text obj utag13}
$w create text 150.0 347.0 -font {Arial 10 bold} -text {chou_bronzes $wv 2} -tags {text obj utag14}
$w create text 153.0 415.0 -font {Arial 10 bold} -text {chou_bronzes $wv 3} -tags {text obj utag15}
$w create polygon 99.224826735 326.679389889 99.224826735 326.679389889 199.911166651 326.679389889
199.911166651 326.679389889 242.423176837 326.679389889 242.423176837 343.049593559 242.423176837
343.049593559 242.423176837 350.803900561 242.423176837 350.803900561 242.423176837 367.174104231
199.911166651 367.174104231 199.911166651 367.174104231 99.224826735 367.174104231 99.224826735
367.174104231 56.712816549 367.174104231 56.712816549 350.803900561 56.712816549 350.803900561 56.712816549
343.049593559 56.712816549 343.049593559 56.712816549 326.679389889 -fill {} -outline black -smooth 1 -tags
{RoundRect obj utag16}
$w create polygon 100.224826735 394.679389889 100.224826735 394.679389889 200.911166651 394.679389889
200.911166651 394.679389889 243.423176837 394.679389889 243.423176837 411.049593559 243.423176837
411.049593559 243.423176837 418.803900561 243.423176837 418.803900561 243.423176837 435.174104231
200.911166651 435.174104231 200.911166651 435.174104231 100.224826735 435.174104231 100.224826735
435.174104231 57.712816549 435.174104231 57.712816549 418.803900561 57.712816549 418.803900561 57.712816549
411.049593559 57.712816549 411.049593559 57.712816549 394.679389889 -fill {} -outline black -smooth 1 -tags
{RoundRect obj utag17}
$w create polygon 24.0 57.0 24.0 57.0 69.0 57.0 69.0 57.0 88.0 57.0 88.0 76.0 88.0 76.0 88.0 85.0 88.0 85.0
88.0 104.0 69.0 104.0 69.0 104.0 24.0 104.0 24.0 104.0 5.0 104.0 5.0 85.0 5.0 85.0 5.0 76.0 5.0 76.0 5.0
57.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag18}
$w create text 349.0 270.0 -font {Arial 10 bold} -text {bronze m.} -tags {text obj utag19}
$w create text 47.0 79.0 -font {Arial 10 bold} -text {canvas $wv } -tags {text obj utag21}
$w create line 257.0 269.0 298.0 269.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag22}
$w create line 256.0 350.0 302.0 351.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag23}
$w create line 261.0 413.0 300.0 413.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag24}
$w create polygon 487.0 332.0 487.0 332.0 532.0 332.0 532.0 332.0 551.0 332.0 551.0 351.0 551.0 351.0 551.0
360.0 551.0 360.0 551.0 379.0 532.0 379.0 532.0 379.0 487.0 379.0 487.0 379.0 468.0 379.0 468.0 360.0 468.0
360.0 468.0 351.0 468.0 351.0 468.0 332.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag25}
$w create polygon 487.0 332.0 487.0 332.0 532.0 332.0 532.0 332.0 551.0 332.0 551.0 351.0 551.0 351.0 551.0
360.0 551.0 360.0 551.0 379.0 532.0 379.0 532.0 379.0 487.0 379.0 487.0 379.0 468.0 379.0 468.0 360.0 468.0
360.0 468.0 351.0 468.0 351.0 468.0 332.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag26}
$w create polygon 485.0 184.0 485.0 184.0 530.0 184.0 530.0 184.0 549.0 184.0 549.0 203.0 549.0 203.0 549.0
212.0 549.0 212.0 549.0 231.0 530.0 231.0 530.0 231.0 485.0 231.0 485.0 231.0 466.0 231.0 466.0 212.0 466.0
212.0 466.0 203.0 466.0 203.0 466.0 184.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag28}
$w create polygon 690.0 398.0 690.0 398.0 735.0 398.0 735.0 398.0 754.0 398.0 754.0 417.0 754.0 417.0 754.0
426.0 754.0 426.0 754.0 445.0 735.0 445.0 735.0 445.0 690.0 445.0 690.0 445.0 671.0 445.0 671.0 426.0 671.0
426.0 671.0 417.0 671.0 417.0 671.0 398.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag34}
$w create polygon 589.0 398.0 589.0 398.0 634.0 398.0 634.0 398.0 653.0 398.0 653.0 417.0 653.0 417.0 653.0
426.0 653.0 426.0 653.0 445.0 634.0 445.0 634.0 445.0 589.0 445.0 589.0 445.0 570.0 445.0 570.0 426.0 570.0
426.0 570.0 417.0 570.0 417.0 570.0 398.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag32}
$w create polygon 707.0 252.0 707.0 252.0 752.0 252.0 752.0 252.0 771.0 252.0 771.0 271.0 771.0 271.0 771.0
280.0 771.0 280.0 771.0 299.0 752.0 299.0 752.0 299.0 707.0 299.0 707.0 299.0 688.0 299.0 688.0 280.0 688.0
280.0 688.0 271.0 688.0 271.0 688.0 252.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag31}
$w create polygon 595.0 342.0 595.0 342.0 640.0 342.0 640.0 342.0 659.0 342.0 659.0 361.0 659.0 361.0 659.0
370.0 659.0 370.0 659.0 389.0 640.0 389.0 640.0 389.0 595.0 389.0 595.0 389.0 576.0 389.0 576.0 370.0 576.0
370.0 576.0 361.0 576.0 361.0 576.0 342.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag30}
$w create polygon 699.0 335.0 699.0 335.0 744.0 335.0 744.0 335.0 763.0 335.0 763.0 354.0 763.0 354.0 763.0
363.0 763.0 363.0 763.0 382.0 744.0 382.0 744.0 382.0 699.0 382.0 699.0 382.0 680.0 382.0 680.0 363.0 680.0
363.0 680.0 354.0 680.0 354.0 680.0 335.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag33}
$w create polygon 599.0 251.0 599.0 251.0 644.0 251.0 644.0 251.0 663.0 251.0 663.0 270.0 663.0 270.0 663.0
279.0 663.0 279.0 663.0 298.0 644.0 298.0 644.0 298.0 599.0 298.0 599.0 298.0 580.0 298.0 580.0 279.0 580.0
279.0 580.0 270.0 580.0 270.0 580.0 251.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag29}
$w create polygon 482.0 394.0 482.0 394.0 527.0 394.0 527.0 394.0 546.0 394.0 546.0 413.0 546.0 413.0 546.0
422.0 546.0 422.0 546.0 441.0 527.0 441.0 527.0 441.0 482.0 441.0 482.0 441.0 463.0 441.0 463.0 422.0 463.0
422.0 463.0 413.0 463.0 413.0 463.0 394.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag27}
}
proc transnumber {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext u4E00}
if { $item == 5 } {lappend choutext u3024}
if { $item == 6 } {lappend choutext u516D}
if { $item == 7 } {lappend choutext u4E03}
if { $item == 8 } {lappend choutext u516B}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transarabic {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext 1}
if { $item == 5 } {lappend choutext 5}
if { $item == 6 } {lappend choutext 6}
if { $item == 7 } {lappend choutext 7}
if { $item == 8 } {lappend choutext 8}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transodd {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext u4e00 }
if { $item == 5 } {lappend choutext u4e00 }
if { $item == 6 } {lappend choutext "- -"}
if { $item == 7 } {lappend choutext u4e00 }
if { $item == 8 } {lappend choutext "- -"}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
set listx [ transnumber $lister ]
proc chou_bronzes {w state3} {
global listx lister
if { $state3 == 1 } {set listx [ transnumber $lister ]}
if { $state3 == 2 } {set listx [ transarabic $lister ]}
if { $state3 == 3 } {set listx [ transodd $lister ]}
set yy 100
set font3 {Hevetica 35}
set font5 {Hevetica 150}
set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
$w create rect 165 70 260 420 -fill gold
$w create poly 445 60 475 65 475 100 445 120 -fill tan
# $w create text 200 400 -text u2617 -tags "text" -fill tan -font $font5
foreach i {1 2 3 4 5 6 } {
$w create text 210 $yy -text [lpick $listx ] -tags "text" -font $font3
incr yy 50
}
}
proc clrcanvas {w} {
$w delete "all"
}
proc leave {w} {
exit
}
proc board {w} {
#set state3 1
#set state2 1
clrcanvas $w
. configure -background orange -highlightcolor brown -relief raised -border 30
$w configure -bg tan
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 450
set maxY 500
set y 0
set x1 120
set x2 180
set y1 50
set y2 80
canvas .cv -width $maxX -height $maxY -bg tan
pack .cv -in .f1
button .b0 -text "clear" -command { clrcanvas .cv }
button .b5 -text "chou_bronzes" -command {clrcanvas .cv; chou_bronzes .cv 1 }
button .b6 -text "arabic" -command { clrcanvas .cv; chou_bronzes .cv 2 }
button .b7 -text "regular" -command { clrcanvas .cv; chou_bronzes .cv 3}
button .b8 -text "diagram" -command { clrcanvas .cv; diagramx .cv}
button .b9 -text "exit" -command {leave .cv }
pack .b0 .b5 .b6 .b7 .b7 .b8 .b9 -in .f2 -side left -padx 2
board .cv
#catch {console show}
bind . <Motion> {wm title . " Chinese Iching Hexagrams on Chou Bronzes "}
***FIRST VERSION***
======
#start of deck
#start of deck
#start of deck
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
# gold on TCL WIKI , 17Jul2010
package require Tk
proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
set lister { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1 1}
proc transnumber {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4E00}
if { $item == 5 } {lappend choutext \u3024}
if { $item == 6 } {lappend choutext \u516D}
if { $item == 7 } {lappend choutext \u4E03}
if { $item == 8 } {lappend choutext \u516B}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transarabic {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext 1}
if { $item == 5 } {lappend choutext 5}
if { $item == 6 } {lappend choutext 6}
if { $item == 7 } {lappend choutext 7}
if { $item == 8 } {lappend choutext 8}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transodd {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4e00 }
if { $item == 5 } {lappend choutext \u4e00 }
if { $item == 6 } {lappend choutext "- -"}
if { $item == 7 } {lappend choutext \u4e00 }
if { $item == 8 } {lappend choutext "- -"}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
set listx [ transnumber $lister ]
proc chou_bronzes {w state3} {
global listx lister
if { $state3 == 1 } {set listx [ transnumber $lister ]}
if { $state3 == 2 } {set listx [ transarabic $lister ]}
if { $state3 == 3 } {set listx [ transodd $lister ]}
set yy 100
set font3 {Hevetica 35}
set font5 {Hevetica 150}
set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
$w create rect 150 50 250 400 -fill gold
$w create poly 445 60 475 65 475 100 445 120 -fill tan
# $w create text 200 400 -text \u2617 -tags "text" -fill tan -font $font5
foreach i {1 2 3 4 5 6 } {
$w create text 200 $yy -text [lpick $listx ] -tags "text" -font $font3
incr yy 50
}
}
proc clrcanvas {w} {
$w delete "all"
}
proc leave {w} {
exit
}
proc board {w} {
#set state3 1
#set state2 1
clrcanvas $w
. configure -background orange -highlightcolor brown -relief raised -border 30
$w configure -bg tan
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 400
set maxY 450
set y 0
set x1 120
set x2 150
set y1 50
set y2 80
canvas .cv -width $maxX -height $maxY -bg tan
pack .cv -in .f1
button .b0 -text "clear" -command { clrcanvas .cv }
button .b5 -text "chou_bronzes" -command {clrcanvas .cv; chou_bronzes .cv 1 }
button .b6 -text "arabic" -command { clrcanvas .cv; chou_bronzes .cv 2 }
button .b7 -text "regular" -command { clrcanvas .cv; chou_bronzes .cv 3}
button .b8 -text "exit" -command {leave .cv }
pack .b0 .b5 .b6 .b7 .b7 .b8 -in .f2 -side left -padx 2
board .cv
#catch {console show}
bind . <Motion> {wm title . " Chinese Iching Hexagrams on Chou Bronzes "}
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
======
***Version with added hacks ***
======
#start of deck
#start of deck
#start of deck
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
# gold on TCL WIKI , 17Jul2010
package require Tk
proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
#proc poly args {eval .cv create polygon $args}
set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
proc ding {w} {
$w create polygon 22.3130151863 79.8724065423 22.3130151863 79.8724065423 15.3037864986 115.329182243
8.29455781096 150.785957943 6.89271207343 189.079275699 12.5000950236 221.699509343 26.5185523989
242.973574763 43.3407012492 257.156285043 48.9480841993 262.829369155 47.5462384618 271.338995324
60.1628500996 349.343901864 64.3683873122 379.127593452 61.5646958371 406.074742984 57.3591586245
434.440163545 50.3499299369 450.041144853 67.1720787872 452.877686909 98.0126850129 454.295957937
119.040371076 454.295957937 127.451445501 454.295957937 120.442216813 421.675724292 119.040371076
403.238200928 114.834833863 383.382406536 114.834833863 364.944883172 117.638525338 328.069836444
119.040371076 305.377499996 124.647754026 292.613060744 141.469902876 292.613060744 149.880977301
292.613060744 154.086514514 350.762172892 156.890205989 381.964135508 152.684668777 411.747827096
148.479131564 433.021892517 145.675440089 444.368060741 145.675440089 450.041144853 149.880977301
451.459415881 163.899434677 450.041144853 176.516046315 451.459415881 196.14188664 451.459415881
242.402795978 451.459415881 256.421253354 450.041144853 270.439710729 451.459415881 276.047093679
448.622873825 281.654476629 448.622873825 285.860013842 448.622873825 274.645247942 416.00264018
266.234173516 381.964135508 266.234173516 360.690070088 269.037864992 340.834275696 276.047093679
320.978481304 281.654476629 301.122686912 285.860013842 289.776518688 299.878471217 289.776518688
305.485854167 335.161191584 308.289545642 364.944883172 309.69139138 389.055490648 309.69139138
417.420911208 299.878471217 437.276705601 299.878471217 444.368060741 311.093237117 442.949789713
333.522768918 445.786331769 360.157837931 447.204602797 372.774449569 450.041144853 362.961529406
428.767079433 354.550454981 391.892032704 357.354146456 362.108341116 364.363375144 345.08908878
371.372603831 268.502453268 371.372603831 257.156285043 395.203981369 238.718761679 402.213210057
207.516799063 407.820593007 176.314836447 406.418747269 152.204228971 399.409518582 123.838808411
398.007672844 105.401285047 393.802135632 88.3820327104 393.802135632 78.4541355143 390.998444157
69.9445093463 405.016901532 69.9445093463 400.811364319 60.0166121502 400.811364319 31.6511915901
400.811364319 10.3771261699 376.979986781 8.95885514191 378.381832519 20.305023366 382.587369731
50.0887149542 344.737534818 55.7617990662 95.2089935378 58.5983411222 30.7240896114 57.1800700942
36.3314725616 31.6511915901 34.929626824 4.70404205788 25.1167066613 11.7953971979 13.9019407611
11.7953971979 2.68717486084 11.7953971979 6.89271207343 23.141565422 8.29455781096 47.2521728981
8.29455781096 62.8531542062 9.69640354849 74.1993224303 16.7056322361 75.6175934583 19.5093237112
79.8724065423 19.5093237112 92.6368457944 -fill #e9e796 -outline black -smooth 1 -tags {Polygon obj utag3}
}
proc transnumber {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4E00}
if { $item == 5 } {lappend choutext \u3024}
if { $item == 6 } {lappend choutext \u516D}
if { $item == 7 } {lappend choutext \u4E03}
if { $item == 8 } {lappend choutext \u516B}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transarabic {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext 1}
if { $item == 5 } {lappend choutext 5}
if { $item == 6 } {lappend choutext 6}
if { $item == 7 } {lappend choutext 7}
if { $item == 8 } {lappend choutext 8}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transodd {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4e00 }
if { $item == 5 } {lappend choutext \u4e00 }
if { $item == 6 } {lappend choutext "- -"}
if { $item == 7 } {lappend choutext \u4e00 }
if { $item == 8 } {lappend choutext "- -"}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
set listx [ transnumber $lister ]
proc chou_bronzes {w state3} {
global listx lister
if { $state3 == 1 } {set listx [ transnumber $lister ]}
if { $state3 == 2 } {set listx [ transarabic $lister ]}
if { $state3 == 3 } {set listx [ transodd $lister ]}
set yy 100
set font3 {Hevetica 35}
set font5 {Hevetica 150}
set lister { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1 1}
$w create rect 165 70 260 420 -fill gold
$w create poly 445 60 475 65 475 100 445 120 -fill tan
# $w create text 200 400 -text \u2617 -tags "text" -fill tan -font $font5
foreach i {1 2 3 4 5 6 } {
$w create text 210 $yy -text [lpick $listx ] -tags "text" -font $font3
incr yy 50
}
}
proc clrcanvas {w} {
$w delete "all"
}
proc leave {w} {
exit
}
proc board {w} {
#set state3 1
#set state2 1
clrcanvas $w
. configure -background orange -highlightcolor brown -relief raised -border 30
$w configure -bg tan
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 450
set maxY 500
set y 0
set x1 120
set x2 180
set y1 50
set y2 80
canvas .cv -width $maxX -height $maxY -bg tan
pack .cv -in .f1
button .b0 -text "clear" -command { clrcanvas .cv }
button .b5 -text "chou_bronzes" -command {clrcanvas .cv;ding .cv; chou_bronzes .cv 1 }
button .b6 -text "arabic" -command { clrcanvas .cv; ding .cv; chou_bronzes .cv 2 }
button .b7 -text "regular" -command { clrcanvas .cv; ding .cv;chou_bronzes .cv 3}
button .b8 -text "ding" -command { clrcanvas .cv; ding .cv}
button .b9 -text "exit" -command {leave .cv }
pack .b0 .b5 .b6 .b7 .b7 .b8 .b9 -in .f2 -side left -padx 2
board .cv
#catch {console show}
bind . <Motion> {wm title . " Chinese Iching Hexagrams on Chou Bronzes "}
#end of deck
#end of deck*
#end of deck
#end of deck
#end of deck
#end of deck
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
# gold on TCL WIKI , 17Jul2010
package require Tk
proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
#proc poly args {eval .cv create polygon $args}
set lister { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1 1}
proc diagramx {w} {
set TextInfo(utag9) arabic
set TextInfo(utag19) {bronze m.}
set TextInfo(utag20) {}
set TextInfo(utag21) {canvas }
set TextInfo(utag10) regular
set TextInfo(utag11) exit
set TextInfo(utag12) clear
set TextInfo(utag13) {chou_bronzes 1 }
set TextInfo(utag14) {chou_bronzes 2}
set TextInfo(utag15) {chou_bronzes 3}
$w create polygon 331.0 326.0 331.0 326.0 376.0 326.0 376.0 326.0 395.0 326.0 395.0 345.0 395.0 345.0 395.0
354.0 395.0 354.0 395.0 373.0 376.0 373.0 376.0 373.0 331.0 373.0 331.0 373.0 312.0 373.0 312.0 354.0 312.0
354.0 312.0 345.0 312.0 345.0 312.0 326.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag1}
$w create polygon 327.0 249.0 327.0 249.0 372.0 249.0 372.0 249.0 391.0 249.0 391.0 268.0 391.0 268.0 391.0
277.0 391.0 277.0 391.0 296.0 372.0 296.0 372.0 296.0 327.0 296.0 327.0 296.0 308.0 296.0 308.0 277.0 308.0
277.0 308.0 268.0 308.0 268.0 308.0 249.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag6}
$w create polygon 80.0 187.0 80.0 187.0 125.0 187.0 125.0 187.0 144.0 187.0 144.0 206.0 144.0 206.0 144.0
215.0 144.0 215.0 144.0 234.0 125.0 234.0 125.0 234.0 80.0 234.0 80.0 234.0 61.0 234.0 61.0 215.0 61.0 215.0
61.0 206.0 61.0 206.0 61.0 187.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag2}
$w create polygon 330.0 389.039215686 330.0 389.039215686 375.0 389.039215686 375.0 389.039215686 394.0
389.039215686 394.0 408.411764706 394.0 408.411764706 394.0 417.588235294 394.0 417.588235294 394.0
436.960784314 375.0 436.960784314 375.0 436.960784314 330.0 436.960784314 330.0 436.960784314 311.0
436.960784314 311.0 417.588235294 311.0 417.588235294 311.0 408.411764706 311.0 408.411764706 311.0
389.039215686 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag7}
$w create polygon 102.224826735 254.679389889 102.224826735 254.679389889 202.911166651 254.679389889
202.911166651 254.679389889 245.423176837 254.679389889 245.423176837 271.049593559 245.423176837
271.049593559 245.423176837 278.803900561 245.423176837 278.803900561 245.423176837 295.174104231
202.911166651 295.174104231 202.911166651 295.174104231 102.224826735 295.174104231 102.224826735
295.174104231 59.7128165488 295.174104231 59.7128165488 278.803900561 59.7128165488 278.803900561
59.7128165488 271.049593559 59.7128165488 271.049593559 59.7128165488 254.679389889 -fill {} -outline black
-smooth 1 -tags {RoundRect obj utag4}
$w create polygon 485.0 248.0 485.0 248.0 530.0 248.0 530.0 248.0 549.0 248.0 549.0 267.0 549.0 267.0 549.0
276.0 549.0 276.0 549.0 295.0 530.0 295.0 530.0 295.0 485.0 295.0 485.0 295.0 466.0 295.0 466.0 276.0 466.0
276.0 466.0 267.0 466.0 267.0 466.0 248.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag3}
$w create polygon 87.0 460.0 87.0 460.0 132.0 460.0 132.0 460.0 151.0 460.0 151.0 479.0 151.0 479.0 151.0
488.0 151.0 488.0 151.0 507.0 132.0 507.0 132.0 507.0 87.0 507.0 87.0 507.0 68.0 507.0 68.0 488.0 68.0 488.0
68.0 479.0 68.0 479.0 68.0 460.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag5}
$w create text 356.0 345.0 -font {Arial 10 bold} -text arabic -tags {text obj utag9}
$w create text 355.0 411.0 -font {Arial 10 bold} -text regular -tags {text obj utag10}
$w create text 106.0 481.0 -font {Arial 10 bold} -text exit -tags {text obj utag11}
$w create text 98.0 211.0 -font {Arial 10 bold} -text clear -tags {text obj utag12}
$w create text 154.0 275.0 -font {Arial 10 bold} -text {chou_bronzes $wv 1 } -tags {text obj utag13}
$w create text 150.0 347.0 -font {Arial 10 bold} -text {chou_bronzes $wv 2} -tags {text obj utag14}
$w create text 153.0 415.0 -font {Arial 10 bold} -text {chou_bronzes $wv 3} -tags {text obj utag15}
$w create polygon 99.224826735 326.679389889 99.224826735 326.679389889 199.911166651 326.679389889
199.911166651 326.679389889 242.423176837 326.679389889 242.423176837 343.049593559 242.423176837
343.049593559 242.423176837 350.803900561 242.423176837 350.803900561 242.423176837 367.174104231
199.911166651 367.174104231 199.911166651 367.174104231 99.224826735 367.174104231 99.224826735
367.174104231 56.712816549 367.174104231 56.712816549 350.803900561 56.712816549 350.803900561 56.712816549
343.049593559 56.712816549 343.049593559 56.712816549 326.679389889 -fill {} -outline black -smooth 1 -tags
{RoundRect obj utag16}
$w create polygon 100.224826735 394.679389889 100.224826735 394.679389889 200.911166651 394.679389889
200.911166651 394.679389889 243.423176837 394.679389889 243.423176837 411.049593559 243.423176837
411.049593559 243.423176837 418.803900561 243.423176837 418.803900561 243.423176837 435.174104231
200.911166651 435.174104231 200.911166651 435.174104231 100.224826735 435.174104231 100.224826735
435.174104231 57.712816549 435.174104231 57.712816549 418.803900561 57.712816549 418.803900561 57.712816549
411.049593559 57.712816549 411.049593559 57.712816549 394.679389889 -fill {} -outline black -smooth 1 -tags
{RoundRect obj utag17}
$w create polygon 24.0 57.0 24.0 57.0 69.0 57.0 69.0 57.0 88.0 57.0 88.0 76.0 88.0 76.0 88.0 85.0 88.0 85.0
88.0 104.0 69.0 104.0 69.0 104.0 24.0 104.0 24.0 104.0 5.0 104.0 5.0 85.0 5.0 85.0 5.0 76.0 5.0 76.0 5.0
57.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag18}
$w create text 349.0 270.0 -font {Arial 10 bold} -text {bronze m.} -tags {text obj utag19}
$w create text 47.0 79.0 -font {Arial 10 bold} -text {canvas $wv } -tags {text obj utag21}
$w create line 257.0 269.0 298.0 269.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag22}
$w create line 256.0 350.0 302.0 351.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag23}
$w create line 261.0 413.0 300.0 413.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag24}
$w create polygon 487.0 332.0 487.0 332.0 532.0 332.0 532.0 332.0 551.0 332.0 551.0 351.0 551.0 351.0 551.0
360.0 551.0 360.0 551.0 379.0 532.0 379.0 532.0 379.0 487.0 379.0 487.0 379.0 468.0 379.0 468.0 360.0 468.0
360.0 468.0 351.0 468.0 351.0 468.0 332.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag25}
$w create polygon 487.0 332.0 487.0 332.0 532.0 332.0 532.0 332.0 551.0 332.0 551.0 351.0 551.0 351.0 551.0
360.0 551.0 360.0 551.0 379.0 532.0 379.0 532.0 379.0 487.0 379.0 487.0 379.0 468.0 379.0 468.0 360.0 468.0
360.0 468.0 351.0 468.0 351.0 468.0 332.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag26}
$w create polygon 485.0 184.0 485.0 184.0 530.0 184.0 530.0 184.0 549.0 184.0 549.0 203.0 549.0 203.0 549.0
212.0 549.0 212.0 549.0 231.0 530.0 231.0 530.0 231.0 485.0 231.0 485.0 231.0 466.0 231.0 466.0 212.0 466.0
212.0 466.0 203.0 466.0 203.0 466.0 184.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag28}
$w create polygon 690.0 398.0 690.0 398.0 735.0 398.0 735.0 398.0 754.0 398.0 754.0 417.0 754.0 417.0 754.0
426.0 754.0 426.0 754.0 445.0 735.0 445.0 735.0 445.0 690.0 445.0 690.0 445.0 671.0 445.0 671.0 426.0 671.0
426.0 671.0 417.0 671.0 417.0 671.0 398.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag34}
$w create polygon 589.0 398.0 589.0 398.0 634.0 398.0 634.0 398.0 653.0 398.0 653.0 417.0 653.0 417.0 653.0
426.0 653.0 426.0 653.0 445.0 634.0 445.0 634.0 445.0 589.0 445.0 589.0 445.0 570.0 445.0 570.0 426.0 570.0
426.0 570.0 417.0 570.0 417.0 570.0 398.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag32}
$w create polygon 707.0 252.0 707.0 252.0 752.0 252.0 752.0 252.0 771.0 252.0 771.0 271.0 771.0 271.0 771.0
280.0 771.0 280.0 771.0 299.0 752.0 299.0 752.0 299.0 707.0 299.0 707.0 299.0 688.0 299.0 688.0 280.0 688.0
280.0 688.0 271.0 688.0 271.0 688.0 252.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag31}
$w create polygon 595.0 342.0 595.0 342.0 640.0 342.0 640.0 342.0 659.0 342.0 659.0 361.0 659.0 361.0 659.0
370.0 659.0 370.0 659.0 389.0 640.0 389.0 640.0 389.0 595.0 389.0 595.0 389.0 576.0 389.0 576.0 370.0 576.0
370.0 576.0 361.0 576.0 361.0 576.0 342.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag30}
$w create polygon 699.0 335.0 699.0 335.0 744.0 335.0 744.0 335.0 763.0 335.0 763.0 354.0 763.0 354.0 763.0
363.0 763.0 363.0 763.0 382.0 744.0 382.0 744.0 382.0 699.0 382.0 699.0 382.0 680.0 382.0 680.0 363.0 680.0
363.0 680.0 354.0 680.0 354.0 680.0 335.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag33}
$w create polygon 599.0 251.0 599.0 251.0 644.0 251.0 644.0 251.0 663.0 251.0 663.0 270.0 663.0 270.0 663.0
279.0 663.0 279.0 663.0 298.0 644.0 298.0 644.0 298.0 599.0 298.0 599.0 298.0 580.0 298.0 580.0 279.0 580.0
279.0 580.0 270.0 580.0 270.0 580.0 251.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag29}
$w create polygon 482.0 394.0 482.0 394.0 527.0 394.0 527.0 394.0 546.0 394.0 546.0 413.0 546.0 413.0 546.0
422.0 546.0 422.0 546.0 441.0 527.0 441.0 527.0 441.0 482.0 441.0 482.0 441.0 463.0 441.0 463.0 422.0 463.0
422.0 463.0 413.0 463.0 413.0 463.0 394.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag27}
}
proc transnumber {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4E00}
if { $item == 5 } {lappend choutext \u3024}
if { $item == 6 } {lappend choutext \u516D}
if { $item == 7 } {lappend choutext \u4E03}
if { $item == 8 } {lappend choutext \u516B}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transarabic {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext 1}
if { $item == 5 } {lappend choutext 5}
if { $item == 6 } {lappend choutext 6}
if { $item == 7 } {lappend choutext 7}
if { $item == 8 } {lappend choutext 8}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transodd {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4e00 }
if { $item == 5 } {lappend choutext \u4e00 }
if { $item == 6 } {lappend choutext "- -"}
if { $item == 7 } {lappend choutext \u4e00 }
if { $item == 8 } {lappend choutext "- -"}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
set listx [ transnumber $lister ]
proc chou_bronzes {w state3} {
global listx lister
if { $state3 == 1 } {set listx [ transnumber $lister ]}
if { $state3 == 2 } {set listx [ transarabic $lister ]}
if { $state3 == 3 } {set listx [ transodd $lister ]}
set yy 100
set font3 {Hevetica 35}
set font5 {Hevetica 150}
set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
$w create rect 165 70 260 420 -fill gold
$w create poly 445 60 475 65 475 100 445 120 -fill tan
# $w create text 200 400 -text \u2617 -tags "text" -fill tan -font $font5
foreach i {1 2 3 4 5 6 } {
$w create text 210 $yy -text [lpick $listx ] -tags "text" -font $font3
incr yy 50
}
}
proc clrcanvas {w} {
$w delete "all"
}
proc leave {w} {
exit
}
proc board {w} {
#set state3 1
#set state2 1
clrcanvas $w
. configure -background orange -highlightcolor brown -relief raised -border 30
$w configure -bg tan
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 450
set maxY 500
set y 0
set x1 120
set x2 180
set y1 50
set y2 80
canvas .cv -width $maxX -height $maxY -bg tan
pack .cv -in .f1
button .b0 -text "clear" -command { clrcanvas .cv }
button .b5 -text "chou_bronzes" -command {clrcanvas .cv; chou_bronzes .cv 1 }
button .b6 -text "arabic" -command { clrcanvas .cv; chou_bronzes .cv 2 }
button .b7 -text "regular" -command { clrcanvas .cv; chou_bronzes .cv 3}
button .b8 -text "diagram" -command { clrcanvas .cv; diagramx .cv}
button .b9 -text "exit" -command {leave .cv }
pack .b0 .b5 .b6 .b7 .b7 .b8 .b9 -in .f2 -side left -padx 2
board .cv
#catch {console show}
bind . <Motion> {wm title . " Chinese Iching Hexagrams on Chou Bronzes "}
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
======
***Extra Program***
======
console show
proc calculation { facen } {
# prob. subroutines for mimic sequence of bronze
# prob. is throw conbos of eg. "7" over all possible throws
set lister {5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1}
set ee [llength $lister ]
set kk [ llength [ lsearch -all $lister $facen ] ]
set prob [ expr { ($kk*1.) / $ee } ]
return $prob
}
set limit 12
for { set i 1 } { $i <= $limit } { incr i } {
lappend listxxx $i
lappend listxxx [ calculation $i ]
puts " $i [ calculation $i ] "
}
#end
output.
1 0.45454545454545453
2 0.0
3 0.0
4 0.0
5 0.045454545454545456
6 0.2727272727272727
7 0.13636363636363635
8 0.09090909090909091
9 0.0
10 0.0
11 0.0
12 0.0
#end
======
----
Aside from the hexagram analysis, this TCL script can be a workhorse for all kinds of problems just by loading a different list of numbers to examine. Suppose you were given a loaded dice and loaded about 30 throws in the list. For an honest 6-sided die, the probability of each throw { sequence 1 2 3 4 5 6} should be equal over a large enough set of tests. The exact probability for each throw would be 1/6 or 1.6666 . A loaded die will give percentages that are not equal for all numbers or different probabilities than the honest die.
Another problem type is the continued mantissas like pi. Are the numbers that show up in the pi mantissa equally probable? If the mantissa of pi was split by TCL into a list of 0-9 integers, this theorm could be checked by our script. Lets try the handy [AMG] pi procedure from [One Liners]
1% proc pi {} {expr acos(-1)}
2% proc mac {aa} { regexp {.(\d+)} $aa -> bb;return $bb }
3% mac [pi]
141592653589793
Now we have a short mantissa for testing and there are websites that will give pi with more digits.
set sequence3 [ split {14159265358979323846264338327950288419716939937} "" ]
2% split {14159265358979323846264338327950288419716939937} ""
1 4 1 5 9 2 6 5 3 5 8 9 7 9 3 2 3 8 4 6 2 6 4 3 3 8 3 2 7 9 5 0 2 8 8 4 1 9 7 1 6 9 3 9 9 3 7
# Sequence for combos of 2 6-sided dice. sample space is 36.
{3 4 5 6 7 8 4 5 6 7 8 9 5 6 7 8 9 10 6 7 8 9 10 11 7 8 9 10 11 12}
sequence of one 6-sided dice, turned in numberic order.
{ 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6}
honest die
{2 5 1 6 4 3 5 3 2 1 5 2 1 3 6 1 6 1 3 1 4 1 4 3 5 2 4 1 6 6}
loaded die in favor of 5
{5 6 1 6 3 5 5 4 6 2 5 4 6 6 4 3 4 3 1 1 2 5 2 1 2 5 1 4 3 5}
sequence for 2-sided coin, ready for shuffle.1 for head, 2 for tail
{1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1}
honest coin , 1 head, 2 for tail
{1 2 2 2 1 1 2 1 1 1 2 1 2 1 2 1 2 1 2 1 2 2 1 1 1 2 2 1 1 2 2 1 2}
dishonest coin loaded for 1 (heads)
2 1 2 1 1 1 2 2 2 1 2 2 1 1 1 1 2 2 1 2 1 1 2 1 1 2 1 1 1 1 1 2 1
another dishonest coin , loaded for 2 (tails),
1 for heads, 2 for tails
{1 2 2 1 2 1 1 1 2 2 2 2 1 1 2 2 1 2 2 1 1 2 1 1 2 2 2 2 1 1 2 2 2}
combos for three 2-sided stick dice, marked 1 and 2
sample space is 8.
{3 4 4 5 4 5 5 6}
combos for four 2-sided stick dice, marked 1 and 2
sample space is 16.
{4 5 5 6 5 6 6 5 7 5 6 6 7 6 7 7 8}
combos for five 2-sided stick dice, marked 1 and 2
sample space is 32.(use split here)
{ 56676768677877889677878797889899 10}
<<categories>> Toys | Example | Games | Characters | Mathematics} regexp2} CALL {my render {Chinese Iching Hexagrams on Chou Bronzes : TCL Example} {
**Chinese Iching Hexagrams on Chou Bronzes: TCL Example**
This page is under development. Comments are welcome,
but please load any comments in the comments section
at the middle of the page. Thanks, [gold]
----
Here is some starter code for Chinese Iching Hexagrams on Chou Bronzes. The Iching is the ancient fortune telling book of China. The Iching literature mentions various methods for casting fortune patterns.
----
The canvas and buttons presented here are largely based on the [Simple Canvas Demo] by [HJG].
The random pick algorithm was posted by Suchenworth [RS] on [Horseracing in Tcl]
Other dice pages are [Throwing Two Dice] [GWM] and [Dice] by Keith Vetter.
Several Dr. Math emails are in the references, which reduce some dice issues to simple paths.
----
In the West, Leibniz recognized that the whole and broken lines in the hexagram patterns could be counted as ones and zeros, respectively in a binary number system. For example, a cast or list of { 6,7,8,9,6,7 } could be expressed as a binary number, 010101. For computer procedures, the patterns are effectively a horizontal bar code of 6 lines. The probability of each line by the yarrow stick method or coin casting method is different.
* The probability of the yarrow stick method is 1,3,5,7 over 16.
* The number 6 or old yin is 1/16 or 0.0625
* The number 7 or young yang is 3/16 or 0.1875.
* The number 8 or young yin is 5/16 or 0.3125.
* The number 9 or old yang is 7/16 or .4375.
* For the yarrow sticks, the combined probability of any throw is .0625 + .1875 + .3125 + .4375 = 1
For the iching dice pictured below, the three sticks read 2,3,and 3 which totals 8. The combined probability of casting 2,3, and 3 is 0.3125 (with the sticks).
For the coins,the probability of the coin casting method is 2,2,6,6 over 16. The number 6 or old yin is 2/6 or 0.125.
* The number 7 or young yang is 2/16 or 0.125.
* The number 8 or young yin is 6/16 or 0.375.
* The number 9 or old yang is 6/16 or .375.
* For the coins, the combined probability of any throw is .125 + .125 + .375 + .375 = 1
----
On about 28 pieces of Chou bronzes, there were several series of numbers possibly representing divinatory numbers. These series were described in a thesis by Chang Cheng Land, called Interpretation of Divinatory Inscriptions on Early Chou Bronzes.The numbers in ancient Chou script are not completely understood, but have the following number space { 1:36,2:0,3:0,4:0,5:11,6:64,7:33,8:24}. The puzzle is that ones and fives are not normally generated in the modern I Ching practice, meaning after 1100 AD. Part of the problem is that the Chinese scripts for one, two,three, and four were normally horizontal slashes in those times. So numbers 2,3,and 4 could be confused with marks for the number one. Also some of the numbers seem to be archaic or oracle bone script versions of modern chinese numbers, like X for 5.
It seems reasonable that a TCL procedure might be able to reproduce the same generating odds with dice or coins, even the Chou generating procedures are lost but for a few peg points.
----
Here are the peg points.
1. One generating method involves 36 counters, lacking four. Apparently the counters are taken/divided away by four and the remainders laid in three piles, upper on side, middle upright, and lower on side.
1. The number 36 makes one think of the 36 chessboard squares, which are 8 by 8 on a side. ([RLE] Note, 8 times 8 is 64, not 36)
1. The Chou regarded the odd numbers as "lucky" yang and the even numbers as "unlucky" yin.
From the probability of 6-sided double dice, the number space of the bronze method guesstimates at 23. The bronze method sample space is likely between the sample space of 4 coins (sp16) and 5 coins (sp32).
The probabilities from 4 2-sided sticks are a 40 to 60 percent off the estimated bronze figures. But the number 6 has highest frequency in both sticks and bronzes. In the 5 2-sided sticks, its number 7 with the highest frequency.
Kind of hokey math, but if you assess 6 has 6 combos, then x= 6/.264 or 22.72 eg. nearest whole number space is 23.
Pseudocode. llength { 6 6 6 6 6 6 etc } = 23
1's = 0.1487 * 23 =3.42 > 4
5's = .0454 *23 or 1.04 > 2
6's =.264*23 or 6.02 > 6
7's = .136*23 or 3.128 > 4
8's = .0625 *23 or 1.43 > 2
Pseudocode. llength { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 etc } = 23
Pseudocode. llength { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 etc. } = 23
Since 1's in bronzes are poorly understood, don't mind filling up rest ( to 23) with ones. So now the Suchenworth random pick procedure lpick will deliever the same frequency of characters on the bronzes.
Pseudocode. lpick { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
With a text translation scheme and suitable unicode, the TCL procedure can mimic the appearence of Chou horizontal script on the bronzes.
----
space of 4 2-sided sticks marked 1 and 2
space was { 4 5 5 6 5 6 5 7 5 6 6 7 6 7 7 8},size of 16
%| |sticks prob. |prob. |est. bronze prob. |5 sticks prob. |%
|4 |1/16 |0.04625 |unk | |
|5 |5/16 |0.3125 |0.0454545454545 | |
|6 |5/16 |0.3125 |0.264462809 |.1875 |
|7 |4/16 |0.250 |0.13636363636 |.3125 |
|8 |1/16 |0.0625 |0.0991735537 |.2815 |
5 stick prob's are multiples/fractions of bronze values
----
After checking, an lpick(sequence2) was found that better matched the reported bronze values. Here, we are at most 10 to 15 percent off. lpick { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1} #s2 The extra program at the bottom of the page will solve for the probabilities in the bronze sequence (or any sequence loaded in the $lister).
%| |est. bronze prob. |lpick(sequence2) |%
| 1 | .4347 | 0.45454545454545453 |
| 2 | n/a | 0.0 |
| 3 | n/a | 0.0 |
| 4 | n/a | 0.0 |
| 5 | 0.0454545454545 | 0.045454545454545456 |
| 6 | 0.264462809 | 0.2727272727272727 |
| 7 | 0.13636363636 | 0.13636363636363635 |
| 8 | 0.0991735537 | 0.09090909090909091 |
----
**Screenshots Section**
[http://farm5.static.flickr.com/4133/4837907275_4863aa5764.jpg]
[http://farm5.static.flickr.com/4136/4812522943_33727ff8ec.jpg]
[http://farm5.static.flickr.com/4114/4812413403_e697523a46.jpg]
[http://farm5.static.flickr.com/4098/4818003683_be9dddea77.jpg]
[http://farm5.static.flickr.com/4123/4821292691_35da154995.jpg]
Oracle bone script numbers ,1600 BC–1046 BC, attributed to Gisling,commons.wikimedia.org
[http://upload.wikimedia.org/wikipedia/commons/3/31/Oracle_numeral.jpg]
----
**Comments Section**
Please place any comments here, Thanks.
[gold] Changes.
----
**References**
* [Simple Canvas Demo]
* [Clock and daylight saving time corrections]
* [timezone]
* http://www-groups.dcs.st-and.ac.uk/~history/HistTopics/Chinese_numerals.html
* In iching, there is a solar eclipse of June 20, 1070 BCE. www.ejournal.unam.mx/atm/Vol04-3/ATM04302.pdf
* http://rishida.net/tools/conversion/, outstanding unicode conversion online!!!
* [Throwing Two Dice]
* [throw a dice]
* [Dice]
* http://pinyin.info/tools/converter/chars2uninumbers.html
* http://en.wikipedia.org/wiki/Miscellaneous_Symbols_Unicode_block
* http://www.dennismerrittjungiananalyst.com/China_paper.htm
* http://www.openexchange.org/archives/AMJ04/gordon.html
* http://www.superiching.com/guanature.htm
* http://news.bbc.co.uk/2/hi/sci/tech/146120.stm
* http://nasgem.rpi.edu/files/1686
* http://www.biroco.com/yijing/Shih-chuan_Chen.pdf
* Early Bronzes, chen lang [http://www.biroco.com/yijing/Chang_Cheng-lang.pdf]
* http://www.nature.com/nature/journal/v256/n5515/abs/256296a0.ht
* http://mysite.du.edu/~jcalvert/math/chinum.htm
* Doctor Syd, The Math Forum, 2/25/96 on probability of 6 choose 2
* http://www.chineseastrologyonline.com/OracleBone.htm
* http://www.chinavista.com/experience/oracle/oracle.html
* http://www.lib.cuhk.edu.hk/uclib/bones/bones.htm
* http://www.chinapage.com/oracle/oracle.html
* http://www.chinapage.com/archeology/030411.pdf
* http://www.chinapage.com/oracle/news.html
* http://www.chinesefortunecalendar.com/CLC/Default.htm
* http://www.chinesefortunecalendar.com/CLC/LunarCalendar.htm
**appendix TCL programs**
***Pretty Print VERSION***
======
# test of autoindent from ased editor
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
# gold on TCL WIKI , 17Jul2010
package require Tk
proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
#proc poly args {eval .cv create polygon $args}
set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
proc ding {w} {
$w create polygon 22.3130151863 79.8724065423 22.3130151863 79.8724065423 15.3037864986 115.329182243
8.29455781096 150.785957943 6.89271207343 189.079275699 12.5000950236 221.699509343 26.5185523989
242.973574763 43.3407012492 257.156285043 48.9480841993 262.829369155 47.5462384618 271.338995324
60.1628500996 349.343901864 64.3683873122 379.127593452 61.5646958371 406.074742984 57.3591586245
434.440163545 50.3499299369 450.041144853 67.1720787872 452.877686909 98.0126850129 454.295957937
119.040371076 454.295957937 127.451445501 454.295957937 120.442216813 421.675724292 119.040371076
403.238200928 114.834833863 383.382406536 114.834833863 364.944883172 117.638525338 328.069836444
119.040371076 305.377499996 124.647754026 292.613060744 141.469902876 292.613060744 149.880977301
292.613060744 154.086514514 350.762172892 156.890205989 381.964135508 152.684668777 411.747827096
148.479131564 433.021892517 145.675440089 444.368060741 145.675440089 450.041144853 149.880977301
451.459415881 163.899434677 450.041144853 176.516046315 451.459415881 196.14188664 451.459415881
242.402795978 451.459415881 256.421253354 450.041144853 270.439710729 451.459415881 276.047093679
448.622873825 281.654476629 448.622873825 285.860013842 448.622873825 274.645247942 416.00264018
266.234173516 381.964135508 266.234173516 360.690070088 269.037864992 340.834275696 276.047093679
320.978481304 281.654476629 301.122686912 285.860013842 289.776518688 299.878471217 289.776518688
305.485854167 335.161191584 308.289545642 364.944883172 309.69139138 389.055490648 309.69139138
417.420911208 299.878471217 437.276705601 299.878471217 444.368060741 311.093237117 442.949789713
333.522768918 445.786331769 360.157837931 447.204602797 372.774449569 450.041144853 362.961529406
428.767079433 354.550454981 391.892032704 357.354146456 362.108341116 364.363375144 345.08908878
371.372603831 268.502453268 371.372603831 257.156285043 395.203981369 238.718761679 402.213210057
207.516799063 407.820593007 176.314836447 406.418747269 152.204228971 399.409518582 123.838808411
398.007672844 105.401285047 393.802135632 88.3820327104 393.802135632 78.4541355143 390.998444157
69.9445093463 405.016901532 69.9445093463 400.811364319 60.0166121502 400.811364319 31.6511915901
400.811364319 10.3771261699 376.979986781 8.95885514191 378.381832519 20.305023366 382.587369731
50.0887149542 344.737534818 55.7617990662 95.2089935378 58.5983411222 30.7240896114 57.1800700942
36.3314725616 31.6511915901 34.929626824 4.70404205788 25.1167066613 11.7953971979 13.9019407611
11.7953971979 2.68717486084 11.7953971979 6.89271207343 23.141565422 8.29455781096 47.2521728981
8.29455781096 62.8531542062 9.69640354849 74.1993224303 16.7056322361 75.6175934583 19.5093237112
79.8724065423 19.5093237112 92.6368457944 -fill #e9e796 -outline black -smooth 1 -tags {Polygon obj utag3}
}
proc transnumber {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext u4E00}
if { $item == 5 } {lappend choutext u3024}
if { $item == 6 } {lappend choutext u516D}
if { $item == 7 } {lappend choutext u4E03}
if { $item == 8 } {lappend choutext u516B}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transarabic {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext 1}
if { $item == 5 } {lappend choutext 5}
if { $item == 6 } {lappend choutext 6}
if { $item == 7 } {lappend choutext 7}
if { $item == 8 } {lappend choutext 8}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transodd {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext u4e00 }
if { $item == 5 } {lappend choutext u4e00 }
if { $item == 6 } {lappend choutext "- -"}
if { $item == 7 } {lappend choutext u4e00 }
if { $item == 8 } {lappend choutext "- -"}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
set listx [ transnumber $lister ]
proc chou_bronzes {w state3} {
global listx lister
if { $state3 == 1 } {set listx [ transnumber $lister ]}
if { $state3 == 2 } {set listx [ transarabic $lister ]}
if { $state3 == 3 } {set listx [ transodd $lister ]}
set yy 100
set font3 {Hevetica 35}
set font5 {Hevetica 150}
set lister { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1 1}
$w create rect 165 70 260 420 -fill gold
$w create poly 445 60 475 65 475 100 445 120 -fill tan
# $w create text 200 400 -text u2617 -tags "text" -fill tan -font $font5
foreach i {1 2 3 4 5 6 } {
$w create text 210 $yy -text [lpick $listx ] -tags "text" -font $font3
incr yy 50
}
}
proc clrcanvas {w} {
$w delete "all"
}
proc leave {w} {
exit
}
proc board {w} {
#set state3 1
#set state2 1
clrcanvas $w
. configure -background orange -highlightcolor brown -relief raised -border 30
$w configure -bg tan
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 450
set maxY 500
set y 0
set x1 120
set x2 180
set y1 50
set y2 80
canvas .cv -width $maxX -height $maxY -bg tan
pack .cv -in .f1
button .b0 -text "clear" -command { clrcanvas .cv }
button .b5 -text "chou_bronzes" -command {clrcanvas .cv;ding .cv; chou_bronzes .cv 1 }
button .b6 -text "arabic" -command { clrcanvas .cv; ding .cv; chou_bronzes .cv 2 }
button .b7 -text "regular" -command { clrcanvas .cv; ding .cv;chou_bronzes .cv 3}
button .b8 -text "ding" -command { clrcanvas .cv; ding .cv}
button .b9 -text "exit" -command {leave .cv }
pack .b0 .b5 .b6 .b7 .b7 .b8 .b9 -in .f2 -side left -padx 2
board .cv
#catch {console show}
bind . <Motion> {wm title . " Chinese Iching Hexagrams on Chou Bronzes "}
#end of deck
#end of deck*
#end of deck
#end of deck
#end of deck
#end of deck
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
# gold on TCL WIKI , 17Jul2010
package require Tk
proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
#proc poly args {eval .cv create polygon $args}
set lister { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1 1}
proc diagramx {w} {
set TextInfo(utag9) arabic
set TextInfo(utag19) {bronze m.}
set TextInfo(utag20) {}
set TextInfo(utag21) {canvas }
set TextInfo(utag10) regular
set TextInfo(utag11) exit
set TextInfo(utag12) clear
set TextInfo(utag13) {chou_bronzes 1 }
set TextInfo(utag14) {chou_bronzes 2}
set TextInfo(utag15) {chou_bronzes 3}
$w create polygon 331.0 326.0 331.0 326.0 376.0 326.0 376.0 326.0 395.0 326.0 395.0 345.0 395.0 345.0 395.0
354.0 395.0 354.0 395.0 373.0 376.0 373.0 376.0 373.0 331.0 373.0 331.0 373.0 312.0 373.0 312.0 354.0 312.0
354.0 312.0 345.0 312.0 345.0 312.0 326.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag1}
$w create polygon 327.0 249.0 327.0 249.0 372.0 249.0 372.0 249.0 391.0 249.0 391.0 268.0 391.0 268.0 391.0
277.0 391.0 277.0 391.0 296.0 372.0 296.0 372.0 296.0 327.0 296.0 327.0 296.0 308.0 296.0 308.0 277.0 308.0
277.0 308.0 268.0 308.0 268.0 308.0 249.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag6}
$w create polygon 80.0 187.0 80.0 187.0 125.0 187.0 125.0 187.0 144.0 187.0 144.0 206.0 144.0 206.0 144.0
215.0 144.0 215.0 144.0 234.0 125.0 234.0 125.0 234.0 80.0 234.0 80.0 234.0 61.0 234.0 61.0 215.0 61.0 215.0
61.0 206.0 61.0 206.0 61.0 187.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag2}
$w create polygon 330.0 389.039215686 330.0 389.039215686 375.0 389.039215686 375.0 389.039215686 394.0
389.039215686 394.0 408.411764706 394.0 408.411764706 394.0 417.588235294 394.0 417.588235294 394.0
436.960784314 375.0 436.960784314 375.0 436.960784314 330.0 436.960784314 330.0 436.960784314 311.0
436.960784314 311.0 417.588235294 311.0 417.588235294 311.0 408.411764706 311.0 408.411764706 311.0
389.039215686 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag7}
$w create polygon 102.224826735 254.679389889 102.224826735 254.679389889 202.911166651 254.679389889
202.911166651 254.679389889 245.423176837 254.679389889 245.423176837 271.049593559 245.423176837
271.049593559 245.423176837 278.803900561 245.423176837 278.803900561 245.423176837 295.174104231
202.911166651 295.174104231 202.911166651 295.174104231 102.224826735 295.174104231 102.224826735
295.174104231 59.7128165488 295.174104231 59.7128165488 278.803900561 59.7128165488 278.803900561
59.7128165488 271.049593559 59.7128165488 271.049593559 59.7128165488 254.679389889 -fill {} -outline black
-smooth 1 -tags {RoundRect obj utag4}
$w create polygon 485.0 248.0 485.0 248.0 530.0 248.0 530.0 248.0 549.0 248.0 549.0 267.0 549.0 267.0 549.0
276.0 549.0 276.0 549.0 295.0 530.0 295.0 530.0 295.0 485.0 295.0 485.0 295.0 466.0 295.0 466.0 276.0 466.0
276.0 466.0 267.0 466.0 267.0 466.0 248.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag3}
$w create polygon 87.0 460.0 87.0 460.0 132.0 460.0 132.0 460.0 151.0 460.0 151.0 479.0 151.0 479.0 151.0
488.0 151.0 488.0 151.0 507.0 132.0 507.0 132.0 507.0 87.0 507.0 87.0 507.0 68.0 507.0 68.0 488.0 68.0 488.0
68.0 479.0 68.0 479.0 68.0 460.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag5}
$w create text 356.0 345.0 -font {Arial 10 bold} -text arabic -tags {text obj utag9}
$w create text 355.0 411.0 -font {Arial 10 bold} -text regular -tags {text obj utag10}
$w create text 106.0 481.0 -font {Arial 10 bold} -text exit -tags {text obj utag11}
$w create text 98.0 211.0 -font {Arial 10 bold} -text clear -tags {text obj utag12}
$w create text 154.0 275.0 -font {Arial 10 bold} -text {chou_bronzes $wv 1 } -tags {text obj utag13}
$w create text 150.0 347.0 -font {Arial 10 bold} -text {chou_bronzes $wv 2} -tags {text obj utag14}
$w create text 153.0 415.0 -font {Arial 10 bold} -text {chou_bronzes $wv 3} -tags {text obj utag15}
$w create polygon 99.224826735 326.679389889 99.224826735 326.679389889 199.911166651 326.679389889
199.911166651 326.679389889 242.423176837 326.679389889 242.423176837 343.049593559 242.423176837
343.049593559 242.423176837 350.803900561 242.423176837 350.803900561 242.423176837 367.174104231
199.911166651 367.174104231 199.911166651 367.174104231 99.224826735 367.174104231 99.224826735
367.174104231 56.712816549 367.174104231 56.712816549 350.803900561 56.712816549 350.803900561 56.712816549
343.049593559 56.712816549 343.049593559 56.712816549 326.679389889 -fill {} -outline black -smooth 1 -tags
{RoundRect obj utag16}
$w create polygon 100.224826735 394.679389889 100.224826735 394.679389889 200.911166651 394.679389889
200.911166651 394.679389889 243.423176837 394.679389889 243.423176837 411.049593559 243.423176837
411.049593559 243.423176837 418.803900561 243.423176837 418.803900561 243.423176837 435.174104231
200.911166651 435.174104231 200.911166651 435.174104231 100.224826735 435.174104231 100.224826735
435.174104231 57.712816549 435.174104231 57.712816549 418.803900561 57.712816549 418.803900561 57.712816549
411.049593559 57.712816549 411.049593559 57.712816549 394.679389889 -fill {} -outline black -smooth 1 -tags
{RoundRect obj utag17}
$w create polygon 24.0 57.0 24.0 57.0 69.0 57.0 69.0 57.0 88.0 57.0 88.0 76.0 88.0 76.0 88.0 85.0 88.0 85.0
88.0 104.0 69.0 104.0 69.0 104.0 24.0 104.0 24.0 104.0 5.0 104.0 5.0 85.0 5.0 85.0 5.0 76.0 5.0 76.0 5.0
57.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag18}
$w create text 349.0 270.0 -font {Arial 10 bold} -text {bronze m.} -tags {text obj utag19}
$w create text 47.0 79.0 -font {Arial 10 bold} -text {canvas $wv } -tags {text obj utag21}
$w create line 257.0 269.0 298.0 269.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag22}
$w create line 256.0 350.0 302.0 351.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag23}
$w create line 261.0 413.0 300.0 413.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag24}
$w create polygon 487.0 332.0 487.0 332.0 532.0 332.0 532.0 332.0 551.0 332.0 551.0 351.0 551.0 351.0 551.0
360.0 551.0 360.0 551.0 379.0 532.0 379.0 532.0 379.0 487.0 379.0 487.0 379.0 468.0 379.0 468.0 360.0 468.0
360.0 468.0 351.0 468.0 351.0 468.0 332.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag25}
$w create polygon 487.0 332.0 487.0 332.0 532.0 332.0 532.0 332.0 551.0 332.0 551.0 351.0 551.0 351.0 551.0
360.0 551.0 360.0 551.0 379.0 532.0 379.0 532.0 379.0 487.0 379.0 487.0 379.0 468.0 379.0 468.0 360.0 468.0
360.0 468.0 351.0 468.0 351.0 468.0 332.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag26}
$w create polygon 485.0 184.0 485.0 184.0 530.0 184.0 530.0 184.0 549.0 184.0 549.0 203.0 549.0 203.0 549.0
212.0 549.0 212.0 549.0 231.0 530.0 231.0 530.0 231.0 485.0 231.0 485.0 231.0 466.0 231.0 466.0 212.0 466.0
212.0 466.0 203.0 466.0 203.0 466.0 184.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag28}
$w create polygon 690.0 398.0 690.0 398.0 735.0 398.0 735.0 398.0 754.0 398.0 754.0 417.0 754.0 417.0 754.0
426.0 754.0 426.0 754.0 445.0 735.0 445.0 735.0 445.0 690.0 445.0 690.0 445.0 671.0 445.0 671.0 426.0 671.0
426.0 671.0 417.0 671.0 417.0 671.0 398.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag34}
$w create polygon 589.0 398.0 589.0 398.0 634.0 398.0 634.0 398.0 653.0 398.0 653.0 417.0 653.0 417.0 653.0
426.0 653.0 426.0 653.0 445.0 634.0 445.0 634.0 445.0 589.0 445.0 589.0 445.0 570.0 445.0 570.0 426.0 570.0
426.0 570.0 417.0 570.0 417.0 570.0 398.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag32}
$w create polygon 707.0 252.0 707.0 252.0 752.0 252.0 752.0 252.0 771.0 252.0 771.0 271.0 771.0 271.0 771.0
280.0 771.0 280.0 771.0 299.0 752.0 299.0 752.0 299.0 707.0 299.0 707.0 299.0 688.0 299.0 688.0 280.0 688.0
280.0 688.0 271.0 688.0 271.0 688.0 252.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag31}
$w create polygon 595.0 342.0 595.0 342.0 640.0 342.0 640.0 342.0 659.0 342.0 659.0 361.0 659.0 361.0 659.0
370.0 659.0 370.0 659.0 389.0 640.0 389.0 640.0 389.0 595.0 389.0 595.0 389.0 576.0 389.0 576.0 370.0 576.0
370.0 576.0 361.0 576.0 361.0 576.0 342.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag30}
$w create polygon 699.0 335.0 699.0 335.0 744.0 335.0 744.0 335.0 763.0 335.0 763.0 354.0 763.0 354.0 763.0
363.0 763.0 363.0 763.0 382.0 744.0 382.0 744.0 382.0 699.0 382.0 699.0 382.0 680.0 382.0 680.0 363.0 680.0
363.0 680.0 354.0 680.0 354.0 680.0 335.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag33}
$w create polygon 599.0 251.0 599.0 251.0 644.0 251.0 644.0 251.0 663.0 251.0 663.0 270.0 663.0 270.0 663.0
279.0 663.0 279.0 663.0 298.0 644.0 298.0 644.0 298.0 599.0 298.0 599.0 298.0 580.0 298.0 580.0 279.0 580.0
279.0 580.0 270.0 580.0 270.0 580.0 251.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag29}
$w create polygon 482.0 394.0 482.0 394.0 527.0 394.0 527.0 394.0 546.0 394.0 546.0 413.0 546.0 413.0 546.0
422.0 546.0 422.0 546.0 441.0 527.0 441.0 527.0 441.0 482.0 441.0 482.0 441.0 463.0 441.0 463.0 422.0 463.0
422.0 463.0 413.0 463.0 413.0 463.0 394.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag27}
}
proc transnumber {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext u4E00}
if { $item == 5 } {lappend choutext u3024}
if { $item == 6 } {lappend choutext u516D}
if { $item == 7 } {lappend choutext u4E03}
if { $item == 8 } {lappend choutext u516B}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transarabic {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext 1}
if { $item == 5 } {lappend choutext 5}
if { $item == 6 } {lappend choutext 6}
if { $item == 7 } {lappend choutext 7}
if { $item == 8 } {lappend choutext 8}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transodd {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext u4e00 }
if { $item == 5 } {lappend choutext u4e00 }
if { $item == 6 } {lappend choutext "- -"}
if { $item == 7 } {lappend choutext u4e00 }
if { $item == 8 } {lappend choutext "- -"}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
set listx [ transnumber $lister ]
proc chou_bronzes {w state3} {
global listx lister
if { $state3 == 1 } {set listx [ transnumber $lister ]}
if { $state3 == 2 } {set listx [ transarabic $lister ]}
if { $state3 == 3 } {set listx [ transodd $lister ]}
set yy 100
set font3 {Hevetica 35}
set font5 {Hevetica 150}
set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
$w create rect 165 70 260 420 -fill gold
$w create poly 445 60 475 65 475 100 445 120 -fill tan
# $w create text 200 400 -text u2617 -tags "text" -fill tan -font $font5
foreach i {1 2 3 4 5 6 } {
$w create text 210 $yy -text [lpick $listx ] -tags "text" -font $font3
incr yy 50
}
}
proc clrcanvas {w} {
$w delete "all"
}
proc leave {w} {
exit
}
proc board {w} {
#set state3 1
#set state2 1
clrcanvas $w
. configure -background orange -highlightcolor brown -relief raised -border 30
$w configure -bg tan
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 450
set maxY 500
set y 0
set x1 120
set x2 180
set y1 50
set y2 80
canvas .cv -width $maxX -height $maxY -bg tan
pack .cv -in .f1
button .b0 -text "clear" -command { clrcanvas .cv }
button .b5 -text "chou_bronzes" -command {clrcanvas .cv; chou_bronzes .cv 1 }
button .b6 -text "arabic" -command { clrcanvas .cv; chou_bronzes .cv 2 }
button .b7 -text "regular" -command { clrcanvas .cv; chou_bronzes .cv 3}
button .b8 -text "diagram" -command { clrcanvas .cv; diagramx .cv}
button .b9 -text "exit" -command {leave .cv }
pack .b0 .b5 .b6 .b7 .b7 .b8 .b9 -in .f2 -side left -padx 2
board .cv
#catch {console show}
bind . <Motion> {wm title . " Chinese Iching Hexagrams on Chou Bronzes "}
***FIRST VERSION***
======
#start of deck
#start of deck
#start of deck
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
# gold on TCL WIKI , 17Jul2010
package require Tk
proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
set lister { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1 1}
proc transnumber {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4E00}
if { $item == 5 } {lappend choutext \u3024}
if { $item == 6 } {lappend choutext \u516D}
if { $item == 7 } {lappend choutext \u4E03}
if { $item == 8 } {lappend choutext \u516B}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transarabic {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext 1}
if { $item == 5 } {lappend choutext 5}
if { $item == 6 } {lappend choutext 6}
if { $item == 7 } {lappend choutext 7}
if { $item == 8 } {lappend choutext 8}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transodd {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4e00 }
if { $item == 5 } {lappend choutext \u4e00 }
if { $item == 6 } {lappend choutext "- -"}
if { $item == 7 } {lappend choutext \u4e00 }
if { $item == 8 } {lappend choutext "- -"}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
set listx [ transnumber $lister ]
proc chou_bronzes {w state3} {
global listx lister
if { $state3 == 1 } {set listx [ transnumber $lister ]}
if { $state3 == 2 } {set listx [ transarabic $lister ]}
if { $state3 == 3 } {set listx [ transodd $lister ]}
set yy 100
set font3 {Hevetica 35}
set font5 {Hevetica 150}
set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
$w create rect 150 50 250 400 -fill gold
$w create poly 445 60 475 65 475 100 445 120 -fill tan
# $w create text 200 400 -text \u2617 -tags "text" -fill tan -font $font5
foreach i {1 2 3 4 5 6 } {
$w create text 200 $yy -text [lpick $listx ] -tags "text" -font $font3
incr yy 50
}
}
proc clrcanvas {w} {
$w delete "all"
}
proc leave {w} {
exit
}
proc board {w} {
#set state3 1
#set state2 1
clrcanvas $w
. configure -background orange -highlightcolor brown -relief raised -border 30
$w configure -bg tan
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 400
set maxY 450
set y 0
set x1 120
set x2 150
set y1 50
set y2 80
canvas .cv -width $maxX -height $maxY -bg tan
pack .cv -in .f1
button .b0 -text "clear" -command { clrcanvas .cv }
button .b5 -text "chou_bronzes" -command {clrcanvas .cv; chou_bronzes .cv 1 }
button .b6 -text "arabic" -command { clrcanvas .cv; chou_bronzes .cv 2 }
button .b7 -text "regular" -command { clrcanvas .cv; chou_bronzes .cv 3}
button .b8 -text "exit" -command {leave .cv }
pack .b0 .b5 .b6 .b7 .b7 .b8 -in .f2 -side left -padx 2
board .cv
#catch {console show}
bind . <Motion> {wm title . " Chinese Iching Hexagrams on Chou Bronzes "}
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
======
***Version with added hacks ***
======
#start of deck
#start of deck
#start of deck
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
# gold on TCL WIKI , 17Jul2010
package require Tk
proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
#proc poly args {eval .cv create polygon $args}
set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
proc ding {w} {
$w create polygon 22.3130151863 79.8724065423 22.3130151863 79.8724065423 15.3037864986 115.329182243
8.29455781096 150.785957943 6.89271207343 189.079275699 12.5000950236 221.699509343 26.5185523989
242.973574763 43.3407012492 257.156285043 48.9480841993 262.829369155 47.5462384618 271.338995324
60.1628500996 349.343901864 64.3683873122 379.127593452 61.5646958371 406.074742984 57.3591586245
434.440163545 50.3499299369 450.041144853 67.1720787872 452.877686909 98.0126850129 454.295957937
119.040371076 454.295957937 127.451445501 454.295957937 120.442216813 421.675724292 119.040371076
403.238200928 114.834833863 383.382406536 114.834833863 364.944883172 117.638525338 328.069836444
119.040371076 305.377499996 124.647754026 292.613060744 141.469902876 292.613060744 149.880977301
292.613060744 154.086514514 350.762172892 156.890205989 381.964135508 152.684668777 411.747827096
148.479131564 433.021892517 145.675440089 444.368060741 145.675440089 450.041144853 149.880977301
451.459415881 163.899434677 450.041144853 176.516046315 451.459415881 196.14188664 451.459415881
242.402795978 451.459415881 256.421253354 450.041144853 270.439710729 451.459415881 276.047093679
448.622873825 281.654476629 448.622873825 285.860013842 448.622873825 274.645247942 416.00264018
266.234173516 381.964135508 266.234173516 360.690070088 269.037864992 340.834275696 276.047093679
320.978481304 281.654476629 301.122686912 285.860013842 289.776518688 299.878471217 289.776518688
305.485854167 335.161191584 308.289545642 364.944883172 309.69139138 389.055490648 309.69139138
417.420911208 299.878471217 437.276705601 299.878471217 444.368060741 311.093237117 442.949789713
333.522768918 445.786331769 360.157837931 447.204602797 372.774449569 450.041144853 362.961529406
428.767079433 354.550454981 391.892032704 357.354146456 362.108341116 364.363375144 345.08908878
371.372603831 268.502453268 371.372603831 257.156285043 395.203981369 238.718761679 402.213210057
207.516799063 407.820593007 176.314836447 406.418747269 152.204228971 399.409518582 123.838808411
398.007672844 105.401285047 393.802135632 88.3820327104 393.802135632 78.4541355143 390.998444157
69.9445093463 405.016901532 69.9445093463 400.811364319 60.0166121502 400.811364319 31.6511915901
400.811364319 10.3771261699 376.979986781 8.95885514191 378.381832519 20.305023366 382.587369731
50.0887149542 344.737534818 55.7617990662 95.2089935378 58.5983411222 30.7240896114 57.1800700942
36.3314725616 31.6511915901 34.929626824 4.70404205788 25.1167066613 11.7953971979 13.9019407611
11.7953971979 2.68717486084 11.7953971979 6.89271207343 23.141565422 8.29455781096 47.2521728981
8.29455781096 62.8531542062 9.69640354849 74.1993224303 16.7056322361 75.6175934583 19.5093237112
79.8724065423 19.5093237112 92.6368457944 -fill #e9e796 -outline black -smooth 1 -tags {Polygon obj utag3}
}
proc transnumber {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4E00}
if { $item == 5 } {lappend choutext \u3024}
if { $item == 6 } {lappend choutext \u516D}
if { $item == 7 } {lappend choutext \u4E03}
if { $item == 8 } {lappend choutext \u516B}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transarabic {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext 1}
if { $item == 5 } {lappend choutext 5}
if { $item == 6 } {lappend choutext 6}
if { $item == 7 } {lappend choutext 7}
if { $item == 8 } {lappend choutext 8}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transodd {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4e00 }
if { $item == 5 } {lappend choutext \u4e00 }
if { $item == 6 } {lappend choutext "- -"}
if { $item == 7 } {lappend choutext \u4e00 }
if { $item == 8 } {lappend choutext "- -"}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
set listx [ transnumber $lister ]
proc chou_bronzes {w state3} {
global listx lister
if { $state3 == 1 } {set listx [ transnumber $lister ]}
if { $state3 == 2 } {set listx [ transarabic $lister ]}
if { $state3 == 3 } {set listx [ transodd $lister ]}
set yy 100
set font3 {Hevetica 35}
set font5 {Hevetica 150}
set lister { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1 1}
$w create rect 165 70 260 420 -fill gold
$w create poly 445 60 475 65 475 100 445 120 -fill tan
# $w create text 200 400 -text \u2617 -tags "text" -fill tan -font $font5
foreach i {1 2 3 4 5 6 } {
$w create text 210 $yy -text [lpick $listx ] -tags "text" -font $font3
incr yy 50
}
}
proc clrcanvas {w} {
$w delete "all"
}
proc leave {w} {
exit
}
proc board {w} {
#set state3 1
#set state2 1
clrcanvas $w
. configure -background orange -highlightcolor brown -relief raised -border 30
$w configure -bg tan
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 450
set maxY 500
set y 0
set x1 120
set x2 180
set y1 50
set y2 80
canvas .cv -width $maxX -height $maxY -bg tan
pack .cv -in .f1
button .b0 -text "clear" -command { clrcanvas .cv }
button .b5 -text "chou_bronzes" -command {clrcanvas .cv;ding .cv; chou_bronzes .cv 1 }
button .b6 -text "arabic" -command { clrcanvas .cv; ding .cv; chou_bronzes .cv 2 }
button .b7 -text "regular" -command { clrcanvas .cv; ding .cv;chou_bronzes .cv 3}
button .b8 -text "ding" -command { clrcanvas .cv; ding .cv}
button .b9 -text "exit" -command {leave .cv }
pack .b0 .b5 .b6 .b7 .b7 .b8 .b9 -in .f2 -side left -padx 2
board .cv
#catch {console show}
bind . <Motion> {wm title . " Chinese Iching Hexagrams on Chou Bronzes "}
#end of deck
#end of deck*
#end of deck
#end of deck
#end of deck
#end of deck
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
# gold on TCL WIKI , 17Jul2010
package require Tk
proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
#proc poly args {eval .cv create polygon $args}
set lister { 5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1 1}
proc diagramx {w} {
set TextInfo(utag9) arabic
set TextInfo(utag19) {bronze m.}
set TextInfo(utag20) {}
set TextInfo(utag21) {canvas }
set TextInfo(utag10) regular
set TextInfo(utag11) exit
set TextInfo(utag12) clear
set TextInfo(utag13) {chou_bronzes 1 }
set TextInfo(utag14) {chou_bronzes 2}
set TextInfo(utag15) {chou_bronzes 3}
$w create polygon 331.0 326.0 331.0 326.0 376.0 326.0 376.0 326.0 395.0 326.0 395.0 345.0 395.0 345.0 395.0
354.0 395.0 354.0 395.0 373.0 376.0 373.0 376.0 373.0 331.0 373.0 331.0 373.0 312.0 373.0 312.0 354.0 312.0
354.0 312.0 345.0 312.0 345.0 312.0 326.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag1}
$w create polygon 327.0 249.0 327.0 249.0 372.0 249.0 372.0 249.0 391.0 249.0 391.0 268.0 391.0 268.0 391.0
277.0 391.0 277.0 391.0 296.0 372.0 296.0 372.0 296.0 327.0 296.0 327.0 296.0 308.0 296.0 308.0 277.0 308.0
277.0 308.0 268.0 308.0 268.0 308.0 249.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag6}
$w create polygon 80.0 187.0 80.0 187.0 125.0 187.0 125.0 187.0 144.0 187.0 144.0 206.0 144.0 206.0 144.0
215.0 144.0 215.0 144.0 234.0 125.0 234.0 125.0 234.0 80.0 234.0 80.0 234.0 61.0 234.0 61.0 215.0 61.0 215.0
61.0 206.0 61.0 206.0 61.0 187.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag2}
$w create polygon 330.0 389.039215686 330.0 389.039215686 375.0 389.039215686 375.0 389.039215686 394.0
389.039215686 394.0 408.411764706 394.0 408.411764706 394.0 417.588235294 394.0 417.588235294 394.0
436.960784314 375.0 436.960784314 375.0 436.960784314 330.0 436.960784314 330.0 436.960784314 311.0
436.960784314 311.0 417.588235294 311.0 417.588235294 311.0 408.411764706 311.0 408.411764706 311.0
389.039215686 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag7}
$w create polygon 102.224826735 254.679389889 102.224826735 254.679389889 202.911166651 254.679389889
202.911166651 254.679389889 245.423176837 254.679389889 245.423176837 271.049593559 245.423176837
271.049593559 245.423176837 278.803900561 245.423176837 278.803900561 245.423176837 295.174104231
202.911166651 295.174104231 202.911166651 295.174104231 102.224826735 295.174104231 102.224826735
295.174104231 59.7128165488 295.174104231 59.7128165488 278.803900561 59.7128165488 278.803900561
59.7128165488 271.049593559 59.7128165488 271.049593559 59.7128165488 254.679389889 -fill {} -outline black
-smooth 1 -tags {RoundRect obj utag4}
$w create polygon 485.0 248.0 485.0 248.0 530.0 248.0 530.0 248.0 549.0 248.0 549.0 267.0 549.0 267.0 549.0
276.0 549.0 276.0 549.0 295.0 530.0 295.0 530.0 295.0 485.0 295.0 485.0 295.0 466.0 295.0 466.0 276.0 466.0
276.0 466.0 267.0 466.0 267.0 466.0 248.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag3}
$w create polygon 87.0 460.0 87.0 460.0 132.0 460.0 132.0 460.0 151.0 460.0 151.0 479.0 151.0 479.0 151.0
488.0 151.0 488.0 151.0 507.0 132.0 507.0 132.0 507.0 87.0 507.0 87.0 507.0 68.0 507.0 68.0 488.0 68.0 488.0
68.0 479.0 68.0 479.0 68.0 460.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag5}
$w create text 356.0 345.0 -font {Arial 10 bold} -text arabic -tags {text obj utag9}
$w create text 355.0 411.0 -font {Arial 10 bold} -text regular -tags {text obj utag10}
$w create text 106.0 481.0 -font {Arial 10 bold} -text exit -tags {text obj utag11}
$w create text 98.0 211.0 -font {Arial 10 bold} -text clear -tags {text obj utag12}
$w create text 154.0 275.0 -font {Arial 10 bold} -text {chou_bronzes $wv 1 } -tags {text obj utag13}
$w create text 150.0 347.0 -font {Arial 10 bold} -text {chou_bronzes $wv 2} -tags {text obj utag14}
$w create text 153.0 415.0 -font {Arial 10 bold} -text {chou_bronzes $wv 3} -tags {text obj utag15}
$w create polygon 99.224826735 326.679389889 99.224826735 326.679389889 199.911166651 326.679389889
199.911166651 326.679389889 242.423176837 326.679389889 242.423176837 343.049593559 242.423176837
343.049593559 242.423176837 350.803900561 242.423176837 350.803900561 242.423176837 367.174104231
199.911166651 367.174104231 199.911166651 367.174104231 99.224826735 367.174104231 99.224826735
367.174104231 56.712816549 367.174104231 56.712816549 350.803900561 56.712816549 350.803900561 56.712816549
343.049593559 56.712816549 343.049593559 56.712816549 326.679389889 -fill {} -outline black -smooth 1 -tags
{RoundRect obj utag16}
$w create polygon 100.224826735 394.679389889 100.224826735 394.679389889 200.911166651 394.679389889
200.911166651 394.679389889 243.423176837 394.679389889 243.423176837 411.049593559 243.423176837
411.049593559 243.423176837 418.803900561 243.423176837 418.803900561 243.423176837 435.174104231
200.911166651 435.174104231 200.911166651 435.174104231 100.224826735 435.174104231 100.224826735
435.174104231 57.712816549 435.174104231 57.712816549 418.803900561 57.712816549 418.803900561 57.712816549
411.049593559 57.712816549 411.049593559 57.712816549 394.679389889 -fill {} -outline black -smooth 1 -tags
{RoundRect obj utag17}
$w create polygon 24.0 57.0 24.0 57.0 69.0 57.0 69.0 57.0 88.0 57.0 88.0 76.0 88.0 76.0 88.0 85.0 88.0 85.0
88.0 104.0 69.0 104.0 69.0 104.0 24.0 104.0 24.0 104.0 5.0 104.0 5.0 85.0 5.0 85.0 5.0 76.0 5.0 76.0 5.0
57.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag18}
$w create text 349.0 270.0 -font {Arial 10 bold} -text {bronze m.} -tags {text obj utag19}
$w create text 47.0 79.0 -font {Arial 10 bold} -text {canvas $wv } -tags {text obj utag21}
$w create line 257.0 269.0 298.0 269.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag22}
$w create line 256.0 350.0 302.0 351.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag23}
$w create line 261.0 413.0 300.0 413.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -width 2 -tags
{Line obj utag24}
$w create polygon 487.0 332.0 487.0 332.0 532.0 332.0 532.0 332.0 551.0 332.0 551.0 351.0 551.0 351.0 551.0
360.0 551.0 360.0 551.0 379.0 532.0 379.0 532.0 379.0 487.0 379.0 487.0 379.0 468.0 379.0 468.0 360.0 468.0
360.0 468.0 351.0 468.0 351.0 468.0 332.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag25}
$w create polygon 487.0 332.0 487.0 332.0 532.0 332.0 532.0 332.0 551.0 332.0 551.0 351.0 551.0 351.0 551.0
360.0 551.0 360.0 551.0 379.0 532.0 379.0 532.0 379.0 487.0 379.0 487.0 379.0 468.0 379.0 468.0 360.0 468.0
360.0 468.0 351.0 468.0 351.0 468.0 332.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag26}
$w create polygon 485.0 184.0 485.0 184.0 530.0 184.0 530.0 184.0 549.0 184.0 549.0 203.0 549.0 203.0 549.0
212.0 549.0 212.0 549.0 231.0 530.0 231.0 530.0 231.0 485.0 231.0 485.0 231.0 466.0 231.0 466.0 212.0 466.0
212.0 466.0 203.0 466.0 203.0 466.0 184.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag28}
$w create polygon 690.0 398.0 690.0 398.0 735.0 398.0 735.0 398.0 754.0 398.0 754.0 417.0 754.0 417.0 754.0
426.0 754.0 426.0 754.0 445.0 735.0 445.0 735.0 445.0 690.0 445.0 690.0 445.0 671.0 445.0 671.0 426.0 671.0
426.0 671.0 417.0 671.0 417.0 671.0 398.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag34}
$w create polygon 589.0 398.0 589.0 398.0 634.0 398.0 634.0 398.0 653.0 398.0 653.0 417.0 653.0 417.0 653.0
426.0 653.0 426.0 653.0 445.0 634.0 445.0 634.0 445.0 589.0 445.0 589.0 445.0 570.0 445.0 570.0 426.0 570.0
426.0 570.0 417.0 570.0 417.0 570.0 398.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag32}
$w create polygon 707.0 252.0 707.0 252.0 752.0 252.0 752.0 252.0 771.0 252.0 771.0 271.0 771.0 271.0 771.0
280.0 771.0 280.0 771.0 299.0 752.0 299.0 752.0 299.0 707.0 299.0 707.0 299.0 688.0 299.0 688.0 280.0 688.0
280.0 688.0 271.0 688.0 271.0 688.0 252.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag31}
$w create polygon 595.0 342.0 595.0 342.0 640.0 342.0 640.0 342.0 659.0 342.0 659.0 361.0 659.0 361.0 659.0
370.0 659.0 370.0 659.0 389.0 640.0 389.0 640.0 389.0 595.0 389.0 595.0 389.0 576.0 389.0 576.0 370.0 576.0
370.0 576.0 361.0 576.0 361.0 576.0 342.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag30}
$w create polygon 699.0 335.0 699.0 335.0 744.0 335.0 744.0 335.0 763.0 335.0 763.0 354.0 763.0 354.0 763.0
363.0 763.0 363.0 763.0 382.0 744.0 382.0 744.0 382.0 699.0 382.0 699.0 382.0 680.0 382.0 680.0 363.0 680.0
363.0 680.0 354.0 680.0 354.0 680.0 335.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag33}
$w create polygon 599.0 251.0 599.0 251.0 644.0 251.0 644.0 251.0 663.0 251.0 663.0 270.0 663.0 270.0 663.0
279.0 663.0 279.0 663.0 298.0 644.0 298.0 644.0 298.0 599.0 298.0 599.0 298.0 580.0 298.0 580.0 279.0 580.0
279.0 580.0 270.0 580.0 270.0 580.0 251.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag29}
$w create polygon 482.0 394.0 482.0 394.0 527.0 394.0 527.0 394.0 546.0 394.0 546.0 413.0 546.0 413.0 546.0
422.0 546.0 422.0 546.0 441.0 527.0 441.0 527.0 441.0 482.0 441.0 482.0 441.0 463.0 441.0 463.0 422.0 463.0
422.0 463.0 413.0 463.0 413.0 463.0 394.0 -fill {} -outline black -smooth 1 -tags {RoundRect obj utag27}
}
proc transnumber {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4E00}
if { $item == 5 } {lappend choutext \u3024}
if { $item == 6 } {lappend choutext \u516D}
if { $item == 7 } {lappend choutext \u4E03}
if { $item == 8 } {lappend choutext \u516B}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transarabic {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext 1}
if { $item == 5 } {lappend choutext 5}
if { $item == 6 } {lappend choutext 6}
if { $item == 7 } {lappend choutext 7}
if { $item == 8 } {lappend choutext 8}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
proc transodd {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext \u4e00 }
if { $item == 5 } {lappend choutext \u4e00 }
if { $item == 6 } {lappend choutext "- -"}
if { $item == 7 } {lappend choutext \u4e00 }
if { $item == 8 } {lappend choutext "- -"}
if { $item >= 9 } {lappend choutext ? }
}
return $choutext}
set listx [ transnumber $lister ]
proc chou_bronzes {w state3} {
global listx lister
if { $state3 == 1 } {set listx [ transnumber $lister ]}
if { $state3 == 2 } {set listx [ transarabic $lister ]}
if { $state3 == 3 } {set listx [ transodd $lister ]}
set yy 100
set font3 {Hevetica 35}
set font5 {Hevetica 150}
set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
$w create rect 165 70 260 420 -fill gold
$w create poly 445 60 475 65 475 100 445 120 -fill tan
# $w create text 200 400 -text \u2617 -tags "text" -fill tan -font $font5
foreach i {1 2 3 4 5 6 } {
$w create text 210 $yy -text [lpick $listx ] -tags "text" -font $font3
incr yy 50
}
}
proc clrcanvas {w} {
$w delete "all"
}
proc leave {w} {
exit
}
proc board {w} {
#set state3 1
#set state2 1
clrcanvas $w
. configure -background orange -highlightcolor brown -relief raised -border 30
$w configure -bg tan
}
#: Main :
frame .f1
frame .f2
pack .f1 .f2
set maxX 450
set maxY 500
set y 0
set x1 120
set x2 180
set y1 50
set y2 80
canvas .cv -width $maxX -height $maxY -bg tan
pack .cv -in .f1
button .b0 -text "clear" -command { clrcanvas .cv }
button .b5 -text "chou_bronzes" -command {clrcanvas .cv; chou_bronzes .cv 1 }
button .b6 -text "arabic" -command { clrcanvas .cv; chou_bronzes .cv 2 }
button .b7 -text "regular" -command { clrcanvas .cv; chou_bronzes .cv 3}
button .b8 -text "diagram" -command { clrcanvas .cv; diagramx .cv}
button .b9 -text "exit" -command {leave .cv }
pack .b0 .b5 .b6 .b7 .b7 .b8 .b9 -in .f2 -side left -padx 2
board .cv
#catch {console show}
bind . <Motion> {wm title . " Chinese Iching Hexagrams on Chou Bronzes "}
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
======
***Extra Program***
======
console show
proc calculation { facen } {
# prob. subroutines for mimic sequence of bronze
# prob. is throw conbos of eg. "7" over all possible throws
set lister {5 6 6 6 6 6 6 7 7 7 8 8 1 1 1 1 1 1 1 1 1 1}
set ee [llength $lister ]
set kk [ llength [ lsearch -all $lister $facen ] ]
set prob [ expr { ($kk*1.) / $ee } ]
return $prob
}
set limit 12
for { set i 1 } { $i <= $limit } { incr i } {
lappend listxxx $i
lappend listxxx [ calculation $i ]
puts " $i [ calculation $i ] "
}
#end
output.
1 0.45454545454545453
2 0.0
3 0.0
4 0.0
5 0.045454545454545456
6 0.2727272727272727
7 0.13636363636363635
8 0.09090909090909091
9 0.0
10 0.0
11 0.0
12 0.0
#end
======
----
Aside from the hexagram analysis, this TCL script can be a workhorse for all kinds of problems just by loading a different list of numbers to examine. Suppose you were given a loaded dice and loaded about 30 throws in the list. For an honest 6-sided die, the probability of each throw { sequence 1 2 3 4 5 6} should be equal over a large enough set of tests. The exact probability for each throw would be 1/6 or 1.6666 . A loaded die will give percentages that are not equal for all numbers or different probabilities than the honest die.
Another problem type is the continued mantissas like pi. Are the numbers that show up in the pi mantissa equally probable? If the mantissa of pi was split by TCL into a list of 0-9 integers, this theorm could be checked by our script. Lets try the handy [AMG] pi procedure from [One Liners]
1% proc pi {} {expr acos(-1)}
2% proc mac {aa} { regexp {.(\d+)} $aa -> bb;return $bb }
3% mac [pi]
141592653589793
Now we have a short mantissa for testing and there are websites that will give pi with more digits.
set sequence3 [ split {14159265358979323846264338327950288419716939937} "" ]
2% split {14159265358979323846264338327950288419716939937} ""
1 4 1 5 9 2 6 5 3 5 8 9 7 9 3 2 3 8 4 6 2 6 4 3 3 8 3 2 7 9 5 0 2 8 8 4 1 9 7 1 6 9 3 9 9 3 7
# Sequence for combos of 2 6-sided dice. sample space is 36.
{3 4 5 6 7 8 4 5 6 7 8 9 5 6 7 8 9 10 6 7 8 9 10 11 7 8 9 10 11 12}
sequence of one 6-sided dice, turned in numberic order.
{ 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6}
honest die
{2 5 1 6 4 3 5 3 2 1 5 2 1 3 6 1 6 1 3 1 4 1 4 3 5 2 4 1 6 6}
loaded die in favor of 5
{5 6 1 6 3 5 5 4 6 2 5 4 6 6 4 3 4 3 1 1 2 5 2 1 2 5 1 4 3 5}
sequence for 2-sided coin, ready for shuffle.1 for head, 2 for tail
{1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1}
honest coin , 1 head, 2 for tail
{1 2 2 2 1 1 2 1 1 1 2 1 2 1 2 1 2 1 2 1 2 2 1 1 1 2 2 1 1 2 2 1 2}
dishonest coin loaded for 1 (heads)
2 1 2 1 1 1 2 2 2 1 2 2 1 1 1 1 2 2 1 2 1 1 2 1 1 2 1 1 1 1 1 2 1
another dishonest coin , loaded for 2 (tails),
1 for heads, 2 for tails
{1 2 2 1 2 1 1 1 2 2 2 2 1 1 2 2 1 2 2 1 1 2 1 1 2 2 2 2 1 1 2 2 2}
combos for three 2-sided stick dice, marked 1 and 2
sample space is 8.
{3 4 4 5 4 5 5 6}
combos for four 2-sided stick dice, marked 1 and 2
sample space is 16.
{4 5 5 6 5 6 6 5 7 5 6 6 7 6 7 7 8}
combos for five 2-sided stick dice, marked 1 and 2
sample space is 32.(use split here)
{ 56676768677877889677878797889899 10}
<<categories>> Toys | Example | Games | Characters | Mathematics}} CALL {my revision {Chinese Iching Hexagrams on Chou Bronzes : TCL Example}} CALL {::oo::Obj820677 process revision/Chinese+Iching+Hexagrams+on+Chou+Bronzes+%3A+TCL+Example} CALL {::oo::Obj820675 process}
-errorcode
NONE
-errorinfo
Unknow state transition: LINE -> END
while executing
"error $msg"
(class "::Wiki" method "render_wikit" line 6)
invoked from within
"my render_$default_markup $N $C $mkup_rendering_engine"
(class "::Wiki" method "render" line 8)
invoked from within
"my render $name $C"
(class "::Wiki" method "revision" line 31)
invoked from within
"my revision $page"
(class "::Wiki" method "process" line 56)
invoked from within
"$server process [string trim $uri /]"
-errorline
4