#!/bin/sh
# -*- tcl -*- \
exec wish "$0" "$@"


#### testar jogo #28409

# MAXLIN pode ser no maximo 11
set MAXLIN 5
set MAXCOL 9

#set LIN 11 ;# numero de linhas (maximo 11)
#set COL 11
set MAX 9
#set operador +
set REGRA ""


proc define_opcoes {} {
    global LIN COL MAXLIN MAXCOL
    set LIN [expr [randomRange [expr $MAXLIN]]+1]
    set COL [expr [randomRange [expr $MAXCOL]]+1]
    if {$LIN == $COL && $LIN == 1} {
	set COL [expr [randomRange [expr $MAXCOL-1]]+2]
    }
}

proc ajuda {} {
    tk_messageBox -parent .j \
	-title {tk+- bis} \
	-message \
	{tk+- bis
Hudson Lacerda (2009)

Como jogar:
Percorra o quadro fazendo operações\
cujos resultados estejam no intervalo\
de 0 a 10, até zerar todas as casas.

Comandos do teclado:
F1: Ajuda
F2 ou Enter: Novo Jogo
Esc ou Ctl+r : Reiniciar Jogo
q: Sair

Teclas para movimentação:
w e r
s d f
x c v

Teclas para rolar a tela:
Setas
W E R
S D F
X C V
}
}

proc OP {} {
    global operador cont ;#RES
    set atual $operador
    if {$operador == "-"} {
	set operador +
    } else {
	set operador -
    }
    if {$cont == 0} {set operador " " }

    return $atual
}

proc GANHOU {} {
    global TOTAL PONTOS
    tk_messageBox -parent .j \
	-message "VOCÊ GANHOU!\nPontos: $PONTOS de $TOTAL" \
	-title "PARABÉNS!"
    NOVO_JOGO
}

proc PERDEU {} {
    global TOTAL PONTOS NUMERO_JOGO NUMERO_JOGO_ANTERIOR rand
    set escolha [tk_messageBox -parent .j \
		     -message "Fim do jogo.\nPontos: $PONTOS de $TOTAL" \
		     -title "Fim do jogo" \
		     -type retrycancel -default retry
		]
    switch $escolha {
	retry {
	    set NUMERO_JOGO $NUMERO_JOGO_ANTERIOR
	}
    }

    NOVO_JOGO
}

proc MOD {n m} {
  return [expr round(fmod($m+fmod($n,$m),$m))]
}

proc TRANSPOE {{dx 0} {dy 0}} {
    global xx LIN COL ultimo
    array set bak [array get xx]
    for {set n 0} {$n < $LIN} {incr n} {
	for {set m 0} {$m < $COL} {incr m} {
	    set x [MOD [expr $n + $dx] $LIN]
	    set y [MOD [expr $m + $dy] $COL]
	    set xx($n$m) $bak($x$y)
	}
    }
    if {$ultimo(x) >= 0} {
	ATUALIZA_BOTOES $x $y
	set x [MOD [expr $ultimo(x) - $dx] $LIN]
	set y [MOD [expr $ultimo(y) - $dy] $COL]
	set ultimo(x) $x
	set ultimo(y) $y
	focus .j.q1.b$x$y
    }
    ATUALIZA_BOTOES $ultimo(x) $ultimo(y)

}

proc randomInit { seed } {
  global rand
  set rand(ia) 9301 ;# Multiplier
  set rand(ic) 49297 ;# Constant
  set rand(im) 233280;# Divisor
  set rand(seed) $seed;# Last result
}
proc random {} {
  global rand
  set rand(seed) \
    [expr ($rand(seed)*$rand(ia) + $rand(ic)) % $rand(im)]
  return [expr $rand(seed)/double($rand(im))]
}
proc randomRange { range } {
    expr int([random]*$range)
}

proc oeste {} {
    global ultimo LIN COL xx
    if {$ultimo(x) < 0 } { return }
    set linha $ultimo(x)
    set coluna [expr [MOD [expr $ultimo(y) -1] $COL]]
    if { $xx($linha$coluna) != 0 } {
	RODA $linha $coluna
    }
}

proc noroeste {} {
    global ultimo LIN COL xx
    if {$ultimo(x) < 0 } { return }
    set linha [expr [MOD [expr $ultimo(x) -1] $LIN]]
    set coluna [expr [MOD [expr $ultimo(y) -1] $COL]]
    if { $xx($linha$coluna) != 0 } {
	RODA $linha $coluna
    }
}

proc nordeste {} {
    global ultimo LIN COL xx
    if {$ultimo(x) < 0 } { return }
    set linha [expr [MOD [expr $ultimo(x) -1] $LIN]]
    set coluna [expr [MOD [expr $ultimo(y) +1] $COL]]
    if { $xx($linha$coluna) != 0 } {
	RODA $linha $coluna
    }
}

proc sudoeste {} {
    global ultimo LIN COL xx
    if {$ultimo(x) < 0 } { return }
    set linha [expr [MOD [expr $ultimo(x) +1] $LIN]]
    set coluna [expr [MOD [expr $ultimo(y) -1] $COL]]
    if { $xx($linha$coluna) != 0 } {
	RODA $linha $coluna
    }
}

proc sudeste {} {
    global ultimo LIN COL xx
    if {$ultimo(x) < 0 } { return }
    set linha [expr [MOD [expr $ultimo(x) +1] $LIN]]
    set coluna [expr [MOD [expr $ultimo(y) +1] $COL]]
    if { $xx($linha$coluna) != 0 } {
	RODA $linha $coluna
    }
}

proc norte {} {
    global ultimo LIN COL xx
    if {$ultimo(x) < 0 } { return }
    set linha [expr [MOD [expr $ultimo(x) -1] $LIN]]
    set coluna $ultimo(y)
    if { $xx($linha$coluna) != 0 } {
	RODA $linha $coluna
    }
}

proc leste {} {
    global ultimo LIN COL xx
    if {$ultimo(x) < 0 } { return }
    set linha $ultimo(x)
    set coluna [expr [MOD [expr $ultimo(y) +1] $COL]]
    if { $xx($linha$coluna) != 0 } {
	RODA $linha $coluna
    }
}

proc sul {} {
    global ultimo LIN COL xx
    if {$ultimo(x) < 0 } { return }
    set linha [expr [MOD [expr $ultimo(x) +1] $LIN]]
    set coluna $ultimo(y)
    if { $xx($linha$coluna) != 0 } {
	RODA $linha $coluna
    }
}

proc RAND {m} {
    #return [expr round(fmod($m+fmod([clock clicks],$m),$m))]
    return [expr [randomRange $m] + 1]
}

proc RODA {x y} {
    global xx RES cont PONTOS MAX TOTAL ultimo LIN COL operador REGRA

    if { $x == $ultimo(x) && $y == $ultimo(y) } {
	return
    }

    if {$ultimo(x) < 0 || $ultimo(y) < 0} {
	set ultimo(x) $x
	set ultimo(y) $y
    }
    if {$xx($x$y) == 0 ||
	[expr  ([MOD [expr 1+abs($ultimo(x) - $x)] $LIN])] > 2 ||
	[expr  ([MOD [expr 1+abs($ultimo(y) - $y)] $COL])] > 2
    } {
	return
    }

    focus .j.q1.b$x$y



    incr cont -1

    set RES [expr $RES [OP] $xx($x$y)]
    if {$operador=={+}} {
	set REGRA " <=10 "
    } else {
	set REGRA " >= 0 "
    }
    
#    puts $RES

    incr PONTOS $xx($x$y)

    set nv [ATUALIZA_BOTOES $x $y]

#    incr PONTOS [expr + $xx($x$y)]
    if { $RES < 0 || $RES > [expr $MAX + 1] } {
	incr PONTOS [expr - $xx($x$y)]
	if {$RES < 0} {
	    incr PONTOS $RES
	    set REGRA ""
	    set operador "< 0"
	} else {
	    incr PONTOS [expr $RES - $MAX + 1]
	    set REGRA ""
	    set operador ">[expr $MAX+1]"
	}
	.j.q2.m1 configure -background red
	.j.q2.m2 configure -background red
	PERDEU

	return
    } 
    if {$cont == 0} {
	#	    incr PONTOS [expr + abs($xx($x$y))]
	GANHOU
	return
    }
    if {$nv == 1} {
	PERDEU
	return
    }
    
    set ultimo(x) $x
    set ultimo(y) $y
    if { $operador == {+} } {
	set ope -
    } else {
	set ope +
    }
    set xx($x$y) 0
}

proc ATUALIZA_BOTOES {x y} { ;# atualiza tela \
				 ;#(cores, botoes ativos/inativos) \
				 ;# e RETORNA NUMERO DE VIZINHOS \
				 ;# (contando o botao atual)
    global LIN COL xx RES MAX
    set nv 0
    for {set n 0} {$n<$LIN} {incr n} {
	for {set m 0} {$m<$COL} {incr m}  {
	    .j.q1.b$n$m configure -foreground black \
		-activebackground darkgray \
		-background darkgray \
		-activeforeground black \
		-relief raised \
		-state normal

 	    if {$xx($n$m) == 0} {
 	    .j.q1.b$n$m configure -foreground black \
 		-activebackground black \
 		-background black \
 		-activeforeground black \
 		-disabledforeground black \
		-state disabled
 	    }
 	}
    }

    if {$x < 0 || $y < 0} {
	return 0
    }

    for {set n -1} {$n<=1} {incr n} {
	for {set m -1} {$m<=1} {incr m}  {
	    set vx [ MOD [expr $x + $n] $LIN ]
	    set vy [ MOD [expr $y + $m] $COL ]
	    .j.q1.b$vx$vy configure -state normal -foreground blue \
		-activeforeground black \
		-activebackground yellow \
		-background white -relief groove
	    
	    incr nv
	    if { $xx($vx$vy) == 0 } {
		.j.q1.b$vx$vy configure -state disabled \
		    -background black \
		    -foreground black \
		    -disabledforeground black \
		    -activebackground black \
		    -activeforeground black
		
		incr nv -1
	    }
	}
    }
    # .j.q1.b$x$y configure -state disabled
    .j.q1.b$x$y configure -activebackground yellow \
	-activeforeground yellow \
	-foreground yellow \
	-background yellow \
	-disabledforeground yellow




#     for {set n -1} {$n < [expr $MAX + 1] } {incr n} {
# 	.j.qanima.m$n configure -background lightgray
# 	if {$RES >= 0 && $RES <= $MAX} {
# 	    .j.qanima.m$RES configure -background yellow
# 	} elseif {$RES < 0} {
# 	    .j.qanima.m-1 configure -background yellow
# 	} elseif {$RES > $MAX} {
# 	    .j.qanima.m[expr 1+$MAX] configure -background yellow
# 	}
#     }
    
    return $nv
}

## janela principal

wm title . {...teste!}
button .b1 -text {Fechar o programa} -command {exit}
pack .b1

## janela nova

toplevel .j
wm title .j {tk+- bis}
#wm minsize .j 300 440
#wm maxsize .j 300 440
#wm resizable .j 0 0

frame .j.q1 -borderwidth 16 -relief ridge
frame .j.q2
frame .j.q3

proc atualiza_grade {{lin 3} {col 3}} {
    global xx MAXLIN MAXCOL LIN COL
    set LIN $lin
    set COL $col
    for {set xlin 0} {$xlin<$MAXLIN} {incr xlin} {
	for {set ylin 0} {$ylin<$MAXCOL} {incr ylin} {
	    if {$xlin >= $LIN || $ylin >= $COL} {
		grid remove .j.q1.b$xlin$ylin
	    } else {
		grid .j.q1.b$xlin$ylin -row $xlin -column $ylin
	    }
	}
    }
}

# cria grade de botões

for {set xlin 0} {$xlin<$MAXLIN} {incr xlin} {
    for {set ylin 0} {$ylin<$MAXCOL} {incr ylin} {
	button .j.q1.b$xlin$ylin -textvariable xx($xlin$ylin) \
	    -width 1 \
	    -command "RODA $xlin $ylin" \
	    -font "Helvetica 16"
	grid .j.q1.b$xlin$ylin -row $xlin -column $ylin
    }
}
# define tamanho default da grade

button .j.q3.b1 -text "Ajuda" -command ajuda \
    -activebackground blue -background lightblue
button .j.q3.b2 -text "Novo Jogo" -command NOVO_JOGO \
    -activebackground green -background lightgreen \
    -width 10
button .j.q3.b3 -text "Reiniciar Jogo" -command REPETE_JOGO \
    -activebackground snow1 -background snow2 \
    -width 10
button .j.q3.b4 -text "Sair" -command exit -activebackground red \
    -background orange
label .j.q2.m1 -textvariable RES -font "Helvetica 36" \
    -width 3 -relief ridge -borderwidth 2 -background yellow
label .j.q2.m2 -textvariable operador -font "Helvetica 36" \
    -width 3 -relief ridge -borderwidth 2 -background yellow
label .j.q2.m3 -textvariable REGRA -font "Helvetica 12" \
    -relief ridge -borderwidth 2 -width 5
label .j.q2.m0 -width 3 ;# espaçador
label .j.q2.m100 -width 10 ;# espaçador
label .j.m1 -textvariable PONTOS -font "Helvetica 12" \
    -width 5 -relief ridge -borderwidth 2
label .j.m2 -textvariable TOTAL -font "Helvetica 12" \
    -width 5 -relief ridge -borderwidth 2
frame .j.qt
button .j.qt.bN -text "^" -command {TRANSPOE -1 0}
button .j.qt.bS -text "v" -command {TRANSPOE 1 0}
button .j.qt.bO -text "<" -width 2 -command {TRANSPOE 0 -1}
button .j.qt.bL -text ">" -width 2 -command {TRANSPOE 0 1}
pack .j.qt.bN  .j.qt.bS  -side top
pack .j.qt.bO -side left
pack .j.qt.bL -side right
pack .j.qt.bS -side bottom
pack  .j.q2.m100 .j.q2.m1 .j.q2.m2 .j.q2.m0 .j.q2.m3 -side left
pack .j.q3.b1 .j.q3.b2 .j.q3.b3 .j.q3.b4 -side left
pack .j.q2 .j.q1 .j.qt .j.m1 .j.m2 .j.q3 -expand 1





#### teclas de atalho
bind .j <Key-F1> {ajuda}
bind .j <Key-F2> {NOVO_JOGO}
bind .j <Key-Return> {NOVO_JOGO}
bind .j <Key-Escape> {REPETE_JOGO}
bind .j <Control-r> {REPETE_JOGO}
bind .j q {exit}
bind .j <Key-Up> {TRANSPOE -1 0}
bind .j <Key-Down> {TRANSPOE 1 0}
bind .j <Key-Left> {TRANSPOE 0 -1}
bind .j <Key-Right> {TRANSPOE 0 1}

bind .j <Key-e> {norte}
bind .j <Key-s> {oeste}
bind .j <Key-d> {sul}
bind .j <Key-c> {sul}
bind .j <Key-f> {leste}
bind .j <Key-w> {noroeste}
bind .j <Key-r> {nordeste}
bind .j <Key-x> {sudoeste}
bind .j <Key-v> {sudeste}

bind .j E {TRANSPOE -1 0}
bind .j S {TRANSPOE 0 -1}
bind .j D {TRANSPOE 1 0}
bind .j C {TRANSPOE 1 0}
bind .j F {TRANSPOE 0 1}
bind .j W {TRANSPOE -1 -1}
bind .j R {TRANSPOE -1 1}
bind .j X {TRANSPOE 1 -1}
bind .j V {TRANSPOE 1 1}

# bind .j <Key-KP_8> {norte}
# bind .j <Key-KP_4> {oeste}
# bind .j <Key-KP_5> {sul}
# bind .j <Key-KP_2> {sul}
# bind .j <Key-KP_6> {leste}
# bind .j <Key-KP_7> {noroeste}
# bind .j <Key-KP_9> {nordeste}
# bind .j <Key-KP_1> {sudoeste}
# bind .j <Key-KP_3> {sudeste}

proc NOVO_JOGO {} {

    global RES MAX LIN COL PONTOS operador cont xx TOTAL ultimo REGRA

    global NUMERO_JOGO NUMERO_JOGO_ANTERIOR rand

    randomInit $NUMERO_JOGO
    wm title .j "tk+- bis (\#$NUMERO_JOGO)"

    define_opcoes
#     set x [expr {([winfo screenwidth .j]-[winfo width .j])/2}]
#     set y [expr {([winfo screenheight .j]-[winfo height .j])/2}]
#     wm geometry  .j +$x+$y
    atualiza_grade $LIN $COL

    set ultimo(x) -1000
    set ultimo(y) -1000

    set PONTOS 0
    set RES 0
    set TOTAL 0
    set REGRA ""
    set cont [expr $LIN * $COL]
    set operador +
    .j.q2.m1 configure -background yellow
    .j.q2.m2 configure -background yellow
    for {set x 0} {$x<$LIN} {incr x} {
	for {set y 0} {$y<$COL} {incr y} {

	    set xx($x$y) [expr [RAND [expr $MAX]]]
	    #	    set xx($x$y) [expr [RAND [expr $MAX+1]] -1] ;# com zeros

	    incr TOTAL $xx($x$y)
 	}
     }
    ATUALIZA_BOTOES -1 -1

    # foco no botão central
    focus .j.q1.b[expr $LIN/2][expr $COL/2]

    # gera novo inicializador de gerador randomico
    set NUMERO_JOGO_ANTERIOR $NUMERO_JOGO
    set NUMERO_JOGO [expr [randomRange 65535]+1]

}

proc REPETE_JOGO {} {
    global NUMERO_JOGO NUMERO_JOGO_ANTERIOR
    set NUMERO_JOGO $NUMERO_JOGO_ANTERIOR
    NOVO_JOGO
}

## oculta janela principal
wm withdraw .
## deixa a janela .j terminar o programa
wm protocol .j WM_DELETE_WINDOW {exit}

wm resizable .j 0 0


################
### JOGAR!!! ###
################



##wm withdraw .j
####ajuda
randomInit [pid] ;# este comando deve ficar antes de usar 'random'
set NUMERO_JOGO [pid] ;#[clock clicks]
set NUMERO_JOGO_ANTERIOR 0
#set LIN [expr [randomRange [expr $MAXLIN]]+1]
#set COL [expr [randomRange [expr $MAXCOL]]+1]
NOVO_JOGO
wm deiconify .j

# frame .j.qanima
# label .j.qanima.m-1 -text "!!!"
# pack  .j.qanima.m-1 -side left
# for {set n 0} {$n <= [expr 1+$MAX]} {incr n} {
#     label .j.qanima.m$n -text "$n"
#     pack  .j.qanima.m$n -side left
# }
# label .j.qanima.m[expr 2+$MAX] -text "!!!"
# pack  .j.qanima.m[expr 2+$MAX] -side left
# pack .j.qanima