home *** CD-ROM | disk | FTP | other *** search
/ 300 Totally Awesome Games for DOS / 300Games.iso / ttactoe / tictact2.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1993-11-05  |  14.2 KB  |  526 lines
  1. program Tic_Tac_Toe_2_Players(Input,Output);
  2. uses Dos,CRT,Graph,Doms;
  3.  
  4. var
  5.  Won,Mouse,OneTwo : Boolean;
  6.  Board : Array[1..9]of string[1];
  7.  Put : Integer;
  8.  Regs : Registers;
  9.  
  10. procedure Exit;
  11. begin
  12.  CloseGraph;
  13.  RestoreCRTMode;
  14.  ClrScr;
  15.  Halt;
  16. end;
  17.  
  18. procedure NumberBoard;
  19. begin
  20.  SetTextStyle(DefaultFont,HorizDir,1);
  21.  SetColor(63);
  22.  OutTextXY(65,15,'1');
  23.  OutTextXY(131,15,'2');
  24.  OutTextXY(211,15,'3');
  25.  OutTextXY(65,61,'4');
  26.  OutTextXY(131,61,'5');
  27.  OutTextXY(211,61,'6');
  28.  OutTextXY(65,101,'7');
  29.  OutTextXY(131,101,'8');
  30.  OutTextXY(211,101,'9');
  31. end;
  32.  
  33. procedure LoadBoard(Page : Integer);
  34. begin
  35.  SetActivePage(Page);
  36.  SetColor(62);
  37.  Line(65,60,275,60);{First Cross Bar}
  38.  Line(65,100,275,100);{Second Cross Bar}
  39.  Line(130,15,130,145);{First Down Bar}
  40.  Line(210,15,210,145);{Second Down Bar}
  41.  SetVisualPage(Page);
  42. end;
  43.  
  44. procedure ClearBoard;
  45. var
  46.  i : integer;
  47. begin
  48.  for i := 1 to 9 do
  49.   board[i] := '';
  50. end;
  51.  
  52. procedure Start; forward;
  53. procedure Start2; forward;
  54.  
  55. procedure Title;{Creates Title Screen}
  56. var
  57.  ch  : char;
  58.  cool1,cool2 : boolean;
  59. begin
  60.  SetActivePage(0);
  61.  SetFillStyle(1,2);
  62.  FloodFill(1,1,4);
  63.  SetTextStyle(DefaultFont,HorizDir,5);
  64.  SetColor(56);
  65.  OutTextXY(70,20,'T I C');
  66.  SetColor(7);
  67.  OutTextXY(150,61,'T A C');
  68.  SetColor(63);
  69.  OutTextXY(230,101,'T O E');
  70.  SetColor(62);
  71.  Line(67,18,261,130);
  72.  LoadBoard(0);
  73.  SetVisualPage(0);
  74.  SetActivePage(1);
  75.  SetColor(63);{Start Box}
  76.  Line(340,20,500,20);
  77.  Line(500,20,500,44);
  78.  Line(500,44,340,44);
  79.  Line(340,44,340,20);
  80.  SetFillStyle(1,0);
  81.  FloodFill(341,21,63);
  82.  SetTextStyle(DefaultFont,HorizDir,1);
  83.  SetColor(63);
  84.  OutTextXY(342,22,'[1]Player');
  85.  OutTextXY(426,22,'[2]Player');
  86.  OutTextXY(396,32,'[Q]uit');
  87.  delay(500);
  88.  FadeIn(340,20,500,44,1,0);
  89.  if Mouse then
  90.   begin
  91.    Regs.AX := 1;
  92.    Intr($33,Regs);
  93.    end;
  94.  cool1 := false;
  95.  cool2 := False;
  96.  repeat
  97.   Regs.AX := 0;
  98.   Intr($33,Regs);
  99.   Regs.AX := 1;
  100.   Intr($33,Regs);
  101.   repeat
  102.    setvisualPage(0);
  103.    if Mouse then
  104.     begin
  105.      Regs.AX := 3;
  106.      Intr($33,Regs);
  107.      if keypressed then
  108.       begin
  109.        ch := readkey;
  110.        if (ch = '1')or(ch = '2')or(ch = 'Q')or(ch = 'q') then
  111.         begin
  112.          if (ch = '1') then begin Start; cool2 := true; end;
  113.          if (ch = '2') then begin Start2; cool2 := true; end;
  114.          if (ch = 'Q')or(ch = 'q') then begin Exit; cool2 := true; end;begin Start; cool2 := true; end;
  115.         end;
  116.       end;
  117.      if (Mouse) and (Regs.BX = 1) then
  118.       begin
  119.        if (regs.cx > 341)and(Regs.cx < 367)and(regs.DX > 21)and(regs.DX < 32) then
  120.         begin Start; cool2 := true; end;
  121.        if (regs.cx > 425)and(regs.cx < 452)and(regs.dx > 21)and(regs.dx < 32) then
  122.         begin Start2; cool2 := true; end;
  123.        if (regs.cx > 395)and(regs.cx < 422)and(regs.dx > 31)and(regs.dx < 42) then
  124.         begin Exit; cool2 := true; end;
  125.       end;
  126.     end
  127.    else
  128.     begin
  129.      ch := readkey;
  130.      if (ch = 'B')or(ch = 'b')or(ch = 'Q')or(ch = 'q') then
  131.       begin
  132.        if (ch = 'B')or(ch = 'b') then begin Start; cool2 := true; end;
  133.        if (ch = 'Q')or(ch = 'q') then begin Exit; cool2 := true; end;
  134.       end
  135.       else
  136.       begin
  137.        sound(200);
  138.        delay(200);
  139.        nosound;
  140.       end;
  141.     end;
  142.   until cool2;
  143.  cool2 := false;
  144.  until cool1;
  145. end;
  146.  
  147. procedure Check(Team : Char);
  148. var
  149.  i,n : integer;
  150.  Temp : Array[1..3,1..3]of string[1];
  151.  
  152. begin
  153.  for i := 1 to 3 do
  154.   for n := 1 to 3 do
  155.    Temp[i,n] := '';
  156.  For i := 1 to 3 do
  157.   Temp[1,i] := Board[i];
  158.  for i := 4 to 6 do
  159.   Temp[2,i-3] := Board[i];
  160.  for i := 7 to 9 do
  161.   Temp[3,i-6] := Board[i];
  162.  won := false;
  163.  for i := 1 to 3 do
  164.  begin
  165.   for n := 1 to 3 do
  166.   begin
  167.    if (Temp[i,n] = Team)and(not(won)) then
  168.    begin
  169.     if (i = 1)and(n = 1) then
  170.      begin
  171.       if (temp[i,n+1] = Team)and(Temp[i,n+2] = Team) then Won := True;
  172.       if (temp[i+1,n] = Team)and(temp[i+2,n] = Team) then Won := True;
  173.       if (temp[i+1,n+1] = Team)and(temp[i+2,n+2] = Team) then won := true;
  174.      end;
  175.     if (i = 1)and(n = 2) then
  176.      if (temp[i+1,n] = Team)and(temp[i+2,n] = Team) then won := true;
  177.     if (i = 1)and(n = 3) then
  178.      begin
  179.       if (temp[i+1,n-1] = Team)and(temp[i+2,n-2] = Team) then Won := True;
  180.       if (temp[i+1,n] = Team)and(temp[i+2,n] = Team) then won := true;
  181.      end;
  182.     if (i = 2)and(n = 1) then
  183.      if (temp[i,n+1] = Team)and(temp[i,n+2] = Team) then won := true;
  184.     if (i = 3)and(n = 1) then
  185.      if (temp[i,n+1] = Team)and(temp[i,n+2] = Team) then won := true;
  186.    end;
  187.   end;
  188.  end;
  189. end;
  190.  
  191. procedure Place(Team:Char;Spot: integer);
  192. begin
  193.  SetTextStyle(DefaultFont,HorizDir,5);
  194.  SetColor(63);
  195.  If Spot in [1,2,3,4,5,6,7,8,9] then
  196.   case spot of
  197.    1 : OutTextXY(70,15,Team);
  198.    2 : OutTextXY(150,15,Team);
  199.    3 : OutTextXY(230,15,Team);
  200.    4 : OutTextXY(70,61,Team);
  201.    5 : OutTextXY(150,61,Team);
  202.    6 : OutTextXY(230,61,Team);
  203.    7 : OutTextXY(70,101,Team);
  204.    8 : OutTextXY(150,101,Team);
  205.    9 : OutTextXY(230,101,Team);
  206.   end;{Case}
  207.  SetTextStyle(DefaultFont,HorizDir,1);
  208. end;
  209.  
  210. procedure Start2;
  211. var
  212.  Spot,Code,OSpot,Chose,i,yn : Integer;
  213.  ch : Char;
  214.  choice : string[1];
  215.  Done : Boolean;
  216.  
  217. begin
  218.  Regs.AX := 2;
  219.  Intr($33,Regs);
  220.  Won := False;
  221.  ClearBoard;
  222.  SetActivepage(1);
  223.  ClearViewPort;
  224.  LoadBoard(1);
  225.  NumberBoard;
  226.  SetTextStyle(DefaultFont,HorizDir,1);
  227.  OutTextXY(5,150,'You will be X''s and I will be O''s!');
  228.  Chose := 9;
  229.  Randomize;
  230.  Done := False;
  231.  repeat
  232.   SetTextStyle(DefaultFont,HorizDir,1);
  233.   OutTextXY(5,160,'Please Enter Your Spot: ');
  234.   repeat
  235.    Done := False;
  236.    repeat
  237.     Regs.AX := 1;
  238.     Intr($33,Regs);
  239.     if mouse then
  240.      begin
  241.       Regs.AX := 3;
  242.       Intr($33,Regs);
  243.       if keypressed then
  244.        begin
  245.         ch := readkey;
  246.         if ch = #27 then Exit;
  247.         OutTextXY(197,160,ch);
  248.         choice := ch;
  249.         Val(Choice,Spot,Code);
  250.         Done := True;
  251.        end;
  252.       if regs.BX = 1 then
  253.        begin
  254.         if (regs.cx > 64)and(regs.cx < 131)and(regs.DX > 14)and(regs.dx < 62)then
  255.          begin Spot := 1; Done := true; end;
  256.         if (regs.cx > 130)and(regs.cx < 212)and(regs.DX > 14)and(regs.dx < 62)then
  257.          begin Spot := 2; done := true; end;
  258.         if (regs.cx > 212)and(regs.cx < 294)and(regs.DX > 14)and(regs.dx < 62)then
  259.          begin Spot := 3; done := true; end;
  260.         if (regs.cx > 64)and(regs.cx < 131)and(regs.DX > 62)and(regs.dx < 101)then
  261.          begin Spot := 4; done := true; end;
  262.         if (regs.cx > 130)and(regs.cx < 212)and(regs.DX > 62)and(regs.dx < 101)then
  263.          begin Spot := 5; done := true; end;
  264.         if (regs.cx > 212)and(regs.cx < 294)and(regs.DX > 62)and(regs.dx < 101)then
  265.          begin Spot := 6; done := true; end;
  266.         if (regs.cx > 64)and(regs.cx < 131)and(regs.DX > 101)and(regs.dx < 148)then
  267.          begin Spot := 7; done := true; end;
  268.         if (regs.cx > 130)and(regs.cx < 212)and(regs.DX > 101)and(regs.dx < 148)then
  269.          begin Spot := 8; done := true; end;
  270.         if (regs.cx > 212)and(regs.cx < 294)and(regs.DX > 101)and(regs.dx < 148)then
  271.          begin Spot := 9; done := true; end;
  272.        end;
  273.      end
  274.     else
  275.      begin
  276.       ch := readkey;
  277.       if ch = #27 then exit;
  278.       OutTextXY(197,160,ch);
  279.       choice := ch;
  280.       Val(Choice,Spot,Code);
  281.       Done := True;
  282.      end;
  283.    until Done;
  284.   until (Board[Spot] = '');
  285.   Regs.AX := 2;
  286.   Intr($33,Regs);
  287.   Place('X',Spot);
  288.   Board[Spot] := 'X';
  289.   chose := 0;
  290.   for i := 1 to 9 do
  291.    if Board[i] = '' then chose := chose + 1;
  292.   Check('X');
  293.   Done := False;
  294.   Regs.AX := 0;
  295.   Intr($33,Regs);
  296.   if not(won) and (chose > 0) then
  297.    begin
  298.     Done := False;
  299.     repeat
  300.     Regs.AX := 1;
  301.     Intr($33,Regs);
  302.     if mouse then
  303.      begin
  304.       Regs.AX := 3;
  305.       Intr($33,Regs);
  306.       if keypressed then
  307.        begin
  308.         ch := readkey;
  309.         if ch = #27 then exit;
  310.         OutTextXY(197,160,ch);
  311.         choice := ch;
  312.         Val(Choice,Spot,Code);
  313.         Done := True;
  314.        end;
  315.       if regs.BX = 1 then
  316.        begin
  317.         if (regs.cx > 64)and(regs.cx < 131)and(regs.DX > 14)and(regs.dx < 62)then
  318.          begin Spot := 1; Done := true; end;
  319.         if (regs.cx > 130)and(regs.cx < 212)and(regs.DX > 14)and(regs.dx < 62)then
  320.          begin Spot := 2; done := true; end;
  321.         if (regs.cx > 212)and(regs.cx < 294)and(regs.DX > 14)and(regs.dx < 62)then
  322.          begin Spot := 3; done := true; end;
  323.         if (regs.cx > 64)and(regs.cx < 131)and(regs.DX > 62)and(regs.dx < 101)then
  324.          begin Spot := 4; done := true; end;
  325.         if (regs.cx > 130)and(regs.cx < 212)and(regs.DX > 62)and(regs.dx < 101)then
  326.          begin Spot := 5; done := true; end;
  327.         if (regs.cx > 212)and(regs.cx < 294)and(regs.DX > 62)and(regs.dx < 101)then
  328.          begin Spot := 6; done := true; end;
  329.         if (regs.cx > 64)and(regs.cx < 131)and(regs.DX > 101)and(regs.dx < 148)then
  330.          begin Spot := 7; done := true; end;
  331.         if (regs.cx > 130)and(regs.cx < 212)and(regs.DX > 101)and(regs.dx < 148)then
  332.          begin Spot := 8; done := true; end;
  333.         if (regs.cx > 212)and(regs.cx < 294)and(regs.DX > 101)and(regs.dx < 148)then
  334.          begin Spot := 9; done := true; end;
  335.        end;
  336.       end
  337.      else
  338.       begin
  339.        Ch := Readkey;
  340.        if ch = #27 then Exit;
  341.        OutTextXY(197,160,ch);
  342.        choice := ch;
  343.        Val(Choice,Spot,Code);
  344.        Done := True;
  345.       end;
  346.     until Done;
  347.    end;
  348.   if Board[Spot] = '' then
  349.    begin
  350.     Board[Spot] := 'O';
  351.     Regs.AX := 2;
  352.     Intr($33,Regs);
  353.     Place('O',Spot);
  354.    end;
  355.   if not(won)then Check('O');
  356.   chose := 0;
  357.   for i := 1 to 9 do
  358.    if Board[i] = '' then chose := chose + 1;
  359.   Regs.AX := 0;
  360.   Intr($33,Regs);
  361.  until (chose = 0)or Won;
  362.  SetTextStyle(DefaultFont,HorizDir,1);
  363.  OutTextXY(5,170,'Game Over!');
  364.  OutTextXY(10,180,'Press ENTER');
  365.  readln;
  366. end;
  367.  
  368. procedure CheckForX;
  369. var
  370.  Temp : Array[1..3,1..3]of string[1];
  371.  i,n : integer;
  372.  
  373. begin
  374.  for i := 1 to 3 do
  375.   for n := 1 to 3 do
  376.    Temp[i,n] := '';
  377.  for i := 1 to 3 do
  378.   Temp[1,i] := Board[i];
  379.  for i := 4 to 6 do
  380.   Temp[2,i-3] := Board[i];
  381.  for i := 7 to 9 do
  382.   Temp[3,i-6] := Board[i];
  383.  Put := 0;
  384.  for i := 1 to 3 do {Check for 2}
  385.  begin
  386.   for n := 1 to 3 do
  387.    if (Put > 0)and(Board[Put] <> '') then Put := 0;
  388.    if ((Temp[i,n] = 'X')and(Put < 1))or((Temp[i,n] = 'X')and(Put > 9)) then
  389.     begin
  390.      if (Temp[i,n+1] = 'X') then Put := n+2;
  391.      if (Temp[i,n-1] = 'X') then Put := n-2;
  392.      if (Temp[i+1,n] = 'X') then Put := n+6;
  393.      if (Temp[i-1,n] = 'X') then Put := n-6;
  394.      if (Temp[i+1,n+1] = 'X') then begin Put := n+8; if Put > 9 then Put := 1; end;
  395.      if (Temp[i+1,n-1] = 'X') then begin Put := n+4; if Put > 9 then Put := 3; end;
  396.      if (Temp[i-1,n+1] = 'X') then Put := n-4;
  397.      if (Temp[i-1,n-1] = 'X') then Put := n-8;
  398.     end;
  399.   end;
  400.  if (Put < 1)and(Put > 9) Then Put := 0;
  401. end;
  402.  
  403. procedure Start;
  404. var
  405.  Spot,Code,OSpot,Chose,i,yn : Integer;
  406.  ch : Char;
  407.  choice : string[1];
  408.  Done : Boolean;
  409.  
  410. begin
  411.  Regs.AX := 2;
  412.  Intr($33,Regs);
  413.  Won := False;
  414.  ClearBoard;
  415.  SetActivepage(1);
  416.  ClearViewPort;
  417.  LoadBoard(1);
  418.  NumberBoard;
  419.  SetTextStyle(DefaultFont,HorizDir,1);
  420.  OutTextXY(5,150,'You will be X''s and I will be O''s!');
  421.  Chose := 9;
  422.  Randomize;
  423.  Done := False;
  424.  repeat
  425.   SetTextStyle(DefaultFont,HorizDir,1);
  426.   OutTextXY(5,160,'Please Enter Your Spot: ');
  427.   repeat
  428.    repeat
  429.     Regs.AX := 1;
  430.     Intr($33,Regs);
  431.     if mouse then
  432.      begin
  433.       Regs.AX := 3;
  434.       Intr($33,Regs);
  435.       if keypressed then
  436.        begin
  437.         ch := readkey;
  438.         if ch = #27 then Exit;
  439.         OutTextXY(197,160,ch);
  440.         choice := ch;
  441.         Val(Choice,Spot,Code);
  442.         Done := True;
  443.        end;
  444.       if regs.BX = 1 then
  445.        begin
  446.         if (regs.cx > 64)and(regs.cx < 131)and(regs.DX > 14)and(regs.dx < 62)then
  447.          begin Spot := 1; Done := true; end;
  448.         if (regs.cx > 130)and(regs.cx < 212)and(regs.DX > 14)and(regs.dx < 62)then
  449.          begin Spot := 2; done := true; end;
  450.         if (regs.cx > 212)and(regs.cx < 294)and(regs.DX > 14)and(regs.dx < 62)then
  451.          begin Spot := 3; done := true; end;
  452.         if (regs.cx > 64)and(regs.cx < 131)and(regs.DX > 62)and(regs.dx < 101)then
  453.          begin Spot := 4; done := true; end;
  454.         if (regs.cx > 130)and(regs.cx < 212)and(regs.DX > 62)and(regs.dx < 101)then
  455.          begin Spot := 5; done := true; end;
  456.         if (regs.cx > 212)and(regs.cx < 294)and(regs.DX > 62)and(regs.dx < 101)then
  457.          begin Spot := 6; done := true; end;
  458.         if (regs.cx > 64)and(regs.cx < 131)and(regs.DX > 101)and(regs.dx < 148)then
  459.          begin Spot := 7; done := true; end;
  460.         if (regs.cx > 130)and(regs.cx < 212)and(regs.DX > 101)and(regs.dx < 148)then
  461.          begin Spot := 8; done := true; end;
  462.         if (regs.cx > 212)and(regs.cx < 294)and(regs.DX > 101)and(regs.dx < 148)then
  463.          begin Spot := 9; done := true; end;
  464.        end;
  465.      end
  466.     else
  467.      begin
  468.       ch := readkey;
  469.       if ch = #27 then Exit;
  470.       OutTextXY(197,160,ch);
  471.       choice := ch;
  472.       Val(Choice,Spot,Code);
  473.      end;
  474.    until Done;
  475.   until (Board[Spot] = '');
  476.   Regs.AX := 2;
  477.   Intr($33,Regs);
  478.   Place('X',Spot);
  479.   Board[Spot] := 'X';
  480.   Check('X');
  481.   chose := 0;
  482.   for i := 1 to 9 do
  483.    if board[i] = '' then chose := i;
  484.   Delay(500);
  485.   CheckForX;
  486.   if (chose <> 0)and(not(won)) then
  487.   begin
  488.     yn := 0;
  489.     for i := 1 to 9 do
  490.      if board[i] = '' then yn := yn + 1;
  491.     if (put > 0)and(Board[Put] = '') then ospot := put;
  492.     CheckForX;
  493.     if (yn > 1)and(Put < 1 )or(Put > 9) then
  494.     begin
  495.      repeat
  496.       OSpot := Random(Chose+1);
  497.      until (OSpot <> Spot)and(OSpot <> 0)and(Board[OSpot] = '');
  498.     end
  499.     else
  500.      begin
  501.       if put = 0 then
  502.        for i := 1 to 9 do
  503.         if board[i] = '' then ospot := i;
  504.      end;
  505.     Place('O',OSpot);
  506.     Board[OSpot] := 'O';
  507.     Check('O');
  508.   end;
  509.   chose := 0;
  510.   for i := 1 to 9 do
  511.   if board[i] = '' then chose := i;
  512.  until (chose = 0)or Won;
  513.  SetTextStyle(DefaultFont,HorizDir,1);
  514.  OutTextXY(5,170,'Game Over!');
  515.  OutTextXY(10,180,'Press ENTER');
  516.  readln;
  517. end;
  518.  
  519. begin
  520.  StartGraph(EGA,EGALO,'d:\tp\bgi');
  521.  Mouse := true;
  522.  Regs.AX := 0;
  523.  Intr($33,Regs);
  524.  If Regs.AX = 0 then Mouse := False;
  525.  Title;
  526. end.