home *** CD-ROM | disk | FTP | other *** search
/ Más de 2,500 Juegos / CD1.iso / ZIPDAT / 0829 / 0829.ZIP / TIKTAK.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1998-04-07  |  15.5 KB  |  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^);    {store the screen before drawing}
  208.     setcolor(9);
  209.     rectangle(200+px*80,120+py*80,279+px*80,199+py*80);         {draw a semi-3D-rectangle}
  210.     setcolor(8);
  211.     rectangle(202+px*80,122+py*80,279+px*80,199+py*80);
  212.     setcolor(10);
  213.     rectangle(200+px*80,120+py*80,277+px*80,197+py*80);
  214.     setcolor(14);
  215.     rectangle(201+px*80,121+py*80,278+px*80,198+py*80);
  216.     repeat
  217.       getkey;
  218.     until key in [#13,#27,#199..#201,#203,#205,#207..#209];     {wait for a key to be pressed, check whether it's a valid key}
  219.     putimage(200+px*80,120+py*80,back^,0);                      {restore screen/remove rectangle}
  220.     if key in [#199,#203,#207] then px:=(px+2) mod 3;           {the numeric keypad has extended charactres, the}
  221.     if key in [#201,#205,#209] then px:=(px+1) mod 3;           {GETKEY-statement from the SMGRAF-unit reads the second}
  222.     if key in [#199..#201] then py:=(py+2) mod 3;               {charactre and adds 128 to its ordinal value}
  223.     if key in [#207..#209] then py:=(py+1) mod 3;               { - hence these values}
  224.     if key=#13 then if grid[px,py]>0 then key:=#255;            {#13 is the Enter-key. If it's pressed over an invalid square
  225.                                                                 (not empty) 'key' gets a dummy value}
  226.   until key in [#13,#27];                                       {#27 is the Esc-key}
  227.   if key=#27 then quit('You gave up...',180);                   {when Esc is pressed the game is aborted, 'Quit' shows a
  228.                                                                 message (msg) at horizontal coordinate 'x'}
  229.   grid[px,py]:=1;                                               {when Enter is pressed the grid-value is set to 1 indicating
  230.                                                                 a cross for the human player}
  231.   cross(px,py);                                                 {draw the cross}
  232.   delay(1000);                                                  {wait}
  233.   wipe(px,py);                                                  {'gray out' the cross}
  234.   i:=check(grid,1);                                             {check whether the human player ('1') has won}
  235.   if i>0 then                                                   {if so...}
  236.   begin
  237.     if i in [1,2,3] then cross(0,0);
  238.     if i in [2,4] then cross(1,0);
  239.     if i in [2,6,7] then cross(2,0);
  240.     if i in [1,5] then cross(0,1);
  241.     if i in [3,4,5,6] then cross(1,1);
  242.     if i in [5,7] then cross(2,1);
  243.     if i in [1,6,8] then cross(0,2);
  244.     if i in [4,8] then cross(1,2);
  245.     if i in [3,7,8] then cross(2,2);                            {highlight the winning line, retrieved from the check-value}
  246.  
  247.     quit('You win!',232);                                       {congratulations}
  248.   end;
  249. end;
  250.  
  251. procedure computermove;
  252.  
  253. var
  254.   cx,cy:integer;                                                {position}
  255.   table:array[0..2,0..2] of integer;                            {stores a value for each field indicating a good or bad move}
  256.   tmpgrid:gridtype;                                             {to store a temporary playing field}
  257.   i,j,x,y,a,b:integer;                                          {dummy- or loop-variables}
  258.  
  259. begin
  260.   font30_2('Use arrows to move,',220,364,1,2,fontgray);         {'gray out' text}
  261.   font30_2('Enter to select',248,380,1,2,fontgray);
  262.   for i:=0 to 2 do for j:=0 to 2 do table[i,j]:=1000+random(10);{set initial value for each move at 1000 and something; the
  263.                                                                 highest value indicates the best move}
  264.   inc(table[0,0],8);                                            {give the corners some extra, they're better to start with}
  265.   inc(table[0,2],8);
  266.   inc(table[2,0],8);
  267.   inc(table[2,2],8);
  268.   inc(table[1,1],10);                                           {give the center a big extra, it's best to start with}
  269.   for i:=0 to 2 do for j:=0 to 2 do                             {start checking each possible move}
  270.   begin
  271.     if grid[i,j]>0 then table[i,j]:=-1                          {if a square is not empty set the table-value at -1: invalid}
  272.     else
  273.     begin
  274.       for x:=0 to 2 do for y:=0 to 2 do tmpgrid[x,y]:=grid[x,y];{make a temporary playing field}
  275.       tmpgrid[i,j]:=1;                                          {simulate a human player's move at (i,j)}
  276.       if check(tmpgrid,1)>0 then inc(table[i,j],200);           {if it's a winning move increase the table-value to block this
  277.                                                                 human move}
  278.       tmpgrid[i,j]:=2;                                          {simulate a computer move at (i,j)}
  279.       if check(tmpgrid,2)>0 then inc(table[i,j],1000);          {if it's a winning move for the computer increase a lot: this
  280.                                                                 must be the move!}
  281.       for a:=0 to 2 do for b:=0 to 2 do if tmpgrid[a,b]=0 then  {check for the human player's move next}
  282.       begin
  283.         for x:=0 to 2 do for y:=0 to 2 do tmpgrid[x,y]:=grid[x,y];
  284.         tmpgrid[i,j]:=2;                                        {reset the temporary grid at this 'virtual move'}
  285.         tmpgrid[a,b]:=1;                                        {add a human's move}
  286.         if check(tmpgrid,1)>0 then dec(table[i,j],50);          {if the human will win on this next move the computer should
  287.                                                                 find a better one}
  288.       end;
  289.     end;
  290.   end;
  291.   cx:=0;
  292.   cy:=0;
  293.   for i:=0 to 2 do for j:=0 to 2 do if table[i,j]>table[cx,cy] then {find the highest table-value}
  294.   begin
  295.     cx:=i;
  296.     cy:=j;
  297.   end;
  298.   grid[cx,cy]:=2;                                               {put a naught here - '2' for computer-player}
  299.   naught(cx,cy);                                                {draw a circle}
  300.   delay(1000);                                                  {wait}
  301.   wipe(cx,cy);                                                  {'gray out' the circle}
  302.   i:=check(grid,2);                                             {check if it's a winning move}
  303.   if i>0 then                                                   {if so....}
  304.   begin
  305.     setfillstyle(0,0);
  306.     bar(160,360,479,399);                                       {same as in playermove}
  307.     if i in [1,2,3] then naught(0,0);
  308.     if i in [2,4] then naught(1,0);
  309.     if i in [2,6,7] then naught(2,0);
  310.     if i in [1,5] then naught(0,1);
  311.     if i in [3,4,5,6] then naught(1,1);
  312.     if i in [5,7] then naught(2,1);
  313.     if i in [1,6,8] then naught(0,2);
  314.     if i in [4,8] then naught(1,2);
  315.     if i in [3,7,8] then naught(2,2);
  316.     quit('You lose!',232);                                      {rub it in}
  317.   end;
  318. end;
  319.  
  320. procedure play;
  321.  
  322. var
  323.   i,j,k:integer;
  324.  
  325. begin
  326.   for i:=0 to 2 do for j:=0 to 2 do grid[i,j]:=0;               {initialize empty playing field}
  327.   if random(2)=0 then computermove;                             {toss for the first turn}
  328.   repeat
  329.     playermove;
  330.     k:=0;
  331.     for i:=0 to 2 do for j:=0 to 2 do if grid[i,j]>0 then inc(k);{check if all squares are filled}
  332.     if k<9 then computermove;                                   {if not k<9}
  333.     k:=0;
  334.     for i:=0 to 2 do for j:=0 to 2 do if grid[i,j]>0 then inc(k);
  335.   until k=9;                                                    {loop until all squares are filled}
  336.   quit('It''s a draw.',205);                                    {if noone wins... it's a draw}
  337. end;
  338.  
  339. begin
  340.   preparegraphics;                                              {obvious}
  341.   play;                                                         {obvious}
  342. end.