{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       ANSI/VT100 protocol implementation (VCL)        }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 22 Sep 2008                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}

unit nransi;

interface
uses windows, classes, nrdataproc;

Type

  TnrAnsiCommands = (
    acUnknown,
    acQueryDeviceCode,
    acReportDeviceCode,
    acQueryDeviceStatus,
    acReportDeviceOK,
    acReportDeviceFailure,
    acQueryCursorPosition,
    acReportCursorPosition,
    acResetDevice,
        //EnableLineWrap,
        //DisableLineWrap,
    acCursorHome,
    acCursorUp,
    acCursorDown,
    acCursorForward,
    acCursorBackward,
    acCursorLine,
    acCursorColumn,
    acSaveCursor,
    acUnsaveCursor,
    acSaveCursorAndAttrs,
    acRestoreCursorAndAttrs,
        //ScrollScreen,
    acScrollDown,
    acScrollUp,
    acSetTab,
    acClearTab,
    acEraseLine,
    acEraseLines,
    acEraseChars,
    acDeleteLine,
    acInsertLine,
    acPrint,
    acSetKeyDefinition,
    acSetAttributeMode,
    acKeyMode,
        //Mouse,
    acVTWindow,
    acSetModePrivate,
    acResetModePrivate,
    acSetMode,
    acResetMode,
    acLEDs,
    acSetScrollRegion,

    acSetDefaultCharSet,
    acSetUTF8CharSet,
    acFontSet,
    acNewLine
  );

{  TnrAnsiPacket = class(TnrDataPacket)
  private
    fCommand : TnrAnsiCommands;
  public
    property Command : TnrAnsiCommands read fCommand;
  end;}

  TnrAnsiPacketEvent = procedure (Sender:TObject; packet:TnrDataPacket; cmd:TnrAnsiCommands) of object;

  TnrAnsi = class (TnrDataProtocol)
  private
    fOnAnsiPacket: TnrAnsiPacketEvent;
    slArguments:TStrings;
    function GetOnAnsiPacket: TnrAnsiPacketEvent;
    procedure SetOnAnsiPacket(const Value: TnrAnsiPacketEvent);
  protected
    procedure DoHandlePacket(i:integer); override;
    function AddPacket(cmd:TnrAnsiCommands):TnrDataPacket;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    function IsPacket(ch:byte):integer;  override;
    function GetArguments(packet: TnrDataPacket): TStrings;
    function IsPacketPossible:boolean; override;
  published
    property Active;
    property Log;
    property DataProcessor;
    property Timeout;
    property OnFatalError;
    property OnAnsiPacket: TnrAnsiPacketEvent read GetOnAnsiPacket write SetOnAnsiPacket;
  end;

implementation
uses nrclasses, sysutils, nrsysutils;

{ TnrAnsi }

constructor TnrAnsi.Create(AOwner: TComponent);
begin
  inherited;
  slArguments := TStringList.Create;
  //slArguments.Delimiter := ';';

  sLogPrefix := 'nrAnsi: ';

  with AddPacket(acSetModePrivate) do begin
    PacketBegin := #27'[?';
    PacketEnd := 'h';
  end;

  with AddPacket(acResetModePrivate) do begin
    PacketBegin := #27'[?';
    PacketEnd := 'l';
  end;

  with AddPacket(acSetMode) do begin
    PacketBegin := #27'[';
    PacketEnd := 'h';
  end;

  with AddPacket(acResetMode) do begin
    PacketBegin := #27'[';
    PacketEnd := 'l';
  end;

  // Set Display Attributes ...
  with AddPacket(acSetAttributeMode) do begin
     PacketBegin := #27'[';
     PacketEnd := 'm';
  end;

 // Cursor Control ...
  with AddPacket(acCursorHome) do begin
    PacketBegin := #27'[';
    PacketEnd := 'H';
  end;

  with AddPacket(acCursorUp) do begin
    PacketBegin := #27'[';
    PacketEnd := 'A';
  end;

  with AddPacket(acCursorDown) do begin
    PacketBegin := #27'[';
    PacketEnd := 'B';
  end;

  with AddPacket(acCursorForward) do begin
    PacketBegin := #27'[';
    PacketEnd := 'C';
  end;

  with AddPacket(acCursorBackward) do begin
    PacketBegin := #27'[';
    PacketEnd := 'D';
  end;

  with AddPacket(acCursorLine) do begin
    PacketBegin := #27'[';
    PacketEnd := 'd';
  end;

  with AddPacket(acCursorColumn) do begin
    PacketBegin := #27'[';
    PacketEnd := 'G';
  end;

  with AddPacket(acCursorHome) do begin
    PacketBegin := #27'[';
    PacketEnd := 'f';
  end;

  with AddPacket(acSaveCursor) do begin
    PacketBegin := #27'[s';
    PacketLength := 3;
  end;

  with AddPacket(acUnsaveCursor) do begin
    PacketBegin := #27'[u';
    PacketLength := 3;
  end;

  with AddPacket(acSaveCursorAndAttrs) do begin
    PacketBegin := #27'7';
    PacketLength := 2;
  end;

  with AddPacket(acRestoreCursorAndAttrs) do begin
    PacketBegin := #27'8';
    PacketLength := 2;
  end;

  // VT52 Compatible Mode

  with AddPacket(acKeyMode) do begin
    PacketBegin := #27'=';
    PacketLength := 2
  end;

  with AddPacket(acKeyMode) do begin
    PacketBegin := #27'>';
    PacketLength := 2;
  end;

  with AddPacket(acKeyMode) do begin
    PacketBegin := #27'<';
    PacketLength := 2;
  end;

  with AddPacket(acNewLine) do begin
    PacketBegin := #27'E';
    PacketLength := 2;
  end;

  // Scrolling ...

  with AddPacket(acSetScrollRegion) do begin
    PacketBegin := #27'[';
    PacketEnd := 'r';
  end;

  with AddPacket(acScrollDown) do begin
    PacketBegin := #27'D';
    PacketLength := 2;
  end;

  with AddPacket(acScrollUp) do begin
    PacketBegin := #27'M';
    PacketLength := 2;
  end;

  // Tab Control ...
  with AddPacket(acSetTab) do begin
    PacketBegin := #27'H';
    PacketLength := 2;
  end;

  with AddPacket(acClearTab) do begin
    PacketBegin := #27'[';
    PacketEnd := 'g';
  end;

  // Erasing Text ...
  with AddPacket(acEraseLine) do begin
    PacketBegin := #27'[';
    PacketEnd := 'K';
  end;

  with AddPacket(acEraseLines) do begin
    PacketBegin := #27'[';
    PacketEnd := 'J';
  end;

  with AddPacket(acEraseChars) do begin
    PacketBegin := #27'[';
    PacketEnd := 'X';
  end;

  with AddPacket(acDeleteLine) do begin
    PacketBegin := #27'[';
    PacketEnd := 'M';
  end;

  with AddPacket(acInsertLine) do begin
    PacketBegin := #27'[';
    PacketEnd := 'L';
  end;

  // Device Status commands ...
  with AddPacket(acQueryDeviceCode) do begin
    PacketBegin := #27'[c';
    PacketLength := 3;
  end;

  with AddPacket(acReportDeviceCode) do begin
    PacketBegin := #27'[';
    PacketEnd := '0c';
  end;

  with AddPacket(acQueryDeviceStatus) do begin
    PacketBegin := #27'[5n';
    PacketLength := 4;
  end;

  with AddPacket(acReportDeviceOK) do begin
    PacketBegin := #27'[0n';
    PacketLength := 4;
  end;

  with AddPacket(acReportDeviceFailure) do begin
    PacketBegin := #27'[3n';
    PacketLength := 4
  end;

  with AddPacket(acQueryCursorPosition) do begin
    PacketBegin := #27'[6n';
    PacketLength := 4;
  end;

  with AddPacket(acReportCursorPosition) do begin
    PacketBegin := #27'[';
    PacketEnd := 'R';
  end;

  // Terminal Setup ...
  with AddPacket(acResetDevice) do begin
    PacketBegin := #27'c';
    PacketLength := 2;
  end;

 // Fonts and charsets...
  with AddPacket(acSetDefaultCharSet) do begin
    PacketBegin := #27'%@';
    PacketLength := 3;
  end;

  with AddPacket(acSetUTF8CharSet) do begin
    PacketBegin := #27'%G';
    PacketLength := 3;
  end;
{
  with AddPacket(acFontSetG0) do begin
    PacketBegin := #27'(';
    PacketLength := 3;
  end;

  with AddPacket(acFontSetG1) do begin
    PacketBegin := #27')';
    PacketLength := 3;
  end;

  with AddPacket(acFontSetG2) do begin
    PacketBegin := #27'*';
    PacketLength := 3;
  end;

  with AddPacket(acFontSetG3) do begin
    PacketBegin := #27'+';
    PacketLength := 3;
  end;
  }

  // Printing ...
  with AddPacket(acPrint) do begin
    PacketBegin := #27'[';
    PacketEnd := 'i';
  end;

  // Define Key ...
  with AddPacket(acSetKeyDefinition) do begin
    PacketBegin := #27'[';
    PacketEnd := 'p';
  end;

  with AddPacket(acVTWindow) do begin
    PacketBegin := #27']';
    PacketEnd := #7;
  end;

  with AddPacket(acLEDs) do begin
    PacketBegin := #27'[';
    PacketEnd := 'q';
  end;


{
  with AddPacket(acUnknown) do begin
    PacketBegin := #27;
    PacketEnd := #27;
    //PacketLength := 4;
    ResetOthers := false;
  end;
 }               
  

  Active := true;

  Reset();

  Timeout := 5000;

end;

destructor TnrAnsi.Destroy;
begin
  slArguments.Free;
  inherited;
end;

function TnrAnsi.AddPacket(cmd: TnrAnsiCommands): TnrDataPacket;
begin
  Result := DataPackets.Add;
  Result.Active := True;
  Result.Caption := 'ANSI cmd';
  Result.ResetOthers := True;
  Result.Tag := Integer(cmd);
end;

function TnrAnsi.GetArguments(packet: TnrDataPacket): TStrings;
var i, cnt : integer;
begin
  i := packet.PacketBeginLength + 1;
  if(packet.PacketLength > 0)
    then cnt := packet.DataLength - i + 1
    else cnt := packet.DataLength - i + 1 - packet.PacketEndLength;
  if cnt > 0 then begin
    //slArguments.DelimitedText := Copy(packet.Data, i, cnt);
    slArguments.Text := StringReplace(Copy(String(packet.Data), i, cnt), ';',#13#10,[rfReplaceAll]);

    for i := 0 to slArguments.Count - 1
      do slArguments.Objects[i] := TObject(StrToIntDef(slArguments[i], 0));
  end else slArguments.Clear;
  Result := slArguments;
end;

procedure TnrAnsi.DoHandlePacket(i: integer);
var packet:TnrDataPacket;
begin
  inherited DoHandlePacket(i);

  if Assigned(fOnAnsiPacket) then begin
    try
      packet := DataPackets[i];
      fOnAnsiPacket(self, packet, TnrAnsiCommands(packet.Tag));
//      ResetOthers
    except
    end;
  end;

end;


function TnrAnsi.IsPacket(ch: byte): integer;
begin
  Result := inherited IsPacket(ch);
end;

function TnrAnsi.GetOnAnsiPacket: TnrAnsiPacketEvent;
begin
  Result := fOnAnsiPacket;
end;

procedure TnrAnsi.SetOnAnsiPacket(const Value: TnrAnsiPacketEvent);
begin
  fOnAnsiPacket := Value;
end;

function TnrAnsi.IsPacketPossible: boolean;
var i:integer;
begin
//  Result := inherited IsPacketPossible;
  Result := True;
  for i := 0 to DataPackets.Count - 2 do
    if DataPackets.IsPacketPossible then exit;
  Result := False;
end;

end.
