API tools faq
paste
Guest User

Untitled

a guest
Apr 19th, 2018
92
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 13.36 KB | None | 0 0
raw download clone embed print report
  1. {Criado por alunos da Unifacs - Pedro Moraes , Felipe Barreto , Cosme Henrique e Fernando Carvalho}
  2. program tutosnake;
  3.  
  4. uses crt,Dos;
  5.  
  6. Type
  7.     CoOrd = Record
  8.     X, Y : Byte;
  9. End;
  10.  
  11.  
  12. Snake = Record
  13.     Partes : Array[1..100] of CoOrd;                                                                 { A posição de cada parte da minhoca}
  14.     Tamanho : Byte;                                                                                  { O tamanho da minhoca}
  15.     Direcao : Byte;                                                                                  { Direção da minhoca}
  16.     Velocidade:real;                                                                                 { Velocidade da minhoca}
  17.     Vidas:byte;                                                                                      { Vidas da minhoca}
  18. End;
  19.  
  20. Food = Record
  21.     Posicao : CoOrd;
  22.     Quantidade : byte;
  23.     Comida:Char;
  24. End;
  25.  
  26.  VAR
  27.     TUTO : Snake;                                                                                    { Instanciando a minhoca}
  28.     TUTOS_FOOD: Food;                                                                                { Instanciando a comida}
  29.     quit:boolean;                                                                                    { Variavel de saida do jogo}
  30.     key:char;                                                                                        { Variavel de leitura do teclado}
  31.     mapaX: byte;                                                                                     { Variavel da largura da tela}
  32.     mapaY: byte;                                                                                     { Variavel da altura da tela}
  33.    
  34.  
  35. {-----HELPERS-----}
  36. function timer:real;                                                                                { }
  37. var hour,minute,second,sec100:word;
  38. begin
  39.    GetTime(hour,minute,second,sec100);
  40.    timer:=(hour*3600.0+minute*60.0+second)*100.0+1.0*sec100;
  41. end;
  42.  
  43. procedure wait_seconds(t:real);
  44. var t1:real;
  45. begin
  46.  t1:=timer;
  47.  repeat until timer>t1+100*t;
  48. end;
  49.  
  50.  {-----PROCEDURES-----}
  51. Procedure Desenha_Info;
  52.  Begin
  53.     textcolor(7);
  54.     GoToXY(20,2);
  55.     write('Vidas : ',TUTO.Vidas);
  56.     GoToXY(35,2);
  57.     Write('Pontuacao : ',TUTOS_FOOD.Quantidade*10-10);
  58.     GoToXY(50,2);
  59.     write('comidaX : ',TUTOS_FOOD.Posicao.X,'  comidaY : ',TUTOS_FOOD.Posicao.Y);
  60.  End;
  61.  
  62.  Procedure Desenha_Limites;
  63.  Var i:integer;
  64.  Begin
  65.     for  i:=1 to mapaX do                                                                            { Desenhando os limites do scoreboard}
  66.     begin
  67.         if i=1 then begin
  68.             GoToXY(i,1);
  69.             write(char(201));
  70.             GoToXY(i,2);
  71.             write(char(186));
  72.             GoToXY(i,3);
  73.             write(char(186))
  74.         end else begin
  75.             if i=100 then begin
  76.                 GoToXY(i,1);
  77.                 write(char(187));
  78.                 GoToXY(i,2);
  79.                 write(char(186));
  80.                 GoToXY(i,3);
  81.                 write(char(186))
  82.             end else begin
  83.                 GoToXY(i,1);
  84.                 write(char(205));
  85.             end;
  86.         end;   
  87.         GoToXY(i,4);       
  88.         write(char(177));
  89.         GoToXY(i,mapaY+5);     
  90.         write(char(177));
  91.     end;
  92.     for  i:=5 to mapaY+5 do                                                                          { Desenhando os limites do scoreboard}
  93.     begin
  94.         GoToXY(1,i);
  95.         write(char(186));
  96.         GoToXY(100,i);
  97.         write(char(186));
  98.     end;
  99.  End;
  100. Procedure Desenhar_Comida;
  101. Begin
  102.     if TUTOS_FOOD.Posicao.X < 3 then
  103.         TUTOS_FOOD.Posicao.X :=3;
  104.     if TUTOS_FOOD.Posicao.X > mapaX-1 then
  105.         TUTOS_FOOD.Posicao.X :=mapaX-2;
  106.     if TUTOS_FOOD.Posicao.Y < 6 then
  107.         TUTOS_FOOD.Posicao.Y :=6;
  108.     GoToXY(TUTOS_FOOD.Posicao.X,TUTOS_FOOD.Posicao.Y);
  109.     randomize;
  110.     textcolor(random(10)+1);
  111.     write(TUTOS_FOOD.Comida);
  112. End;
  113.  
  114. Procedure comeca(tamanho,vidas,quantidade:byte);                                                                                     { Valores iniciais para a minhoca}
  115. Var i : Byte;
  116. Begin
  117.     randomize;
  118.     TUTOS_FOOD.Quantidade := quantidade;
  119.     TUTOS_FOOD.Posicao.X := Random(mapaX-1)+1;
  120.     TUTOS_FOOD.Posicao.Y := Random(mapaY-2)+6;
  121.     TUTOS_FOOD.Comida := char(248);
  122.    
  123.     TUTO.Tamanho := tamanho;  {Part 4 is the clean up part}
  124.     TUTO.Direcao := 2; {Left}  
  125.     TUTO.Velocidade := (0.3/TUTOS_FOOD.Quantidade);
  126.     TUTO.Vidas := vidas;
  127.     For i := 1 to tamanho do
  128.     Begin
  129.         TUTO.Partes[i].X := i + 25; {começar em X = 26}
  130.         TUTO.Partes[i].Y :=  10; {começar em Y = 10}
  131.     End;
  132.    
  133.    
  134.     textcolor(9);
  135.     Desenha_Limites;
  136.     Desenhar_Comida;
  137. End;
  138.  
  139.  
  140.  
  141.  Procedure Fim_de_Jogo;
  142.  Begin
  143.     clrscr;
  144.     writeln(' _______ _______ _______      _____  _______        _____ _______ _______ _______ __ __ ');
  145.     writeln('|    ___|_     _|   |   |    |     \|    ___|     _|     |       |     __|       |  |  |');
  146.     writeln('|    ___|_|   |_|       |    |  --  |    ___|    |       |   -   |    |  |   -   |__|__|');
  147.     writeln('|___|   |_______|__|_|__|    |_____/|_______|    |_______|_______|_______|_______|__|__|');
  148.     quit:=true;
  149.  End;
  150.  
  151.  Procedure Perde_Vida;
  152.  Var i:byte;
  153.  Begin
  154.     randomize;
  155.     for i:=1 to 5 do begin
  156.         sound(i*10);
  157.         wait_seconds((random(3)+1)/10);
  158.     end;
  159.     if TUTO.Vidas > 0 then begin
  160.         TUTO.Vidas := TUTO.Vidas -1;
  161.         clrscr;
  162.         comeca(TUTO.Tamanho,TUTO.Vidas,TUTOS_FOOD.Quantidade);
  163.     end else
  164.         Fim_de_Jogo;
  165.  End;
  166.  
  167.  
  168.  
  169. Procedure Comida_Comida;
  170. Begin
  171.     randomize;
  172.     if TUTO.Tamanho < 100 then
  173.         TUTO.Tamanho := TUTO.Tamanho + 1;
  174.     TUTO.Velocidade := (0.3/TUTOS_FOOD.Quantidade);
  175.     TUTOS_FOOD.Posicao.X := Random(mapaX)+1;
  176.     TUTOS_FOOD.Posicao.Y := Random(mapaY)+1;
  177.     TUTOS_FOOD.Quantidade := TUTOS_FOOD.Quantidade + 1;
  178.     Desenhar_Comida;
  179. End;
  180.  
  181.  Procedure Desenhar_Minhoca;
  182. Var i : Byte;
  183. Begin
  184.     textcolor(7);
  185.     GotoXY(TUTO.Partes[1].X, TUTO.Partes[1].Y);                                                         {Partes[1] = Cabeça}
  186.     Write('@');
  187.     For i := 2 to TUTO.Tamanho - 2 Do                                                                   {Encher o corpo}
  188.     Begin
  189.         GotoXY(TUTO.Partes[i].X, TUTO.Partes[i].Y);
  190.         Write('0');
  191.     End;                                                                                   
  192.     GotoXY(TUTO.Partes[TUTO.Tamanho-1].X, TUTO.Partes[TUTO.Tamanho-1].Y);                               {Desenhar rabo}
  193.     Write('*');
  194.     GotoXY(TUTO.Partes[TUTO.Tamanho].X, TUTO.Partes[TUTO.Tamanho].Y);
  195.     Write(' ');                                                                                         { Limpar "rastros"}
  196.     GotoXY(1,1);                                                                                        { Evitar que o cursor siga o "rabo" da minhoca}
  197. End;
  198.  
  199. Procedure Mover_Minhoca;
  200. Var i : Byte;
  201. Begin
  202.     if (TUTOS_FOOD.Posicao.X = TUTO.Partes[1].X) and (TUTOS_FOOD.Posicao.Y = TUTO.Partes[1].Y) then
  203.         Comida_Comida;     
  204.        
  205.     if (TUTO.Partes[1].X = mapaX-1) or (TUTO.Partes[1].X = 2) or (TUTO.Partes[1].Y = mapaY+4) or (TUTO.Partes[1].Y = 5) then
  206.         Perde_Vida
  207.     else begin
  208.         For i := TUTO.Tamanho downto 2 do                                                                       { Mover o ultimo "pedaco" da minhoca para a }
  209.         Begin                                                                                                   { posição do penultimo e assim por diante }
  210.             TUTO.Partes[i].X := TUTO.Partes[i-1].X;                                                                        
  211.             TUTO.Partes[i].Y := TUTO.Partes[i-1].Y;
  212.         End;
  213.     {GotoXY(1, 10);                                                                                         Partes[1] = Cabeça}
  214.     {Write(TUTO.Partes[1].X);
  215.     GotoXY(1, 11);                                                      
  216.     Write(TUTO.Partes[1].Y);}
  217.     Case TUTO.Direcao of                                                                                    {incrementar a posição de acordo com a direção}
  218.         1 : if TUTO.Partes[1].X < mapaX-1 then Inc(TUTO.Partes[1].X);                                       {Direita}
  219.         2 : if TUTO.Partes[1].X > 2        then  Dec(TUTO.Partes[1].X);                                     {Esquerda}
  220.         3 : if TUTO.Partes[1].Y < mapaY+4 then  Inc(TUTO.Partes[1].Y);                                      {Baixo}
  221.         4 : if TUTO.Partes[1].Y > 5        then  Dec(TUTO.Partes[1].Y);                                     {Cima}
  222.     End;
  223.     For i := TUTO.Tamanho downto 2 do
  224.     if (TUTO.Partes[i].X = TUTO.Partes[1].X) and (TUTO.Partes[i].Y = TUTO.Partes[1].Y) then                 { cabeca tocou corpo}
  225.                 Perde_Vida;
  226.     Desenhar_Minhoca;                                                                                       {redesenhar a minhoca}                                                         
  227.     End;
  228. End;
  229.  
  230. Procedure Desenha_Telainicial;
  231. Begin
  232.     writeln('');
  233.    
  234. writeln('                                      88888888888888888888888888                ');
  235. writeln('                                  888888888888888888888888888888888             ');
  236. writeln('                                888888888887IIIIIII?IIIIIII78888888888          ');
  237. writeln('                              8888888IIIII???????????????????III$88888888       ');
  238. writeln('                             88888IIIII?????????????????????????III$888888      ');
  239. writeln('                           88888IIII???????????????????????????????III888888    ');
  240. writeln('                           8888IIII?????????????????????????????????IIII88888   ');
  241. writeln('                          8888III????????????????????????????????????IIII88888  ');
  242. writeln('                          8888III?????????????????????????????????????IIII8888  ');
  243. writeln('                          8888III?????????????????????????????????????IIIII8888 ');
  244. writeln('                         88887III?????????????????????????????????????IIIII8888 ');
  245. writeln('                         8888IIII???????????????:,,,,,,,=????????????IIIIIII8888');
  246. writeln('                         8888IIIII????????????,,,,,,,,,,,,??????,,,,,IIIIIII8888');
  247. writeln('                         8888IIIIIII?????????,,,,,,,,,,,,,:????,,,,,,,?IIIII8888');
  248. writeln('                         8888IIIIIIII???????:,,,,,,,,,,,,,,???,,,,,,,,,IIII78888');
  249. writeln('                         8888IIIIIIIIIII????,,,,,.....,,,,,~?,,,,,,,,,,,III8888 ');
  250. writeln('                         88887IIIIIIIIIIIII:,,,,.......,,,,,I,,,,,...,,,III8888 ');
  251. writeln('                          8888IIIIIIIIIIIII,,,,.....ZMMMM,,,,,,,,.....,,+I8888  ');
  252. writeln('                          8888IIIIIIIIIIIII,,,,.....MMMMMM,,,,MMMM....,,+88888  ');  
  253. writeln('                          8888IIIIIIIIIIIII,,,.....?MMMMMM,,,MMMMMI...,,78888   ');
  254. writeln('                           888ZIIIIIIIIIIII,,,.....MMMMMMM,,,MMMMMM..,,,8888    ');
  255. writeln('                           8888IIIIIIIIIIII=,,.....MMMMMMM,,8MMMMMM..,,?888     ');
  256. writeln('                           8888$IIIIIIIIIII7,,.....MMMMMMM,,8MMMMMN.,,,888      ');
  257. writeln('                            8888IIIIIIIIIIII,,,.....MMMMM,,,,MMMMM..,,888       ');
  258. writeln('                            8888OIIIIIIIIIII+,,.....MMMM,,+,,MMMM..,,,88        ');
  259. writeln('                             8888IIIIIIIIIII7,,,......,,,,7,,.....,,,88         ');
  260. writeln('                             8888IIIIIIIIIIII7,,,,...,,,,,$,,,...,,,88          ');
  261. writeln('                              8888IIIIIIIIIIII,,,,,,,,,,,I$,,,,,,,,888          ');
  262. writeln('                              88887IIIIIIIIIII$,,,,,,,,,7I$,,,,,,,888           ');
  263. writeln('                               8888IIIIIIIIIIII7I,,,,,,7II$:,,,,7888            ');
  264. writeln('                               8888OIIIIIIIIIIIII$$=?$IIIII$,,~$888             ');
  265. writeln('                                8888IIIIIIIIIIIIIIIIIIIIIIII$II8888             ');
  266. writeln('                                8888IIIIIIIIIIIIIIIIIIIIIIIIIII8888             ');
  267. writeln('                                 8888IIIIIIIIIIIIIIIIIIIIIIIIII8888             ');
  268. writeln('                                 8888ZIIIIIIIIIIIIIIIIIIIIIIIII8888             ');
  269. writeln('                     888888       8888IIIIIIIIIIIIIIIIIIIIIIIII8888             ');
  270. writeln('                   8888888888     88887IIIIIIIIIIIIIIIIIIIIIIII8888             ');
  271. writeln('                  88888Z888888     8888IIIIIIIIIIIIIIIIIIIIIII8888              ');
  272. writeln('                 8888I????Z8888    8888II88888IIIIIIIIIIIIIII88888              ');
  273. writeln('                8888ZIIIII?Z88888   888OI88888888888Z$$$Z8888888                ');
  274. writeln('               8888ZIIIIIIIII88888888888II$$8888888888888888888                 ');
  275. writeln('               8888IIIIIIIIIIII88888888IIII$$$$$$O88888888888                   ');
  276. writeln('              8888IIIIIIIIIIIIIIII7Z8$IIIIIII$$$$$$$$$$II8888                   ');
  277. writeln('             88888IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII8888                   ');
  278. writeln('             8888IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII8888                   ');
  279. writeln('            8888OIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII8888                   ');
  280. writeln('            8888IIIIII$88IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII7888                   ');
  281. writeln('           8888IIIIIII8888IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII888                   ');
  282. writeln('      888888888IIIIIIO8888IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII888                   ');
  283. writeln('   8888888888$IIIIIII888888$IIIIIIIIIIIIIIIIIIIIIIIIIIIIII888                   ');
  284. writeln(' 88888888887IIIIIIIII888888Z$$$IIIIIIIIIIIIIIIIIIIIIIII$$$888                   ');
  285. writeln('88888ZIIIIIIIIIIII$$$88888888$$$$$$IIIIIIIIIIIIIIIII$$$$$8888                   ');
  286. writeln('888Z$$$$$$$$$$$$$$$$8888 88888$$$$$$$$$$$$$$$$$$$$$$$$$$88888                   ');
  287. writeln('8888$$$$$$$$$$$$$$$88888  888888$$$$$$$$$$$$$$$$$$$$$$888888                    ');
  288. writeln('88888888O$$$$$$$O888888     8888888O$$$$$$$$$$$$$$88888888                      ');
  289. writeln(' 888888888888888888888        888888888888888888888888888                       ');
  290. writeln('    8888888888888888            888888888888888888888                ');    
  291. writeln('                                      888888888  ');
  292. writeln('');  
  293. writeln('');      
  294. writeln(' _______ _______ _______ _______      _______ _______ _______      ________ _______ ______  _______ __ __ ');
  295. writeln('|_     _|   |   |_     _|       |    |_     _|   |   |    ___|    |  |  |  |       |   __ \|   |   |  |  |');
  296. writeln('  |   | |   |   | |   | |   -   |      |   | |       |    ___|    |  |  |  |   -   |      <|       |__|__|');
  297. writeln('  |___| |_______| |___| |_______|      |___| |___|___|_______|    |________|_______|___|__||__|_|__|__|__|');
  298. End;
  299.  
  300.  
  301.  
  302. {-----Inicializacao-----}
  303.  
  304.  
  305. BEGIN  
  306.     Desenha_Telainicial;
  307.     readln;
  308.     clrscr;
  309.     mapaX :=100;
  310.     mapaY := 30;
  311.     quit := false;
  312.     comeca(6,3,1);
  313.     textcolor(7);
  314.     textcolor(8);
  315.     repeat
  316.     Desenha_Info;
  317.     wait_seconds(TUTO.Velocidade);
  318.     if KeyPressed then
  319.         key:=Readkey;
  320.         case key of
  321.         #72: if TUTO.Direcao <> 3 then TUTO.Direcao := 4 ;
  322.         #75: if TUTO.Direcao <> 1 then TUTO.Direcao := 2 ;
  323.         #77: if TUTO.Direcao <> 2 then TUTO.Direcao := 1 ;
  324.         #80: if TUTO.Direcao <> 4 then TUTO.Direcao := 3 ;
  325.         end;
  326.         Mover_Minhoca;
  327.     until quit;
  328.     readln;
  329. END.
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!