SRL Archive - Discussions and Debates

Well, I was writing a Standards parser. I gave up, thought I might as well post the source up and someone else can finish it if they be so inclined.

If you have any questions about it, just ask.

Here it is:

program StandardsParser;

var
  EndMainFormForm : Boolean;
  MainForm : TForm;
  Title, Label1 : TLabel;
  Panel1 : TPanel;
  Functions : TGroupBox;
  ScriptText : TMemo;
  Start, CopyToClip, OpenScript : TButton;
  
  SArr : TStringArray;
  ICA : TIntegerArray;
  
  Script : string;

// The Explode procedure looks through a string and separates it with whatever
// you suplied as a separator, and takes each value and puts them into an array.
// Example: Explode('*', 'a*b*c*d*e*');
// Made by Ron :)
function Explode(Separator, Str : string) : array of string;
var
  i : integer;
begin
  if(pos(Separator, Str) > 0)then
    repeat
      SetArrayLength(Result, i + 2);
      Result[i] := copy(Str, 1, pos(Separator, Str)-1);
      delete(Str, 1, pos(Result[i], Str)+Length(Result[i]));
      Inc(i);
    until(pos(Separator, Str) = 0)
  else
    SetArrayLength(Result, 1);
  Result[i] := Str;
end;

procedure PadS(var s: string; Int: integer);

var
  z : integer;

begin
  for z := 0 to (Int - 1) do
    s := ' ' + s;
end;

function ChS(str1: TStringArray; str2: string): boolean;

var
  i, H : integer;

begin
  H := High(Str1);
  for i := 0 to H do
  begin
    Result := (Pos(str1[i], Lowercase(str2)) > 0);
    if Result then Break;
  end;
end;

procedure MAL;

begin
  SetArrayLength(ICA, Length(SArr));
end;

//by bullzeye95
procedure InsertElement(S: String; E: Integer);
var
  I, Hi: Integer;
begin
  SetLength(SArr, Length(SArr) + 1);
  MAL;
  Hi:= High(SArr);
  SArr[Hi]:= S;
  Swap(SArr[E], SArr[Hi]);
  E:= E + 2
  for I:= Hi downto E do
    Swap(SArr[I], SArr[I - 1]);
end;



// by MylesMadness
Procedure RemoveElement(Index:Integer);

var
  I, H : Integer;
  
begin
  H := High(SArr);
  for I:= Index to H do
    SArr[Index]:=SArr[Index+1];
  SetarrayLength(SArr, High(SArr))
  MAL;
end;

function CheckText(S: string; Start: boolean; Num: integer): boolean;

var
  i : integer;
  Letters : String;

begin
  Letters := 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  case Start of
    true: for i := 0 to High(Letters) do
          begin
            result := (Pos(Letters[i], S) <= Num);
            if Result then Break;
          end;
    false: for i := 0 to High(Letters) do
           begin
             result := (Pos(Letters[i], S) >= Num);
             if Result then Break;
           end;
  end;
end;


procedure GenerateStandards(Sender: TObject);
var
  Nested, Comment, IfStairs, variables: boolean;
  a, i, H, IC, IfStairL : integer;
  
begin
  //Explode the string into each individual line.
  SArr := Explode(Chr(13), Script);
  //Remove all the spaces at the beginning of lines

  Insertelement('', 0);
  H := High(SArr);
  for i := 0 to H do
  begin
    SArr[i] := Replace(SArr[i], Chr(10), '');
    SArr[i] := Trim(SArr[i]);
  end;
  
  SetArrayLength(ICA, H);
  
  for i := 1 to High(SArr) do
  begin
    if Chs(['{', '(*'], SArr[i]) then
      Comment := true;
      
    if Chs(['}', '*)'], SArr[i]) then
      Comment := false;

    if Comment then Continue;

    // Checks that there is a blank line after function or procedure
    if ChS(['function', 'procedure'], SArr[i]) then
    begin
      if (not (SArr[i + 1] = '')) then
        Insertelement('', i + 1);
      Continue;
    end;
  
    //checks for correct structure of variables
    if ChS(['var'], SArr[i]) then
    begin
      if (not(CheckText(SArr[i], false, 3)) or (Pos('var', SArr[i]) = 1)) then
        Variables := true;
      if (Length(SArr[i]) > 4) then
      begin
        Insertelement(Copy(SArr[i], 4, Length(SArr[i])), i + 1);
        Delete(SArr[i], 4, Length(SArr[i]));
      end;
      Inc(IC);
      ICA[i] := IC;
      Continue;
    end;
    
    if Variables then
    begin
      if Chs(['begin'], SArr[i]) then
      begin
        Variables := false;
        Dec(IC);
        if (SArr[i - 1] <> '') then
          Insertelement('', i - 1);
        ICA[i] := IC;
        Continue;
      end;
      
      if ((SArr[i] = '') and Chs(['var'], SArr[i - 1])) then
      begin
        RemoveElement(i);
        Dec(i);
        Continue;
      end;
      
      if IfStairs then
      begin
        if ChS(['begin'], SArr[i]) then
        begin
          IfStairs := false;
          ICA[i] := IC - 1;
        end;
      end;


      if ChS(['if ', 'if('], SArr[i]) then
      begin
        ICA[i] := IC;
        Inc(IC);
        if ChS(['if ', 'if('], SArr[i - 1]) then
        begin
          IfStairs := true;
          IfStairL := ICA[i - 1];
        end;
      end;
        
      if ChS(['begin'], SArr[i]) then
      begin
        Nested := true;
        Dec(IC);
        ICA[i] := IC;
        Continue;
      end;


      
      if ICA[i] = 0 then
        ICA[i] := ICA[i - 1];
      
    end;
  end;
  
  
  H := High(SArr);
  for i := 0 to H do
    PadS(SArr[i], ICA[i]);
  
  with ScriptText.Lines do
  begin
    Clear;
    for i := 0 to High(SArr) do
      Add(SArr[i]);
  end;
end;

// From Ron's Form Parser v.23 ~ Modded by myself for my purposes
procedure Browse(Sender : TObject);
var
  OpenDialog1 : TOpenDialog;
  i : integer;
  
begin
  OpenDialog1 := TOpenDialog.Create(MainForm);
  with OpenDialog1 do
  begin
    InitialDir := ScriptPath;
    Options := [ofFileMustExist, ofReadOnly];
    Filter := 'SCAR Script (*.scar)|*.scar|' +
              'All Files|*|';
    if(Execute)then
    begin
      i := OpenFile(FileName, false);
      ReadFileString(i, Script, FileSize(i));
      ScriptText.Lines.Clear;
      ScriptText.Lines.Add(Script);
      CloseFile(i);
    end;
    Free;
  end;
end;

procedure CopyClip(Sender: TObject);
begin
  ScriptText.SelectAll;
  ScriptText.CopyToClipboard;
end;


// When the form is closed, this code will be executed.
procedure MainFormFormOnClose(Sender : TObject; var Action : TCloseAction);
begin
  if(not(MainForm.ModalResult = 1))then
    EndMainFormForm := True;
end;

// This form was parsed using: DFM Form Parser v.23 by Ron.
procedure MainFormForm;
begin
  MainForm := CreateForm;
  with MainForm do
  begin
    OnClose := @MainFormFormOnClose;
    Position := poScreenCenter;
    BorderStyle := bsSingle;
    BorderIcons := [biSystemMenu];
    FormStyle := fsStayOnTop;
    Width := 696;
    Height := 480;
    Caption := 'MainForm';
    Color := clBtnFace;
    Font.Color := clWindowText;
    Font.Height := -11;
    Font.Name := 'MS Sans Serif';
    Font.Style := [];
    PixelsPerInch := 96;
  end;
  Title := TLabel.Create(MainForm);
  with Title do
  begin
    Parent := MainForm;
    Left := 40;
    Top := 24;
    Width := 282;
    Height := 29;
    Caption := 'Nava2'#39's Standards Parser!';
    Font.Color := clWindowText;
    Font.Height := -24;
    Font.Name := 'MS Sans Serif';
    Font.Style := [];
    ParentFont := False;
  end;
  Label1 := TLabel.Create(MainForm);
  with Label1 do
  begin
    Parent := MainForm;
    Left := 224;
    Top := 56;
    Width := 59;
    Height := 13;
    Caption := 'Version 0.01';
  end;
  Panel1 := TPanel.Create(MainForm);
  with Panel1 do
  begin
    Parent := MainForm;
    Left := 32;
    Top := 80;
    Width := 617;
    Height := 329;
    Caption := 'Panel1';
    TabOrder := 12;
  end;
  Functions := TGroupBox.Create(MainForm);
  with Functions do
  begin
    Parent := MainForm;
    Left := 352;
    Top := 16;
    Width := 289;
    Height := 57;
    Caption := 'Functions';
    TabOrder := 11;
  end;
  ScriptText := TMemo.Create(MainForm);
  with ScriptText do
  begin
    Parent := MainForm;
    Left := 40;
    Top := 88;
    Width := 601;
    Height := 313;
    Hint := 'Paste or Open a Script into Here';
    with ScriptText.Lines do
    begin
      Add('Paste or Open Your Script into here.');
    end;
    TabOrder := 8;
    ScrollBars := SSBoth;
  end;
  Start := TButton.Create(MainForm);
  with Start do
  begin
    Parent := MainForm;
    Left := 416;
    Top := 34;
    Width := 97;
    Height := 25;
    Caption := 'Standardize!';
    TabOrder := 9;
    OnClick := @GenerateStandards;
  end;
  CopyToClip := TButton.Create(MainForm);
  with CopyToClip do
  begin
    Parent := MainForm;
    Left := 528;
    Top := 34;
    Width := 97;
    Height := 25;
    Caption := 'CopyToClipboard';
    TabOrder := 10;
    OnClick := @CopyClip;
  end;
  OpenScript := TButton.Create(MainForm);
  with OpenScript do
  begin
    Parent := MainForm;
    Left := 361;
    Top := 34;
    Width := 41;
    Height := 25;
    Caption := 'Open';
    TabOrder := 13;
    OnClick := @Browse;
  end;
end;

procedure SafeMainFormForm;
var
  V : TVariantArray;
begin
  SetArrayLength(V, 0);
  ThreadSafeCall('MainFormForm', V);
end;

procedure ShowMainFormFormModal;
begin
  MainForm.ShowModal;
end;

procedure SafeShowMainFormFormModal;
var
  V : TVariantArray;
begin
  SetArrayLength(V, 0);
  ThreadSafeCall('ShowMainFormFormModal', V);
end;

procedure MainFormMainFormForm;
begin
  try
    SafeMainFormForm;
    SafeShowMainFormFormModal;
  finally
    FreeForm(MainForm);
  except
    WriteLn('An error seems to have occurred in: MainFormForm');
  end;
end;

begin
  MainFormMainFormForm;
  if(EndMainFormForm)then
    TerminateScript;
end.

Try it on some of Wizzup's keywords with uppercase letter :p

Nava, Why did you give up? I bet you can make it :o

yea man dont give up ypu can do it come onnnnnnnnnnnnnnnn do it man :)

Nava, if you think the project is worth it, then continue, even if it's hard, even if it's boring, continue and finish it, you'll be glad you did. If you think it's not worth it, give up now because you're wasting your time. that's how I do it and it's worked out pretty well so far.

some pretty good advice that freddy :) i like it

Ugh, haha. It is boring, and the logic is so hard todo. The variable change so freaking much. I mean, fixing the spacing after a variable, and detecting if an if..then..else statement is current is hard. :(

Hmm, maybe I should finish it. I just need some help.

man, everybody keeps making things that i plan on doing but never get around to :p.

i say you keep going cuz its a worth-ful endeavor.