program CONNECT4 ; uses Crt ;

const
   Line = 4 ; Rmax = 6 ; Cmax = 7 ; { about 10*15 is biggest that fits ! }
   {screen placings} XO = 16 ; YO = 1 ;
   {Key codes} Enter = #13 ; Escape = #27 ; Space = #32 ; BackSpace = #8 ;
   HasBeen = #239 ; Spot = #250 ; WhiteFace = #2 ; BlackFace = #1 ;

type
   Rowtype = 1..Rmax ; Coltype = 1..Cmax ;
   State = (White, Black, Empty) ;
   Player = White..Black ;

var
   Alt : 0..Rmax ; Col : Coltype ;
   Frame : array [Rowtype, Coltype] of State ;
   Scorer, Mover : Player ;
   Counters, Score : integer ;

const
   Wins : array [Player] of word = (0, 0) ;
   Pixel : array [State] of char = (WhiteFace, BlackFace, Spot) ;
   NameOf : array [Player] of string[30] = ('White', 'Black') ;

procedure Pieces ;
var Co : Coltype ; Ro : Rowtype ;
begin
for Ro := 1 to Rmax do
   for Co := 1 to Cmax do begin GotoXY(XO + 4*Co, YO + 2*Ro) ;
      Write(Pixel[Frame[Ro, Co]]) end ;
end {Pieces};

procedure GetMove(Man : Player) ;
var Key : char ;
begin GoToXY(1, 1) ; Write('Move by ', NameOf[Man], ' now') ;
Col := 1 + Cmax div 2 ;
repeat GoToXY(XO + 4*Col, YO) ; Write(Pixel[Man], BackSpace) ;
   while KeyPressed do Key := ReadKey { use up type-ahead } ;
   Key := ReadKey ; if Key=Escape then Halt ;
   if Key=#0 then {extended keycode} begin Key := ReadKey ;
      if (Key=#75) {Left Arrow} and (Col>1) then Dec(Col) ;
      if (Key=#77) {Right Arrow} and (Col<Cmax) then Inc(Col) ;
      end {#0};
   Write(Space) {wipe old face} ;
   until ((Key=Enter) or (Key=#80)) and (Frame[1, Col]=Empty) ;
Alt := 0 ;
repeat Inc(Alt) ;
   GoToXY(XO + 4*Col, YO + 2*Alt) ; Write(Pixel[Man]) ;
   Delay(150) ; Write(BackSpace, HasBeen) ;
   until (Alt=Rmax) or (Frame[Succ(Alt), Col]<>Empty) ;
Frame[Alt, Col] := Man ;
end {GetMove};

procedure OKpos(Man : state ; Angle, OneEnd : shortint) {test a possibility} ;
const vecR : array [0..3] of shortint = (+1,  0, -1, -1) ;
      vecC : array [0..3] of shortint = (+1, +1, +1,  0) ;
var A, C, J : shortint ;
begin
   for J := OneEnd downto OneEnd - Line + 1 do begin
      A := Alt + J*VecR[Angle] ; if (A<1) or (A>Rmax) then Exit ;
      C := Col + J*VecC[Angle] ; if (C<1) or (C>Cmax) then Exit ;
      if Frame[A, C]<>Man then Exit ;
      end {J} ;
   for J := OneEnd downto OneEnd - Line + 2 do begin
      GoToXY(XO + 4*Col + 2*(2*J-1)*VecC[Angle],
             YO + 2*Alt +   (2*J-1)*VecR[Angle]) ;
      Write('*'#7) end {J};
   Inc(Score) ;
   end {OKpos} ;

function Won(Man : Player) : Boolean {test all possibilities for a win} ;
var OneEnd, Angle : shortint ;
begin Score := 0 ;
   for Angle := 0 to 3 do
      for OneEnd := 0 to Line-1 do
         OKpos(Man, Angle, OneEnd) ;
   Won := Score>0 end {Won} ;


begin ClrScr ;
Write('CONNECT4.PAS >=27/03/89 : ',
   Rmax, ' Rows, ', Cmax, ' Cols; ', Line, ' in a line.') ;
Writeln('  White = ', Pixel[White], ', Black = ', Pixel[Black], '.') ;
Writeln('The Left & Right Cursor keys select the column,',
   ' the Enter key drops the piece.') ;
Randomize ; Mover := Player(Random(2)) ;
Window(1, 4, 80, 25) ;

repeat
   for Alt := 1 to Rmax do for Col := 1 to Cmax do Frame[Alt, Col] := Empty ;
   Counters := 0 ; ClrScr ;
   Pieces ;

   repeat Mover := Player(1 - Ord(Mover)) ;
      GetMove(Mover) ; Pieces ; Inc(Counters) ;
      until (Won(Mover)) or (Counters=Rmax*Cmax) ;

   GotoXY(1, 1) ; ClrEol ; Writeln('FINISH of GAME') ;
   if Score>0 then begin Inc(Wins[Mover]) ;
      Writeln(NameOf[Mover], Space, Pixel[Mover]) ;
      Write('made ', Score, ' line') ; if Score<>1 then Write('s') ;
      end ;

   GotoXY(1, 5) ; Writeln('Win Totals:') ;
   for Scorer := White to Black do Writeln(Nameof[Scorer], Wins[Scorer]:5) ;

   Writeln ;
   Write('Press any key ') ; repeat until ReadKey<>#0 ;
   until false ;

end.