pong = function( #cria a função pong
mode=c("easy","hard","arcade"), #modo de jogo com 3 opções
placar=T #ter o placar como output?
)
{
###requerir pacotes apropriados####
if(!require(tcltk2)){install.packages("tcltk2");require(tcltk2)} #janela da interface
if(!require(tkrplot)){install.packages("tkrplot");require(tkrplot)} #plotador de gráficos
###acertar o modo de jogo####
mode= match.arg(mode) #ajusta o que o usuário escreveu para as opções que existem ou pega a primeira opção caso esteja em branco
ojogo= function(mode){ #não tem mistério, essa função é o jogo inteiro
###preparando objetos úteis####
##bolinha##
bx = 10 #posição em x
by = 5 #posição em y
dbx= 0 #velocidade em x
dby= 0.1 #velocidade em y
###paddle###
px = 10 #posição do centro
ix = 10 #posição do oponente
###atraso do oponente###
delay = switch( #coloca um atraso...
mode, #...de acordo com a dificuldde escolhida
easy = 20, #no modo easy ele está 20 frames atrasado
hard = 10, #no hard são só 10
arcade= 4 #no modo arcade o oponente não pode ser derrotado
)
###outros###
res = "Aperte ok" #mensagem caso o jogo acabe
GO = F #checa se o jogo acabou
pxV = tclVar(px*10) #dummy para poder capturar a posição do slider depois
score= 0 #contador de pontos
plotatudo = function() { #função que será chamada quando precisar plotar
##criar a base do cenário####
par( #retira os labels...
xaxt="n", #...do eixo x e...
yaxt="n", #...do eixo y
xaxs="i", #Coloca a borda do plot nos pontos onde ele começa/termina (sem dar uma margem interna) em x...
yaxs="i" #... e em y
)
##plota a bolinha####
plot( #faz um plot novo
bx,by, #coordenadas da bolinha
xlim=c(0,20), #limite horizontal do gráfico
ylim=c(-0.5,20.5), #limite vertical do gráfico (como os paddles ficam em 0 e 20, os valores aqui tem uma folga para a bolinha ter espaço para cair)
pch=19, #formato da bolinha
xlab = "", #retirando os rótulos de x...
ylab = "" #... e de y
)
##plota o paddle####
segments( #adiciona uma linha no plot
x0 = px-2.5, #dessa coordenada...
x1 = px+2.5, #até essa coordenada (calculamos os extremos do paddle com base em seu ponto central)
y0 = 0, #e será horizontal, na altura zero (y1 = y0 por default)
lwd= 3 #a espessura da linha
)
###plota o inimigo####
segments( #adiciona uma linha no plot
x0 = ix-2.5, #dessa coordenada...
x1 = ix+2.5, #até essa coordenada (calculamos os extremos do paddle com base em seu ponto central)
y0 = 20, #e será horizontal, na altura zero (y1 = y0 por default)
lwd= 3 #a espessura da linha
)
###insere o score####
text( #insere um texto na área do gráfico...
x=20, #...no canto esquerdo...
y=20, #...superior...
labels=score, #...contendo o score...
pos=2 #...e com alinhamento à esquerda para não sair da área do plot
)
}
###cria a interface####
tela = tktoplevel() #abre uma janela
tktitle(tela) = "PONG!" #muda o título da janela
tela$env$plot = tkrplot(tela, fun = plotatudo, hscale=1.5, vscale=1.5) #cria um plot na janela "tela" usando a função "plotatudo" criada e com o dobro to tamnho default
tela$env$slider <- tk2scale( #cria um slider...
tela, #...na janela "tela"...
from = 25, #...com range de 25 (só números inteiros são aceitos, então a escala está multiplicada por 10 para ter maior precisão)...
to = 175, #...até 175 (não é de 0 a 200 porque o slider indica o centro do paddle e não queremos que ele saia da área de jogo) ...
variable = pxV, #...associado à variável pxV...
orient = "horizontal", #...que desliza na horizontal...
length = 400 #...e tem esse comprimento
)
tkgrid(tela$env$plot) #Adiciona o plot na janela
tkgrid(tela$env$slider, padx = 20, pady = c(5, 15)) #Adiciona o slider na janela
##########################
### aqui começa o jogo ###
##########################
while(GO == F){ #enquanto não der game over
##atualiza as posições####
px = as.integer(tclvalue(pxV))/10 #atualiza a posição do paddle
bx = bx+dbx #atualiza a posição da bolinha em x
by = by+dby #atualiza a posição da bolinha em y
ix = min(max(bx-(dbx*delay),2.5),17.5) #atualiza a posição do oponente sem deixar ele passar da borda (com um delay)
##colisão com as laterais####
if(bx>=20 || bx <= 0){ #se sair da área de jogo na horizontal...
dbx=dbx*(-1) #...inverter a direção horizontal
}
##colisão com o fundo####
if(by<=0){ #se sair da área de jogo para baixo
bx0 = (by*dbx) + bx #calcula onde o trajeto da bolinha intercepta o eixo y, explicação no fim do código para poluir menos
if(bx0>=px-2.5 & bx0<=px+2.5){ #se atravessou o paddle
score=score+round(abs(dbx)*10)*100+100 #dá uma pontuação baseada na velocidade da bolinha quando foi pega, mínimo de 100 porque sim
dby=dby*(-1) #inverte a diereção vertical
dbx= min( #atualiza a velocidade horizontal
dbx+(bx0-px)/(2.5)*0.05, #dependendo da distancia do centro onde a bolinha tocou, a inclinação do trajeto muda...
0.3 #..., mas tudo tem limite
)
}
else { #se não...
GO = "L" #...game over, derrota :(
res= "Bom jogo!\n Aperte ok para fechar" #mensagem de derrota
vic = F #marca o resultado negativo
}
}
##colisão com o teto####
if(by>=20){ #se sair da área de jogo para cima:
bx20 = ((20-by)*dbx) + bx #calcula onde o trajeto da bolinha intercepta o teto
if(bx20>=ix-2.5 & bx20<=ix+2.5){ #se atravessou o oponente
dby=dby*(-1) #inverte a diereção vertical
dbx= min( #atualiza a velocidade horizontal
dbx+(bx20-ix)/(2.5)*0.05, #dependendo da distancia do centro onde a bolinha tocou, a inclinação do trajeto muda...
0.3 #..., mas tudo tem limite
)
}
else { #se não...
GO = T #...game over, vitória!
res= "Você venceu!\n Aperte ok para fechar" #mensagem de vitória,
vic = T #resultado positivo
score = score*10 #vencer multiplica seu score por 10
}
}
##renderizar####
tkrreplot(tela$env$plot) #atualiza o plot com as novas posições calculadas
}#fim da partida
###tela de game over#####
tkmessageBox(title="Fim de Jogo",message=res, type="ok") #exibe a mensagem final
tkdestroy(tela) #fecha o jogo
return(data.frame(score,vic)) #retorna resultado como dataframe
} #termina ojogo()
##prepara o output####
resumo = data.frame(0,0) #cria um dataframe para por os resultados dos jogos
resumo = resumo[0,0] #esvazia o dataframe
##prepara para jogar pelo menos 1 vez####
play=tclVar(0) #variável que diz se é pra rodar o jogo
while(tclvalue(play)==0){ #enquanto não dizer chega
resumo = rbind(resumo,ojogo(mode=mode)) #roda ojogo() e salva o resultado em uma nova linha do resumo
#depois do jogo
win = tktoplevel() #cria uma janela nova
tktitle(win) = "Novo Jogo" #chama de Novo Jogo
win$env$butsim = tk2button(win, text = "SIM", command = function() tclvalue(play) <- 0) #Coloca um botâo sim que na prática não faz nada
win$env$butnope= tk2button(win, text = "NÃO", command = function() tclvalue(play) <- 1) #Coloca um botão não que diz chega
tkgrid(tk2label(win, text = "Jogar Novamente?")) #coloca um texto simples na janela
tkgrid(win$env$butsim, win$env$butnope, padx = 20, pady = 15) #coloca os botões na janela e em linha
tkwait.variable(play) #espera a variável play ser atualizada (na prática espera um botão ser apertado) para continuar com o código
tkdestroy(win) #fecha a janela
}
if(placar==T){ #se o placar foi pedido
colnames(resumo) = c("score","vitoria") #ajeita o nome das colunas
return(resumo) #e pode entregar
}
}
#considerações: ####
#1. Colocar o controle e o jogo em telas diferentes (como dito na proposta) tornava a experiência pior, agora eles estão na mesma janela
#2. O grau de precisão da posição da bolinha é maior do que eu pretendia originalmente, então os cálculos para corrigir a posição após colisões foi retirado por ser quase imperceptível
#3. Na proposta original seria retornado o tempo de jogo como forma de score, mas o calculo de score usado aqui é mais interessante
#4. O aumento de velocidade em y da bolinha também foi retirado por estar ativamente tornando o jogo menos divertido, além disso, para derrotar o oponente jogador terá que acelerar a bolinha por conta própria
#5. Dependendo do programa que você usar para trabalhar no R, as janelas criadas pelo tcltk podem aparecer quando você criar a função (mesmo sem dar o comando para rodar) e podem estar desconfiguradas....
#...Nesse caso, surgirá a janela de fim de jogo com a mensagem padrão "Aperte Ok". Apertar ok deve fazer as janelas fecharem. A função deve rodar normalmente independente disso acontecer.
#6. Os pacotes tcltk permitem que as funções do R sejam chamadas de acordo com eventos e rodem em paralelo, por exemplo o slider pode ter uma função chamada sempre que seu valor é mudado...
#...Provavelmente tem como fazer esse jogo rodar ainda melhor usando essas opções orientadas a eventos...
#..., mas considerando a justificativa da proposta achei melhor evita-las o máximo possível...
#...A janela de novo jogo atribui uma função aos botões que é ativada no evento do botão ser apertado, mas como tk.wait mantém o R em pausa até um botão ser apertado...
#...e essa função apenas atribui um novo valor a uma variável, a lógica não é diferente de pedir input do usuário na linha de comando, usei a janela pela estética.
#Cálculo por trás da intercepção da bolinha:####
# dado que a cada instante bolinha tem movimento retilíneo e uniforme, seu trajeto pode ser expresso em y = x*a + b
# logo:
#
# by = bx * a + b [1]
# by - dby = (bx - dbx) * a + b [2]
#
# para o caso em que estamos interessados, dby = -1
#
# substituímos [1] em [2] para descobrir
#
# a = -1/dbx [3]
#
# substituímos [3] em [1] para descobrir
#
# b = by+bx/dbx [4]
#
# agora podemos usar [3] e [4] para calcular o valor de bx quando by = 0
#
# 0 = bx0 * (-1/dbx) + by+ bx/dbx
# bx0 = (by*dbx) + bx
#
#
# o mesmo tipo de raciocínio foi utilizado para calcular bx20
########