war.pas

program WAR;

uses crt,DispANS,TextCursor;

const
 top = 1;
 whichCards : array[2..14] of char =
   ('2','3','4','5','6','7','8','9','0','J','Q','K','A');

type setCards = array[2..14] of integer;

var     player1,player2 : string;
    winTimes1,winTimes2 : longint;

{===========================================================================}
PROCEDURE DrawImage;

VAR
 ANSfile : TEXT;
 TempChar : CHAR;

BEGIN
 assign(ANSfile,'WAR.ANS');
 {$I-} reset(ANSfile); {$I+}
 if IOResult <> 0 then begin
  writeln;
  writeln(' Err: WAR.ANS not found in current directory.');
  halt;
 end
 else clrscr;
 while not eof(ANSfile) do begin
  while not eoln(ANSfile) do begin
   read(ANSfile,tempChar);
   displayANSI(tempChar);
  end;
  readln(ANSfile);
  writeln;
 end;
 close(ANSfile);
 textbackground(black);
 textcolor(lightgray);
END;

{===========================================================================}
procedure getCards (var player1,player2 : string);
var
 cardOK,magic : boolean;   rndCheck : setCards;
       player : char;    index,blah : integer;

 {---------------------------------------------------}
 function cardChecker (which : integer) : boolean;
  begin
   if rndCheck[which] < 4
    then begin
     inc(rndCheck[which]);
     inc(index);
     cardChecker := true;
    end
    else cardChecker := false;
  end;
 {---------------------------------------------------}
 function caseCardChecker (card : char) : boolean;
  begin
   case card of
    '2' : caseCardChecker := cardChecker(2);
    '3' : caseCardChecker := cardChecker(3);
    '4' : caseCardChecker := cardChecker(4);
    '5' : caseCardChecker := cardChecker(5);
    '6' : caseCardChecker := cardChecker(6);
    '7' : caseCardChecker := cardChecker(7);
    '8' : caseCardChecker := cardChecker(8);
    '9' : caseCardChecker := cardChecker(9);
    '0' : caseCardChecker := cardChecker(10);
    'J' : caseCardChecker := cardChecker(11);
    'Q' : caseCardChecker := cardChecker(12);
    'K' : caseCardChecker := cardChecker(13);
    'A' : caseCardChecker := cardChecker(14);
   end;
  end;
 {---------------------------------------------------}

begin
 index := 0; player1 := ''; player2 := '';
 for blah := 2 to 14 do rndCheck[blah] := 0;
 magic := random(2)=0;
 repeat
  if magic
   then begin
    player := whichCards[random(13)+2];
    if caseCardChecker(player) then begin
     player1 := player1 + player;
     magic := false;
    end
    else magic := true;
   end
   else begin
    player := whichCards[random(13)+2];
    if caseCardChecker(player) then begin
     player2 := player2 + player;
     magic := true;
    end
    else magic := false;
   end;
 until index = 52;
end;

{===========================================================================}
function cardVal(blah : string) : integer;
var x,err : integer;
begin
 case blah[1] of
  '2'..'9' : val(blah,x,err);
       '0' : x := 10;
       'J' : x := 11;
       'Q' : x := 12;
       'K' : x := 13;
       'A' : x := 14;
 end;
 cardVal := x;
end;

{===========================================================================}
function hndlWar (var player1,player2,cardsWon : string) : boolean;

 {---------------------------------------------------}
 procedure deleteWar (var warCards, player : string);
  var index : integer;
  begin
   for index := 1 to 3 do
    warCards := warCards + player[index];
   delete(player,1,3);
  end;
 {---------------------------------------------------}

begin
 delete(player1,1,1);
 delete(player2,1,1);
 if length(player1) <= 4
  then begin
   player1 := '';
   hndlWar := false;
  end
  else begin
   deleteWar(cardsWon,player1);
   hndlWar := true;
   if length(player2) <= 4
    then begin
     player1 := '';
     hndlWar := false;
    end
    else begin
     deleteWar(cardsWon,player2);
     hndlWar := true;
    end;
  end;
end;

{===========================================================================}
procedure playOnce (var player1,player2 : string);
var
 card1,card2,err : integer;
         War,win : boolean;
        cardsWon : string;

begin
 War := false;
 repeat
  card1 := cardVal(player1[top]);
  card2 := cardVal(player2[top]);
  if not War then begin
   case random(2) of
    0 : cardsWon := player2[top] + player1[top];
    1 : cardsWon := player1[top] + player2[top];
   end
  end
  else begin
   case random(2) of
    0 : cardsWon := cardsWon + player2[top] + player1[top];
    1 : cardsWon := cardsWon + player1[top] + player2[top];
   end;
  end;
  if card1 > card2
   then begin
    player1 := player1 + cardsWon;
    win := true;
    war := false;
    delete(player1,1,1);
    delete(player2,1,1);
   end
   else if card2 > card1
    then begin
     player2 := player2 + cardsWon;
     win := false;
     war := false;
     delete(player1,1,1);
     delete(player2,1,1);
    end
    else if card1 = card2
     then begin
      war := hndlWar(player1,player2,cardsWon);
     end;
 until not War;
 textcolor(lightblue);
 gotoxy(13,4);clreol;write(player1);
 gotoxy(13,6);clreol;write(player2);
end;

{===========================================================================}
procedure printStats(winTimes1,winTimes2 : longint);
var play1per,play2per : real;
begin
 textcolor(lightgreen);
 gotoxy(20,12); write(' ':10); gotoxy(20,12); write(winTimes1);
 gotoxy(20,14); write(' ':10); gotoxy(20,14); write(winTimes2);
 gotoxy(20,16); write(' ':10); gotoxy(20,16); write(winTimes1+winTimes2);
 if (winTimes1+winTimes2) > 0
  then begin
   play1per := (winTimes1/(winTimes1+winTimes2)) * 100;
   play2per := (winTimes2/(winTimes1+winTimes2)) * 100;
  end else begin
   play1per := 100.0;
   play2per := 100.0;
  end;
 textcolor(lightgreen);
 gotoxy(68,12); write(' ':9); gotoxy(68,12); write(play1per:0:1,'%');
 gotoxy(68,14); write(' ':9); gotoxy(68,14); write(play2per:0:1,'%');
end;

{===========================================================================}
begin
 SetCursorForm(cuNone);
 randomize;
 winTimes1 := 0;
 winTimes2 := 0;
 drawImage;
 getCards(player1,player2);
 repeat
  playOnce(player1,player2);
  if length(player2) = 0
   then begin
    inc(winTimes1);
    getCards(player1,player2);
    printStats(winTimes1,winTimes2);
   end
   else if length(player1) = 0
    then begin
     inc(winTimes2);
     getCards(player1,player2);
     printStats(winTimes1,winTimes2);
    end;
 until (keypressed) OR
  (winTimes1 = maxLongInt) OR (winTimes2 = maxLongInt);
 SetCursorForm(cuLine);
 gotoxy(1,22);
end.