#! /Apps/usr-local/tcl_tk-8.4.11/bin/wish84.exe
##=================================================================
## exit2exit
##=================================================================
## exit と(ゆっくり)入力されると終了するスクリプト
## 全画面モードにしての利用をお勧め。自動で全画面にする方法がわからん…
##=================================================================
#wm attributes . -fullscreen 1; #使えない環境が多いので…
#wm overrideredirect . 1; #タイトルバーを消す (Windows)

set passkey "exit"
set mojis ""
set mojid ""

label .lk -text "" -font {{ＭＳ ゴシック} 300 bold}
label .lm -text "Type \"exit\" to exit this window." -font {Times 20 bold}

pack .lm
pack .lk

set imai 99999
image create photo ima -file "anpan.gif"
canvas .ca -width 200 -height 172
#.ca create image 100 86 -image ima
pack .ca

set swidth [winfo screenwidth .]
set sheight [winfo screenheight .]

label .l2 -text "geometry $swidth x $sheight"
pack .l2


proc release_button {i} {
  global imai
  if { $imai < 90000 } {
    .ca delete $imai

    set istart 1
    set istarx [expr $imai - 100]
    if { 1 < $istarx } { set istart $istarx }
    set zz ""
    for {set index $istart} {$index < $imai} {incr index} {
        set zz "$zz $index"
    }
    .ca delete $zz

    set imai 99999
  }
}

proc push_button {i} {
  global mojis
  global mojid
  global passkey
  global imai
  
  if { $imai < 90000 } { return } 
  ## KeyRelease 前は動作しない! (^o^)

  
  if { $i == "slash" } { set i "/" } \
  elseif { $i == "comma" } { set i "," } \
  elseif { $i == "period" } { set i "." }
  
  set mojis "$mojis$i"
  set mojid "$mojid$i"

  if { $i == [string index $passkey 0] } { set mojid $i } \
  elseif { 7 < [string length "$mojid"] } {
#    set mojid [string range "$mojid" end-6 end]
    set mojid $i
  }
  .lk configure -text $mojid

  if { 0 == [string compare "$passkey" "$mojis"] } { my_finish }
  if { 0 != [string first "$mojis" "$passkey"] } { 
    set mojis ""
  }
  setBgColor "$i"

  if { 90000 < $imai } {
    set imai [.ca create image 100 86 -image ima]
  }
}


proc setBgColor {i} {
  set col [setBgColor_Rand  $i]

  . configure -background "$col"
  .lk configure -background "$col"
  .ca configure -background "$col"
}

set numrando 0
proc setBgColor_Rand {i} {
  global numrando
  set i 0
  set co($i) "#BBB" ; incr i
  set co($i) "#F22" ; incr i
  set co($i) "#2F2" ; incr i
  set co($i) "#22F" ; incr i
  set co($i) "#FF2" ; incr i
  set co($i) "#F2F" ; incr i
  set co($i) "#2FF" ; incr i
  set co($i) "#d9a527" ; incr i
  set co($i) "#FFA500" ; incr i
  set co($i) "#FF6347" ; incr i
  set co($i) "#880" ; incr i
  set co($i) "#00FF7F" ; incr i
  set co($i) "#32CD32" ; incr i
  set co($i) "#228B22" ; incr i
  set co($i) "#008000" ; incr i
  set co($i) "#FFDAB9" ; incr i
  set co($i) "#87CEEB" ; incr i
  set co($i) "#FFF" ; incr i
  
  set numrand [expr int(rand()*$i)]

  if { $numrand == $numrando } { incr numrand }
  if { $i <= $numrand }        { set numrand 0 }
  set num $numrand
  set numrando $numrand

  return $co($num)
}


proc my_finish { } { grab release .; exit; }

bind . <KeyPress> { push_button %K }
bind . <KeyRelease> { release_button %K }

grab set .
#grab set -global .; # -global はトラブル発生時に危険すぎる (-_-)