Program LinearGame02

This version uses our unit CrtUtils to change the window size and the font. It is quick hack that serves our present purpose, using the undocumented function SetConsoleFont in kernel32.dll.

You can experiment with the integer argument supplied to ChangeFont in LinearGame02.

See our notes on program LinearGame01 in the previous section for the rules of the game. Compile the program using Lazarus (which has a crt unit) rather than Delphi.

program LinearGame02;
uses
  Crt, CrtUtils;
const
  MAX_X = 20;
var
  c : char;
  CurrentPos : integer = 1;
  NumOfMoves : integer = -1;
  MoveDist : integer = 2;
  Cells : array[1 .. MAX_X] of integer = (15, Blue, 15, Green, 15, Green, Blue, Green, 15, 15,
                                          Green, Blue, 15, 15, Blue, Blue, 15, 15, 15, 15);

//Draws the background with the colours in the Cells array.
procedure DrawBackground;
var
  i : integer;
begin
  for i := 1 to MAX_X do
    begin
      GoToXY(i, 1);
      TextBackground(Cells[i]);
      write(' ');
    end;
end;

//Calculates the position to move to (if necessary).
function EndPos(KeyCode, StartPos : integer) : integer;
begin
  Result := StartPos;
  case KeyCode of
    77 :  if StartPos < MAX_X then
            Result := StartPos + 1;
    116 : if StartPos < (MAX_X - MoveDist + 1) then
            Result := StartPos + MoveDist;
  end;
end;

//Makes a move by drawing a yellow cell at position Dest.
procedure Move(Dest : integer);
begin
  DrawBackground;
  goToXY(Dest, 1);
  TextBackground(Yellow);
  write(' ');
  NumOfMoves := NumOfMoves + 1;
end;

begin
  Resize(20, 2);
  //The following gives Lucida Console 36 on our Windows Vista.
  ChangeFont(1); //Try with different numbers if 1 does not work.
  CursorOff;
  Move(1);
  repeat
    c := readkey;
    if ord(c) > 0 then
      begin
        CurrentPos := EndPos(ord(c), CurrentPos);
        Move(CurrentPos);
        case Cells[CurrentPos] of
          Green : MoveDist := MoveDist * 2;
          Blue :  MoveDist := 5;
        end;
      end;
  until CurrentPos = MAX_X;
  gotoXY(1, 2);
  write('Moves: ', NumOfMoves);
  readln;
end.

Code of CrtUtils Unit

unit CrtUtils;

interface

uses
  crt, windows;

procedure Resize(NewWidth, NewHeight : integer);

function SetConsoleFont(hOutput: HANDLE; fontIndex:  DWORD) : integer; stdcall; external 'kernel32';

procedure ChangeFont(FontNum : integer);

implementation

procedure Resize(NewWidth, NewHeight : integer);
var
  BuffInfo : CONSOLE_SCREEN_BUFFER_INFO;
  OutputHandle : HANDLE;
  WinRect : SMALL_RECT;
  BuffSize : COORD;
begin
  OutputHandle := GetStdHandle(STD_OUTPUT_HANDLE);
  GetConsoleScreenBufferInfo(OutputHandle, @BuffInfo);
  WinRect := BuffInfo.srWindow;
  BuffSize := BuffInfo.dwSize;
  BuffSize.X := NewWidth;
  BuffSize.Y := NewHeight;
  WinRect.Right := NewWidth - 1;
  WinRect.Bottom := NewHeight - 1;
  SetConsoleWindowInfo(OutputHandle, TRUE, WinRect);
  SetConsoleScreenBufferSize(OutputHandle, BuffSize);
end;

procedure ChangeFont(FontNum : integer);
var
  OutputHandle :  HANDLE;
begin
  OutputHandle := GetStdHandle(STD_OUTPUT_HANDLE);
  SetConsoleFont(OutputHandle, FontNum);
end;

end.