home *** CD-ROM | disk | FTP | other *** search
/ Más de 2,500 Juegos / CD3.iso / zipdat / 2645 / 2645.txt next >
Text File  |  1998-04-06  |  16KB  |  342 lines
  1. {I made this game as a challenge. It took me two-and-half hours to finish it,
  2. starting from scratch.
  3. To compile this code you'll need two units:
  4.   - SMGRAF for some graphics routines (initgraf, setpal & fades).
  5.   - SMFONT30 for the font.
  6. You can download both from my website at http://www.xs4all.nl/~remcodek/
  7. (go to the fontpage for the font and the downloadpage for SMGRAF).
  8. You may alter and/or distribute this code and program but I would appreciate
  9. it if you'd keep me informed and gave me some credit(s). Handing it in as
  10. homework is very unwise.
  11.  
  12. I added some comments hoping to make it all a bit clearer. I'm not used to
  13. doing that so if you still find it cryptic I'm sorry.
  14.  
  15. If you need some comments or help let me know.
  16. Have fun!
  17.  
  18. Remco de Korte
  19. e-mail: remcodek@xs4all.nl}
  20.  
  21. program tiktak;
  22.  
  23. uses
  24.   crt,graph,smgraf,smfont30;
  25.  
  26. type
  27.   gridtype=array[0..2,0..2] of byte;
  28.  
  29. var
  30.   p:array[0..8] of pointer; {tilting tiles}
  31.   grid,checktable:gridtype; {store the grid to check}
  32.   back:pointer;             {to (re)store part of the screen}
  33.  
  34. const
  35.   fontcol:tctype30=(8,9,10,11,12,13,14,15,15,15,15,15,15,15,15,15);
  36.   fontgray:tctype30=(1,2,3,4,5,6,7,7,7,7,7,7,7,7,7,7);
  37.     {constants for the colors of the font}
  38.  
  39. procedure preparegraphics;
  40.  
  41. var
  42.   i,j,k,z:integer;
  43.  
  44. begin
  45.   initgraf;                                                       {initialize graphics - same as GRAPHs InitGraph()}
  46.   getmem(back,imagesize(0,0,79,79));                              {allocate memory for the size of a tile}
  47.   for i:=0 to 7 do setpal(colnum[i],i*5,i*5,i*5);
  48.   for i:=0 to 7 do setpal(colnum[8+i],42+i*3,21+i*6,i*6);         {initialize custom palette}
  49.   quickfadeout(1);                                                {fade to black}
  50.   for j:=0 to 79 do for i:=0 to 79 do putpixel(i,j,1+random(5));  {draw 'raw' tile...}
  51.   setcolor(7);
  52.   rectangle(1,1,79,79);
  53.   setcolor(0);
  54.   rectangle(0,0,79,79);                                           {...with some edges...}
  55.   setfillstyle(1,0);
  56.   bar(5,5,8,8);
  57.   bar(72,5,75,8);
  58.   bar(5,72,8,75);
  59.   bar(72,72,75,75);
  60.   setfillstyle(1,7);
  61.   bar(5,5,6,6);
  62.   bar(72,5,73,6);
  63.   bar(5,72,6,73);
  64.   bar(72,72,73,73);                                              {...and some bolts}
  65.   for i:=0 to 79 do for j:=0 to 79 do
  66.   begin
  67.     k:=getpixel(i,j)+getpixel((i+1) mod 80,j)+getpixel(i,(j+1) mod 80)+getpixel((i+1) mod 80,(j+1) mod 80);
  68.     putpixel(i,j,k div 4);                                       {smoothen tile}
  69.   end;
  70.   getmem(p[0],imagesize(0,0,79,79));                             {allocate memory for full tile}
  71.   getimage(0,0,79,79,p[0]^);                                     {store tile}
  72.   setfillstyle(1,0);
  73.   for z:=1 to 8 do
  74.   begin
  75.     k:=trunc(40*cos(z*pi/16));                                   {calculate height of tilting tile}
  76.     bar(80,0,159,79);                                            {clear background}
  77.     if k>0 then for j:=0 to k do for i:=0 to 79 do
  78.     begin
  79.       putpixel(i+80,39-j,getpixel(i,39-j*40 div k));             {draw top half of tile}
  80.       putpixel(i+80,40+j,getpixel(i,40+j*40 div k));             {draw bottom half}
  81.     end;
  82.     getmem(p[z],imagesize(0,0,79,79));                           {allocate memory}
  83.     getimage(80,0,159,79,p[z]^);                                 {store tilted tile}
  84.   end;
  85.  
  86.   for j:=0 to 5 do for i:=0 to 7 do putimage(i*80,j*80,p[0]^,0); {fill the screen with tiles}
  87.   quickfadein(256);                                              {fade in, slowly, ironically}
  88.   for j:=1 to 4 do for i:=2 to 5 do for k:=1 to 8 do             {remove center with a simple animation}
  89.   begin
  90.     putimage(i*80,j*80,p[k]^,0);
  91.     delay(50);
  92.   end;
  93.   for j:=2 downto 0 do for i:=2 downto 0 do for k:=7 downto 0 do {draw tiles of playing field}
  94.   begin
  95.     putimage(i*80+200,j*80+120,p[k]^,0);
  96.     delay(50);
  97.   end;
  98.   font30_4('Tik!',200,90,2,2,fontcol);                           {draw text}
  99.   delay(1000);
  100.   font30_4('Tak!',280,90,2,2,fontcol);
  101.   delay(1000);
  102.   font30_4('Tor!',360,90,2,2,fontcol);
  103.   font30_2('Use arrows to move,',220,364,1,2,fontgray);
  104.   font30_2('Enter to select',248,380,1,2,fontgray);
  105. end;
  106.  
  107. procedure quit(msg:string;x:integer);
  108.  
  109. begin
  110.   setfillstyle(0,0);
  111.   bar(160,360,479,399);                                         {remove previous text}
  112.   repeat
  113.     font30_4(msg,x,368,4,1,fontgray);                           {draw text in gray}
  114.     if not keypressed then delay(500);
  115.     font30_4(msg,x,368,4,1,fontcol);                            {draw text in color}
  116.     if not keypressed then delay(500);
  117.   until keypressed;                                             {repeating makes the text blink}
  118.   emptykey;                                                     {empty the keyboardbuffer}
  119.   closegraph;
  120.   halt;                                                         {the end......}
  121. end;
  122.  
  123. procedure plot(x,y:integer);                                    {just a fancy way to draw}
  124.  
  125. var
  126.   z,xx,yy,kk:integer;
  127.  
  128. begin
  129.   for z:=0 to 15 do                                             {randomly distribute some pixels around a given pixel}
  130.   begin
  131.     xx:=random(z)-z div 2;
  132.     yy:=random(z)-z div 2;
  133.     kk:=15-(abs(xx)+abs(yy)) div 2;                             {the closer the pixel is to the center, the lighter the color}
  134.     if getpixel(x+xx,y+yy)<8 then putpixel(x+xx,y+yy,kk);
  135.   end;
  136.   for z:=0 to 15 do                                             {increase the 'pixel-density' towards the center}
  137.   begin
  138.     xx:=random(15)-7;
  139.     yy:=random(15)-7;
  140.     kk:=15-(abs(xx)+abs(yy)) div 2;
  141.     if getpixel(x+xx,y+yy)<8 then putpixel(x+xx,y+yy,kk);
  142.     delay(1);                                                   {show you're stuff....}
  143.   end;
  144. end;
  145.  
  146. function check(gr:gridtype;cc:byte):byte;                       {checks whether a game is won by player cc}
  147.  
  148. var
  149.   eval:byte;
  150.  
  151. begin
  152.   eval:=0;                                                      {there are 8 different ways to win, each one has its code,
  153.                                                                 used for drawing}
  154.   if gr[0,0]=cc then if gr[0,1]=cc then if gr[0,2]=cc then eval:=1;
  155.   if gr[0,0]=cc then if gr[1,0]=cc then if gr[2,0]=cc then eval:=2;
  156.   if gr[0,0]=cc then if gr[1,1]=cc then if gr[2,2]=cc then eval:=3;
  157.   if gr[1,0]=cc then if gr[1,1]=cc then if gr[1,2]=cc then eval:=4;
  158.   if gr[0,1]=cc then if gr[1,1]=cc then if gr[2,1]=cc then eval:=5;
  159.   if gr[2,0]=cc then if gr[1,1]=cc then if gr[0,2]=cc then eval:=6;
  160.   if gr[2,0]=cc then if gr[2,1]=cc then if gr[2,2]=cc then eval:=7;
  161.   if gr[0,2]=cc then if gr[1,2]=cc then if gr[2,2]=cc then eval:=8;
  162.   check:=eval;                                                  {if check=0 then the game isn't over, otherwise the value
  163.                                                                 tells you which line is complete}
  164. end;
  165.  
  166. procedure cross(x,y:integer);                                   {draws a colored cross}
  167.  
  168. var
  169.   i:integer;
  170.  
  171. begin
  172.   for i:=16 to 63 do plot(200+x*80+i,120+y*80+i);
  173.   for i:=16 to 63 do plot(279+x*80-i,120+y*80+i);
  174. end;
  175.  
  176. procedure naught(x,y:integer);                                  {draws a colored circle}
  177.  
  178. var
  179.   i:integer;
  180.  
  181. begin
  182.   for i:=0 to 63 do plot(240+x*80+trunc(24*sin(i*pi/32)),160+y*80+trunc(24*cos(i*pi/32)));
  183. end;
  184.  
  185. procedure wipe(x,y:integer);                                    {makes cross or circle gray}
  186.  
  187. var
  188.   i,j:integer;
  189.  
  190. begin
  191.   for j:=y*80+120 to y*80+199 do for i:=x*80+200 to x*80+279 do
  192.   if getpixel(i,j)>7 then putpixel(i,j,getpixel(i,j)-8);        {if a pixel is colored make it gray}
  193. end;
  194.  
  195. procedure playermove;
  196.  
  197. var
  198.   px,py:integer;                                                {position}
  199.   i,j:integer;                                                  {dummy- or loop-variables}
  200.  
  201. begin
  202.   font30_2('Use arrows to move,',220,364,1,2,fontcol);          {highlight text}
  203.   font30_2('Enter to select',248,380,1,2,fontcol);
  204.   px:=0;
  205.   py:=0;                                                        {start in the topleft corner}
  206.   repeat
  207.     getimage(200+px*80,120+py*80,279+px*80,199+py*80,back