{
    This file is part of Langton's Ant
    Copyright (c) 2002 by Ian Hickson

    A text implementation of Langton's Ant

    See the file COPYING, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
{$MODE OBJFPC}
program Text;

uses
  DOS,
  Video,
  Keyboard,
  SysUtils,
  LangtonAnt,
  Scenarios;

const
  R = LightBlue;
  L = Blue;

type
  TTextAnt = class (TAnt)
  protected
    procedure SetPixel(aState: Boolean); override;
    function GetPixel: Boolean; override;
  end;

  TTextAntFarm = class (TAntFarm)
    function Stop: Boolean; override;
    function Width: Integer; override;
    function Height: Integer; override;
  end;

    procedure TTextAnt.SetPixel(aState: Boolean);
    var
       aColor: Byte;
    begin
       if aState then
          aColor := R
       else
          aColor := L;
       VideoBuf^[(FX-1) + (FY-1) * ScreenWidth] := (aColor and $000F) shl 12;
    end;

    function TTextAnt.GetPixel: Boolean;
    begin
       Result := (VideoBuf^[(FX-1) + (FY-1) * ScreenWidth] and $F000) shr 12 = R;
    end;

  function TTextAntFarm.Stop: Boolean;
  begin
     UpdateScreen(False);
     Result := PollKeyEvent <> 0;
  end;

  function TTextAntFarm.Width: Integer;
  begin
     Result := ScreenWidth;
  end;

  function TTextAntFarm.Height: Integer;
  begin
     Result := ScreenHeight;
  end;

var
  Cursor: Word;
  Mode: TVideoMode;
  Farm: TAntFarm;
begin
  InitVideo;
  InitKeyboard;
  GetVideoModeData(GetVideoModeCount-1, Mode);
  SetVideoMode(Mode);
  Cursor := GetCursorType;
  SetCursorType(crHidden);
  ClearScreen;
  Farm := TTextAntFarm.Create(TTextAnt);
  Scenarios.RunLangtonsAnt(Farm);
  Farm.Destroy;
  GetKeyEvent;
  SetCursorType(Cursor);
  DoneKeyboard;
  DoneVideo;
end.

