& pourquoi j’n’écrirais pas ça ?

program wp4c;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils;

{$R wp4c.res}


type
  TAuthorizedChars = set of Char;

const
  BG    = 1;
  FG    = 15;
  J1    = 12;
  J2    = 14;
  COL   = 10;
  WINJ1 = 3;
  WINJ2 = 4;
  DRAW  = 5;

var
  hci        : THandle;   // handle de l'input clavier
  nextPlayer : Smallint;  // Joueur qui va jouer ou 0 en fin de partie
  key        : char;      // Touche frappée en cours de jeu
  lastRows   : string;    // Hauteur de jetons par colonne
  lastRow    : Smallint;  // Dernière ligne jouée
  lastCol    : Smallint;  // Dernière colonne jouée
  grid       : array[1..7] of array[1..6] of Smallint; // Matrice du jeu (0=vide;1|2=J1|J2)

procedure SetColor(fg: byte; bg: byte);
begin
  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),fg + (bg * 16));
end;

procedure ClrScr;
var
  position : TCoord;
  h        : HWND;
  sbi      : TConsoleScreenBufferInfo;
  len: LongWord;
  nbr_ecrits: LongWord;
begin
  position.X := 0;
  position.Y := 0;

  h := GetStdHandle(STD_OUTPUT_HANDLE);
  GetConsoleScreenBufferInfo(h, sbi);
  len := sbi.dwSize.x * sbi.dwSize.y;
  FillConsoleOutputCharacter(h, #32, len, position, nbr_ecrits);
  FillConsoleOutputAttribute(h, sbi.wAttributes, len,  position, nbr_ecrits);
  SetConsoleCursorPosition(h, position);
end;
{$ENDREGION}

function GetKey(authorized: TAuthorizedChars): char;
var
  noer   : DWord;
  buffer : TInputRecord;
begin
  FlushConsoleInputBuffer(hci);
  repeat
    noer := 0;
    ReadConsoleInput(hci, buffer, 1, noer);
  until (buffer.EventType = KEY_EVENT) and (buffer.Event.KeyEvent.AsciiChar in authorized);

  WriteLn(buffer.Event.KeyEvent.AsciiChar);
  Sleep(250);

  Result := buffer.Event.KeyEvent.AsciiChar;
end;

procedure PrintGrid();
var
  x, y : Smallint;
begin
  ClrScr;
  for y := 6 downto 1 do
  begin
    for x := 1 to 7 do
    begin
      SetColor(FG, BG);
      Write('|');
      case grid[x,y] of
        1:
        begin
          SetColor(J1, BG);
        end;
        2:
        begin
          SetColor(J2, BG);
        end
        else
        begin
          SetColor(BG, BG);
        end;
      end;
      Write('o');
    end;
  SetColor(FG, BG);
  Writeln('|');
  end;
  for x := 1 to 7 do
  begin
    if (x = lastCol) then
    begin
      SetColor(COL, BG);
    end
    else
    begin
      SetColor(FG, BG);
    end;
    Write(' ' + IntToStr(x));
  end;
  Writeln('');
end;

procedure InitGame();
var
  x, y : Smallint;
begin
  // Affichage
  SetColor(FG, BG);
  ClrScr;
  Writeln('Qui commence ? (1|2) ');
  // Données
  nextPlayer := StrToInt(GetKey(['1', '2']));
  for y := 1 to 6 do
  begin
    for x := 1 to 7 do
    begin
      grid[x,y] := 0;
    end;
  end;
  lastRows := '0000000';
  lastCol  := 0;
  PrintGrid;
end;


function HasWin():Boolean;
  function HowMany(dX, dY: Smallint): Smallint;
  var
    x, y : Smallint;
  begin
    Result := 0;
    x := lastCol + dX;
    y := lastRow + dY;
    while ((1<=x) AND (x<=7) AND (1<=y) AND (y<=6)) do
    begin
      if (grid[x, y] = nextPlayer) then
      begin
        Inc(Result);
        x := x + dX;
        y := y + dY;
      end
      else
      begin
        Exit;
      end;
    end;
  end;
begin

  // Vertical
  if (HowMany(0, -1) >= 3) then
  begin
    Result := True;
  end
  // Horizontal
  else if ((HowMany(1, 0)+HowMany(-1, 0)) >= 3) then
  begin
    Result := True;
  end
  // SO - NE
  else if ((HowMany(-1, -1)+HowMany(1, 1)) >= 3) then
  begin
    Result := True;
  end
  // NO - SE
  else if ((HowMany(-1, 1)+HowMany(1, -1)) >= 3) then
  begin
    Result := True;
  end
  // Pas gagnant !
  else
  begin
    Result := False;
  end;
end;

//-----------------------------------------------------------------------
begin
  // Récupération du handle du clavier
  hci := GetStdHandle(STD_INPUT_HANDLE);
  repeat
    // Nouvelle grille
    InitGame;

    // Début concrêt de la partie
    while ((nextPlayer = 1) or (nextPlayer = 2)) do
    begin
      case nextPlayer of
        1:
        begin
          SetColor(J1, BG);
          Write('Joueur 1 ? (1-7|0) ');
        end;
        2:
        begin
          SetColor(J2, BG);
          Write('Joueur 2 ? (1-7|0) ');
        end;
      end;
      key := GetKey(['0','1','2','3','4','5','6','7']);

      case key of
        '0':
        begin
          nextPlayer := 0;
        end
        else
        begin
          lastCol := StrToInt(key);
          lastRow := StrToIntDef(lastRows[lastCol], 6) + 1;
          // Colonne pleine ?
          if (lastRow<>7) then
          begin
            // Ajouter dernier jeton / colonne
            lastRows[lastCol] := IntToStr(lastRow)[1];
            // Ajouter jeton
            grid[lastCol, lastRow] := nextPlayer;
            Beep;
            // Vérifie si le joueur gagné
            if HasWin then
            begin
              nextPlayer := nextPlayer + 2;
            end
            else
            begin
              // On vérifie si le jeu est rempli
              if lastRows = '6666666' then
              begin
                nextPlayer := DRAW;
              end
              else
              begin
                // Changer de joueur
                // 2->1  1->2
                Dec(nextPlayer);
                nextPlayer := 1 - nextPlayer;
                Inc(nextPlayer);
              end;
            end;
            PrintGrid;
          end;
        end;
      end;
    end;
    Writeln('');
    // Si un joueur a gagné
    case nextPlayer of
      WINJ1: // J1 gagne
      begin
        SetColor(J1, BG);
        Writeln('Le joueur 1 gagne !');
      end;
      WINJ2: // J2 gagne
      begin
        SetColor(J2, BG);
        Writeln('Le joueur 2 gagne !');
      end;
      DRAW: // Match nul
      begin
        SetColor(FG, BG);
        Writeln('Match nul !');
      end;
    end;

    // Rejouer ?
    SetColor(FG, BG);
    Writeln('Rejouer ? (O|N) ');
  until (LowerCase(GetKey(['o','O','n','N'])) = 'n')

end.