Program KABBOOUM;
uses crt,graph,dos;
{ Constantes }
const
opca_x=250; { define a posi‡ao horizontal da 1¦ opcao }
opca_y=110; { define a posi‡ao vertical da 1¦ opcao }
t_bot_x=130; { tamanho do botÆo x }
t_bot_y=40; { tamanho do botÆo y }
espaco=50; { Espa‡o entre os botäes }
n_botoes=5; { N§ de botoes }
cor_botao=7; { Cor de fundo dos botäes }
cor_opcao=1; { Cor das varias opcoes }
enter=chr(13);
scim= chr(72);
sbax= chr(80);
sesq= chr(75);
sdir= chr(77);
esc=chr(27);
tab=chr(9);
alt_tab=chr(15);
dlt=chr(83);
home=chr(71);
ende=chr(79);
pgdw=chr(81);
c_ma=chr(67); { Faz apagar todos os ponto brancos do ecran}
c_mi=chr(99);
x_ma=chr(88); { Faz sair da procedure jogo e acabar com o torneio}
x_mi=chr(120);
bola1=25;
n_notas=20; { N§ maximo de notas }
{variaveis do jogo}
var
tan : pointer;
Size : Word;
min, max, ax, ay, bx, by, grav_op, turn, temp, kills, cai, t_corpo, t_arma,
som, ganhou, t_c, acel, vez, move, cont, conta, rastro, computador, n_jogad, axx,
ayy, r_exp, c_exp_x, c_exp_y, top1, top2, vencedor, vento, n_jogos, suavidade,
cre_y,npicos, n_jogo_actual,opcao, sair,vento_max: integer;
picox, picoy: array[0..200] of integer;
nomes, dead, energ, n_exp, cor, p_c_y, p_c_x, victorias, pontos: array [0..10] of integer;
armas_dsp: array[1..10,1..11] of integer;
grav, vent: real;
ang, v, norma: array[0..10] of real;
rastro_0, rastro_1, rastro_texto, som_t, som_1, som_2, comput, comput_1,
comput_2, comput_3, n_jogadores, gravidade, suave_ss, suave_ps, suave_as,
suave_sn, suave_ms, suave_es, salvar, num_picos, suave, grav_1, grav_2,
grav_3, vento_txt,num_jogos: string;
nome_opca: array [1..n_botoes] of string;
armas: array [1..11] of string;
ik, tecla: char;
{
*****************************************************************************
* Procedure : Botao *
* Descri‡Æo : Consiste em criar uma box *
* Variaveis : x, y, xf, yf *
* Parte : Menu *
* *
*****************************************************************************
}
procedure botao(x, y, xf, yf: integer);
begin
{setcolor(cor_botao);
setfillstyle(1,cor_botao);
bar(x,y,xf,yf);
setcolor(15);
line(x-1,y-1,xf,y-1);
line(x-1,y-1,x-1,yf);
setcolor(8);
line(x-1,yf+1,xf+1,yf+1);
line(xf+1,y-1,xf+1,yf+1);}
setcolor(cor_botao);
rectangle(x,y,xf,yf);
setfillstyle(1,cor_botao);
floodfill(x+1,y+1,cor_botao);
setcolor(15);
line(x-1,y-1,xf,y-1);
line(x-1,y-1,x-1,yf);
setcolor(8);
line(x-1,yf+1,xf+1,yf+1);
line(xf+1,y-1,xf+1,yf+1);
end;
{
*****************************************************************************
* Procedure : Botao_actual *
* Descri‡Æo : Consiste em criar uma box do botao actual *
* Variaveis : x, y, xf, yf *
* Parte : Menu *
* *
*****************************************************************************
}
procedure botao_actual(x, y, xf, yf:integer);
begin
{ setcolor(cor_botao);
setfillstyle(1,cor_botao);
bar(x,y,xf,yf);
setcolor(8);
line(x-1,y-1,xf+1,y-1);
line(x-1,y-1,x-1,yf+1);
setcolor(15);
line(x,yf+2,xf+1,yf+2);
line(xf+1,y,xf+1,yf+1);
setcolor(15);}
setcolor(cor_botao);
rectangle(x,y,xf,yf);
setfillstyle(1,cor_botao);
floodfill(x+1,y+1,cor_botao);
setcolor(8);
line(x-1,y-1,xf+1,y-1);
line(x-1,y-1,x-1,yf+1);
setcolor(15);
line(x,yf+2,xf+1,yf+2);
line(xf+1,y,xf+1,yf+1);
setcolor(15);
end;
{
*****************************************************************************
* Procedure : Bomba_apre *
* Descri‡Æo : Consiste em apresentar uma cena fixe no menu do jogo *
* Variaveis : nÆo tem variaveis *
* Parte : MAIN *
* *
*****************************************************************************
}
procedure bomba_apre;
var
i: integer;
begin
if som=1 then
begin
sound(70);
delay(10);
nosound;
end;
end;
{
*****************************************************************************
* Procedure : Creditos *
* Descri‡Æo : Consiste na opcao que expoe os autores do programa *
* Variaveis : nÆo tem variaveis *
* *
*****************************************************************************
}
procedure creditos(i:integer);
var
cre_1,cre_2 : pointer;
Size_1,Size_2: Word;
begin
setcolor(14);
Size_1 := ImageSize(40,400,240,430);
Size_2 := ImageSize(400,400,600,430);
GetMem(cre_1, Size_1);
GetMem(cre_2, Size_2);
getimage(40,400-(i*5),240,430-(i*5),cre_1^);
getimage(400,400-(i*5),600,430-(i*5),cre_2^);
settextstyle(2,0,7);
{ Para o Pedro S Ferreira }
outtextxy(40,400-(i*5),'Pedro S Ferreira');
{ Para o Pedro Miguel de Andrade Tarrinho }
outtextxy(400,400-(i*5),'Pedro A. Tarrinho');
if computador=1 then delay(1000)
else if computador=2 then delay(500)
else if computador=3 then delay(250);
putimage(40,400-(i*5),cre_1^, CopyPut);
putimage(400,400-(i*5),cre_2^, CopyPut);
FreeMem(cre_1, size_1);
FreeMem(cre_2, size_2);
end;
{
*****************************************************************************
* Procedure : Prima_esc *
* Descri‡Æo : Consiste numa procedure que avisa para primir ESC *
* Variaveis : nÆo tem variaveis *
* *
*****************************************************************************
}
procedure prima_esc;
begin
settextstyle(2, HorizDir, 7);
botao(190,448,450,475);
setcolor(0);
outtextxy(200,448,'Prima ESC para Sair');
end;
{
*****************************************************************************
* Procedure : Opcoes *
* Descri‡Æo : Consiste pedir informa‡Æo sobre o computador e jogo *
* Variaveis : nÆo tem variaveis *
* Parte : Op‡oes *
* *
*****************************************************************************
}
procedure opcoes;
var
P,T : pointer;
Sz : Word;
tecla1 : Char;
nopcoes,opcao,saire: integer ;
txt :string;
i :integer;
begin
saire:=0;
tecla1:='1';
opcao:=1;
nopcoes:=10;
botao(200,20,450,70);
settextstyle(1, HorizDir, 5);
setcolor(14);
outtextxy(237,15,' OP€OES ');
settextstyle(2, HorizDir, 5);
for i:=0 to trunc(nopcoes/2)-1 do
begin
botao(10,90+(60*i),320,130+(60*i));
end;
for i:=0 to trunc(nopcoes/2)-1 do
begin
botao(330,90+(60*i),630,130+(60*i));
end;
setcolor(cor_opcao);
outtextxy(20,100,som_t);
outtextxy(340,100,comput);
outtextxy(20,160,n_jogadores);
outtextxy(340,160,gravidade);
outtextxy(20,220,rastro_texto);
outtextxy(340,220,num_picos);
outtextxy(20,280,suave);
outtextxy(340,280,vento_txt);
outtextxy(20,340,num_jogos);
outtextxy(340,340,salvar);
{++++++++++++++Imprimir no ecran a op‡Æo actual++++++++++++++++}
botao_actual(10,90,320,130-1);
SetFillStyle(1,cor_botao);
bar(199,99,310,120);
setcolor(15);
if (som=1) then outtextxy(200,100,som_1)
else if (som=0) then outtextxy(200,100,som_2);
{++++++++Imprimir no ecran as op‡äes nÆo selecionadas++++++++++}
setcolor(8);
if (computador=1) then outtextxy(520,100,comput_1)
else if (computador=2) then outtextxy(520,100,comput_2)
else if (computador=3) then outtextxy(520,100,comput_3);
setcolor(8);
str(n_jogad,txt);
outtextxy(200,160,txt);
setcolor(8);
if (grav_op=1) then outtextxy(520,160,grav_1)
else if (grav_op=2) then outtextxy(520,160,grav_2)
else if (grav_op=3) then outtextxy(520,160,grav_3);
setcolor(8);
if (rastro=0) then outtextxy(200,220,rastro_0)
else if (rastro=1) then outtextxy(200,220,rastro_1);
setcolor(8);
str(npicos,txt);
outtextxy(520,220,txt);
if (suavidade=20) then outtextxy(200,280,suave_es)
else if (suavidade=100) then outtextxy(200,280,suave_ms)
else if (suavidade=180) then outtextxy(200,280,suave_as)
else if (suavidade=260) then outtextxy(200,280,suave_sn)
else if (suavidade=340) then outtextxy(200,280,suave_ps)
else if (suavidade=420) then outtextxy(200,280,suave_ss);
str(vento_max,txt);
outtextxy(520,280,txt);
str(n_jogos,txt);
outtextxy(220,340,txt);
while(saire<>1) do
begin
tecla1:=readkey;
if (tecla1<>'0') then
begin
if (opcao=1) then
begin
botao(10,90,320,130);
SetFillStyle(1,cor_botao);
bar(199,99,310,120);
setcolor(8);
if (som=1) then outtextxy(200,100,som_1)
else if (som=0) then outtextxy(200,100,som_2);
end
else if (opcao=2) then
begin
botao(330,90,630,130);
SetFillStyle(1,cor_botao);
bar(519,99,600,120);
setcolor(8);
if (computador=1) then outtextxy(520,100,comput_1)
else if (computador=2) then outtextxy(520,100,comput_2)
else if (computador=3) then outtextxy(520,100,comput_3);
end
else if (opcao=3) then
begin
botao(10,150,320,190);
SetFillStyle(1,cor_botao);
bar(199,159,310,181);
setcolor(8);
str(n_jogad,txt);
outtextxy(200,160,txt)
end
else if (opcao=4) then
begin
botao(330,150,630,190);
SetFillStyle(1,cor_botao);
bar(519,159,600,181);
setcolor(8);
if (grav_op=1) then outtextxy(520,160,grav_1)
else if (grav_op=2) then outtextxy(520,160,grav_2)
else if (grav_op=3) then outtextxy(520,160,grav_3);
end
else if (opcao=5) then
begin
botao(10,210,320,250);
SetFillStyle(1,cor_botao);
bar(199,219,310,249);
setcolor(8);
if (rastro=0) then outtextxy(200,220,rastro_0)
else if (rastro=1) then outtextxy(200,220,rastro_1);
end
else if (opcao=6) then
begin
botao(330,210,630,250);
SetFillStyle(1,cor_botao);
bar(519,219,600,249);
setcolor(8);
str(npicos,txt);
outtextxy(520,220,txt)
end
else if (opcao=7) then
begin
botao(10,270,320,310);
SetFillStyle(1,cor_botao);
bar(199,279,310,309);
setcolor(8);
if (suavidade=20) then outtextxy(200,280,suave_es)
else if (suavidade=100) then outtextxy(200,280,suave_ms)
else if (suavidade=180) then outtextxy(200,280,suave_as)
else if (suavidade=260) then outtextxy(200,280,suave_sn)
else if (suavidade=340) then outtextxy(200,280,suave_ps)
else if (suavidade=420) then outtextxy(200,280,suave_ss);
end
else if (opcao=8) then
begin
botao(330,270,630,310);
SetFillStyle(1,cor_botao);
bar(499,279,610,309);
setcolor(8);
str(vento_max,txt);
outtextxy(520,280,txt);
end
else if (opcao=9) then
begin
botao(10,330,320,370);
SetFillStyle(1,cor_botao);
bar(199,339,310,369);
setcolor(8);
str(n_jogos,txt);
outtextxy(220,340,txt);
end
else if (opcao=10) then botao(330,330,630,370);
if (tecla1=sdir) then
begin
if (opcao<>nopcoes) then opcao:=opcao+1
else if (opcao=nopcoes) then opcao:=1;
end;
if (tecla1=sesq) then
begin
if (opcao<>1) then opcao:=opcao-1
else if (opcao=1) then opcao:=nopcoes;
end;
if (tecla1=scim) then
begin
if (opcao=1) then if (som=1) then som:=0 else som:=1
else if (opcao=2) then
begin
if (computador=1) then computador:=3
else computador:=computador-1;
end
else if (opcao=3) then
begin
if n_jogad=10 then n_jogad:=2
else n_jogad:=n_jogad+1;
end
else if (opcao=4) then
begin
if (grav_op=3) then grav_op:=1
else grav_op:=grav_op+1;
if (grav_op=1) then grav:=1
else if (grav_op=2) then grav:=5
else if (grav_op=3) then grav:=15;
end
else if (opcao=5) then
begin
if (rastro=0) then rastro:=1
else rastro:=0;
end
else if (opcao=6) then
begin
if (npicos=200) then npicos:=0
else npicos:=npicos+5;
end
else if (opcao=7) then
begin
if (suavidade<>20) then suavidade:=suavidade-80
else suavidade:=420;
end
else if (opcao=8) then
begin
if (vento_max<200) then vento_max:=vento_max+10
else vento_max:=0;
end
else if (opcao=9) then
begin
if (n_jogos<9) then n_jogos:=n_jogos+2
else n_jogos:=1;
end;
end;
if (tecla1=sbax) then
begin
if (opcao=1) then if (som=1) then som:=0 else som:=1
else if (opcao=2) then
begin
if (computador=3) then computador:=1
else computador:=computador+1;
end
else if (opcao=3) then
begin
if n_jogad=2 then n_jogad:=10
else n_jogad:=n_jogad-1;
end
else if (opcao=4) then
begin
if (grav_op=1) then grav_op:=3
else grav_op:=grav_op-1;
if (grav_op=1) then grav:=1
else if (grav_op=2) then grav:=5
else if (grav_op=3) then grav:=15;
end
else if (opcao=5) then
begin
if (rastro=0) then rastro:=1
else rastro:=0;
end
else if (opcao=6) then
begin
if (npicos=0) then npicos:=200
else npicos:=npicos-5;
end
else if (opcao=7) then
begin
if (suavidade<>420) then suavidade:=suavidade+80
else suavidade:=20;
end
else if (opcao=8) then
begin
if (vento_max<>0) then vento_max:=vento_max-10
else vento_max:=200;
end
else if (opcao=9) then
begin
if (n_jogos<>1) then n_jogos:=n_jogos-2
else n_jogos:=9;
end;
end;
if (opcao=1) then
begin
botao_actual(10,90,320,130-1);
SetFillStyle(1,cor_botao);
bar(199,99,310,120);
setcolor(15);
if (som=1) then outtextxy(200,100,som_1)
else if (som=0) then outtextxy(200,100,som_2);
end
else if (opcao=2) then
begin
botao_actual(330,90,630,130-1);
SetFillStyle(1,cor_botao);
bar(519,99,600,120);
setcolor(15);
if (computador=1) then outtextxy(520,100,comput_1)
else if (computador=2) then outtextxy(520,100,comput_2)
else if (computador=3) then outtextxy(520,100,comput_3);
end
else if (opcao=3) then
begin
botao_actual(10,150,320,190-1);
SetFillStyle(1,cor_botao);
bar(199,159,310,181);
setcolor(15);
str(n_jogad,txt);
outtextxy(200,160,txt)
end
else if (opcao=4) then
begin
botao_actual(330,150,630,190-1);
SetFillStyle(1,cor_botao);
bar(519,159,600,181);
setcolor(15);
if (grav_op=1) then outtextxy(520,160,grav_1)
else if (grav_op=2) then outtextxy(520,160,grav_2)
else if (grav_op=3) then outtextxy(520,160,grav_3);
end
else if (opcao=5) then
begin
botao_actual(10,210,320,250-1);
SetFillStyle(1,cor_botao);
bar(199,219,310,249);
setcolor(15);
if (rastro=0) then outtextxy(200,220,rastro_0)
else if (rastro=1) then outtextxy(200,220,rastro_1);
end
else if (opcao=6) then
begin
botao_actual(330,210,630,250-1);
SetFillStyle(1,cor_botao);
bar(519,219,600,249);
setcolor(15);
str(npicos,txt);
outtextxy(520,220,txt);
end
else if (opcao=7) then
begin
botao_actual(10,270,320,310-1);
SetFillStyle(1,cor_botao);
bar(199,279,310,309);
setcolor(15);
if (suavidade=20) then outtextxy(200,280,suave_es)
else if (suavidade=100) then outtextxy(200,280,suave_ms)
else if (suavidade=180) then outtextxy(200,280,suave_as)
else if (suavidade=260) then outtextxy(200,280,suave_sn)
else if (suavidade=340) then outtextxy(200,280,suave_ps)
else if (suavidade=420) then outtextxy(200,280,suave_ss);
end
else if (opcao=8) then
begin
botao_actual(330,270,630,310-1);
SetFillStyle(1,cor_botao);
bar(499,279,610,309);
setcolor(15);
str(vento_max,txt);
outtextxy(520,280,txt);
end
else if (opcao=9) then
begin
botao_actual(10,330,320,370-1);
SetFillStyle(1,cor_botao);
bar(199,339,310,369);
setcolor(15);
str(n_jogos,txt);
outtextxy(220,340,txt);
end
else if (opcao=10) then botao_actual(330,330,630,370-1);
end;
if (tecla1=enter) and (opcao=10) then saire:=1;
if (tecla1=x_ma) or (tecla1=x_mi) then saire:=1;
end;
end;
{
*****************************************************************************
* Procedure : Apre_menu *
* Descri‡Æo : Consiste em criar o menu *
* Variaveis : NÆo tem variaveis *
* Parte : Menu *
* *
*****************************************************************************
}
procedure apre_menu;
var
i,j:integer;
begin
settextstyle(3,0,6);
setcolor(4);
outtextxy(188,25,'KABBOOUM');
j:=1;
{ Desenhar os botäes do menu }
for i:=1 to n_botoes*espaco do
begin
botao(opca_x,opca_y+i,opca_x+t_bot_x,opca_y+i+t_bot_y);
settextstyle(3,0,4);
outtextxy(opca_x-55,opca_y+i,nome_opca[j]);
i:=i+espaco-1;
j:=1+j;
end;
botao_actual(opca_x,opca_y+(opcao-1)*espaco,opca_x+t_bot_x,opca_y+(opcao-1)*espaco+t_bot_y);
p_c_y[0]:=opca_y+(opcao-2)*espaco+10;
outtextxy(opca_x-55,opca_y+(opcao-1)*espaco+1,nome_opca[opcao]);
end;
{
*****************************************************************************
* Procedure : Troca *
* Descri‡Æo : Muda os valores da barra *
* Variaveis : x,y,txt *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure troca(x,y,txt:integer);
var
temp:string;
begin
str(txt,temp);
setfillstyle(1,0);
floodfill(x+1,y+1,8);
setfillstyle(1,7);
floodfill(x+1,y+1,8);
setcolor(0);
settextstyle(2,0,5);
outtextxy(x+8,y,temp);
end;
{
*****************************************************************************
* Procedure : Ang *
* Descri‡Æo : Converter graus para radianos *
* Variaveis : graus *
* Parte : Jogo *
* *
*****************************************************************************
}
function angu(graus :integer):real;
begin
angu:=(Pi*graus)/180;
end;
function rad(radianos :real):integer;
begin
rad:=trunc((180*radianos)/Pi);
end;
{
*********************** Inicia‡„o das variaveis *****************************
* Procedure : Inicializacao *
* Descri‡Æo : Inicializar variaveis para o menu *
* Variaveis : NÆo tem variaveis *
* Parte : Menu *
* *
*****************************************************************************
}
procedure inicializacao;
var
txt:string;
i,j:integer;
begin
{ atribui‡Æo do texto do menu … estrutura }
nome_opca[1]:=' Jogar '; { inicializa‡Æo da op‡Æo 0 }
nome_opca[2]:=' Op‡oes '; { inicializa‡Æo da op‡Æo 2 }
nome_opca[3]:=' Ajuda '; { inicializa‡Æo da op‡Æo 3 }
nome_opca[4]:=' Cr‚ditos '; { inicializa‡Æo da op‡Æo 3 }
nome_opca[5]:=' Sair '; { inicializa‡Æo da op‡Æo 4 }
{ atribui‡Æo das varias op‡äes}
som:=0;
som_t:='Efeitos Digitalizados';
som_1:='Speaker';
som_2:='Sem Som';
computador:=1;
comput:='Tipo de Computador';
comput_1:='R pido';
comput_2:='Normal';
comput_3:='Lento';
n_jogadores:='N§ de Jogadores ';
gravidade:='Gravidade do planeta';
grav_1:='Lua';
grav_2:='Terra';
grav_3:='Jupiter';
grav:=5; {Gravidade inicial}
grav_op:=2; {Opcao da gravidade}
num_picos:='N§ m ximo de Picos';
suave:='Suavidade do terreno';
salvar:='Menu Principal';
suave_ss:='Nenhuma';
suave_ps:='Pouca';
suave_sn:='Normal';
suave_as:='Alguma';
suave_ms:='Muita';
suave_es:='Extrema';
vento_txt:='Vento m ximo';
vento_max:=100;
num_jogos:='N£mero de jogos';
n_jogos:=3;
opcao:=1;
tecla:='0';
sair:=0;
turn:=1;
cont:=1;
n_jogad:=2;
{se deixa rastro ou nÆo}
rastro:=1;
rastro_texto:='Com ou sem Rastro';
rastro_0:='Sem Rastro';
rastro_1:='Com Rastro';
{inicializa tank da apresenta‡Æo }
ang[0]:=angu(45);
p_c_x[0]:=150;
p_c_y[0]:=opca_y;
npicos:=50;
suavidade:=260;
min:=1;
max:=639;
armas[1]:='Granada';
armas[2]:='Morteiro';
armas[3]:='deslizante';
armas[4]:='DESLIZANTE';
armas[5]:='Lazer';
armas[6]:='napalme';
armas[7]:='NAPALME';
armas[8]:='Terramoto';
armas[9]:='Desvatador';
armas[10]:='terra';
armas[11]:='TERRA';
for i:=1 to 10 do
begin
nomes[i]:=i;
end;
{incializa‡Æo da variavel da subida dos cr‚ditos}
cre_y:=1;
end;
{
*****************************************************************************
* Procedure : Inicializa *
* Descri‡Æo : Inicializa‡Æo da variaveis que regulam o jogo *
* Variaveis : t_c,acel,enter,scim,sbax,sesq,sdir,esc *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure inicializa ;
var
i,difer1,difer2 : integer;
begin
{Inicializa‡äes}
ik:=chr(0);
acel:=-1;
t_corpo:=8;
t_arma:=15;
c_exp_x:=0;
c_exp_y:=0;
difer1:=trunc(((640/(n_jogad+1))/2)/(n_jogad/10));
difer2:=trunc((640+difer1*2)/(n_jogad+1));
for i:=1 to n_jogad do
begin
energ[i]:=100;
dead[i]:=1;
n_exp[i]:=1;
v[i]:=20;
ang[i]:=angu(90);
p_c_x[i]:=trunc(-difer1+difer2*i);
p_c_y[i]:=40+t_arma;
norma[i]:=30;
end;
cor[1]:=0;
cor[2]:=2;
cor[3]:=3;
cor[4]:=4;
cor[5]:=5;
cor[6]:=6;
cor[7]:=8;
cor[8]:=9;
cor[9]:=11;
cor[10]:=12;
cai:=1;
vez:=1;
kills:=0;
vento:=1;
vencedor:=0;
end;
{
*****************************************************************************
* Procedure : Rot *
* Descri‡Æo : Rota‡Æo de um ponto relativamente a uma origem *
* Variaveis : cntx,cnty,rai1,rai2,direc,cor e ang_c *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure rot(cntx,cnty,rai1,rai2,direc,cor : integer);
begin
ax:=trunc(cntx+rai1*cos(-ang[vez]));
ay:=trunc(cnty+rai1*sin(-ang[vez]));
bx:=trunc(cntx+rai2*cos(-ang[vez]));
by:=trunc(cnty+rai2*sin(-ang[vez]));
setcolor(1);
line(ax,ay,bx,by);
if ((ang[vez]>=angu(179)) and (direc=1)) then ang[vez]:=0
else if ((ang[vez]<=angu(1)) and (direc=-1)) then ang[vez]:=angu(180)
else if ((ang[vez]>=angu(175)) and (direc=5)) then ang[vez]:=0
else if ((ang[vez]<=angu(5)) and (direc=-5)) then ang[vez]:=angu(180)
else ang[vez]:=ang[vez]+angu(direc);
ax:=trunc(cntx+rai1*cos(-ang[vez]));
ay:=trunc(cnty+rai1*sin(-ang[vez]));
bx:=trunc(cntx+rai2*cos(-ang[vez]));
by:=trunc(cnty+rai2*sin(-ang[vez]));
setcolor(cor);
line(ax,ay,bx,by);
end;
{
*****************************************************************************
* Procedure : Tanque *
* Descri‡Æo : Consiste em criar um tank para a apresenta‡Æo *
* Variaveis : posx,posy,cor,qual *
* Parte : Menu *
* *
*****************************************************************************
}
procedure tanque(posx,posy,cor,qual:integer);
begin
setcolor(cor);
SetFillStyle(1, cor);
pieslice(posx,posy,0,180,20);
SetFillStyle(1, 8);
setcolor(8);
pieslice(posx-12,posy-3,0,360,4);
SetFillStyle(1, 8);
setcolor(8);
pieslice(posx+12,posy-3,0,360,4);
line(posx-12,posy-7,posx+12,posy-7);
line(posx-12,posy+1,posx+12,posy+1);
setcolor(7);
if qual=1 then
begin
line(posx-12,posy-8,posx-12,posy-7);
line(posx-8,posy-8,posx-8,posy-6);
line(posx-4,posy-8,posx-4,posy-6);
line(posx,posy-8,posx,posy-6);
line(posx+4,posy-8,posx+4,posy-6);
line(posx+8,posy-8,posx+8,posy-6);
line(posx+12,posy-8,posx+12,posy-7);
line(posx-12,posy,posx-12,posy+1);
line(posx-8,posy,posx-8,posy+2);
line(posx-4,posy,posx-4,posy+2);
line(posx,posy,posx,posy+2);
line(posx+4,posy,posx+4,posy+2);
line(posx+8,posy,posx+8,posy+2);
line(posx+12,posy,posx+12,posy+1);
end
else if qual=2 then
begin
line(posx-14,posy-8,posx-14,posy-7);
line(posx-10,posy-8,posx-10,posy-6);
line(posx-6,posy-8,posx-6,posy-6);
line(posx-2,posy-8,posx-2,posy-6);
line(posx+2,posy-8,posx+2,posy-6);
line(posx+6,posy-8,posx+6,posy-6);
line(posx+10,posy-8,posx+10,posy-6);
line(posx+14,posy-8,posx+14,posy-7);
line(posx-14,posy,posx-14,posy+1);
line(posx-10,posy,posx-10,posy+2);
line(posx-6,posy,posx-6,posy+2);
line(posx-2,posy,posx-2,posy+2);
line(posx+2,posy,posx+2,posy+2);
line(posx+6,posy,posx+6,posy+2);
line(posx+10,posy,posx+10,posy+2);
line(posx+14,posy,posx+14,posy+1);
end;
ax:=trunc(posx+20*cos(-ang[0]));
ay:=trunc(posy+20*sin(-ang[0]));
bx:=trunc(posx+40*cos(-ang[0]));
by:=trunc(posy+40*sin(-ang[0]));
setcolor(cor);
SetLineStyle(0,5,3);
line(ax,ay,bx,by);
SetLineStyle(0,5,1);
end;
{
*****************************************************************************
* Procedure : Barra de status *
* Descri‡Æo : Desenha a barra de status *
* Variaveis : NÆo tem variaveis *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure barra;
begin
setcolor(15);
line(0,0,639,0);
line(0,0,0,30);
setcolor(8);
line(0,30,639,30);
line(639,0,639,30);
setcolor(7);
setfillstyle(1,7);
bar(1,1,638,29);
setcolor(0);
settextstyle(2,0,5);
outtextxy(15,7,'Tanque');
setcolor(8);
rectangle(70,6,100,24);
setcolor(0);
outtextxy(140,7,'Energia');
setcolor(8);
rectangle(200,6,235,24);
setcolor(0);
outtextxy(250,7,'Angulo');
setcolor(8);
rectangle(305,6,341,24);
setcolor(0);
outtextxy(350,7,'Velocidade');
setcolor(8);
rectangle(435,6,483,24);
setcolor(0);
outtextxy(500,7,'Arma');
setcolor(8);
rectangle(540,6,630,24);
end;
{
*****************************************************************************
* Procedure : Energia *
* Descri‡Æo : *
* Variaveis : NÆo tem variaveis *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure energia;
var
nrm1,a1,b1,c1,d1:longint;
i:integer;
begin
for i:=1 to n_jogad do
begin
a1:=c_exp_x-p_c_x[i];
b1:=c_exp_y-p_c_y[i];
c1:=a1*a1;
d1:=b1*b1;
nrm1:=trunc(sqrt(c1+d1)-10);
if r_exp-nrm1>0 then
begin
energ[i]:=energ[i]-(trunc(((r_exp-nrm1)*100)/20));
if energ[i]<=0 then energ[i]:=0;
end;
end;
end;
{
*****************************************************************************
* Procedure : tanq *
* Descri‡Æo : desenhar o tanque *
* Variaveis : posx e posy *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure tanq(posx,posy,cor:integer);
begin
setcolor(cor);
setfillstyle(1, cor);
pieslice(posx,posy,0,180,t_corpo-1);
end;
{
*****************************************************************************
* Procedure : caitanq *
* Descri‡Æo : *
* Variaveis : *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure caitanq(apre:integer);
var
tmp_vez:integer;
ponto:array[1..10]of integer;
begin
tmp_vez:=vez;
for vez:=1 to n_jogad do
begin
if energ[vez]>0
then begin
ponto[vez]:=getpixel(p_c_x[vez],p_c_y[vez]+1);
while (ponto[vez]<>10) and (ponto[vez]<>13) do
begin
rot(p_c_x[vez],p_c_y[vez],t_corpo-1,t_arma,0,1);
SetFillStyle(1,1);
pieslice(p_c_x[vez],p_c_y[vez]-5,0,180,t_corpo);
setcolor(1);
arc(p_c_x[vez],p_c_y[vez],0,180,t_corpo-1);
p_c_y[vez]:=p_c_y[vez]+1;
rot(p_c_x[vez],p_c_y[vez],t_corpo,t_arma,0,cor[vez]);
ponto[vez]:=getpixel(p_c_x[vez],p_c_y[vez]+1);
if apre=1 then energ[vez]:=energ[vez]-1;
if computador=1 then delay(5)
else if computador=2 then delay(2)
else if computador=3 then delay(0);
SetFillStyle(1,cor[vez]);
pieslice(p_c_x[vez],p_c_y[vez],0,180,t_corpo-1);
end;
if apre=1 then if energ[vez]<=0 then energ[vez]:=0;
end;
end;
vez:=tmp_vez;
end;
{
*****************************************************************************
* Procedure : limpa *
* Descri‡Æo : *
* Variaveis : *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure limpa(a,b:integer);
var
i,j :integer;
begin
if min<>1 then
begin
for i:=1 to min do
begin
putpixel(i,31,15);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
end;
for i:=min to max do
begin
for j:=32 to 478 do
begin
putpixel(i,31,15);
if getpixel(i,j)=a then putpixel(i,j,b);
end;
end;
if max<>639 then
begin
for i:=max to 639 do
begin
putpixel(i,31,15);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
end;
setcolor(0);
line(0,31,639,31);
end;
{
*****************************************************************************
* Procedure : Aparar Terra *
* Descri‡Æo : Varredor de Terra *
* Variaveis : NÆo tem variaveis *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure aparar_terra;
var
x,y,xstart,xend,ystart,yend,yterra,i,j:integer;
texto:string;
flag:boolean;
begin
for i:=1 to n_jogad do
begin
xstart:=p_c_x[i]-t_corpo-t_arma;
xend:=p_c_x[i]+t_corpo+t_arma;
ystart:=p_c_y[i];
yend:=34;
flag:=false;
while not flag do
begin
for x:=xstart to xend do
if getpixel(x,yend)=10 then flag:=true;
yend:=yend+1;
end;
for x:=xstart to xend do begin
yterra:=ystart;
while (getpixel(x,yterra-1)<>1) and (getpixel(x,yterra)=10) do
begin
yterra:=yterra-1;
end;
for y:=ystart downto yend do
if ((getpixel(x,y+1)=1)or(getpixel(x,y+1)=15)) and (getpixel(x,y)=10)
then begin
PutPixel(x,y,1);
PutPixel(x,yterra,10);
yterra:=yterra-1;
end;
end;
end;
setcolor(13);
rectangle(0,32,639,479);
min:=1;
max:=639;
end;
{
*****************************************************************************
* Procedure : Terra *
* Descri‡Æo : Varredor de Terra *
* Variaveis : NÆo tem variaveis *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure terra;
var
teste1,teste2,x,y,xstart,xend,ystart,yend,yterra,i:integer;
texto:string;
flag:boolean;
begin
if min<>1 then
begin
for i:=1 to min do
begin
putpixel(i,31,15);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
end;
if (n_exp[vez]=8)or(n_exp[vez]=9)
then begin
xstart:=min;
xend:=max;
ystart:=478;
flag:=false;
yend:=34;
while not flag do
begin
for x:=xstart to xend do
if getpixel(x,yend)=10 then flag:=true;
yend:=yend+1;
end;
for x:=xstart to xend do begin
putpixel(x,31,15);
yterra:=ystart;
while (getpixel(x,yterra-1)<>1) and (getpixel(x,yterra)=10) do
begin
yterra:=yterra-1;
end;
for y:=ystart downto yend do
if ((getpixel(x,y+1)=1)or(getpixel(x,y+1)=15)) and (getpixel(x,y)=10)
then begin
PutPixel(x,y,1);
PutPixel(x,yterra,10);
yterra:=yterra-1;
end;
end;
end
else begin
if (n_exp[vez]=10)or(n_exp[vez]=11)
then begin
if c_exp_x-(bola1*2+1) <= 0 then xstart:=0
else xstart:=c_exp_x-(bola1*2+1);
if c_exp_x+(bola1*2+1) >= 639 then xend:=639
else xend:=c_exp_x+(bola1*2+1);
ystart:=478
end
else begin
if c_exp_x-(r_exp+1) <= 0 then xstart:=0
else xstart:=c_exp_x-(r_exp+1);
if c_exp_x+(r_exp+1) >= 639 then xend:=639
else xend:=c_exp_x+(r_exp+1);
if c_exp_y+(r_exp+1) >= 478 then ystart:=478
else ystart:=c_exp_y+(r_exp+1);
end;
flag:=false;
yend:=32;
while not flag do begin
for x:=xstart to xend do
if getpixel(x,yend)=10 then flag:=true;
yend:=yend+1;
end;
for x:=xstart to xend do begin
yterra:=ystart;
teste1:=getpixel(x,yterra-1);
teste2:=getpixel(x,yterra);
while not (getpixel(x,yterra-1)=1) and (getpixel(x,yterra)=10) {and (getpixel(x,yterra)=13)} do
begin
teste1:=getpixel(x,yterra-1);
teste2:=getpixel(x,yterra);
yterra:=yterra-1;
end;
for y:=ystart downto yend do
if (getpixel(x,y+1)=1) and (getpixel(x,y)=10) then begin
PutPixel(x,y,1);
PutPixel(x,yterra,10);
yterra:=yterra-1;
end;
end;
end;
if max<>639 then
begin
for i:=max to 639 do
begin
putpixel(i,31,15);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
end;
setcolor(13);
rectangle(0,32,639,479);
setcolor(0);
line(0,31,639,31);
min:=1;
max:=639;
end;
{
*****************************************************************************
* Procedure : explos *
* Descri‡Æo : desenhar a explosÆo *
* Variaveis : cntx e cnty *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure explos(cntx,cnty:integer);
var i,saidas,dir,encontrou,comp,conta,pos_x_i,pos_y_i,pos_x_f,pos_y_f,p_cx,p_cy,t,find:integer;
g:longint;
a,b,c,d,e,angl,ang_c:real;
begin
setlinestyle(0,1,3);
if n_exp[vez]=1
then
begin
r_exp:=10;
if (som=1) then sound(70);
setcolor(4);
for i:=1 to r_exp do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
setcolor(1);
if som=1 then sound(50);
for i:=r_exp downto 1 do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
nosound;
end
else if n_exp[vez]=2
then
begin
r_exp:=20;
if som=1 then sound(70);
setcolor(4);
for i:=1 to r_exp do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
setcolor(1);
if som=1 then sound(50);
for i:=r_exp downto 1 do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
nosound;
end
else if n_exp[vez]=3
then
begin
angl:=ang[vez];
if angl>Pi/2 then dir:=-1
else dir:=1;
saidas:=1;
cnty:=cnty-1;
if (getpixel(cntx+dir,cnty)<>1)and(getpixel(cntx+dir,cnty)<>15) then dir:=-dir;
while saidas<>0 do
begin
saidas:=0;
while (getpixel(cntx,cnty+1)=1) or (getpixel(cntx,cnty+1)=15) do
begin
putpixel(cntx,cnty,1);
cnty:=cnty+1;
putpixel(cntx,cnty,15);
saidas:=1;
if computador=1 then delay(50)
else if computador=2 then delay(25)
else if computador=3 then delay(0);
end;
if (getpixel(cntx+dir,cnty)=1) or (getpixel(cntx+dir,cnty)=15)
then
begin
putpixel(cntx,cnty,1);
cntx:=cntx+dir;
putpixel(cntx,cnty,15);
saidas:=1;
if computador=1 then delay(50)
else if computador=2 then delay(25)
else if computador=3 then delay(0);
end;
end;
putpixel(cntx,cnty,1);
cntx:=cntx;
cnty:=cnty;
r_exp:=10;
if som=1 then sound(70);
setcolor(4);
for i:=1 to r_exp do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
setcolor(1);
if som=1 then sound(50);
for i:=r_exp downto 1 do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
nosound;
end
else if n_exp[vez]=4
then
begin
angl:=ang[vez];
if angl>Pi/2 then dir:=-1
else dir:=1;
saidas:=1;
cnty:=cnty-1;
if (getpixel(cntx+dir,cnty)<>1) and (getpixel(cntx+dir,cnty)<>15) then dir:=-dir;
while saidas<>0 do
begin
saidas:=0;
while (getpixel(cntx,cnty+1)=1) or (getpixel(cntx,cnty+1)=15) do
begin
putpixel(cntx,cnty,1);
cnty:=cnty+1;
putpixel(cntx,cnty,15);
saidas:=1;
if computador=1 then delay(50)
else if computador=2 then delay(25)
else if computador=3 then delay(0);
end;
if (getpixel(cntx+dir,cnty)=1) or (getpixel(cntx+dir,cnty)=15)
then
begin
putpixel(cntx,cnty,1);
cntx:=cntx+dir;
putpixel(cntx,cnty,15);
saidas:=1;
if computador=1 then delay(50)
else if computador=2 then delay(25)
else if computador=3 then delay(0);
end;
end;
putpixel(cntx,cnty,1);
r_exp:=20;
if som=1 then
begin
if computador=1 then delay(70)
else if computador=2 then delay(40)
else if computador=3 then delay(20);
end;
setcolor(4);
for i:=1 to r_exp do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
setcolor(1);
if som=1 then
begin
if computador=1 then delay(50)
else if computador=2 then delay(30)
else if computador=3 then delay(20);
end;
for i:=r_exp downto 1 do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
nosound;
end
else if n_exp[vez]=5
then
begin
ang_c:=ang[vez];
p_cx:=p_c_x[vez];
p_cy:=p_c_y[vez];
t_arma:=t_arma+1;
pos_x_i:=trunc(p_cx+(t_arma)*cos(-ang_c));
pos_y_i:=trunc(p_cy+(t_arma)*sin(-ang_c));
t_arma:=t_arma+1;
pos_x_f:=trunc(p_cx+(t_arma)*cos(-ang_c));
pos_y_f:=trunc(p_cy+(t_arma)*sin(-ang_c));
while (getpixel(pos_x_f,pos_y_f)=1)or(getpixel(pos_x_f,pos_y_f)=15) do
begin
t_arma:=t_arma+1;
pos_x_f:=trunc(p_cx+(t_arma)*cos(-ang_c));
pos_y_f:=trunc(p_cy+(t_arma)*sin(-ang_c));
end;
cntx:=pos_x_f;
cnty:=pos_y_f;
for i:=1 to 100 do
begin
setcolor(random(15));
line(pos_x_i,pos_y_i,pos_x_f,pos_y_f);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
setcolor(1);
line(pos_x_i,pos_y_i,pos_x_f,pos_y_f);
r_exp:=20;
if som=1 then
begin
if computador=1 then delay(70)
else if computador=2 then delay(40)
else if computador=3 then delay(20);
end;
setcolor(4);
for i:=1 to r_exp do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
setcolor(1);
if som=1 then
begin
if computador=1 then delay(50)
else if computador=2 then delay(30)
else if computador=3 then delay(10);
end;
for i:=r_exp downto 1 do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
t_arma:=15;
nosound;
end
else if n_exp[vez]=6
then
begin
nosound;
min:=cntx;
max:=cntx;
r_exp:=0;
angl:=ang[vez];
if angl>Pi/2 then dir:=-1
else dir:=1;
saidas:=1;
comp:=0;
cnty:=cnty-1;
if (getpixel(cntx+dir,cnty)<>1)and(getpixel(cntx+dir,cnty)<>15) then dir:=-dir;
conta:=1;
while comp<=200 do
begin
if conta<>1 then begin
t:=t+1;
cnty:=cnty-1;
if (t/3)=trunc(t/3) then dir:=0-dir;
end;
conta:=2;
saidas:=1;
while saidas<>0 do
begin
saidas:=0;
for i:=1 to n_jogad do
begin
if getpixel(cntx,cnty+1)=cor[i] then energ[i]:=energ[i]-10;
end;
while (getpixel(cntx,cnty+1)=1) or (getpixel(cntx,cnty+1)=15) do
begin
if cntxmax then max:=cntx;
cnty:=cnty+1;
putpixel(cntx,cnty,14);
comp:=comp+1;
saidas:=1;
if computador=1 then delay(20)
else if computador=2 then delay(10)
else if computador=3 then delay(0);
end;
for i:=1 to n_jogad do
begin
if getpixel(cntx+dir,cnty)=cor[i] then energ[i]:=energ[i]-10;
end;
if (getpixel(cntx+dir,cnty)=1) or (getpixel(cntx+dir,cnty)=15)
then
begin
if cntxmax then max:=cntx;
cntx:=cntx+dir;
putpixel(cntx,cnty,14);
comp:=comp+1;
saidas:=1;
if computador=1 then delay(20)
else if computador=2 then delay(10)
else if computador=3 then delay(0);
end;
if comp>=200 then saidas:=0;
end;
end;
limpa(14,10);
min:=1;
max:=639;
nosound;
end
else if n_exp[vez]=7
then
begin
nosound;
min:=cntx;
max:=cntx;
r_exp:=0;
angl:=ang[vez];
if angl>Pi/2 then dir:=-1
else dir:=1;
saidas:=1;
comp:=0;
cnty:=cnty-1;
if (getpixel(cntx+dir,cnty)<>1)and(getpixel(cntx+dir,cnty)<>15) then dir:=-dir;
conta:=1;
t:=0;
while comp<=400 do
begin
if conta<>1 then begin
t:=t+1;
cnty:=cnty-1;
if (t/3)=trunc(t/3) then dir:=0-dir;
end;
conta:=2;
saidas:=1;
while saidas<>0 do
begin
saidas:=0;
for i:=1 to n_jogad do
begin
if getpixel(cntx,cnty+1)=cor[i] then energ[i]:=energ[i]-10;
end;
while (getpixel(cntx,cnty+1)=1) or (getpixel(cntx,cnty+1)=15) do
begin
if cntxmax then max:=cntx;
cnty:=cnty+1;
putpixel(cntx,cnty,14);
comp:=comp+1;
saidas:=1;
if computador=1 then delay(20)
else if computador=2 then delay(10)
else if computador=3 then delay(0);
end;
for i:=1 to n_jogad do
begin
if getpixel(cntx+dir,cnty)=cor[i] then energ[i]:=energ[i]-10;
end;
if (getpixel(cntx+dir,cnty)=1) or (getpixel(cntx+dir,cnty)=15)
then
begin
if cntxmax then max:=cntx;
cntx:=cntx+dir;
putpixel(cntx,cnty,14);
comp:=comp+1;
saidas:=1;
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
if comp>=400 then saidas:=0;
end;
end;
limpa(14,10);
min:=1;
max:=639;
nosound;
end
else if n_exp[vez]=8 then
begin
nosound;
min:=cntx;
max:=cntx;
r_exp:=0;
Randomize;
putpixel(cntx,cnty,2);
for g:=1 to 125000 do
begin
dir:=0;
find:=0;
while find<>1 do
begin
dir:=random(4);
find:=0;
if dir=0
then begin
if (getpixel(cntx+1,cnty)=10)or(getpixel(cntx+1,cnty)=7)
then begin
find:=1;
cntx:=cntx+1;
putpixel(cntx,cnty,7);
if cntx>max then max:=cntx;
end;
end
else if dir=1
then begin
if (getpixel(cntx,cnty+1)=10)or(getpixel(cntx,cnty+1)=7)
then begin
find:=1;
cnty:=cnty+1;
putpixel(cntx,cnty,7);
end;
end
else if dir=2
then begin
if (getpixel(cntx-1,cnty)=10)or(getpixel(cntx-1,cnty)=7)
then begin
find:=1;
cntx:=cntx-1;
putpixel(cntx,cnty,7);
if cntx10)or(getpixel(cntx+1,cnty)<>7))and((find=0)and(g=1))
then begin
g:=125000;
find:=1;
end;
end;
end;
limpa(7,1);
nosound;
end
else if n_exp[vez]=9 then
begin
nosound;
min:=cntx;
max:=cntx;
r_exp:=0;
Randomize;
putpixel(cntx,cnty,2);
for g:=1 to 250000 do
begin
dir:=0;
find:=0;
while find<>1 do
begin
dir:=random(4);
find:=0;
if dir=0
then begin
if (getpixel(cntx+1,cnty)=10)or(getpixel(cntx+1,cnty)=7)
then begin
find:=1;
cntx:=cntx+1;
putpixel(cntx,cnty,7);
if cntx>max then max:=cntx;
end;
end
else if dir=1
then begin
if (getpixel(cntx,cnty+1)=10)or(getpixel(cntx,cnty+1)=7)
then begin
find:=1;
cnty:=cnty+1;
putpixel(cntx,cnty,7);
end;
end
else if dir=2
then begin
if (getpixel(cntx-1,cnty)=10)or(getpixel(cntx-1,cnty)=7)
then begin
find:=1;
cntx:=cntx-1;
putpixel(cntx,cnty,7);
if cntx10)or(getpixel(cntx+1,cnty)<>7))and((find=0)and(g=1))
then begin
g:=250000;
find:=1;
end;
end;
end;
limpa(7,1);
nosound;
end
else if n_exp[vez]=10
then
begin
r_exp:=0;
if (som=1) then sound(70);
setcolor(10);
for i:=1 to bola1 do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
nosound;
end
else if n_exp[vez]=11
then
begin
r_exp:=0;
if (som=1) then
begin
if computador=1 then delay(70)
else if computador=2 then delay(30)
else if computador=3 then delay(10);
end;
setcolor(10);
for i:=1 to 2*bola1 do
begin
circle(cntx,cnty,i);
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
nosound;
end;
c_exp_x:=cntx;
c_exp_y:=cnty;
setlinestyle(0,1,1);
{borda}
setcolor(13);
rectangle(0,32,639,479);
setcolor(0);
line(0,31,639,31);
barra;
energia;
for i:=1 to n_jogad do
begin
if energ[i]>0 then begin tanq(p_c_x[i],p_c_y[i],cor[i]);
caitanq(i);
end;
end;
if (n_exp[vez]<>6)and(n_exp[vez]<>7) then terra;
aparar_terra;
troca(70,6,vez);
troca(305,6,rad(ang[vez]));
troca(435,6,trunc(v[vez]*10));
troca(200,6,energ[vez]);
setfillstyle(1,0);
floodfill(541,7,8);
setfillstyle(1,7);
floodfill(541,7,8);
setcolor(0);
settextstyle(2,0,5);
outtextxy(548,6,armas[n_exp[vez]]);
end;
{
*****************************************************************************
* Procedure : Cenario *
* Descri‡Æo : Constru‡Æo do cen rio. *
* Variaveis : NÆo existem *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure cenario;
var
tmp_vez,i,j,x:integer;
xini,xfim,yini,yfim:integer;
npic:integer;
begin
tmp_vez:=vez;
{constru‡Æo do cen rio}
xini:=1;
xfim:=638;
yini:=0;
yfim:=0;
while yini<45+t_arma do
begin
yini:=random(478);
end;
while yfim<45+t_arma do
begin
yfim:=random(478);
end;
setcolor(10);
npic:=random(npicos);
if npic=0
then line(xini,yini,xfim,yfim)
else begin
for i:=1 to npic do
begin
picox[i]:=638;
end;
for i:=1 to npic do
begin
picox[i]:=random(638);
picoy[i]:=30;
while (picoy[i]<45+t_arma)do
begin
picoy[i]:=random(478);
end;
if i>1 then
begin
while (picoy[i]<45+t_arma) or (picoy[i]+suavidadepicoy[i-1])do
begin
picoy[i]:=random(478);
end;
end;
end;
for i:=1 to npic do
begin
x:=picox[i];
picox[0]:=x;
j:=i-1;
while x5 then
begin
ax:=trunc(origx+(rai1+rai2)*cos(-ang_c));
ay:=trunc(origy+(rai1+rai2)*sin(-ang_c));
acel:=-1;
t:=0.001;
vix:=vi*cos(ang_c);
viy:=vi*sin(ang_c);
find:=1;
desenha:=1;
repeat
if computador=1 then t:=t+0.005
else if computador=2 then t:=t+0.01
else if computador=3 then t:=t+0.03;
if (ax+x=1)or(ax+x=0) then ax:=638-x
else if (ax+x=638)or(ax+x=639) then ax:=1-x;
if (som=1) then sound(y*50);
x:=trunc(vix*t);
vix:=vix+vent;
y:=trunc(viy*t+(acel*sqr(t)*grav)/2);
if ay-y<32 then desenha:=0
else if ay-y>32 then begin
desenha:=1;
find:=getpixel(ax+x,ay-y);
putpixel(0,ay-y,15);
putpixel(0,ay-y-1,15);
putpixel(0,ay-y+1,15);
putpixel(0,ay-y+2,13);
putpixel(0,ay-y-2,13);
end;
putpixel(ax+x+1,32,15);
putpixel(ax+x,32,15);
putpixel(ax+x-1,32,15);
putpixel(ax+x+2,32,13);
putpixel(ax+x-2,32,13);
if (rastro=1) then
begin
if desenha=1 then
begin
putpixel(ax+x,ay-y,15);
end;
end;
if (rastro=0) then
begin
if desenha=1 then
begin
putpixel(ax+x,ay-y,15);
tempy:=ay-y;
tempx:=ax+x;
if computador=1 then delay(10)
else if computador=2 then delay(5)
else if computador=3 then delay(0);
end;
end;
if (rastro=0) then
begin
if desenha=1 then
begin
putpixel(tempx,tempy,1);
end;
end;
if (rastro=1) then
begin
if desenha=1 then
begin
putpixel(ax+x,ay-y,15);
end;
end;
until (find<>1) and (find<>15) and (find<>13);
end;
explos(ax+x,ay-y);
if computador=1 then delay(8)
else if computador=2 then delay(4)
else if computador=3 then delay(2);
nosound;
end;
{
*****************************************************************************
* Procedure : loc_canh *
* Descri‡Æo : Procura de um local para colucar o tank *
* Variaveis : qual,origx,origy,rai1,rai2,vi,ang_c *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure loc_canh;
begin
caitanq(1);
end;
{
*****************************************************************************
* Procedure : Move_tanque *
* Descri‡Æo : Move o tanque do menu para a frente e tras *
* Variaveis : NÆo tem variaveis *
* Parte : Menu *
* *
*****************************************************************************
}
procedure move_tanque;
begin
GetMem(tan, Size);
getimage(p_c_x[0]-35,p_c_y[0],p_c_x[0]+50,p_c_y[0]+80,tan^);
tanque(20+p_c_x[0],p_c_y[0]+75,1,turn);
p_c_x[0]:=p_c_x[0]+cont;
if computador=1 then delay(300)
else if computador=2 then delay(200)
else if computador=3 then delay(50);
if turn=1 then turn:=2 else turn:=1;
putimage(p_c_x[0]-35-cont,p_c_y[0],tan^,normalPut);
if p_c_x[0]=500 then
begin
temp:=45;
while temp<135 do
begin
tanque(20+p_c_x[0],p_c_y[0]+75,1,turn);
ang[0]:=angu(temp);
temp:=temp+5;
putimage(p_c_x[0]-35-cont,p_c_y[0],tan^,normalPut);
end;
cont:=-cont;
end;
if p_c_x[0]=100 then
begin
tanque(20+p_c_x[0],p_c_y[0]+75,1,turn);
temp:=135;
while temp>45 do
begin
tanque(20+p_c_x[0],p_c_y[0]+75,1,turn);
ang[0]:=angu(temp);
temp:=temp-5;
putimage(p_c_x[0]-35-cont,p_c_y[0],tan^,normalPut);
end;
cont:=-cont;
end;
FreeMem(tan, size);
end;
{
*****************************************************************************
* Procedure : Quer_sair *
* Descri‡Æo : Consiste em saber se o utilizador quer sair do jogo *
* Variaveis : nÆo tem variaveis *
* Parte : Menu *
* *
*****************************************************************************
}
procedure quer_sair;
var
P,T : pointer;
Sz : Word;
tecla1 : Char;
saire: integer ;
begin
saire:=0;
tecla1:='1';
sair:=1;
sz:=imagesize(opca_x-t_bot_x-22,opca_y+t_bot_y*(n_botoes+1)-2,opca_x-20+2,opca_y+t_bot_y*(n_botoes+1)+t_bot_y+2);
GetMem(P, Sz);
GetMem(T, Sz);
getimage(opca_x-t_bot_x-20-2,opca_y+t_bot_y*(n_botoes+1)-2,opca_x-20+2,opca_y+t_bot_y*(n_botoes+1)+t_bot_y+2,P^);
getimage(opca_x+t_bot_x+20-2,opca_y+t_bot_y*(n_botoes+1)-2,opca_x+2*t_bot_x+20+2,opca_y+t_bot_y*(n_botoes+1)+t_bot_y+2,T^);
botao(opca_x-t_bot_x-20,opca_y+t_bot_y*(n_botoes+1),opca_x-20,opca_y+t_bot_y*(n_botoes+1)+t_bot_y);
botao(opca_x+t_bot_x+20,opca_y+t_bot_y*(n_botoes+1),opca_x+2*t_bot_x+20,opca_y+t_bot_y*(n_botoes+1)+t_bot_y);
botao_actual(opca_x+t_bot_x+20,opca_y+t_bot_y*(n_botoes+1),opca_x+2*t_bot_x+20,opca_y+t_bot_y*(n_botoes+1)+t_bot_y-1);
setcolor(8);
settextstyle(3,0,4);
outtextxy(opca_x+t_bot_x+60,opca_y+t_bot_y*(n_botoes+1),'NŽO');
setcolor(15);
outtextxy(opca_x-t_bot_x+20,opca_y+t_bot_y*(n_botoes+1),'SIM');
while(saire<>1) do
begin
if keypressed then
begin
tecla1:=readkey;
if (tecla1<>'0') then
begin
if ((tecla1=sdir) and (sair<>0)) then sair:=sair-1
else if ((tecla1=sdir) and (sair=0)) then sair:=1;
if ((tecla1=sesq) and (sair<>1)) then sair:=sair+1
else if ((tecla1=sesq) and (sair=1)) then sair:=0;
if (som=1) then
begin
sound(100);
if computador=1 then delay(50)
else if computador=2 then delay(200)
else if computador=3 then delay(300);
nosound;
end;
if (sair=1) then
begin
botao(opca_x-t_bot_x-20,opca_y+t_bot_y*(n_botoes+1),opca_x-20,opca_y+t_bot_y*(n_botoes+1)+t_bot_y);
botao(opca_x+t_bot_x+20,opca_y+t_bot_y*(n_botoes+1),opca_x+2*t_bot_x+20,opca_y+t_bot_y*(n_botoes+1)+t_bot_y);
botao_actual(opca_x+t_bot_x+20,opca_y+t_bot_y*(n_botoes+1),opca_x+2*t_bot_x+20,opca_y+t_bot_y*(n_botoes+1)+t_bot_y-1);
setcolor(8);
settextstyle(3,0,4);
outtextxy(opca_x+t_bot_x+60,opca_y+t_bot_y*(n_botoes+1),'NŽO');
setcolor(15);
outtextxy(opca_x-t_bot_x+20,opca_y+t_bot_y*(n_botoes+1),'SIM');
end;
if (sair=0) then
begin
botao(opca_x-t_bot_x-20,opca_y+t_bot_y*(n_botoes+1),opca_x-20,opca_y+t_bot_y*(n_botoes+1)+t_bot_y);
botao(opca_x+t_bot_x+20,opca_y+t_bot_y*(n_botoes+1),opca_x+2*t_bot_x+20,opca_y+t_bot_y*(n_botoes+1)+t_bot_y);
botao_actual(opca_x-t_bot_x-20,opca_y+t_bot_y*(n_botoes+1),opca_x-20,opca_y+t_bot_y*(n_botoes+1)+t_bot_y-1);
setcolor(15);
settextstyle(3,0,4);
outtextxy(opca_x+t_bot_x+60,opca_y+t_bot_y*(n_botoes+1),'NŽO');
setcolor(8);
outtextxy(opca_x-t_bot_x+20,opca_y+t_bot_y*(n_botoes+1),'SIM');
end;
end;
if (tecla1=enter) then saire:=1;
end;
if cre_y>0 then
begin
if cre_y<=50 then
begin
cre_y:=cre_y+1;
creditos(cre_y);
end
else cre_y:=0;
end
else move_tanque;
end;
putimage(opca_x+t_bot_x+20-2,opca_y+t_bot_y*(n_botoes+1)-2,T^,NORMALPUT);
putimage(opca_x-t_bot_x-20-2,opca_y+t_bot_y*(n_botoes+1)-2,P^,NORMALPUT);
FreeMem(t, sz);
FreeMem(p, sz);
end;
{
*****************************************************************************
* Procedure : qual_ajuda *
* Descri‡Æo : Consiste em saber se o utilizador quer sair do jogo *
* Variaveis : nÆo tem variaveis *
* Parte : Menu *
* *
*****************************************************************************
}
function qual_ajuda:integer;
var
P,T : pointer;
Sz : Word;
tecla1 : Char;
ajudar : integer ;
begin
ajudar:=1;
tecla1:='1';
sz:=imagesize(opca_x-t_bot_x-22,opca_y+t_bot_y*(opcao)-2,opca_x+20+2,opca_y+t_bot_y*(opcao)+t_bot_y+2);
GetMem(P, Sz);
GetMem(T, Sz);
getimage(opca_x-t_bot_x-20-2,opca_y+t_bot_y*(opcao)-2,opca_x-20+2,opca_y+t_bot_y*(opcao)+t_bot_y+2,P^);
getimage(opca_x+t_bot_x+20-2,opca_y+t_bot_y*(opcao)-2,opca_x+2*t_bot_x+60+2,opca_y+t_bot_y*(opcao)+t_bot_y+2,T^);
botao(opca_x-t_bot_x-20,opca_y+t_bot_y*(opcao),opca_x-20,opca_y+t_bot_y*(opcao)+t_bot_y);
botao(opca_x+t_bot_x+20,opca_y+t_bot_y*(opcao),opca_x+2*t_bot_x+60,opca_y+t_bot_y*(opcao)+t_bot_y);
botao_actual(opca_x+t_bot_x+20,opca_y+t_bot_y*(opcao),opca_x+2*t_bot_x+60,opca_y+t_bot_y*(opcao)+t_bot_y-1);
setcolor(8);
settextstyle(3,0,4);
outtextxy(opca_x+t_bot_x+40-10,opca_y+t_bot_y*(opcao),'Introdu‡„o');
setcolor(15);
outtextxy(opca_x-t_bot_x-5,opca_y+t_bot_y*(opcao),'Teclas');
while(tecla1<>enter)and (tecla1<>esc) do
begin
if keypressed then
begin
tecla1:=readkey;
if (tecla1<>'0') then
begin
if tecla1=esc then ajudar:=2;
if ((tecla1=sdir) and (ajudar=0)) then ajudar:=1
else if ((tecla1=sdir) and (ajudar=1)) then ajudar:=0;
if ((tecla1=sesq) and (ajudar=1)) then ajudar:=0
else if ((tecla1=sesq) and (ajudar=0)) then ajudar:=1;
if (som=1) then
begin
sound(100);
if computador=1 then delay(50)
else if computador=2 then delay(200)
else if computador=3 then delay(300);
nosound;
end;
if (ajudar=1) then
begin
botao(opca_x-t_bot_x-20,opca_y+t_bot_y*(opcao),opca_x-20,opca_y+t_bot_y*(opcao)+t_bot_y);
botao(opca_x+t_bot_x+20,opca_y+t_bot_y*(opcao),opca_x+2*t_bot_x+60,opca_y+t_bot_y*(opcao)+t_bot_y);
botao_actual(opca_x+t_bot_x+20,opca_y+t_bot_y*(opcao),opca_x+2*t_bot_x+60,opca_y+t_bot_y*(opcao)+t_bot_y-1);
setcolor(8);
settextstyle(3,0,4);
outtextxy(opca_x+t_bot_x+40-10,opca_y+t_bot_y*(opcao),'Introdu‡„o');
setcolor(15);
outtextxy(opca_x-t_bot_x-5,opca_y+t_bot_y*(opcao),'Teclas');
end;
if (ajudar=0) then
begin
botao(opca_x-t_bot_x-20,opca_y+t_bot_y*(opcao),opca_x-20,opca_y+t_bot_y*(opcao)+t_bot_y);
botao(opca_x+t_bot_x+20,opca_y+t_bot_y*(opcao),opca_x+2*t_bot_x+60,opca_y+t_bot_y*(opcao)+t_bot_y);
botao_actual(opca_x-t_bot_x-20,opca_y+t_bot_y*(opcao),opca_x-20,opca_y+t_bot_y*(opcao)+t_bot_y-1);
setcolor(15);
settextstyle(3,0,4);
outtextxy(opca_x+t_bot_x+40-10,opca_y+t_bot_y*(opcao),'Introdu‡„o');
setcolor(8);
outtextxy(opca_x-t_bot_x-5,opca_y+t_bot_y*(opcao),'Teclas');
end;
end;
end;
if cre_y>0 then
begin
if cre_y<=50 then
begin
cre_y:=cre_y+1;
creditos(cre_y);
end
else cre_y:=0;
end
else move_tanque;
end;
putimage(opca_x+t_bot_x+20-2,opca_y+t_bot_y*(opcao)-2,T^,NORMALPUT);
putimage(opca_x-t_bot_x-20-2,opca_y+t_bot_y*(opcao)-2,P^,NORMALPUT);
FreeMem(t, sz);
FreeMem(p, sz);
qual_ajuda:=ajudar;
end;
{
*****************************************************************************
* Procedure : Mensagem *
* Descri‡Æo : Consiste em criar uma caixa com uma mensagem didactica *
* Variaveis : NÆo tem variaveis *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure mensagem;
var
ficheiro : text;
texto,txt: string;
cont,code: integer;
DirInfo : SearchRec;
posi : array[0..n_notas] of integer;
nome : array[0..n_notas] of string;
begin
cont:=0;
FindFirst('data\*.dat', Archive, DirInfo);
while DosError = 0 do
begin
txt:=Copy(DirInfo.Name, 5, 2);
if Pos('.', txt) > 0 then
begin
txt:=Copy(txt, 1, 1);
end;
val(txt,posi[cont],code);
FindNext(DirInfo);
cont:=cont+1;
end;
settextstyle(2, HorizDir, 5);
code:=15;
if cont<>0 then
begin
cont:=random(cont);
str(posi[cont],txt);
Assign(ficheiro, concat('data\mens',txt,'.dat'));
Reset(ficheiro);
Read(ficheiro,texto);
cont:=trunc((639-length(texto)*8)/2);
if (length(texto)<=70) and (length(texto)<>0) then
begin
if length(texto)<10 then botao(cont,400,length(texto)*8+cont+15,440)
else if length(texto)<20 then botao(cont,400,length(texto)*8+cont+11,440)
else if length(texto)<30 then botao(cont,400,length(texto)*8+cont+7,440)
else if length(texto)<40 then botao(cont,400,length(texto)*8+cont+3,440)
else if length(texto)<50 then botao(cont,400,length(texto)*8+cont-1,440)
else if length(texto)<60 then botao(cont,400,length(texto)*8+cont-5,440)
else if length(texto)<70 then botao(cont,400,length(texto)*8+cont-9,440);
setcolor(12);
outtextxy(cont+10,403,'Nota');
setcolor(15);
outtextxy(cont+10,423,texto);
end;
Close(ficheiro);
end;
end;
{
*****************************************************************************
* Procedure : Quadro *
* Descri‡Æo : Serve para criar uma box que cont‚m a pontua‡Æo dos jogadores *
* Variaveis : n *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure quadro(n:integer);
var
h,f,vence,victor,a,b,c,d,j,temp1,temp2,i:integer;
txt,temp:string;
begin
settextstyle(25,0,5);
if vencedor<>0 then
begin
for f:=1 to n_jogad do
begin
if nomes[f]=vencedor then victorias[f]:=victorias[f]+1;
end;
end;
for i:=2 to n_jogad do
begin
temp1:=victorias[i];
temp2:=nomes[i];
victorias[0]:=temp1;
j:=i-1;
while temp1>victorias[j] do
begin
victorias[j+1]:=victorias[j];
nomes[j+1]:=nomes[j];
j:=j-1;
victorias[j+1]:=temp1;
nomes[j+1]:=temp2;
end;
end;
setfillstyle(1,7);
a:=213;
b:=240-(10*(n_jogad+1));
c:=426;
d:=240-(10*(n_jogad+1))+15+(n_jogad*20)+30;
bar(a,b,c,d);
setcolor(8);
rectangle(a-1,b-1,c+1,d+1);
setcolor(8);
rectangle(a-2,b-2,c+2,d+2);
setcolor(0);
rectangle(a-3,b-3,c+3,d+3);
setcolor(0);
settextstyle(2,0,5);
outtextxy(213+60,(240-(10*(n_jogad+1)))+2,'Jogo / ');
str(n,txt);
outtextxy(213+108,(240-(10*(n_jogad+1)))+2,txt);
str(n_jogos,txt);
outtextxy(213+125,(240-(10*(n_jogad+1)))+2,txt);
for f:=1 to n_jogad do
begin
if nomes[f]=vencedor then
begin
setcolor(8);
settextstyle(25,0,5);
outtextxy(213+17,(240-(10*(n_jogad+1)))+20+(f*20),chr(2));
end;
setcolor(cor[nomes[f]]);
settextstyle(2,0,5);
str(nomes[f],txt);
txt:=concat(' Jogador ',txt);
outtextxy(213+25,(240-(10*(n_jogad+1)))+15+(f*20),txt);
str(victorias[f],txt);
outtextxy(426-30,(240-(10*(n_jogad+1)))+15+(f*20),txt);
end;
mensagem;
prima_esc;
repeat
ik:=readkey;
until ik=esc;
end;
{
*****************************************************************************
* Procedure : Ajuda *
* Descri‡Æo : Consiste na opcao que explica quais as teclas a utilizar *
* Variaveis : nÆo tem variaveis *
* *
*****************************************************************************
}
procedure por_opcao;
begin
botao(50,50,590,370);
botao(145,390,515,430);
settextstyle(2,0,7);
setcolor(11);
outtextxy(150,395,'Prima para voltar ao menu');
setcolor(1);
outtextxy(220,75,'AJUDA');
setcolor(0);
outtextxy(340,75,'Teclas');
setcolor(2);
outtextxy(340,75,'T');
settextstyle(2,0,5);
setcolor(0);
settextstyle(0,0,1);
setcolor(6);
outtextxy(90,360,'Prima "-", "-" e "ENTER" para escolher o menu pretendido');
end;
{
*****************************************************************************
* Procedure : Ajuda *
* Descri‡Æo : Consiste na opcao que explica quais as teclas a utilizar *
* Variaveis : nÆo tem variaveis *
* *
*****************************************************************************
}
procedure muda_opcao(opcao:integer);
begin
if opcao=1 then
begin
botao_actual(120,140,220,170-1);
botao(260,180,360,210);
botao(400,220,500,250);
setcolor(15);
outtextxy(150,150,'Menu');
setcolor(8);
outtextxy(290,190,'Jogo');
outtextxy(425,230,'Op‡”es');
end
else if opcao=2 then
begin
botao(120,140,220,170);
botao_actual(260,180,360,210-1);
botao(400,220,500,250);
setcolor(8);
outtextxy(150,150,'Menu');
setcolor(15);
outtextxy(290,190,'Jogo');
setcolor(8);
outtextxy(425,230,'Op‡”es');
end
else if opcao=3 then
begin
botao(120,140,220,170);
botao(260,180,360,210);
botao_actual(400,220,500,250-1);
setcolor(8);
outtextxy(150,150,'Menu');
outtextxy(290,190,'Jogo');
setcolor(15);
outtextxy(425,230,'Op‡”es');
end;
end;
{
*****************************************************************************
* Procedure : Ajuda *
* Descri‡Æo : Consiste na opcao que explica quais as teclas a utilizar *
* Variaveis : nÆo tem variaveis *
* *
*****************************************************************************
}
procedure ajuda(ajudar:integer);
var
i, opcao :integer;
begin
cleardevice;
opcao:=1;
if ajudar=0 then
begin
botao(50,50,590,370);
botao(145,390,515,430);
settextstyle(2,0,7);
setcolor(11);
outtextxy(150,395,'Prima para voltar ao menu');
setcolor(1);
outtextxy(200,75,'AJUDA');
setcolor(0);
outtextxy(300,75,'Introdu‡„o');
setcolor(2);
outtextxy(300,75,'I');
settextstyle(0,0,1);
setcolor(0);
outtextxy(70,140,' Kabbooum ‚ um jogo Pedag¢gico / Did ctico que utiliza');
outtextxy(70,160,'certos conhecimentos f¡sicos, tais como a equa‡„o do lan‡amento');
outtextxy(70,180,'obliquo e utiliza‡„o da gravidade e do vento como acelera‡”es');
outtextxy(70,200,'auxiliares.');
outtextxy(70,220,' Este programa foi concebido para ilustrar os ');
outtextxy(70,240,'conhecimentos adquiridos nas aulas de programa‡„o com ');
outtextxy(70,260,'objectivos de simular o lan‡amento de um projectil.');
repeat
ik:=readkey;
until ik=esc;
end
else if ajudar=1 then
begin
por_opcao;
muda_opcao(opcao);
repeat
ik:=readkey;
if (ik<>'1') then
begin
if ((ik=sdir) and (opcao<>3)) then opcao:=opcao+1
else if ((ik=sdir) and (opcao=3)) then opcao:=1;
if ((ik=sesq) and (opcao<>1)) then opcao:=opcao-1
else if ((ik=sesq) and (opcao=1)) then opcao:=3;
muda_opcao(opcao);
if ik=enter then
begin
bar(50,50,590,370);
if opcao=1 then
begin
por_opcao;
for i:=1 to 7 do
begin
botao(215,100+i*30,425,120+i*30);
end;
settextstyle(2,0,5);
setcolor(8);
outtextxy(225,100+30*1,'Para Cima');
outtextxy(225,100+30*2,'Para Baixo');
outtextxy(225,100+30*3,'Para Direita');
outtextxy(225,100+30*4,'Para Esquerda');
outtextxy(225,100+30*5,'Para Selecionar');
outtextxy(225,100+30*6,'Para Sair');
outtextxy(225,100+30*7,'Para Sair (S/N)');
setcolor(4);
settextstyle(0,0,1);
outtextxy(225,105+30*1,' : ');
outtextxy(225,105+30*2,' : ');
outtextxy(225,105+30*3,' : - ');
outtextxy(225,105+30*4,' : - ');
outtextxy(225,105+30*5,' : ENTER');
outtextxy(225,105+30*6,' : X ');
outtextxy(225,105+30*7,' : ESC ');
end
else if opcao=2 then
begin
por_opcao;
for i:=1 to 7 do
begin
botao(80,100+i*30,300,120+i*30);
botao(340,100+i*30,560,120+i*30);
end;
settextstyle(2,0,5);
setcolor(8);
outtextxy(90,100+30*1,'Mais Velocidade');
outtextxy(90,100+30*2,'Menos Velocidade');
outtextxy(90,100+30*3,'Mais Angulo');
outtextxy(90,100+30*4,'Menos Angulo');
outtextxy(90,100+30*5,'Para Disparar');
outtextxy(90,100+30*6,'Para Sair');
outtextxy(90,100+30*7,'Sair do Torneio');
setcolor(4);
settextstyle(0,0,1);
outtextxy(90,105+30*1,' : ');
outtextxy(90,105+30*2,' : ');
outtextxy(90,105+30*3,' : - ');
outtextxy(90,105+30*4,' : - ');
outtextxy(90,105+30*5,' : ENTER');
outtextxy(90,105+30*6,' : ESC ');
outtextxy(90,105+30*7,' : X ');
settextstyle(2,0,5);
setcolor(8);
outtextxy(350,100+30*1,'+10X Velocidade');
outtextxy(350,100+30*2,'-10X Velocidade');
outtextxy(350,100+30*3,'+5 X Angulo');
outtextxy(350,100+30*4,'-5 X Angulo');
outtextxy(350,100+30*5,'Limpa Trajectos');
outtextxy(350,100+30*6,'Muda (+1) Armas');
outtextxy(350,100+30*7,'Muda (-1) Armas');
setcolor(4);
settextstyle(0,0,1);
outtextxy(350,105+30*1,' : Home ');
outtextxy(350,105+30*2,' : End ');
outtextxy(350,105+30*3,' : Delete ');
outtextxy(350,105+30*4,' : Pg-Up ');
outtextxy(350,105+30*5,' : C ');
outtextxy(350,105+30*6,' : TAB ');
outtextxy(350,105+30*7,' : Shift+TAB');
end
else if opcao=3 then
begin
por_opcao;
for i:=1 to 6 do
begin
botao(215,100+i*30,425,120+i*30);
end;
settextstyle(2,0,5);
setcolor(8);
outtextxy(225,100+30*1,'Para Mudar (+1)');
outtextxy(225,100+30*2,'Para Mudar (-1)');
outtextxy(225,100+30*3,'Para Aumentar ');
outtextxy(225,100+30*4,'Para Diminuir ');
outtextxy(225,100+30*5,'Para Selecionar');
outtextxy(225,100+30*6,'Para Sair');
setcolor(4);
settextstyle(0,0,1);
outtextxy(225,105+30*1,' : ');
outtextxy(225,105+30*2,' : ');
outtextxy(225,105+30*3,' : - ');
outtextxy(225,105+30*4,' : - ');
outtextxy(225,105+30*5,' : ENTER');
outtextxy(225,105+30*6,' : X ');
end;
ik:=readkey;
bar(50,50,590,370);
por_opcao;
muda_opcao(opcao);
end;
end;
until (ik=esc) or (ik=x_ma) or (ik=x_mi);
end;
cleardevice;
apre_menu;
end;
{
*****************************************************************************
* Procedure : Jogo *
* Descri‡Æo : Consiste no proprio jogo quem manda os tiros e quem explode *
* Variaveis : nÆo tem variaveis *
* *
*****************************************************************************
}
procedure jogo;
var
txt:string;
x,temp,i,verifica,n_exp_temp,direc:integer;
begin
inicializa;
cenario;
barra;
troca(70,6,vez);
troca(305,6,rad(ang[vez]));
troca(435,6,trunc(v[vez]*10));
troca(200,6,energ[vez]);
setfillstyle(1,0);
floodfill(541,7,8);
setfillstyle(1,7);
floodfill(541,7,8);
setcolor(0);
settextstyle(2,0,5);
outtextxy(548,6,armas[n_exp[vez]]);
if vento=1 then begin
vent:=(random(vento_max+1)/20000);
direc:=random(2);
if direc=1
then vent:=-vent;
end;
setcolor(15);
settextstyle(25,0,1);
if vent<0
then begin
outtextxy(590,50,chr(17));
str(trunc(-vent*20000),txt);
outtextxy(610,50,txt);
end
else begin
outtextxy(590,50,chr(16));
str(trunc(vent*20000),txt);
outtextxy(610,50,txt);
end;
repeat
if keypressed then
begin
ik:=readkey;
if (ik=c_mi)or(ik=c_ma) then
begin
limpa(15,1);
setcolor(15);
settextstyle(25,0,1);
if vent<0
then begin
outtextxy(590,50,chr(17));
str(trunc(-vent*20000),txt);
outtextxy(610,50,txt);
end
else begin
outtextxy(590,50,chr(16));
str(trunc(vent*20000),txt);
outtextxy(610,50,txt);
end;
end;
if (ik=x_mi)or(ik=x_ma) then
begin
ik:=esc;
n_jogo_actual:=n_jogos;
end;
if ik=sdir then
begin
rot(p_c_x[vez],p_c_y[vez],t_corpo,t_arma,-1,cor[vez]);
troca(305,6,rad(ang[vez]));
end;
if ik=sesq then
begin
rot(p_c_x[vez],p_c_y[vez],t_corpo,t_arma,1,cor[vez]);
troca(305,6,rad(ang[vez]));
end;
if ik=pgdw then
begin
rot(p_c_x[vez],p_c_y[vez],t_corpo,t_arma,-5,cor[vez]);
troca(305,6,rad(ang[vez]));
end;
if ik=dlt then
begin
rot(p_c_x[vez],p_c_y[vez],t_corpo,t_arma,5,cor[vez]);
troca(305,6,rad(ang[vez]));
end;
if ik=scim then
begin
v[vez]:=v[vez]+0.1;
if v[vez]>energ[vez] then v[vez]:=energ[vez];
troca(435,6,trunc(v[vez]*10));
end;
if ik=sbax then
begin
v[vez]:=v[vez]-0.1;
if v[vez]<0 then v[vez]:=0;
troca(435,6,trunc(v[vez]*10));
end;
if ik=home then
begin
v[vez]:=v[vez]+1;
if v[vez]>energ[vez] then v[vez]:=energ[vez];
troca(435,6,trunc(v[vez]*10));
end;
if ik=ende then
begin
v[vez]:=v[vez]-1;
if v[vez]<0 then v[vez]:=0;
troca(435,6,trunc(v[vez]*10));
end;
if ik=enter then
begin
if n_exp[vez]<>1 then armas_dsp[vez,n_exp[vez]]:=armas_dsp[vez,n_exp[vez]]-1;
tiro(p_c_x[vez],p_c_y[vez],t_corpo,t_arma,v[vez],ang[vez]);
aparar_terra;
loc_canh;
for temp:=1 to n_jogad do
begin
if energ[temp]<=0 then
begin
if dead[temp]<>0
then begin
dead[temp]:=0;
kills:=kills+1;
n_exp_temp:=n_exp[vez];
n_exp[vez]:=2;
explos(p_c_x[temp],p_c_y[temp]);
n_exp[vez]:=n_exp_temp;
pontos[vez]:=pontos[vez]+3;
end;
end;
end;
if armas_dsp[vez,n_exp[vez]]=0
then begin
x:=1;
temp:=n_exp[vez];
while x<>0 do
begin
if n_exp[vez]<>11
then begin
if armas_dsp[vez,n_exp[vez]+1]>0
then begin
n_exp[vez]:=n_exp[vez]+1;
x:=0;
end
else begin
n_exp[vez]:=n_exp[vez]+1;
end;
end
else begin
n_exp[vez]:=1;
x:=0
end;
end;
end;
verifica:=1;
while verifica=1 do
begin
if (vez=1) then vez:=vez+1
else if vez=n_jogad then vez:=1;
if dead[vez]=1 then verifica:=0
else if kills>=n_jogad then verifica:=0;
end;
troca(70,7,vez);
troca(305,6,rad(ang[vez]));
troca(200,6,energ[vez]);
setcolor(15);
settextstyle(25,0,1);
if vent<0
then begin
outtextxy(590,50,chr(17));
str(trunc(-vent*20000),txt);
outtextxy(610,50,txt);
end
else begin
outtextxy(590,50,chr(16));
str(trunc(vent*20000),txt);
outtextxy(610,50,txt);
end;
if v[vez]>energ[vez] then v[vez]:=energ[vez];
troca(435,6,trunc(v[vez]*10));
setfillstyle(1,0);
floodfill(541,7,8);
setfillstyle(1,7);
floodfill(541,7,8);
setcolor(0);
settextstyle(2,0,5);
outtextxy(548,6,armas[n_exp[vez]]);
end;
if kills>=n_jogad-1 then
begin
if som=1 then delay(5000);
if dead[vez]=1 then begin
vencedor:=vez;
pontos[vez]:=pontos[vez]+6;
end
else vencedor:=0;
if som=1 then nosound;
end;
if ik=tab then
begin
if n_exp[vez]<>11 then
begin
x:=1;
temp:=n_exp[vez];
while x<>0 do
begin
if n_exp[vez]<>11
then begin
if armas_dsp[vez,n_exp[vez]+1]>0
then begin
n_exp[vez]:=n_exp[vez]+1;
x:=0;
end
else begin
n_exp[vez]:=n_exp[vez]+1;
end;
end
else begin
n_exp[vez]:=temp;
x:=0;
end;
end;
setfillstyle(1,0);
floodfill(541,7,8);
setfillstyle(1,7);
floodfill(541,7,8);
setcolor(0);
settextstyle(2,0,5);
outtextxy(548,6,armas[n_exp[vez]]);
end;
end;
if ik=alt_tab then
begin
if n_exp[vez]<>1 then
begin
x:=1;
temp:=n_exp[vez];
while x<>0 do
begin
if n_exp[vez]<>1
then begin
if armas_dsp[vez,n_exp[vez]-1]>0
then begin
n_exp[vez]:=n_exp[vez]-1;
x:=0;
end
else begin
n_exp[vez]:=n_exp[vez]-1;
end;
end
else begin
n_exp[vez]:=temp;
x:=0;
end;
end;
setfillstyle(1,0);
floodfill(541,7,8);
setfillstyle(1,7);
floodfill(541,7,8);
setcolor(0);
settextstyle(2,0,5);
outtextxy(548,6,armas[n_exp[vez]]);
end;
end;
end;
until (ik=esc) or (kills>=n_jogad-1);
end;
{
*****************************************************************************
* Procedure : COMPRAS *
* Descri‡Æo : Serve para os jogadores poderem comprar armas *
* Variaveis : NÆo tem variaveis *
* Parte : Jogo *
* *
*****************************************************************************
}
procedure compras;
var
txt:string;
i,j,g,k:integer;
begin
for i:=1 to n_jogad do
begin
cleardevice;
setfillstyle(1,7);
floodfill(1,1,2);
botao_actual(120,20,235,50);
setcolor(0);
settextstyle(2,0,6);
str(i,txt);
txt:=concat('Jogador ',txt);
outtextxy(125,25,txt);
botao_actual(420,20,535,50);
setcolor(0);
settextstyle(2,0,6);
str(pontos[i],txt);
txt:=concat('Pontos: ',txt);
outtextxy(425,25,txt);
for j:=1 to 8 do
begin
botao_actual(80,60+(j*40),250,90+(j*40));
setcolor(0);
circle(65,75+(j*40),3);
setfillstyle(1,4);
floodfill(65,75+(j*40),0);
outtextxy(90,64+(j*40),armas[j]);
if j=2 then outtextxy(205,64+(j*40),'1p/5')
else if j=3 then outtextxy(205,64+(j*40),'5p/5')
else if j=4 then outtextxy(205,64+(j*40),'8p/3')
else if j=5 then outtextxy(205,64+(j*40),'3p/1')
else if j=6 then outtextxy(205,64+(j*40),'7p/4')
else if j=7 then outtextxy(195,64+(j*40),'10p/2')
else if j=8 then outtextxy(195,64+(j*40),'10p/1');
if j<=3 then
begin
botao_actual(380,60+(j*40),550,90+(j*40));
setcolor(0);
circle(365,75+(j*40),3);
setfillstyle(1,4);
floodfill(365,75+(j*40),0);
outtextxy(390,64+(j*40),armas[j+8]);
if j=1 then outtextxy(495,64+(j*40),'15p/1')
else if j=2 then outtextxy(505,64+(j*40),'6p/4')
else if j=3 then outtextxy(505,64+(j*40),'8p/4');
end;
end;
j:=1;
k:=0;
setfillstyle(1,10);
floodfill(65,75+(j*40),0);
prima_esc;
botao_actual(380,230,550,410);
setcolor(0);
settextstyle(2,0,4);
for g:=1 to 11 do
begin
str(armas_dsp[i,g],txt);
outtextxy(400,228+(g*15),armas[g]);
if g=1 then outtextxy(515,228+(g*15),'oo')
else outtextxy(520,228+(g*15),txt);
end;
repeat
ik:=readkey;
setfillstyle(1,4);
floodfill(65+k,75+(j*40),0);
if (ik=sbax) and (j<>8) and (k=0) then j:=j+1
else if (ik=sbax) and (j<>3) and (k=300) then j:=j+1
else if (ik=sbax) and (j=8) then j:=1
else if (ik=sbax) and (j=3) and (k=300) then j:=1;
if (ik=scim) and (j<>1) then j:=j-1
else if (ik=scim) and (j=1) then if k=300 then j:=3
else j:=8;
if (ik=sdir) and (k=300) then k:=0
else if (ik=sdir) and (k=0) then if j>3 then
begin
k:=300;
j:=3;
end
else if j<=3 then k:=300;
if (ik=sesq) and (k=300) then k:=0
else if (ik=sesq) and (k=0) then if j>3 then
begin
k:=300;
j:=3;
end
else if j<=3 then k:=300;
if ik=enter
then begin
if (j=2)and(k=0)and(pontos[i]>=1)
then begin
pontos[i]:=pontos[i]-1;
armas_dsp[i,2]:=armas_dsp[i,2]+5;
end
else if (j=3)and(k=0)and(pontos[i]>=5)
then begin
pontos[i]:=pontos[i]-5;
armas_dsp[i,3]:=armas_dsp[i,3]+5;
end
else if (j=4)and(k=0)and(pontos[i]>=8)
then begin
pontos[i]:=pontos[i]-8;
armas_dsp[i,4]:=armas_dsp[i,3]+3;
end
else if (j=5)and(k=0)and(pontos[i]>=3)
then begin
pontos[i]:=pontos[i]-3;
armas_dsp[i,5]:=armas_dsp[i,5]+1;
end
else if (j=6)and(k=0)and(pontos[i]>=7)
then begin
pontos[i]:=pontos[i]-7;
armas_dsp[i,6]:=armas_dsp[i,6]+4;
end
else if (j=7)and(k=0)and(pontos[i]>=10)
then begin
pontos[i]:=pontos[i]-10;
armas_dsp[i,7]:=armas_dsp[i,7]+2;
end
else if (j=8)and(k=0)and(pontos[i]>=10)
then begin
pontos[i]:=pontos[i]-10;
armas_dsp[i,8]:=armas_dsp[i,8]+1;
end
else if (j=1)and(k=300)and(pontos[i]>=15)
then begin
pontos[i]:=pontos[i]-15;
armas_dsp[i,9]:=armas_dsp[i,9]+1;
end
else if (j=2)and(k=300)and(pontos[i]>=6)
then begin
pontos[i]:=pontos[i]-6;
armas_dsp[i,10]:=armas_dsp[i,10]+4;
end
else if (j=3)and(k=300)and(pontos[i]>=8)
then begin
pontos[i]:=pontos[i]-8;
armas_dsp[i,11]:=armas_dsp[i,11]+4;
end;
botao_actual(380,230,550,410);
bar(382,232,548,408);
setcolor(0);
settextstyle(2,0,4);
for g:=1 to 11 do
begin
str(armas_dsp[i,g],txt);
outtextxy(400,228+(g*15),armas[g]);
if g=1 then outtextxy(515,228+(g*15),'oo')
else outtextxy(520,228+(g*15),txt);
end;
botao_actual(420,20,535,50);
bar(422,22,533,48);
setcolor(0);
settextstyle(2,0,6);
str(pontos[i],txt);
txt:=concat('Pontos: ',txt);
outtextxy(425,25,txt);
end;
setfillstyle(1,10);
floodfill(65+k,75+(j*40),0);
until ik=esc;
end;
end;
{
*****************************************************************************
* Procedure : MAIN *
* Descri‡Æo : Consiste no menu do jogo *
* Variaveis : Variaveis de inicializa‡Æo do modo gr fico *
* Parte : MAIN *
* *
*****************************************************************************
}
{ Inicializa‡Æo do Modo grafico }
var
grDriver : Integer;
grMode,ajudar : Integer;
begin
grDriver := Detect;
InitGraph(grDriver,grMode,'C:\TP\BGI');
{****************************************************************************}
randomize;
{Parar todo o som aleio ao programa}
nosound;
{********************************}
{ Inicializa‡äes: cenario e var}
{********************************}
inicializacao;
bomba_apre;
apre_menu;
Size := ImageSize(p_c_x[0]-35,p_c_y[0],p_c_x[0]+50,p_c_y[0]+80);
while(sair=0) do
begin
if keypressed then
begin
tecla:=readkey;
if (tecla<>'1') then
begin
if ((tecla=scim) and (opcao<>1)) then opcao:=opcao-1
else if ((tecla=scim) and (opcao=1)) then opcao:=n_botoes;
if ((tecla=sbax) and (opcao<>n_botoes)) then opcao:=opcao+1
else if ((tecla=sbax) and (opcao=n_botoes)) then opcao:=1;
apre_menu;
if (som=1) then
begin
sound(100);
if computador=1 then delay(50)
else if computador=2 then delay(200)
else if computador=3 then delay(300);
nosound;
end;
end;
if (tecla=enter) then
begin
if (opcao=1) then
begin
for n_jogo_actual:=1 to n_jogad do
begin
pontos[n_jogo_actual]:=0;
victorias[n_jogo_actual]:=0;
end;
for n_jogo_actual:=1 to n_jogad do
begin
armas_dsp[n_jogo_actual,1]:=1;
end;
for n_jogo_actual:=1 to n_jogad do
begin
for conta:=2 to 11 do
begin
armas_dsp[n_jogo_actual,conta]:=0;
end;
end;
for n_jogo_actual:=1 to n_jogos do
begin
cleardevice;
vencedor:=0;
jogo;
quadro(n_jogo_actual);
if (n_jogo_actual<>n_jogos) then compras;
end;
cleardevice;
bomba_apre;
apre_menu;
end
else if (opcao=2) then
begin
cleardevice;
opcoes;
cleardevice;
bomba_apre;
apre_menu;
end
else if (opcao=3) then
begin
ajudar:=qual_ajuda;
if ajudar<>2 then ajuda(ajudar);
end
else if (opcao=4) then
begin
cre_y:=1;
end
else if (opcao=n_botoes) then
begin
quer_sair;
apre_menu;
end;
end;
if (tecla=esc) then
begin
opcao:=n_botoes;
apre_menu;
quer_sair;
apre_menu;
end;
if (tecla=x_ma) or (tecla=x_mi) then
begin
sair:=1;
end;
end;
if cre_y>0 then
begin
if cre_y<=50 then
begin
cre_y:=cre_y+1;
creditos(cre_y);
end
else cre_y:=0;
end
else move_tanque;
end;
{**********Termina o modo gr fico ***********}
CloseGraph;
nosound;
end.
{****************************************************************************
*****************************************************************************
* Programa : Kabbooum *
* Programador : Pedro S Ferreira *
* Programador : Pedro Miguel de Andrade Tarrinho *
* *
*****************************************************************************
*****************************************************************************
}