unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Memo_KeyPress(Sender: TObject; var Key: Char);
  private
    { Private 宣言 }
    gKey: AnsiChar;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
  Buf_Len = 30000;
var
  Buf, P1, P2: PAnsiChar;
  Dmy: AnsiString;
  BCnt: Integer;
begin
  Memo1.SetFocus;
  Memo1.OnKeyPress := nil;
  gKey := #$00;
  Buf := AllocMem(Buf_Len);
  P1 := Buf;
  Dmy := AnsiString(Memo1.Lines.Text);
  P2 := PAnsiChar(Dmy);
  try
    repeat
      case P2^ of
        '>':Inc(P1);
        '<':Dec(P1);
        '+':Inc(P1^);
        '-':Dec(P1^);
        '.':begin
              Memo1.Lines.Text := Memo1.Lines.Text + String(P1^);
              Application.ProcessMessages;
            end;
        ',':begin
              Memo1.OnKeyPress := Memo_KeyPress;
              try
                while gKey = #$00 do
                  Application.ProcessMessages;
                if gKey = #$1B then
                  Break;
                P1^ := gKey;
                gKey := #$00;
              finally
                Memo1.OnKeyPress := nil;
              end;
            end;
        '[':begin
              if P1^ = #$00 then
                begin
                  BCnt := 1;
                  repeat
                    Inc(P2);
                    if P2^ = '[' then
                      Inc(BCnt)
                    else if P2^ = ']' then
                      Dec(BCnt);
                  until (P2^ = ']') and (BCnt = 0);
                end;
            end;
        ']':begin
              BCnt := 1;
              repeat
                Dec(P2);
                if P2^ = ']' then
                  Inc(BCnt)
                else if P2^ = '[' then
                  Dec(BCnt);
              until (P2^ = '[') and (BCnt = 0);
              Continue;
            end;
      end;
      Inc(P2);
    until (P2^ = #$00);
  finally
    FreeMem(Buf);
  end;
end;

procedure TForm1.Memo_KeyPress(Sender: TObject; var Key: Char);
begin
  gKey := AnsiChar(Key);
  Key := #$00;
end;

end.

program bf;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes;

const
  Buf_Len = 30000;
var
  Buf, P1, P2: PAnsiChar;
  C: AnsiChar;
  Dmy: AnsiString;
  BCnt: Integer;
  SourceFile: TFileName;
  Src: TStringList;
begin
  Writeln('Brainf*ck 1.00'#$0D#$0A);
  if ParamCount = 0 then
    begin
      Writeln(Format('Usage: %s sourcefile', [ExtractFileName(ParamStr(0))]));
      Exit;
    end;
  SourceFile := ParamStr(1);
  if not FileExists(SourceFile) then
    begin
      Writeln('File not found.');
      Exit;
    end;
  Src := TStringList.Create;
  try
    Src.LoadFromFile(SourceFile, TEncoding.Default);
    Dmy := AnsiString(Src.Text);
  finally
    Src.Free;
  end;
  Buf := AllocMem(Buf_Len);
  try
    P1 := Buf;
    P2 := PAnsiChar(Dmy);
    repeat
      case P2^ of
        '>':Inc(P1);
        '<':Dec(P1);
        '+':Inc(P1^);
        '-':Dec(P1^);
        '.':Write(P1^);
        ',':begin
              Read(C);
              if C = ^Z then
                Break
              else
                P1^ := C;
            end;
        '[':begin
              if P1^ = #$00 then
                begin
                  BCnt := 1;
                  repeat
                    Inc(P2);
                    if P2^ = '[' then
                      Inc(BCnt)
                    else if P2^ = ']' then
                      Dec(BCnt);
                  until (P2^ = ']') and (BCnt = 0);
                end;
            end;
        ']':begin
              BCnt := 1;
              repeat
                Dec(P2);
                if P2^ = ']' then
                  Inc(BCnt)
                else if P2^ = '[' then
                  Dec(BCnt);
              until (P2^ = '[') and (BCnt = 0);
              Continue;
            end;
      end;
      Inc(P2);
    until (P2^ = #$00);
  finally
    FreeMem(Buf);
  end;
end.