Version 25 of Chinese Fortune Casting Example Demo
Updated 2011-05-18 17:06:29 by goldChinese Fortune Casting Example Demo
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 Fortune Casting Example Demo. The impetus for this calculator was checking some probabilities on the Chinese bronzes example. Its easy enough to plug in formulas/subroutines into the display formats on Game kingdom of Strategy and Chinese Iching Hexagrams on Chou Bronzes : TCL Example. Most of the checked testcases involve flipping two sided objects like coins or popsicle sticks or four sided rectangular dice, see pix below. This page is more an investigation into the mindset of the Chinese sages, using TCL visual and random subroutines.
In planning any software, it is advisable to gather a number of testcases to check the results of the program.
Screenshots Section
Comments Section
Please place any comments here, Thanks.
gold Changes.
References
- factorial
- Slot_Calculator_Demo
- Game kingdom of Strategy
- Chinese Iching Hexagrams on Chou Bronzes : TCL Example
- Iching_Fortunes
- Binomial Probability Slot Calculator Example
- Chinese Iching Random Weather Predictions
appendix TCL programs
***FIRST VERSION***
#autoindent test from ased editor.
#:by gold, Chinese Fortune Casting
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL
1.0.1
# gold on TCL WIKI , 1Aug2011
package require Tk
global bookvalue bookvalue2
set colorground bisque
set wow "bone number"
proc K { x y } { set x }
proc shuffle5 { list } {
set n 1
set slist {}
foreach item $list {
set index [expr {int(rand()*$n)}]
set slist [linsert $slist $index $item]
incr n
}
return $slist
}
proc lremove {_list el} {
upvar 1 $_list list
set pos [lsearch -exact $list $el]
set list [lreplace $list $pos $pos]
}
proc pi {args} [subst -novariable {
expr [expr {atan2(0,-1)}] $args
}]
#wdb,usage [pi] [pi /4]
proc piesq {args} { set pie [pi] ; return [
expr sqrt($pie) ]}
proc geoseries1 {aa bb cc} { if {$bb <= -1||$bb >=
1} { return 0} ;return [ expr $aa / ( 1 - $bb ) ]};
proc box1 {aa bb } { set pie [pi] ;return [ expr
sqrt(($aa * $bb*4 )/ ($pie))]}
proc stuffit {} {
set nums {1 2 3 4 1 2 3 4 }
set numnum [lindex $nums [expr {int(rand() *
[llength $nums])}]]
lremove nums $numnum
append details " "
append details $numnum
append details " "
return $details
}
proc ? L {lindex $L [expr {int(rand()*[llength
$L])}]}
proc recipe {} {
set a {
{1} {2} {3}
{4} {5}
}
set b {
{1} {2}
{3}
{4} {5}
}
set c {1 2 3 4 5 6}
set d {
1 {2} 3v{4} 5 {6}
}
return " 1@ [? $a].
[? $b].
2@ [? $c].
3@ [? $d]."
}
proc ? L {
lindex $L [expr {int(rand()*[llength $L])}]
}
if 0 {This is used several times in:}
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 clrcanvas {w} {
global counter winner5
$w delete "all"
.zzz delete 0 end
.xxx delete 0 end
.t delete 1.0 end
set counter 0
set winner5 0
set loser5 0
}
proc run {w} {
global side1 side2 results
.t delete 1.0 end
.t insert 1.0 "run test5"
}
proc consol {w} {
console show
puts "Chinese Fortune Casting "
}
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
}
proc about {w} {
set msg "Chinese Fortune Casting.
from TCL WIKI,
written on eTCL
cmds take form
of tcl "
tk_messageBox -title "About" -message $msg
}
#: Main :
frame .f1
frame .f2
frame .f3
pack .f1 .f2 .f3
set maxX 400
set maxY 300
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
#set side2 2
button .b0 -text "Coin_Toss" -command {
bonereadxx 2;castfortune;}
button .b3 -text "Cast_Bones" -command
{bonereadxx 1 ;castfortune; }
button .b5 -text "clear" -command {clrcanvas
.cv; }
button .b6 -text "run script" -command {
run .cv}
button .b7 -text "clear" -command {
clrcanvas .cv; }
button .b4 -text "console" -command { consol
.cv; }
button .b8 -text "exit" -command {leave
.cv }
button .b9 -text "about" -command {about
.cv }
text .t -width 40 -height 5 -bg bisque
entry .xxx -width 50 -bg bisque -textvariable
side1
entry .zzz -width 50 -textvariable side2 -bg
bisque
pack .b0 .b3 .b5 .b6 .b7 .b7 .b4 .b9 .b8 -in
.f2 -side left -padx 2
.f2 configure -bg orange
label .kingx -text "entry language"
label .advisora -text "advisor"
pack .advisora .zzz .t .kingx .xxx -in .f3
-side bottom -padx 2
focus .xxx
focus .zzz
board .cv
bind . <Motion> {wm title . "Chinese Fortune
Casting "}
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
if {[file tail [info script]]==[file tail $argv0]} {
package require Tk
#pack [text .t5 -width 40 -height 5]
bind .t <1> {showRecipe %W; break}
proc showRecipe w {
$w delete 1.0 end
$w insert end [recipe]
}
showRecipe .t
}
set width 50
set height 50
set w ".can"
set x 100
set y 100
set dx 50
set dy 30
set colors {white black }
set color 0
proc lpick L {lindex $L [expr {int(rand()*[llength
$L])} ];}
# utilities
proc plainsub {text item replacewith} {
set text [string map [list $item $replacewith]
$text]
}
proc %+ {a } {return [string toupper $a]; #%+
tree >TREE }
proc %- {a } {return [string tolower $a]; #%+
Tree >tree }
proc %++ {a b} {return $a$b;#%+* tree root
>treeroot }
proc %-- {a b} {regsub $b $a "" a; return
$a;#%-- 5 7>5 }
proc %% {a b} {regsub -all $b $a "";#%% tree
root >tree }
proc %1 {a b} {regsub $b $a "" a; return $a;#%1
tree root>tree }
proc %2 {a b} {regsub $b $a "" a;regsub $b $a ""
a; return $a;#%2 tree root>tree }
proc %3 {a b} {regsub $b $a "" a;regsub $b $a
"" a;regsub $b $a "" a; return $a;#%3 tree
root>tree}
proc %2x {a} {return $a$a;#%2x tree>treetree}
proc %3x {a} {return $a$a$a;#%3x
tree>treetreetree}
proc %4x {a} {return "$a,$a,$a";#%5x
tree>tree,tree,tree }
proc %5x {a} {return "$a $a $a";#%5x
tree>tree tree tree }
proc repeat {n body} {while {$n} {incr n -1;
uplevel $body}}
proc random n {expr {round($n*rand())}}
proc whitelist {a} {return [lreplace $a 0 -
1];#take string,return list without blanks}
set k [split {abcdefghijklmnopqrstuvwxyz} {}]
proc average L {expr ([join $L +])/[llength
$L].}
proc srevert s {
set l [string length $s]
set res ""
while {$l} {append res [string index $s [incr l
-1]]}
set res
};# RS,
proc lreverse L {
set res {}
set i [llength $L]
#while {[incr i -1]>=0} {lappend res [lindex $L
$i]}
while {$i} {lappend res [lindex $L [incr i -1]]}
;# rmax
set res
} ;# RS, tuned 10% faster by [rmax]
proc sumoflist L {expr [join [split $L ""] +]
+0} ;# RS
proc convertbase2to10 {jip} {
set l [split $jip ""]
set t 0; set e 0;
foreach n $l {
set exp [ expr int(pow(2,$e))];
incr t [ expr $n * $exp ] ;
incr e;
}
return $t}
proc kvsearch {kvlist item} {
set pos [lsearch $kvlist $item]
if {$pos != -1} {
lindex $kvlist [expr {$pos+1-2*($pos%2)}]
}
} ;# RS
# end utilities
#start iching data
set bookvalue [ list 1 63 43 62 14 61 34
60 9 59 5 58 26 57 11 56 10 55 58 54 38
53 54 52 61 51 60 50 41 49 19 48 13 47 49
46 30 45 55 44 37 43 63 42 22 41 36 40
25 39 17 38 21 37 51 36 42 35 3 34 27
33 24 32 44 31 28 30 50 29 32 28 57 27
48 26 18 25 46 24 6 23 47 22 64 21 40
20 59 19 29 18 4 17 7 16 33 15 31 14 56
13 62 12 53 11 39 10 52 9 15 31 14 56 13
62 12 53 11 39 10 52 9 15 8 12 7 45 6
35 5 16 4 20 3 23 1 2 0 8 2 ]
set bookvalue2 [ list 9999 1 63 43 62 14 61
34 60 9 59 5 58 26 57 11 56 10 55 58 54
38 53 54 52 61 51 60 50 41 49 19 48 13 47
49 46 30 45 55 44 37 43 63 42 22 41 36
40 25 39 17 38 21 37 51 36 42 35 3 34
27 33 24 32 44 31 28 30 50 29 32 28 57
27 48 26 18 25 46 24 6 23 47 22 64 21
40 20 59 19 29 18 4 17 7 16 33 15 31 14
56 13 62 12 53 11 39 10 52 9 15 31 14 56
13 62 12 53 11 39 10 52 9 15 8 12 7 45
6 35 5 16 4 20 3 23 1 2 0 8 2 ]
if 0 { iching hexagrams and trigrams }
if 0 { Little API style database }
set chartbamboo { " list
" }
proc plainsub {text item replacewith} {
set text [string map [list $item $replacewith]
$text] }
foreach piece { + : { } } {
set chartbamboo [ plainsub $chartbamboo $piece
"*" ]
}
set reading [ list [ split $chartbamboo " " ]]
#end iching data
proc binaryexchange {gualisting} {
# converts gualisting as a list
# to binary & decimal numbers.
global dx dy colors color
global guabinary guadecimal guatransform
set guabinary [ whitelist $gualisting ];
set guabinary [ join [ split $guabinary "
"]];
set guabinary [ plainsub $guabinary 6 0 ];
set guabinary [ plainsub $guabinary 7 1 ];
set guabinary [ plainsub $guabinary 8 0 ];
set guabinary [ plainsub $guabinary 9 1 ];
set guabinary [ plainsub $guabinary " " "" ];
return $guabinary;
}
proc second_hexagram_compute {gualisting } {
# subroutine under test
global bookvalue second_hexagram
#set gualisting [ lreverse $gualisting];
set second_hexagram [ list ];
set second_hexagram [ join $gualisting ] ;
set second_hexagram [ plainsub
$second_hexagram 6 7 ];
set second_hexagram [ plainsub
$second_hexagram 9 6 ];
set guabinary [ binaryexchange
$second_hexagram ];
set decimalout [ convertbase2to10 $guabinary
];
set bookgua [ kvsearch $bookvalue $decimalout
];
return $bookgua;
}
proc bonereadxx {coinsread} {
global dx dy colors color gualisting reading
global bookvalue bookvalue2 second_hexagram
set dj 1;
set gualisting [list ];
if { $coinsread == 1 } {
for {set j 0} {$j<6} {incr j $dj} {
set bone1 [lpick {3 3 3 2}]
set bone2 [lpick {3 3 2 2}]
set bone3 [lpick {3 3 2 2}]
set bonereading [expr $bone1 + $bone2 + $bone3
]
set wow [expr $bone1 + $bone2 + $bone3 ]
lappend gualisting $wow;
}
}
if { $coinsread == 2 } {
for {set j 0} {$j<6} {incr j $dj} {
set bone1 [lpick {3 3 2 2}]
set bone2 [lpick {3 3 2 2}]
set bone3 [lpick {3 3 2 2}]
set bonereading [expr $bone1 + $bone2 + $bone3
]
set wow [expr $bone1 + $bone2 + $bone3 ]
lappend gualisting $wow;
}
}
#set guabinary [ list 1 0 1 1 1 si tiene
problema ]
set gualisting [ lreverse $gualisting];
# reading hexagram lines top down,
# opposed to reverse(down top)
# give different binary values
#
set guabinary [ binaryexchange $gualisting ];
set decimalout [ convertbase2to10 $guabinary
];
set bookgua [ kvsearch $bookvalue2
$decimalout ];
set second_hexa [ second_hexagram_compute
$gualisting ];
.t delete 1.0 end;
set outoutfoulspirit " last bone is $wow .gua
listing is $gualisting && binary $guabinary &&
decimal $decimalout &&Iching_gua_# $bookgua && test
2nd hex. $second_hexagram && 2nd h. test
$second_hexa && $second_hexagram
$reading "
.t insert end $outoutfoulspirit
.t insert end [ stuffit ]
}
proc castfortune {} {
global dx dy colors color gualisting
second_hexagram
set colorx black;
for {set i 0; set y 0} {$i<6} {incr i; incr y
$dy} {
set colorx brown;
for {set j 0; set x 0} {$j<3} {incr j; incr x
$dx} {
set colorx brown;
if { $j == 1} {
if { [lindex $gualisting $i ] == 6} {set
colorx tan}
if { [lindex $gualisting $i ] == 7} {set
colorx brown}
if { [lindex $gualisting $i ] == 8} {set
colorx tan}
if { [lindex $gualisting $i ] == 9} {set
colorx brown}
}
.cv create rectangle [expr {$x + 40}]
[expr {$y+50} ] [expr {$x+$dx+40}] [expr
{$y+$dy+50}]
-fill $colorx
}}
set dx 50
set dy 30
set colorx blue;
for {set i 0; set y 0} {$i<6} {incr i; incr y
$dy} {
set colorx blue;
for {set j 0; set x 0} {$j<3} {incr j; incr x
$dx} {
set colorx blue;
if { $j == 1} {
if { [lindex $second_hexagram $i ] == 6}
{set colorx tan}
if { [lindex $second_hexagram $i ] == 7}
{set colorx blue}
if { [lindex $second_hexagram $i ] == 8}
{set colorx tan}
if { [lindex $second_hexagram $i ] == 9}
{set colorx blue}
}
.cv create rectangle [expr {$x + 220}]
[expr {$y+50}] [expr {[expr {$x +220} ]+$dx}] [expr
{$y+$dy+50}]
-fill $colorx
}}
}
***FIRST VERSION***
#autoindent test from ased editor.
#:by gold, Chinese Fortune Casting
# written on Windowws XP on eTCL
# working under TCL version 8.5.6 and eTCL
1.0.1
# gold on TCL WIKI , 1Aug2011
package require Tk
global bookvalue bookvalue2
set colorground bisque
set wow "bone number"
proc K { x y } { set x }
proc shuffle5 { list } {
set n 1
set slist {}
foreach item $list {
set index [expr {int(rand()*$n)}]
set slist [linsert $slist $index $item]
incr n
}
return $slist
}
proc lremove {_list el} {
upvar 1 $_list list
set pos [lsearch -exact $list $el]
set list [lreplace $list $pos $pos]
}
proc pi {args} [subst -novariable {
expr [expr {atan2(0,-1)}] $args
}]
#wdb,usage [pi] [pi /4]
proc piesq {args} { set pie [pi] ; return [
expr sqrt($pie) ]}
proc geoseries1 {aa bb cc} { if {$bb <= -1||$bb >=
1} { return 0} ;return [ expr $aa / ( 1 - $bb ) ]};
proc box1 {aa bb } { set pie [pi] ;return [ expr
sqrt(($aa * $bb*4 )/ ($pie))]}
proc stuffit {} {
set nums {1 2 3 4 1 2 3 4 }
set numnum [lindex $nums [expr {int(rand() *
[llength $nums])}]]
lremove nums $numnum
append details " "
append details $numnum
append details " "
return $details
}
proc ? L {lindex $L [expr {int(rand()*[llength
$L])}]}
proc recipe {} {
set a {
{1} {2} {3}
{4} {5}
}
set b {
{1} {2}
{3}
{4} {5}
}
set c {1 2 3 4 5 6}
set d {
1 {2} 3v{4} 5 {6}
}
return " 1@ [? $a].
[? $b].
2@ [? $c].
3@ [? $d]."
}
proc ? L {
lindex $L [expr {int(rand()*[llength $L])}]
}
if 0 {This is used several times in:}
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 clrcanvas {w} {
global counter winner5
$w delete "all"
.zzz delete 0 end
.xxx delete 0 end
.t delete 1.0 end
set counter 0
set winner5 0
set loser5 0
}
proc run {w} {
global side1 side2 results
.t delete 1.0 end
.t insert 1.0 "run test5"
}
proc consol {w} {
console show
puts "Chinese Fortune Casting "
}
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
}
proc about {w} {
set msg "Chinese Fortune Casting.
from TCL WIKI,
written on eTCL
cmds take form
of tcl "
tk_messageBox -title "About" -message $msg
}
#: Main :
frame .f1
frame .f2
frame .f3
pack .f1 .f2 .f3
set maxX 400
set maxY 300
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
#set side2 2
button .b0 -text "Coin_Toss" -command {
bonereadxx 2;castfortune;}
button .b3 -text "Cast_Bones" -command
{bonereadxx 1 ;castfortune; }
button .b5 -text "clear" -command {clrcanvas
.cv; }
button .b6 -text "run script" -command {
run .cv}
button .b7 -text "clear" -command {
clrcanvas .cv; }
button .b4 -text "console" -command { consol
.cv; }
button .b8 -text "exit" -command {leave
.cv }
button .b9 -text "about" -command {about
.cv }
text .t -width 40 -height 5 -bg bisque
entry .xxx -width 50 -bg bisque -textvariable
side1
entry .zzz -width 50 -textvariable side2 -bg
bisque
pack .b0 .b3 .b5 .b6 .b7 .b7 .b4 .b9 .b8 -in
.f2 -side left -padx 2
.f2 configure -bg orange
label .kingx -text "entry language"
label .advisora -text "advisor"
pack .advisora .zzz .t .kingx .xxx -in .f3
-side bottom -padx 2
focus .xxx
focus .zzz
board .cv
bind . <Motion> {wm title . "Chinese Fortune
Casting "}
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
#end of deck
if {[file tail [info script]]==[file tail $argv0]} {
package require Tk
#pack [text .t5 -width 40 -height 5]
bind .t <1> {showRecipe %W; break}
proc showRecipe w {
$w delete 1.0 end
$w insert end [recipe]
}
showRecipe .t
}
set width 50
set height 50
set w ".can"
set x 100
set y 100
set dx 50
set dy 30
set colors {white black }
set color 0
proc lpick L {lindex $L [expr {int(rand()*[llength
$L])} ];}
# utilities
proc plainsub {text item replacewith} {
set text [string map [list $item $replacewith]
$text]
}
proc %+ {a } {return [string toupper $a]; #%+
tree >TREE }
proc %- {a } {return [string tolower $a]; #%+
Tree >tree }
proc %++ {a b} {return $a$b;#%+* tree root
>treeroot }
proc %-- {a b} {regsub $b $a "" a; return
$a;#%-- 5 7>5 }
proc %% {a b} {regsub -all $b $a "";#%% tree
root >tree }
proc %1 {a b} {regsub $b $a "" a; return $a;#%1
tree root>tree }
proc %2 {a b} {regsub $b $a "" a;regsub $b $a ""
a; return $a;#%2 tree root>tree }
proc %3 {a b} {regsub $b $a "" a;regsub $b $a
"" a;regsub $b $a "" a; return $a;#%3 tree
root>tree}
proc %2x {a} {return $a$a;#%2x tree>treetree}
proc %3x {a} {return $a$a$a;#%3x
tree>treetreetree}
proc %4x {a} {return "$a,$a,$a";#%5x
tree>tree,tree,tree }
proc %5x {a} {return "$a $a $a";#%5x
tree>tree tree tree }
proc repeat {n body} {while {$n} {incr n -1;
uplevel $body}}
proc random n {expr {round($n*rand())}}
proc whitelist {a} {return [lreplace $a 0 -
1];#take string,return list without blanks}
set k [split {abcdefghijklmnopqrstuvwxyz} {}]
proc average L {expr ([join $L +])/[llength
$L].}
proc srevert s {
set l [string length $s]
set res ""
while {$l} {append res [string index $s [incr l
-1]]}
set res
};# RS,
proc lreverse L {
set res {}
set i [llength $L]
#while {[incr i -1]>=0} {lappend res [lindex $L
$i]}
while {$i} {lappend res [lindex $L [incr i -1]]}
;# rmax
set res
} ;# RS, tuned 10% faster by [rmax]
proc sumoflist L {expr [join [split $L ""] +]
+0} ;# RS
proc convertbase2to10 {jip} {
set l [split $jip ""]
set t 0; set e 0;
foreach n $l {
set exp [ expr int(pow(2,$e))];
incr t [ expr $n * $exp ] ;
incr e;
}
return $t}
proc kvsearch {kvlist item} {
set pos [lsearch $kvlist $item]
if {$pos != -1} {
lindex $kvlist [expr {$pos+1-2*($pos%2)}]
}
} ;# RS
# end utilities
#start iching data
set bookvalue [ list 1 63 43 62 14 61 34
60 9 59 5 58 26 57 11 56 10 55 58 54 38
53 54 52 61 51 60 50 41 49 19 48 13 47 49
46 30 45 55 44 37 43 63 42 22 41 36 40
25 39 17 38 21 37 51 36 42 35 3 34 27
33 24 32 44 31 28 30 50 29 32 28 57 27
48 26 18 25 46 24 6 23 47 22 64 21 40
20 59 19 29 18 4 17 7 16 33 15 31 14 56
13 62 12 53 11 39 10 52 9 15 31 14 56 13
62 12 53 11 39 10 52 9 15 8 12 7 45 6
35 5 16 4 20 3 23 1 2 0 8 2 ]
set bookvalue2 [ list 9999 1 63 43 62 14 61
34 60 9 59 5 58 26 57 11 56 10 55 58 54
38 53 54 52 61 51 60 50 41 49 19 48 13 47
49 46 30 45 55 44 37 43 63 42 22 41 36
40 25 39 17 38 21 37 51 36 42 35 3 34
27 33 24 32 44 31 28 30 50 29 32 28 57
27 48 26 18 25 46 24 6 23 47 22 64 21
40 20 59 19 29 18 4 17 7 16 33 15 31 14
56 13 62 12 53 11 39 10 52 9 15 31 14 56
13 62 12 53 11 39 10 52 9 15 8 12 7 45
6 35 5 16 4 20 3 23 1 2 0 8 2 ]
if 0 { iching hexagrams and trigrams }
if 0 { Little API style database }
set chartbamboo { " list
" }
proc plainsub {text item replacewith} {
set text [string map [list $item $replacewith]
$text] }
foreach piece { + : \{ \} } {
set chartbamboo [ plainsub $chartbamboo $piece
"*" ]
}
set reading [ list [ split $chartbamboo " " ]]
#end iching data
proc binaryexchange {gualisting} {
# converts gualisting as a list
# to binary & decimal numbers.
global dx dy colors color
global guabinary guadecimal guatransform
set guabinary [ whitelist $gualisting ];
set guabinary [ join [ split $guabinary "
"]];
set guabinary [ plainsub $guabinary 6 0 ];
set guabinary [ plainsub $guabinary 7 1 ];
set guabinary [ plainsub $guabinary 8 0 ];
set guabinary [ plainsub $guabinary 9 1 ];
set guabinary [ plainsub $guabinary " " "" ];
return $guabinary;
}
proc second_hexagram_compute {gualisting } {
# subroutine under test
global bookvalue second_hexagram
#set gualisting [ lreverse $gualisting];
set second_hexagram [ list ];
set second_hexagram [ join $gualisting ] ;
set second_hexagram [ plainsub
$second_hexagram 6 7 ];
set second_hexagram [ plainsub
$second_hexagram 9 6 ];
set guabinary [ binaryexchange
$second_hexagram ];
set decimalout [ convertbase2to10 $guabinary
];
set bookgua [ kvsearch $bookvalue $decimalout
];
return $bookgua;
}
proc bonereadxx {coinsread} {
global dx dy colors color gualisting reading
global bookvalue bookvalue2 second_hexagram
set dj 1;
set gualisting [list ];
if { $coinsread == 1 } {
for {set j 0} {$j<6} {incr j $dj} {
set bone1 [lpick {3 3 3 2}]
set bone2 [lpick {3 3 2 2}]
set bone3 [lpick {3 3 2 2}]
set bonereading [expr $bone1 + $bone2 + $bone3
]
set wow [expr $bone1 + $bone2 + $bone3 ]
lappend gualisting $wow;
}
}
if { $coinsread == 2 } {
for {set j 0} {$j<6} {incr j $dj} {
set bone1 [lpick {3 3 2 2}]
set bone2 [lpick {3 3 2 2}]
set bone3 [lpick {3 3 2 2}]
set bonereading [expr $bone1 + $bone2 + $bone3
]
set wow [expr $bone1 + $bone2 + $bone3 ]
lappend gualisting $wow;
}
}
#set guabinary [ list 1 0 1 1 1 si tiene
problema ]
set gualisting [ lreverse $gualisting];
# reading hexagram lines top down,
# opposed to reverse(down top)
# give different binary values
#
set guabinary [ binaryexchange $gualisting ];
set decimalout [ convertbase2to10 $guabinary
];
set bookgua [ kvsearch $bookvalue2
$decimalout ];
set second_hexa [ second_hexagram_compute
$gualisting ];
.t delete 1.0 end;
set outoutfoulspirit " last bone is $wow .gua
listing is $gualisting && binary $guabinary &&
decimal $decimalout &&Iching_gua_# $bookgua && test
2nd hex. $second_hexagram && 2nd h. test
$second_hexa && $second_hexagram
$reading "
.t insert end $outoutfoulspirit
.t insert end [ stuffit ]
}
proc castfortune {} {
global dx dy colors color gualisting
second_hexagram
set colorx black;
for {set i 0; set y 0} {$i<6} {incr i; incr y
$dy} {
set colorx brown;
for {set j 0; set x 0} {$j<3} {incr j; incr x
$dx} {
set colorx brown;
if { $j == 1} {
if { [lindex $gualisting $i ] == 6} {set
colorx tan}
if { [lindex $gualisting $i ] == 7} {set
colorx brown}
if { [lindex $gualisting $i ] == 8} {set
colorx tan}
if { [lindex $gualisting $i ] == 9} {set
colorx brown}
}
.cv create rectangle [expr {$x + 40}]
[expr {$y+50} ] [expr {$x+$dx+40}] [expr
{$y+$dy+50}] \
-fill $colorx
}}
set dx 50
set dy 30
set colorx blue;
for {set i 0; set y 0} {$i<6} {incr i; incr y
$dy} {
set colorx blue;
for {set j 0; set x 0} {$j<3} {incr j; incr x
$dx} {
set colorx blue;
if { $j == 1} {
if { [lindex $second_hexagram $i ] == 6}
{set colorx tan}
if { [lindex $second_hexagram $i ] == 7}
{set colorx blue}
if { [lindex $second_hexagram $i ] == 8}
{set colorx tan}
if { [lindex $second_hexagram $i ] == 9}
{set colorx blue}
}
.cv create rectangle [expr {$x + 220}]
[expr {$y+50}] [expr {[expr {$x +220} ]+$dx}] [expr
{$y+$dy+50}] \
-fill $colorx
}}
}
*bonus console program*
#rank of indiv. "throws" over all "throws".
#pi mantissa used here
#autoindent test from ased editor.
console show
proc calculation { facen } {
# prob. subroutines for mimic sequence of bronze
# prob. is throw combos of eg. "7" over all possible throws
set lister [split {14159265358979323846} ""]
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
results for first 20 numbers of pi mantissa
1 0.1
2 0.1
3 0.15
4 0.1
5 0.15
6 0.1
7 0.05
8 0.1
9 0.15
results for small numbers of pi mantissa
1 0.0851063829787234
2 0.10638297872340426
3 0.1702127659574468
4 0.0851063829787234
5 0.0851063829787234
6 0.0851063829787234
7 0.0851063829787234
8 0.10638297872340426
9 0.1702127659574468
results for 100k numbers of pi mantissa
1 0.1000947923455181
2 0.09782372573414697
3 0.0989790074451488
4 0.09843592629895136
5 0.09899875585046508
6 0.09899875585046508
7 0.09898888164780693
8 0.09852479412287458
9 0.09777435472085629