---- Activity Random Poetry Chalkboard this is an starter page. As i am still working on this;please add any comments at bottom, so i will be less confused. 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 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, hexagram.
In developing a computer program or application, it is helpful to develop analogs for the individual tasks of the application. horizontal bar code of 6 lines.
In the process of designing the basic subroutine tasks, we could throw in some Such rule breaking helps keep the finished program more flexible.
#!/usr/bin/env wish #start of deck #Iching_Fortunes # 5Feb2009, [gold] package require Tk #endofdeck #endofdeck #Refrigerator_Magnetic_Poetry # Start of Deck package require Tk namespace eval xpoetry { variable bg black fg white size 30 } set dx 50 set dy 50 set size 30 set colorground bisque # Refrigerator_Magnetic_Poetry # Refrigerator magnet poetry # program is mainly TCL8.0 and # Windows Expect5.2 offshoot of # Suchenwirth's Domino.tcl, circa 2004. # Tried to note which Suchenwirth subroutines # were mostly unchanged. # This was the first TCL canvas code I # saw that one could create easy gamepieces. # Writing grouped designs # on top of canvas shape, so basic canvas # shape and "grouped" design would move # by mouse. "grouped" design is used # extensively in Microsoft powerpoint # and Harvard Graphics, etc. # This first effort is refrigerator # magnet poetry in English. # Believe a similar select & die could # be used for a computer Mahjong game # or coin&card games. # Could use TCL8.4 chinese charactors # on top of tiles for Chinese magnetic # poetry or colored Mahjong tiles. # Various Esc and F-keys activate # to exit program or change background color. # Sliding right mouse across piece # should delete same. # Pick and Sliding left mouse across piece # should move same. # Sliding middle mouse across piece # might delete same piece or other pieces. # from goldshell7 on 10jun2006. proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \ #suchenwirth_subroutine;} proc poetry jill { set jill [lpick { tree happy grass love swan home \ power loss dance rose joy hate juice kick}] return $jill; } proc xpoetry::create {w x y val1 val2} { global jack global jill variable bg; variable fg; variable size set jack [lpick {red yellow blue purple \ pink green brown black gray}] set jill rose #remaining doctered_suchenwirth_subroutine; set tags [list mv d-$val1$val2]; #remaining doctered_suchenwirth_subroutine; set x1 [expr {$x+$size-0.5}] set y1 [expr {$y+$size}] $w create rect $x $y [expr {$x+2*$size}] $y1 \ -fill $jack -tags [linsert $tags 0 bd-$val1$val2] $w create text [expr {$x+1*$size}] [expr {$y+0.5*$size }] \ -text [eval poetry $jill] -fill $fg -tags $tags } if 0 {Clicking on a piece records \ the click position, and its "catch-all" tag, \ in global variables:} proc mv'1 {w x y} { set ::_x $x; set ::_y $y;#suchenwirth subroutine; foreach tag [$w gettags current] { if [regexp ^(d-.+) $tag -> ::_tag] break } } if 0 {Moving the mouse with button 1 down \ moves the items with the "catch-all" tag \ with the mouse pointer:} proc mv'motion {w x y} { $w raise $::_tag;#suchenwirth subroutine; $w move $::_tag [expr {$x-$::_x}] [expr {$y-$::_y}] set ::_x $x; set ::_y $y } pack [canvas .c -bg $colorground -width 500 \ -height 350] -fill both -expand 1 for {set i 0; set y 0} {$i<8} {incr i; incr y $dy} { for {set j 0; set x 0} {$j<8} {incr j; incr x $dx} { xpoetry::create .c [expr $i*65+10] [expr $j*35+100] $i $j } } if 0 {Moving the mouse with button 1 \ down moves the items with the "catch-all" tag \ with the mouse pointer:} proc move&die {w x y} { # remove selected pieces & other pieces # by moving middle mouse # on top of them, not working too well $w raise $::_tag $w move $::_tag [expr {$x-$::_x}] [expr {$y-$::_y}] $w delete $::_tag [expr {$x-$::_x}] [expr {$y-$::_y}] set ::_x $x; set ::_y $y } if 0 {Clicking on a piece records the click position, \ and its "catch-all" tag, in global variables:} proc select&die {w x y} { # remove selected pieces by moving right mouse # on top of them, working better set ::_x $x; set ::_y $y foreach tag [$w gettags current] { if [regexp ^(d-.+) $tag -> ::_tag] break } $w delete $::_tag [expr {$x-$::_x}] [expr {$y-$::_y}] } set size 30 .c bind mv <1> {mv'1 %W %x %y} .c bind mv <B1-Motion> {mv'motion %W %x %y} .c bind mv <B3-Motion> {select&die %W %x %y} .c bind mv <B2-Motion> {move&die %W %x %y} #-- Little development helpers (optional): bind . <Escape> { exit} bind . <F1> {destroy .} bind . <F2> { set colorground LightBlue1; \ .c configure -bg $colorground} bind . <F3> {set colorground Bisque;.c \ configure -bg $colorground } bind . <F4> {set backcolor [lpick {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4 \ SlateBlue3 RoyalBlue1 SteelBlue2 \ DeepSkyBlue3 LightBlue1 DarkSlateGray1 \ Aquamarine2 DarkSeaGreen2 SeaGreen1 Bisque \ Yellow1 IndianRed1 IndianRed2 Tan1 \ Tan4 gray}]; set colorground $backcolor; .c configure -bg $colorground } #end of deck
'''Screenshots Section'''
'''Comments Section''' Please place any comments here, Thanks. [gold] Change:Redundant procedure ? deleted.
References:
Random Divination ( non-Iching)
Programming References ( TCL & C# )
Appendix Tables if 0 { iching hexagrams and trigrams } if 0 { 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
enter categories here |
---|