Version 219 of Iching_Fortunes

Updated 2011-05-19 16:43:12 by gold

The Iching is the ancient fortune telling book of China. The Iching literature mentions various methods for casting fortune patterns of Iching. The various methods include hot ironing of turtle shells (-t.), manipulations of yarrow sticks, flipping coins, throwing shaman bones, and dice. One analogy from North America is a shaman throwing or shuffling stick dice.

I made three stick dice for Iching by cutting a dowel of square cross section into three sticks. For the three stick dice, the flat sides are marked or burned with 2 or 3 holes alternately. Two sticks are marked with {3 2 3 2} dots on the sides. One stick is marked with {3 3 3 2} dots on the sides. In casting such three dice, the possible sums are 6,7,8, or 9. Further, the stick dice are cast six times to obtain whole lines or broken lines in a pattern or set of six lines. A set of six Iching lines is called a gua in the orient or a hexagram in some translations of the Chinese.

In the Iching interpretations, casts of 6 and 8 are broken or yin (female) lines, while casts of 7 and 9 are whole or yang (male) lines. The casts are recorded by pencil with the first line at bottom and marking up the column. It is possible to record the numbers from the casts with tally sticks or Chinese counting rods, which are somewhat reminiscent of the Iching patterns themselves. After marking the original pattern or hexagram, sometimes a second follow-up hexagram is developed by swapping throws of 6 for a 7 and throws of 9 for a 6. These swaps effectively trade a broken line(6) for a whole line(7) and a whole line(9) for a broken line(6). The throws for the changing lines (6&9) may not always be come out in the first hexagram or its component lines, so the followup hexagram may not exist {under consistent rules}. If the first hexagram is interpreted on a line by line basis, any changing lines(6&9) or second hexagram offers some modification or discount on the interpretation of the first hexagram.

In developing a computer program or application, it is helpful to develop analogs for the individual tasks of the application. An Iching application would have to compose, beg, or borrow TCL procedures for random casts, tallies of scores, accounting files, display hexagram lines on a screen, swapping changing lines, hexagram pattern recognition and ranking interpretations. In fact, some TCL one liner procedures and text swapping routines might be useful as utilities in a starter application program, since unruly text strings are expected in the Iching. Casting the sticks or bones for each Iching line is analog for random lpick subroutine below. Adding the top sides of three sticks and throwing six times is analog for the "for 6 times" statement in the bonereadxx procedure below. In the West, Leibniz etc 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 TCL list of { 6,7,8,9,6,7 } could be expressed as a binary number, 010101. The binary numbers are the analogs for the binaryexchange subroutine below. For computer procedures, the patterns are effectively a horizontal bar code of 6 lines.

In the process of designing the basic subroutine tasks, we could throw in some switches, logic chains, or daisy chains that break the outset rules given above. For example, TCL is so good at swapping lines (6&9) for the second hexagram, that it would be easy to put a switch that generates or swaps all hexagram lines (6,7,8,&9) for their opposites. Also from some scripts of the Chinese Chou dynasty, different Iching fortune methods of yarrow sticks or coins would generate different probabilities of obtaining each hexagram line. Might be interesting to have a back door in the program to check (or adapt} the different probabilities of stick or coin throws. Several authors have pointed out that a few of the hexagrams look similar to Chinese characters or even Mayan calendar notation. Without wading too deep into alternate realities, the Iching hexagrams could be used as numerals, script alphabet, game tokens, symbol recognition code, or maybe a programming language (like Greek letters for APL operators). Such rule breaking helps keep the finished program more flexible.

 #!/usr/bin/env wish
 #start of deck
 #Iching_Fortunes
 # or Itching For Tunes [%>}
 # 6Feb2007, [gold]
 # working on XP starter code
 # top browser is written for windows
 # and should open file in notepad,
 # on left mouse click.
 
 #!/usr/bin/env wish
 #start of deck
 #Iching_Fortunes
 # or Itching For Tunes [%>}
 # 6Feb2007, [gold]
 # working on XP starter code
 # top browser is written for windows
 # and should open file in notepad,
 # on left mouse click.
 package require Tk
 global bookvalue bookvalue2
 set colorground bisque
 set wow "bone number"
 proc xlistlistbox {} {
     .labellabel delete 0 end
     foreach filefile [glob .* *] {
        if [file isdirectory $filefile] {
            set filefile "$filefile/"
        }
        .labellabel insert end $filefile;
     }
 }
 proc xskipskipdirectory {dir} {
     cd $dir
    .realcommand configure -text [pwd]
    xlistlistbox
 }
 proc clickclicklistbox {} {
   catch { set index [lindex [.labellabel curselection] 0] }   

   if { $index == "" } { return }

  set filename [.labellabel get $index]   

    if [file isdirectory $filename] {
        xskipskipdirectory $filename
    } else {
        #exec xedit $file &
        # windows editor
        exec notepad $filename}}

 wm title . "File Starter"
 frame .labelframe
 pack .labelframe -expand no -fill x
 label .labellabel1 -text "Directory:"
 label .realcommand -text "" \
    -relief groove
 pack .labellabel1 -in .labelframe \
    -side left -expand no -fill x
 pack .realcommand -in .labelframe \
    -side left -expand yes -fill x -anchor w
 frame .listlistbox
 pack .listlistbox -expand yes -fill both
 listbox .labellabel \
    -width 25 -height 3 \
    -xscrollcommand ".xxxxaxis set" \
    -yscrollcommand ".yyyyaxis set" \
    -bg $colorground
     scrollbar .yyyyaxis \
    -command ".labellabel yview" \
    -orient v
     scrollbar .xxxxaxis \
    -command ".labellabel xview" \
    -orient h
 pack .xxxxaxis -in .listlistbox -side bottom  -fill x    -expand no
 pack .yyyyaxis -in .listlistbox -side right   -fill y    -expand no
 pack .labellabel  -in .listlistbox -side top     -fill both -expand yes
 frame .buttonbuttonx
 pack .buttonbuttonx -fill x
 button .caster -text Cast_Bones -command {bonereadxx 1 ;castfortune;}
 button .coinster -text Coin_Toss -command {bonereadxx 2;castfortune;}

 button .done -text Exit -command exit
 pack .caster .coinster .done -in .buttonbuttonx \
    -side top -fill x
 bind .labellabel <Double-1> clickclicklistbox

   pack  [ label .ww -text "Iching holding tank " -bg $colorground]
   pack [ text .wxxccc -width 80 -height 3 -bg beige ]

   focus .wxxccc           ;# allow keyboard input

   .wxxccc insert end  "xxx starter xxx  ";

 scrollbar .scr -orient vertical -command ".can yview"
 canvas .can -yscrollcommand ".scr set" -width 240 -bg $colorground

 pack .can -fill both -expand 1 -side left
 pack .scr -fill y -expand 0 -side left

 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
 #suchenwirth_subroutine;}
 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
 + hexagram_1 : pinyin Qian wade Ch'ien english {The Creative }
 + hexagram_2 : pinyin Kun wade  K'un english {The Receptive}
 + hexagram_3 : pinyin Zhun wade Chun english { Difficulty at the Beginning  }
 + hexagram_4 : pinyin Meng wade Mêng english {Youthful Folly }
 + hexagram_5 : pinyin Xu wade Hsü english {Waiting  }
 + hexagram_6 : pinyin  Song wade Sung english {Conflict }
 + hexagram_7 : pinyin  Shi wade Shih english {The Army }
 + hexagram_8 : pinyin  Bi wade Pi english {Holding Together}
 + hexagram_9 : pinyin  Xiaoxu wade Hsiao Ch'u english {The Taming Power of the Small}
 + hexagram_10 : pinyin Lü wade Lü english {Treading}
 + hexagram_11 : pinyin Tai wade T'ai english {Peace }
 + hexagram_12 : pinyin Pi wade P'i english {Standstill  }
 + hexagram_13 : pinyin Tongren wade {T'ung Jên} english {Fellowship with Men }
 + hexagram_14 : pinyin Dayou wade { Ta Yu } english {Possession in Great Measure }
 + hexagram_15 : pinyin Qian wade Ch'ien english {Modesty  }
 + hexagram_16 : pinyin Yu wade Yü english {Enthusiasm }
 + hexagram_17 : pinyin Sui wade Sui english {Following }
 + hexagram_18 : pinyin Gu wade Ku english {Work on What Has Been Spoiled  }
 + hexagram_19 : pinyin Lin wade Lin english {Approach  }
 + hexagram_20 : pinyin Guan wade Kuan english {Contemplation  }
 + hexagram_21 : pinyin Shike wade {Shih Ho } english {Biting Through  }
 + hexagram_22 : pinyin Bi wade Pi english {Grace }
 + hexagram_23 : pinyin Bo wade Po english {Splitting Apart }
 + hexagram_24 : pinyin Fu wade Fu english {Return  }
 + hexagram_25 : pinyin Wuwang wade { Wu Wang }english {Innocence }
 + hexagram_26 : pinyin Daxu wade { Ta Ch'u } english {The Taming Power of the Great }
 + hexagram_27 : pinyin Yi wade I english {The Corners of the Mouth }
 + hexagram_28 : pinyin Daguo wade { Ta Kuo } english {Preponderance of the Great }
 + hexagram_29 : pinyin Kan wade K'an english {The Abysmal }
 + hexagram_30 : pinyin Li wade Li english {The Clinging }
 + hexagram_31 : pinyin Xian wade  Hsien english {Influence }
 + hexagram_32 : pinyin Heng wade  Hêng english {Duration}
 + hexagram_33 : pinyin Dun  wade  Tun english {Retreat }
 + hexagram_34 : pinyin Dazhuang wade { Ta Chuang } english {The Power of the Great }
 + hexagram_35 : pinyin Jin wade Chin english {Progress}
 + hexagram_36 : pinyin Mingyi wade { Ming I } english {Darkening of the Light }
 + hexagram_37 : pinyin Jiaren wade Chia Jên english { The Family}
 + hexagram_38 : pinyin Kui wade K'uei english {Opposition  }
 + hexagram_39 : pinyin Jian wade Chien english {Obstruction}
 + hexagram_40 : pinyin  Xie wade Hsieh english {Deliverance}
 + hexagram_41 : pinyin Sun  wade Sun english {Decrease }
 + hexagram_42 : pinyin Yi  wade I english {Increase }
 + hexagram_43 : pinyin Guai wade Kuai english {Break-through}
 + hexagram_44 : pinyin Gou wade Kou english {Coming to Meet}
 + hexagram_45 : pinyin Cui wade Ts'ui english {Gathering Together  }
 + hexagram_46 : pinyin Sheng wade Shêng english {Pushing Upward }
 + hexagram_47 : pinyin Kun wade K'un english {Oppression  }
 + hexagram_48 : pinyin Jing wade Ching english {The Well }
 + hexagram_49 : pinyin Ge wade Ko english {Revolution}
 + hexagram_50 : pinyin Ding wade Ting english {The Caldron }
 + hexagram_51 : pinyin Zhen wade Chên english {The Arousing  }
 + hexagram_52 : pinyin Gen wade Kên english {Keeping Still }
 + hexagram_53 : pinyin Jian wade Chien english {Development }
 + hexagram_54 : pinyin Guimei wade {Kuei Mei} english {The Marrying Maiden }
 + hexagram_55 : pinyin Feng wade Fêng english {Abundance }
 + hexagram_56 : pinyin Lü wade Lü english {The Wanderer }
 + hexagram_57 : pinyin Xun wade Sun english {The Gentle }
 + hexagram_58 : pinyin Dui wade Tui english {The Joyous }
 + hexagram_59 : pinyin Huan wade Huan english { Dispersion }
 + hexagram_60 : pinyin Jie wade Chieh english {Limitation }
 + hexagram_61 : pinyin Zhongfu wade {Chung Fu} english {InnerTruth }
 + hexagram_62 : pinyin Xiaoguo wade { Hsiao Kuo} english {Preponderance of the Small }
 + hexagram_63 : pinyin Jiji wade { Chi Chi } english {After Completion}
 + hexagram_64 : pinyin Weiji wade { Wei Chi } english {Before Completion }
 "  }
     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 ];
      .wxxccc 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 "

     .wxxccc insert end $outoutfoulspirit      }


 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 white}

         if { [lindex $gualisting $i ] == 7} {set colorx brown}
         if { [lindex $gualisting $i ] == 8} {set colorx white}
         if { [lindex $gualisting $i ] == 9} {set colorx brown}
         }

          .can create rectangle $x $y [expr {$x+$dx}] [expr {$y+$dy}] \
            -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 white}

         if { [lindex $second_hexagram $i ] == 7} {set colorx blue}
         if { [lindex $second_hexagram $i ] == 8} {set colorx white}
         if { [lindex $second_hexagram $i ] == 9} {set colorx blue}
         }

          .can create rectangle [expr $x + 180] $y [expr {[expr $x +180 ]+$dx}] [expr {$y+$dy}] \
            -fill $colorx

          }}

     }

 xskipskipdirectory $env(HOME)

Screenshots Section

http://img175.imageshack.us/img175/5109/ichinggenerator5ab5.jpg http://farm5.static.flickr.com/4136/4812522943_33727ff8ec.jpg http://farm5.static.flickr.com/4114/4812413403_e697523a46.jpg

Comments Section

Please place any comments here, Thanks.

gold Change:Redundant procedure ? deleted.

LV slightly reformatted code to some level of consistency, added a few braces around expr arguments, and removed a redundant proc definition.

gold Change 13Mar2007:omitted **(exp) in expr for base2, TCL8.5&>.

CJL thinks that following the guidelines [L1 ] would make this page much more readable, and give browsers a chance to flow the formatting

gold Change 17Mar2007. Pan feature in Kaching.tcl is sticking badly. Temporary fix for pan, touch right mouse, then use middle mouse to pan.

References:

Random Divination ( non-Iching)

Programming References ( TCL & C# )

Appendix Tables

 if 0 { iching hexagrams and trigrams }
1. Qian Ch'ien, The Creative
2. Kun K'un, The Receptive
3. Zhun Chun, Difficulty at the Beginning
4. Meng Mêng, Youthful Folly
5. Xu Hsü, Waiting
6. Song Sung, Conflict
7. Shi Shih, The Army
8. Bi Pi, Holding Together
9. Xiaoxu Hsiao Ch'u, The Taming Power of the Small
10. Lü Lü, Treading
11. Tai T'ai, Peace
12. Pi P'i, Standstill
13. Tongren T'ung Jên, Fellowship with Men
14. Dayou Ta Yu, Possession in Great Measure
15. Qian Ch'ien, Modesty
16. Yu Yü, Enthusiasm
17. Sui Sui, Following
18. Gu Ku, Work on What Has Been Spoiled
19. Lin Lin, Approach
20. Guan Kuan, Contemplation
21. Shike Shih Ho, Biting Through
22. Bi Pi, Grace
23. Bo Po, Splitting Apart
24. Fu Fu, Return
25. Wuwang Wu Wang, Innocence
26. Daxu Ta Ch'u, The Taming Power of the Great
27. Yi I, The Corners of the Mouth
28. Daguo Ta Kuo, Preponderance of the Great
29. Kan K'an, The Abysmal
30. Li Li, The Clinging
31. Xian Hsien, Influence
32. Heng Hêng, Duration
33. Dun Tun, Retreat
34. Dazhuang Ta Chuang, The Power of the Great
35. Jin Chin, Progress
36. Mingyi Ming I, Darkening of the Light
37. Jiaren Chia Jên, The Family
38. Kui K'uei, Opposition
39. Jian Chien, Obstruction
40. Xie Hsieh, Deliverance
41. Sun Sun, Decrease
42. Yi I, Increase
43. Guai Kuai, Break-through
44. Gou Kou, Coming to Meet
45. Cui Ts'ui, Gathering Together
46. Sheng Shêng, Pushing Upward
47. Kun K'un, Oppression
48. Jing Ching, The Well
49. Ge Ko, Revolution
50. Ding Ting, The Caldron
51. Zhen Chên, The Arousing
52. Gen Kên, Keeping Still
53. Jian Chien, Development
54. Guimei Kuei Mei, The Marrying Maiden
55. Feng Fêng, Abundance
56. Lü Lü, The Wanderer
57. Xun Sun, The Gentle
58. Dui Tui, The Joyous
59. Huan Huan, Dispersion
60. Jie Chieh, Limitation
61. Zhongfu Chung Fu, Inner Truth
62. Xiaoguo Hsiao Kuo, Preponderance of the Small
63. Jiji Chi Chi, After Completion
64. Weiji Wei Chi, Before Completion

The names of the trigrams

I Ching Trigram Name Translations
Pinyin Wade-Giles (Wilhelm/Baynes) associations
1. Qian Ch'ien the creative, heaven, Father,northwest,head,lungs
2. Kun K'un the receptive,earth,Mother,southwest,abdomen,reproductive_organs
3. Zhen Chên the arousing, thunder,Eldest_Son,east,throat
4. Kan K'an the abysmal,water,Middle_Son,north,liver,kidneys,inner_ear
5. Gen Kên keeping still, mountain,Youngest_Son,northeast,hands,spine,bones
6. Xun Sun the gentle, wind, Eldest Daughter,southeast,hips,buttocks
7. Li Li the clinging, flame,Middle_Daughter,south,eyes,heart
8. Dui Tui the joyous, lake,Youngest_Daughter,west,mouth }

appendix TCL program

  #!/usr/bin/wish
     # Ka_ching.tcl , test for random binary numbers scheme,
     # goldshell7 ,14Mar2007, working on XP at TCL wiki
     #!/usr/bin/wish
     # Ka_ching.tcl , test for random binary numbers scheme,
     # goldshell7 ,14Mar2007, working on XP at TCL wiki
   #Used drawing tool by suchenwirth as starter code
   # added colors and report text windows.
       global count
       set count 0;
       proc whitelist {a} {return [lreplace $a 0 -1];#take string,return list without blanks}
       proc plainsub {text item replacewith} {
     set text [string map [list $item $replacewith] $text]
      }
   proc radio {w var values {col 0}} {
   frame $w
   set type [expr {$col? "-background" : "-text"}]
   foreach value $values {
       radiobutton $w.v$value $type $value -variable $var -value $value \
        -indicatoron 0
       if $col {$w.v$value config -selectcolor $value -borderwidth 3}
   }
   eval pack [winfo children $w] -side left
   set ::$var [lindex $values 0]
   set w
    }

    proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \
    #suchenwirth_subroutine;}
    proc stringxxx s {
       #suchenwirth_subroutine;
       set res {}
      foreach line [split $s \n] {
         for {set i 0} {$i<[string length $line]} {incr i} {
            if {$i==[string wordstart $line $i]} {
               set w [string range $line $i [expr {[string wordend $line $i]-1}]]
               #if {$w!=" "} {lappend res $w}
               #if {$w!=" " && $w!="\{" && $w!="\}"} {lappend res $w}
               if {$w!=" " && $w!="\{" && $w!="\}" && $w!="\," && $w!="\\" && $w!="\/"} {lappend res $w}
               #if {$w!="\}"} {lappend res $w}
               #if {$w!="\{"} {lappend res $w}
               incr i [expr {[string length $w]-1}];

               # always loop incr
            }
         }
      }
      set res

   }

   proc down(Draw) {w x y} {
   set ::ID [$w create line $x $y $x $y -fill $::Fill]
   }
   proc move(Draw) {w x y} {
   $w coords $::ID [concat [$w coords $::ID] $x $y]
   }

   #-- Movement of an item
   proc down(Move) {w x y} {
   set ::ID [$w find withtag current]
   set ::X $x; set ::Y $y
   }
   proc move(Move) {w x y} {
   $w move $::ID [expr {$x-$::X}] [expr {$y-$::Y}]
   set ::X $x; set ::Y $y
   }

   #-- Clone an existing item
   proc serializeCanvasItem {c item} {
   set data [concat [$c type $item] [$c coords $item]]
   foreach opt [$c itemconfigure $item] {
       # Include any configuration that deviates from the default
       if {[lindex $opt end] != [lindex $opt end-1]} {
           lappend data [lindex $opt 0] [lindex $opt end]
           }
       }
   return $data
   }
   proc down(Clone) {w x y} {
   set current [$w find withtag current]
   if {[string length $current] > 0} {
       set itemData [serializeCanvasItem $w [$w find withtag current]]
       set ::ID [eval $w create $itemData]
       set ::X $x; set ::Y $y
      }
     }
        interp alias {} move(Clone) {} move(Move)

     #-- Drawing a rectangle
    proc down(Rect) {w x y} {
   set ::ID [$w create rect $x $y $x $y -fill $::Fill]
   }
    proc move(Rect) {w x y} {
   $w coords $::ID [lreplace [$w coords $::ID] 2 3 $x $y]
   }

    #-- Drawing an oval (or circle, if you're careful)
    proc down(Oval) {w x y} {
   set ::ID [$w create oval $x $y $x $y -fill $::Fill]
    }
    proc move(Oval) {w x y} {
   $w coords $::ID [lreplace [$w coords $::ID] 2 3 $x $y]
    }

   proc down(Poly) {w x y} {
   if [info exists ::Poly] {
       set coords [$w coords $::Poly]
       foreach {x0 y0} $coords break
       if {hypot($y-$y0,$x-$x0)<10} {
           $w delete $::Poly
           $w create poly [lrange $coords 2 end] -fill $::Fill
           unset ::Poly
       } else {
           $w coords $::Poly [concat $coords $x $y]
       }
   } else {
       set ::Poly [$w create line $x $y $x $y -fill $::Fill]
   }
   }
   
    proc down(canvas) {w x y} {global colorground; set colorground $::Fill; \
      .c configure -bg $colorground}
     proc move(canvas) {w x y} {}
   proc down(circle) {w x y} {
      set tile  [expr {int(rand()*1000000000.)}]
      set poof  "oval" ;
      set tagx [list $poof mv "obj_$tile" "colorit_$::Fill"  d-$x$y];
      set dx 50
      set dy 50

     set ::ID [$w create oval [expr {$x+2}] [expr {$y+2}] [expr {$x+$dx-3}] [expr {$y+$dy-3}]  -tags $tagx -fill $::Fill]
      }
   proc move(circle) {w x y} {
     #$w coords $::ID [lreplace [$w coords $::ID] 2 3 $x $y]
   }

   proc ? L {
   lindex $L [expr {int(rand()*[llength $L])}]
   #suchenwirth_subroutine;
   }
    proc move(Poly) {w x y} {#nothing}
    proc down(clear) {w x y} {
    global helpx
    $w delete "all";
    set helpx 0;
   }
     #-- With little more coding, the Fill mode allows changing an item's fill color:
    proc down(Fill) {w x y} {$w itemconfig current -fill $::Fill}
    proc move(Fill) {w x y} {}
  # touch right mouse, then use middle mouse to pan;
  proc down(pan) {w x y} {}
    proc move(pan) {w x y} {}

    #-- Building the UI
    set modes {Draw Move Clone Fill Rect Oval Poly  exit}
   set modez {canvas circle metal weave pan help binary clear  }
   set colors {
   black white magenta brown red orange yellow green green3 green4
   cyan blue blue4 purple
      }
       set colorz {black brown2 LightGoldenrod1 LightGoldenrod2
       LightGoldenrod3 LightGoldenrod4
      LightYellow2 LightYellow3 LightYellow4 yellow2 yellow3 yellow4
      gold2 gold3 gold4 goldenrod1 goldenrod2 goldenrod3 goldenrod4
      DarkGoldenrod1 DarkGoldenrod2 DarkGoldenrod3
      orange3 orange4 DarkOrange1 DarkOrange2 DarkOrange3 DarkOrange4
      coral1 coral2 coral3 coral4 tomato2 tomato3 tomato4 OrangeRed2
      OrangeRed3 OrangeRed4 red2 red3 red4 DeepPink2 DeepPink3 DeepPink4
      HotPink1 HotPink2 HotPink3 HotPink4 pink1 pink2
   }
      set colorx { blue4 AntiqueWhite3 \
      Bisque1 Bisque2 Bisque3  Bisque4 \
      SlateBlue3 RoyalBlue1 SteelBlue2 \
      DeepSkyBlue3  LightBlue1 DarkSlateGray1 \
      Aquamarine2 DarkSeaGreen2 SeaGreen1 Bisque \
             Yellow1 IndianRed1 IndianRed2 Tan1 \
      lemonchiffon  seashell honeydew mintcream azure \
       peachpuff navajowhite moccasin cornsilk \
       IndianRed3 IndianRed4 sienna1 sienna2 sienna3 sienna4 burlywood1 \
      burlywood2 burlywood3 burlywood4 wheat1 wheat2 wheat3 wheat4 \
      tan2 tan4 chocolate1 chocolate2 chocolate3 firebrick1 firebrick2 \
      firebrick3 firebrick4 \
      }
    global liner
     global ind
     set ind 0
    global   movesit
    set  movesit 1
    set helpx 0
      set loaderx 0
     global xhistory firstnode curnode
    set curnode ""
    set firstnode ""
    set xhistory [list aaa bbb ccc ddd eee fff ggg ]
    set colorground bisque
    global selected_tile previous_tile
    set selected_tile "selected tile";
    set previous_tile "previous tile";
     global counter
     global liner
     global ind
     set ind 0
     set liner [list a b c d e f g ]

     global entries
     set counter 0
     grid [radio .1 Mode $modes]   -sticky nw
     grid [radio .2 Mode $modez ]  -sticky nw

   grid [radio .3 Fill $colors 1]  -sticky nw

   grid [radio .4 Fill $colorx 2] -sticky nw
   grid [radio .5 Fill $colorz 3] -sticky nw
   grid [canvas .c -relief raised -borderwidth 1] - -sticky news

   grid rowconfig . 0 -weight 0
   grid rowconfig . 1 -weight 1
   grid rowconfig . 3 -weight 2
   grid rowconfig . 4 -weight 3
   grid rowconfig . 5 -weight 3
   grid [ label .wcc -text "list of selection history " ]
   grid [entry .wxxccc -textvar e -just left -bg beige -width 50]
   #.wxxccc insert end  "$liner"
   set wow [.c find withtag current];
   .wxxccc insert end  "xxx starter xxx $wow xxx"
   focus .wxxccc           ;# allow keyboard input
   set labelx  [info tclversion];
   grid [ label .ww -text "holding tank, version $labelx " ]
   set txt [text .wxx -width 20 -height 3 -bg beige]
   grid  $txt -sticky news
   focus .wxx           ;# allow keyboard input
   set wow [.c find withtag current];
   .wxx insert end  "xxx starter xxx $wow xxx ";

   #-- The current mode is retrieved at runtime from the global Mode variable:
    bind .c <1> {set firstnode [.c find withtag current];
    initialize %W %x %y ;down($Mode) %W %x %y}
      bind .c <B1-Motion> {move($Mode) %W %x %y}
      bind .c <2>         {%W delete current}
      bind .c <3> {bind .c <2> [bind Text <2>]
      bind .c <B2-Motion> [bind Text <B2-Motion>]
      }
       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 0 0 ];
       set guabinary [ plainsub $guabinary 1 0 ];
       set guabinary [ plainsub $guabinary 2 0 ];
       set guabinary [ plainsub $guabinary 3 1 ];
       set guabinary [ plainsub $guabinary 4 0 ];
       set guabinary [ plainsub $guabinary 5 1 ];
       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 iching {} {
   .wxx insert 1.0 ""
   set tile  [ expr {int(rand()*1000000000.)}]
   set tile  [ binaryexchange $tile ]
   #set quote [lpick {1 2 3 4 5 6 7 8 9}]
   set binaryfill $tile;
   .wxx insert 1.0 "$binaryfill \n\n\n"
    }
     proc down(binary) {w x y} {
     iching
     }

     proc down(exit) {w x y} {
     exit
     }
       proc helptext {stringxxx} {
       set text_texas {
     # Ka_ching.tcl , test for random binary numbers scheme,
     # goldshell7 ,14Mar2007, working on XP at TCL wiki
     #Used drawing tool by suchenwirth as starter code
     # added colors and report text windows.
       # Tried to note which Suchenwirth subroutines
       # were mostly unchanged.
       #The Iching is the ancient fortune telling
       #book of China. The Iching literature mentions
       #various methods for casting fortune patterns
       #of Iching. The various methods include
       #hot ironing of turtle shells (-t.),
       #manipulations of yarrow sticks, flipping coins,
       #throwing shaman bones, and dice.
       #One analogy from North America
       #is a shaman throwing or
       #shuffling stick dice.

       #I made three stick dice for
       #Iching by cutting a dowel of square cross section
       #into three sticks.
       #For the three stick dice, the flat sides are marked or
       #burned with 2 or 3 holes alternately.
       #Two sticks are marked
       #with {3 2 3 2} dots on the sides. One stick is marked
       #with {3 3 3 2} dots on the sides.
       #In casting such three dice,
       #the possible sums are 6,7,8, or 9. Further, the
       #stick dice are cast six times to obtain whole lines
       #or broken lines in a pattern or set of six lines.
       #A set of six Iching lines is called a gua
       #in the orient or a hexagram in some translations
       #of the Chinese.
       }
       return $text_texas;}
      proc reset {w} {
      global goldmine;
       global loaderx 0;
      upvar 1 .wxx .wxx;
      upvar 1 .wxxccc .wxxccc;
     .wxxccc insert 1 " reset screen  on left mouse & touch screen";
     set gold [list];
     set loaderx 1;
      set helpa  [list reset processing may take considerable time ];

 set helpb  [list reset, processing of holding tank, ];
 lappend helpa $helpb;
 global helpx
 #$w delete .wxxccc;
  set innn 1;
 .wxxccc insert end  $helpa;
 set goldmine [.wxx get 1.0 end] ;

 set goldmine [ string tolower $goldmine ] ;
   set goldmine [ split $goldmine ] ;
    set goldmine [ luniq  $goldmine ] ;
   set res {}
    foreach {a } $goldmine {
 set rook [string length $a] ;
    if {$rook > 3} {lappend res $a}}
 set goldmine $res
    set res {}
    foreach {a } $goldmine {
 set rook [string length $a] ;
   if {$rook > 3} {lappend res [? $goldmine]}}

    set goldmine [ lappend $helpa $res];
    set goldmine [plainsub $goldmine # ""];
    set goldmine [plainsub $goldmine \) ""];
    set goldmine [plainsub $goldmine \( ""];
    set goldmine [plainsub $goldmine \} ""];
    set goldmine [plainsub $goldmine \{ ""];

    set goldmine [stringxxx $goldmine ];
     set goldmine [ luniq  $goldmine ] ;
     printstuff $goldmine ;

     #set goldmine [ smoothxxx $goldmine ] ;
 }
      proc printstuff { bigstring } {
      set i 0;
      foreach {a b} $bigstring {

       puts stdout "      $a $b                               #$i   \n

     ";
      incr i;
      }

       }
  proc down(weave) {w x y} {
     global count
     set xwidth 200;
     set xheight 200;
   .wxxccc insert 1 " weave  processing time substantial ";
    if  { $count  == 0 } {
    .wxxccc insert 1 " weave 1 processing time substantial ";

    colorweave  w x y $xwidth $xheight 1 }

       if  { $count  == 1 } {
     .wxxccc insert 1 " weave style 10  processing time substantial ";

 colorweave  w x y $xwidth $xheight 5  }

    if {$count == 2 } {
   .wxxccc insert 1 " weave style 3 on left mouse & touch screen "

 colorweave  w x y $xwidth $xheight 2   }
   if { $count == 3 } {

  .wxxccc insert 1 " weave style 4   on left mouse & touch screen "
    colorweave  w x y $xwidth $xheight 1 }
  if { $count == 4 } {

     .wxxccc insert 1 " weave style 5   on left mouse & touch screen "
    colorweave  w x y $xwidth $xheight 3 }
 incr count 1;
    if { $count == 5 } {
 set count 0}

 }

    proc move(weave) {w x y} {}
    proc stringinsert {string pos char} {
    set original [string index $string $pos]
    string replace $string $pos $pos $char$original
 } ;# RS
    proc colortalk { w x y $width $height colorgroundx } {
    global colorvalue1 colorvalue2
    global rbg1 rbg2 colorvalue1 colorvalue2
    global colorground
     upvar 1 .wxx .wxx;
     upvar 1 .wxxccc .wxxccc;

         set n [catch {winfo rgb . $::Fill} rgb];
          if {$n} continue;
          # Convert to HSV and get the V value to determine fill color;
          set colorvalue1 [lindex [lsort -integer $rgb] end];
          set colorvalue1 [expr {$colorvalue1 / double(65535)}];
          set rgb2 [eval format #%04X%04X%04X [winfo rgb . $::Fill]];
          set n [catch {winfo rgb . $colorground} rgb];

          set colorvalue2 [lindex [lsort -integer $rgb] end];
          set colorvalue2 [expr {$colorvalue2 / double(65535)}];
          set rgb3 [eval format #%04X%04X%04X [winfo rgb . $colorground]];

        set rgb3 [eval format #%04X%04X%04X [winfo rgb . $colorground]];
        .wxxccc insert end " canvas_color 33 $colorground \( rgb $rgb3 \) $colorvalue2 pen_color $::Fill $colorvalue1 $::Fill \(rgb $rgb2 \) \n";

    .wxx insert end " canvas_color 22 $colorground \( rgb $rgb3 \) $colorvalue2   pen_color  $::Fill  $colorvalue1 $::Fill \(rgb $rgb2  \) \n";
     set colorvalue1 [expr { int ($colorvalue1 * 100000)} ] ;
     set rgb5 [winfo rgb . $colorground];
     set colorvalue5 [lindex [lsort -integer $rgb5] end];
    .wxx insert end " test metal_colors  44 $colorground    $rgb5 $colorvalue5 \n";
      #[lpick [list "\#054505" "\#058505" "\#057505"]]  return "\#054505";

}

   # set testererer [ colortalk w x y $width $height $colorground  ];

   proc  colorweave { w x y width height rownumber} {
 set width   400
      set height  200
  global colorground
  .wxxccc insert 1 " metal > processing time substantial ";
     upvar 1 .wxx .wxx;
  .wxxccc insert 1 " create metal background on left mouse & screen touch  ";
     set testererer 45000;
   set testererer [ colortalk w x y $width $height $colorground  ];
    for {set row 0} {$row < $height} {incr row $rownumber} {
      # set line_color [expr {450000+int(1000000*rand())%3000}];
      set line_color [expr { int(45000 ) +int(1000000*rand())%3000}];
     if { $rownumber > 3 } { set line_color [expr { int(500 ) +int(1000000*rand())%3000}];}
    set testererer [winfo rgb . $colorground];
    set rgb3 [eval format #%04X%04X%04X [winfo rgb . $colorground]];
            #"\#057505";#099999957505
     set n [catch {winfo rgb . $colorground} rgb];

    if {$n} continue;
          # Convert to HSV and get the V value to determine fill color;
          set colorvalue1 [lindex [lsort -integer $rgb] end];
          set colorvalue1 [expr {$colorvalue1 / double(65535)}];
          set rgb2 [eval format #%04X%04X%04X [winfo rgb . $::Fill]];
          set n [catch {winfo rgb . $colorground} rgb];
   #.wxx insert end "  special test metal background $testererer real n $n \n"
   set testa  [split [winfo rgb . $::Fill ]];
  set testr [join [split [winfo rgb . $::Fill ]]];
  #.wxx insert end "  special test metal background $testa   \n"
 set test1 [ stringinsert $testr 2 "99" ];
 set test2 [ stringinsert $testr 2 "88" ];
 set test3 [ stringinsert $testr 2 "77" ];
 set testi [ concat $test1 $test2 $test3 ];
 set testi [ stringinsert $test1 2 "" ];
 set testi "\#654535";
 catch {set testi [eval format #%04X%04X%04X [winfo rgb . $::Fill]];}
 set test1 [ stringinsert $testi 12 "9" ];
 set test2 [ stringinsert $testi 8 "8" ];
 set test3 [ stringinsert $testi 4 "7" ];
 set test4 $testi;
 set xlength [string length $testi];
 set xlength [expr { $xlength - 1 }];
 set test1 [ string range   $test1  0  $xlength  ];
 set test2 [ string range   $test2  0  $xlength  ];
 set test3 [ string range   $test3  0  $xlength  ];
  #.wxx insert end "  special test metal background $testererer  \n"
       .c create line 0 $row $width $row -width 1 \
         -fill [ lpick [list $test1 $test2 $test3 $test4]]
   #  \#654545

      }
      }
     proc down(help) {w x y} {
      set tile  [expr {int(rand()*1000000000.)}]
      set poof  "help" ;
      global helpx
     if {$helpx > 0} {return}
      set tagx [list $poof mv "obj_$tile" "colorit_$::Fill"  d-$x$y];
     set base "help";
     set helpx 0;
     set baseline [helptext $base];
     #if {![info exists L]} {set L {}}
     set ::ID [$w create text $x  $y  -text $baseline -tags $tagx -fill $::Fill ]
     set helpx 1;

   }
   proc move(help) {w x y} {}
  proc down(metal) {w x y} {
     set xwidth 200;
     set xheight 200;
 heavymetal  w x y $xwidth $xheight
  make_gradient $w 50 50
    make_gradient $w 30 15
    make_gradient $w 15 15 }
   proc move(metal) {w x y} {}
   proc down(metal) {w x y} {
     set xwidth 200;
     set xheight 200;
 heavymetal  w x y $xwidth $xheight
  make_gradient $w 50 50
    make_gradient $w 30 15
    make_gradient $w 15 15 }

    proc heavymetal { w x y width height } {
 set width   400
      set height  200
  .wxxccc insert 1 " metal processing substantial ";
          for {set row 0} {$row < $height} {incr row 1} {
          set line_color [expr {45000+int(1000000*rand())%3000}]
          .c create line 0 $row $width $row -width 1 \
                  -fill [format "#%04x%04x%04x" \
                  $line_color $line_color $line_color]
      }
      }

    proc make_gradient { canvas N M } {
    set width [$canvas cget -width]
    set height [$canvas cget -height]

    set dx [expr {double($width)/double($N)}]
    set dy [expr {double($height)/double($M)}]
    set a [expr {pow(double($N)/2.0,2)+pow(double($M)/2.0,2)}]

    for {set i 0} {$i <= $N} {incr i} {
        for {set j 0} {$j <= $M} {incr j} {
            set x1 [expr {$dx*double($i)}]
            set x2 [expr {$x1+$dx}]
            set y1 [expr {$dy*double($j)}]
            set y2 [expr {$y1+$dy}]

            set k [expr {int(30000+25000*(1.0 - \
                    0.8*(pow(double($i-$N/2.0),2) + \
                    pow(double($j-$M/2.0),2))/$a))}]

            $canvas create rectangle $x1 $y1 $x2 $y2 \
                    -fill [format "#%04x%04x%04x" $k $k $k] \
                    -width 0
        }
    }
 }
   proc move(metal) {w x y} {}
   proc initialize {w x y} {
      global tile
      global xhistory firstnode curnode
      global ind movesit
    set tile [.c find withtag current]
      set number 2
       set numberx 2
       set ::_x $x; set ::_y $y;
       set firstnode [.c find withtag current]
    set number  [$w gettags current]
     set indexer [string first "mv" $number ];
     set numberx  [string range $number 0 $indexer];
       .wxx delete 1.0 end;
     # general reporting line
    .wxx insert end " xxx $number xxx $numberx xxx \
   indexer  xxx  $indexer xxx number of tiles xxxx \
   $ind xxxx object xxx $tile xxx $ind xxx number of \
    straight moves xxx $movesit xxx ";
     #.wxxccc delete 1.0 end;
     # general reporting line
    .wxxccc insert end " xxx $number xxx $numberx xxx \
   indexer  xxx  $indexer xxx number of tiles xxxx \
   $ind xxxx object xxx $tile xxx $ind xxx number of \
    straight moves xxx $movesit xxx ";
     incr movesit

    }
   #endofdeck

Earlier Version

 package require Tk
 global bookvalue bookvalue2
 set colorground bisque
 set wow "bone number"
 proc xlistlistbox {} {
     .labellabel delete 0 end
     foreach filefile [glob .* *] {
        if [file isdirectory $filefile] {
            set filefile "$filefile/"
        }
        .labellabel insert end $filefile;
     }
 }
 proc xskipskipdirectory {dir} {
     cd $dir
    .realcommand configure -text [pwd]
    xlistlistbox
 }
 proc clickclicklistbox {} {
    set index [lindex [.labellabel curselection] 0]
    set filename [.labellabel get $index]
    if [file isdirectory $filename] {
        xskipskipdirectory $filename
    } else { 
        #exec xedit $file & 
        # windows editor 
        exec notepad $filename}    
}
 
 wm title . "File Starter"
 frame .labelframe
 pack .labelframe -expand no -fill x
 label .labellabel1 -text "Directory:"
 label .realcommand -text "" \
    -relief groove
 pack .labellabel1 -in .labelframe \
    -side left -expand no -fill x
 pack .realcommand -in .labelframe \
    -side left -expand yes -fill x -anchor w
 frame .listlistbox
 pack .listlistbox -expand yes -fill both
 listbox .labellabel \
    -width 25 -height 3 \
    -xscrollcommand ".xxxxaxis set" \
    -yscrollcommand ".yyyyaxis set" \
    -bg $colorground
     scrollbar .yyyyaxis \
    -command ".labellabel yview" \
    -orient v
     scrollbar .xxxxaxis \
    -command ".labellabel xview" \
    -orient h 
 pack .xxxxaxis -in .listlistbox -side bottom  -fill x    -expand no
 pack .yyyyaxis -in .listlistbox -side right   -fill y    -expand no
 pack .labellabel  -in .listlistbox -side top     -fill both -expand yes
 frame .buttonbuttonx
 pack .buttonbuttonx -fill x
 button .caster -text Cast_Bones -command {bonereadxx;castfortune;}

 button .done -text Exit -command exit
 pack .caster .done -in .buttonbuttonx \
    -side top -fill x
 bind .labellabel <Double-1> clickclicklistbox

   pack  [ label .ww -text "Iching holding tank " -bg $colorground]
   pack [ text .wxxccc -width 80 -height 3 -bg beige ]

   focus .wxxccc           ;# allow keyboard input

   .wxxccc insert end  "xxx starter xxx  ";

 scrollbar .scr -orient vertical -command ".can yview"
 canvas .can -yscrollcommand ".scr set" -width 240 -bg $colorground

 pack .can -fill both -expand 1 -side left
 pack .scr -fill y -expand 0 -side left

 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
 #suchenwirth_subroutine;}
 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 }
  
 if 0 {
 + hexagram_1 : pinyin Qian wade Ch'ien english {The Creative }  
 + hexagram_2 : pinyin Kun wade  K'un english {The Receptive}  
 + hexagram_3 : pinyin Zhun wade Chun english { Difficulty at the Beginning  }
 + hexagram_4 : pinyin Meng wade Mêng english {Youthful Folly } 
 + hexagram_5 : pinyin Xu wade Hsü english {Waiting  }
 + hexagram_6 : pinyin  Song wade Sung english {Conflict } 
 + hexagram_7 : pinyin  Shi wade Shih english {The Army } 
 + hexagram_8 : pinyin  Bi wade Pi english {Holding Together}  
 + hexagram_9 : pinyin  Xiaoxu wade Hsiao Ch'u english {The Taming Power of the Small}  
 + hexagram_10 : pinyin Lü wade Lü english {Treading}  
 + hexagram_11 : pinyin Tai wade T'ai english {Peace } 
 + hexagram_12 : pinyin Pi wade P'i english {Standstill  }
 + hexagram_13 : pinyin Tongren wade {T'ung Jên} english {Fellowship with Men } 
 + hexagram_14 : pinyin Dayou wade { Ta Yu } english {Possession in Great Measure } 
 + hexagram_15 : pinyin Qian wade Ch'ien english {Modesty  }
 + hexagram_16 : pinyin Yu wade Yü english {Enthusiasm }
 + hexagram_17 : pinyin Sui wade Sui english {Following }
 + hexagram_18 : pinyin Gu wade Ku english {Work on What Has Been Spoiled  }
 + hexagram_19 : pinyin Lin wade Lin english {Approach  }
 + hexagram_20 : pinyin Guan wade Kuan english {Contemplation  }
 + hexagram_21 : pinyin Shike wade {Shih Ho } english {Biting Through  }
 + hexagram_22 : pinyin Bi wade Pi english {Grace } 
 + hexagram_23 : pinyin Bo wade Po english {Splitting Apart } 
 + hexagram_24 : pinyin Fu wade Fu english {Return  }
 + hexagram_25 : pinyin Wuwang wade { Wu Wang }english {Innocence } 
 + hexagram_26 : pinyin Daxu wade { Ta Ch'u } english {The Taming Power of the Great } 
 + hexagram_27 : pinyin Yi wade I english {The Corners of the Mouth } 
 + hexagram_28 : pinyin Daguo wade { Ta Kuo } english {Preponderance of the Great } 
 + hexagram_29 : pinyin Kan wade K'an english {The Abysmal } 
 + hexagram_30 : pinyin Li wade Li english {The Clinging } 
 + hexagram_31 : pinyin Xian wade  Hsien english {Influence } 
 + hexagram_32 : pinyin Heng wade  Hêng english {Duration} 
 + hexagram_33 : pinyin Dun  wade  Tun english {Retreat } 
 + hexagram_34 : pinyin Dazhuang wade { Ta Chuang } english {The Power of the Great } 
 + hexagram_35 : pinyin Jin wade Chin english {Progress} 
 + hexagram_36 : pinyin Mingyi wade { Ming I } english {Darkening of the Light } 
 + hexagram_37 : pinyin Jiaren wade Chia Jên english { The Family}  
 + hexagram_38 : pinyin Kui wade K'uei english {Opposition  }
 + hexagram_39 : pinyin Jian wade Chien english {Obstruction}  
 + hexagram_40 : pinyin  Xie wade Hsieh english {Deliverance}  
 + hexagram_41 : pinyin Sun  wade Sun english {Decrease } 
 + hexagram_42 : pinyin Yi  wade I english {Increase } 
 + hexagram_43 : pinyin Guai wade Kuai english {Break-through}  
 + hexagram_44 : pinyin Gou wade Kou english {Coming to Meet}  
 + hexagram_45 : pinyin Cui wade Ts'ui english {Gathering Together  }
 + hexagram_46 : pinyin Sheng wade Shêng english {Pushing Upward } 
 + hexagram_47 : pinyin Kun wade K'un english {Oppression  }
 + hexagram_48 : pinyin Jing wade Ching english {The Well } 
 + hexagram_49 : pinyin Ge wade Ko english {Revolution} 
 + hexagram_50 : pinyin Ding wade Ting english {The Caldron }  
 + hexagram_51 : pinyin Zhen wade Chên english {The Arousing  }
 + hexagram_52 : pinyin Gen wade Kên english {Keeping Still } 
 + hexagram_53 : pinyin Jian wade Chien english {Development } 
 + hexagram_54 : pinyin Guimei wade {Kuei Mei} english {The Marrying Maiden } 
 + hexagram_55 : pinyin Feng wade Fêng english {Abundance } 
 + hexagram_56 : pinyin Lü wade Lü english {The Wanderer }  
 + hexagram_57 : pinyin Xun wade Sun english {The Gentle } 
 + hexagram_58 : pinyin Dui wade Tui english {The Joyous } 
 + hexagram_59 : pinyin Huan wade Huan english { Dispersion } 
 + hexagram_60 : pinyin Jie wade Chieh english {Limitation } 
 + hexagram_61 : pinyin Zhongfu wade {Chung Fu} english {InnerTruth } 
 + hexagram_62 : pinyin Xiaoguo wade { Hsiao Kuo} english {Preponderance of the Small } 
 + hexagram_63 : pinyin Jiji wade { Chi Chi } english {After Completion}  
 + hexagram_64 : pinyin Weiji wade { Wei Chi } english {Before Completion } 
 }
       #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 {} {
     global dx dy colors color gualisting
     global bookvalue bookvalue2 second_hexagram
      set dj 1;
      set gualisting [list ];
      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;
       }
       #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 ];
      .wxxccc 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 "

     .wxxccc insert end $outoutfoulspirit      }

 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 white}

         if { [lindex $gualisting $i ] == 7} {set colorx brown}
         if { [lindex $gualisting $i ] == 8} {set colorx white}
         if { [lindex $gualisting $i ] == 9} {set colorx brown}
         }

          .can create rectangle $x $y [expr {$x+$dx}] [expr {$y+$dy}] \
            -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 white}

         if { [lindex $second_hexagram $i ] == 7} {set colorx blue}
         if { [lindex $second_hexagram $i ] == 8} {set colorx white}
         if { [lindex $second_hexagram $i ] == 9} {set colorx blue}
         }

          .can create rectangle [expr $x + 180] $y [expr {[expr $x +180 ]+$dx}] [expr {$y+$dy}] \
            -fill $colorx

          }}

     }

 xskipskipdirectory $env(HOME)

test char 易 經

Category ToysCategory Binary Data