##+##########################################################################
#
# mind.tcl -- A mind reading game based on http://www.flashpsychic.com/
# by Keith Vetter, December 2005
#
package require Tk
if {![catch {package require tile 0.5}]} {
catch {namespace import -force ::ttk::button}
}
set chars [list \x25 \x26 \x27 \x28 \x36 \x3e \x49 \x4d \x4e \x4f \x50 \x51 \
\x52 \x53 \x54 \x55 \x56 \x57 \x58 \x59 \x60 \x61 \x62 \x63 \
\x64 \x65 \x66 \x67 \x68 \x69 \x6a \x6b \x6c \x6d \x79 \x7a \
\x7b \x7c \xa3 \xa5 \xa9 \xaa \xab \xae \xb3 \xb4 \xb5 \xb6 \
\xcb \xd0 \xd9 \xfd]
proc DoDisplay {} {
option add *Background white
. config -bg white
wm title . "Mind Reader"
bind all <Key-F2> {console show}
set msg "Choose any two digit number, add together both digits\n"
append msg "and then subtract the total from your original number.\n"
append msg "For example, if you choose 23: 23-(2+3) = 23-5 = 18.\n\n"
append msg "When you have the final number look it up on the chart\n"
append msg "and find the relevant symbol. Concentrate on the symbol\n"
append msg "and when you have it clearly in your mind, click on the\n"
append msg "crystal ball and it will show you the symbol you are\n"
append msg "thinking of..."
frame .left
label .title -text "Mind Reader" -font {Times 32 italic}
canvas .c -width 200 -height 200 -highlightthickness 0
bind .c <1> Predict
MakeBall
label .l -text $msg -justify left -padx 5 -pady 20 -font {Helvetica 8 bold}
pack .title .c .l -side top -in .left
frame .right -bd 2 -relief ridge
for {set row 0} {$row < 20} {incr row} {
for {set col 0} {$col < 5} {incr col} {
set val [expr {99 - $col*20 - $row}]
label .l$row,$col -text [format "%02d" $val] -font {Helvetica 10 bold}
label .ll$row,$col -textvariable ::T($val) -fg \#640406 -font {Wingdings 10 bold}
grid .l$row,$col -row $row -column [expr {2*$col}] -in .right
grid .ll$row,$col -row $row -column [expr {2*$col+1}] -padx {0 5} -in .right
}
}
pack .left .right -side left -fill both
}
proc FillTable {} {
for {set i 0} {$i < 100} {incr i} {
set ::T($i) [lindex $::chars [expr {int(rand() * [llength $::chars])}]]
}
for {set i 18} {$i <= 81} {incr i 9} {
set ::T($i) $::T(9)
}
}
proc GradientSteps {n c1 c2} {
# Get RGB in 0 to 255 range
foreach var {r1 g1 b1 r2 g2 b2} v [concat [winfo rgb . $c1] [winfo rgb . $c2]] {
set $var [expr {$v * 255 / 65535}]
}
set grad {}
for {set i 0} {$i <= $n} {incr i} {
set r [expr {int($r1 + (($r2 - $r1) * $i / double($n)))}]
set g [expr {int($g1 + (($g2 - $g1) * $i / double($n)))}]
set b [expr {int($b1 + (($b2 - $b1) * $i / double($n)))}]
lappend grad [format "#%.2X%.2X%.2X" $r $g $b]
}
return $grad
}
proc MakeBall {} {
set n 90
set steps [GradientSteps $n white blue]
set width [winfo reqwidth .c]
set height [winfo reqheight .c]
set centre 100
.c create oval 10 10 190 190 -tag o -outline \#0000aa -width 15
for {set i $n} {$i > 0} {incr i -1} {
#set centre [expr $centre - 0.55]
set centre [expr $centre - 0.45]
set x1 [expr $centre - $i]
set x2 [expr $centre + $i]
set color [lindex $steps $i]
.c create oval $x1 $x1 $x2 $x2 -fill $color -outline $color
}
}
proc Predict {} {
wm geom . [wm geom .]
frame .try
pack forget .right ; pack .try -side right -expand 1
.l config -fg white
.c create text 100 100 -tag c -text $::T(9) -anchor c -fill \#004477 \
-font {Wingdings 12 bold}
for {set fsize 24} {$fsize < 90} {incr fsize 6} {
update
after 10
.c itemconfig c -font [list Wingdings $fsize bold]
}
label .try.amazing -text "Can you\nbelieve it?" -font {Times 24 bold} -fg red
button .try.again -text "Try Again?" -command Again
catch {.try.again config -bg wheat} ;# looks better for non-tile buttons
pack .try.amazing .try.again -side top -expand 1 -pady .15i
}
proc Again {} {
destroy .try
pack .right -side right
FillTable
.c delete c
.l config -fg [lindex [.l config -fg] 3]
}
FillTable
DoDisplay
returnInteresting algo. I noticed from testing that all derived values always end up with the same symbol.
