Need SIMPLE file format that includes plain text + embedded commands?

**paul_nicholls** · 11-09-2010, 06:57 AM

Originally Posted by Brainer

You can base your code on this parser.

Hope it helps.

Thanks Patrick

hmm...it is PHP code...I guess I could TRY converting it to Pascal.

On the other hand I only need a small subset of BBCode, so it might be easier (and quicker) to roll my own

EDIT: oh, I see what you mean...I can look at the code and use that as an example for my code

cheers,
Paul

**Brainer** · 11-09-2010, 09:22 AM

That's right.

It shouldn't be too difficult to create one yourself. I suggested writing one 'cause I was thinking about creating such thing for some future works.

Actually, converting this one to Delphi doesn't look like too much work, especially when you have some code to parse regular expressions.

On the other hand, an event-driven class would be the perfect solution, i.e. if the parser finds the "img" tag, it fires an OnBeginTag event and passes the name and its attributes to the event. The declaration could look like the following:
[code=delphi]
type
{ .: TBBCodeTagType :. }
TBBCodeTagType = (tagColor, tagBold, tagItalic, tagImage);

{ .: TTagEvent :. }
TTagEvent = procedure(Tag: TBBCodeTagType; const Attribute: AnsiString) of object;

{ .: TBBCodeParser :. }
TBBCodeParser = class sealed(TObject)
// Some other code here
public
{ Public declarations }
function Parse(const TextToParse: String): Boolean;

property OnBeginTag: TTagEvent read FOnBeginTag write FOnBeginTag;
property OnEndTag: TTagEvent read FOnEndTag write FOnEndTag;
end;

{ ... }

function TBBCodeParser.Parse(const TextToParse: String): Boolean;
var
FoundTag, TagAttr: String;
begin
Result := False;
FoundTag := '';
TagAttr := '';

// .. Some code here ..
if Assigned(FOnBeginTag) then
begin
if (FoundTag = 'color') then
FOnBeginTag(tagColor, TagAttr);
// and so on
end;
end;
[/code]

**paul_nicholls** · 11-09-2010, 11:19 AM

Originally Posted by Brainer

That's right.

It shouldn't be too difficult to create one yourself. I suggested writing one 'cause I was thinking about creating such thing for some future works.

Actually, converting this one to Delphi doesn't look like too much work, especially when you have some code to parse regular expressions.

On the other hand, an event-driven class would be the perfect solution, i.e. if the parser finds the "img" tag, it fires an OnBeginTag event and passes the name and its attributes to the event. The declaration could look like the following:
[code=delphi]
type
{ .: TBBCodeTagType :. }
TBBCodeTagType = (tagColor, tagBold, tagItalic, tagImage);

{ .: TTagEvent :. }
TTagEvent = procedure(Tag: TBBCodeTagType; const Attribute: AnsiString) of object;

{ .: TBBCodeParser :. }
TBBCodeParser = class sealed(TObject)
// Some other code here
public
{ Public declarations }
function Parse(const TextToParse: String): Boolean;

property OnBeginTag: TTagEvent read FOnBeginTag write FOnBeginTag;
property OnEndTag: TTagEvent read FOnEndTag write FOnEndTag;
end;

{ ... }

function TBBCodeParser.Parse(const TextToParse: String): Boolean;
var
FoundTag, TagAttr: String;
begin
Result := False;
FoundTag := '';
TagAttr := '';

// .. Some code here ..
if Assigned(FOnBeginTag) then
begin
if (FoundTag = 'color') then
FOnBeginTag(tagColor, TagAttr);
// and so on
end;
end;
[/code]

Nice idea Patrick, you make me want to start right now! LOL

cheers,
Paul

**Mirage** · 11-09-2010, 04:44 PM

My engine includes a markup unit.
http://www.casteng.com/cast2docs/Markup.htm
Command syntax is "["<Command><Arguments>"]".
Output is pure text without commands and an array of tags.
You can easily override its implementation and add commands.

**paul_nicholls** · 13-09-2010, 12:10 PM

Originally Posted by Mirage

My engine includes a markup unit.
http://www.casteng.com/cast2docs/Markup.htm
Command syntax is "["<Command><Arguments>"]".
Output is pure text without commands and an array of tags.
You can easily override its implementation and add commands.

Thanks Mirage! I will take a look at the code

cheers,
Paul

**paul_nicholls** · 15-09-2010, 03:56 AM

Hey all,
I have expanded Brainer's BBCode parser example so it is now in a working state

It handles these tag types: color, url, img. It can easily be expanded too..

I hope if is useful to someone else too

Code:

unit unit_BBCode;
{$ifdef fpc}
{$mode Delphi}
{$endif}
{+H}
interface

uses
  SysUtils,
  Classes;
  
const
  cBeginTagChar    = '[';
  cEndTagChar      = ']';
  cClosingTagChar  = '/';

  cColorTagIdent   = 'color';
  cURLTagIdent     = 'url';
  cImageTagIdent   = 'img';

type
  TCharSet             = set of AnsiChar;
  BBCodeParseException = class(Exception);
  TBBCodeTagType       = (tagUnknown,tagColor,tagURL,tagImage);

const
  cBBCodeTagType: array[TBBCodeTagType] of AnsiString = (
    'unknown',
    'color',
    'url',
    'img'
  );

type
  TTagEvent  = procedure(Tag: TBBCodeTagType; const Attribute: AnsiString) of object;
  TTextEvent = procedure(c: AnsiChar) of object;

  TBBCodeParser = class(TObject)
  private
    FErrorMsg: AnsiString;
    FBuffer: AnsiString;
    FIndex: Integer;
    FCharacter: AnsiChar;
    FOnBeginTag: TTagEvent;
    FOnEndTag: TTagEvent;
    FOnTextCharacter: TTextEvent;
    FParsingTag: Boolean;
    procedure Error(aErrorMsg: AnsiString);
    procedure Expected(aExpectedMsg: AnsiString);
    procedure GetChar;
    procedure SkipWhiteSpaces;
    function  GetInteger: AnsiString;
    function  GetIdentifier: AnsiString;
    function  GetHexNumber: AnsiString;
    function  ReadUntil(chars: TCharSet): AnsiString;
    procedure Match(aMatchText: AnsiString);
    function  IsWhiteSpace(c: AnsiChar): Boolean;
    function  IsDigit(c: AnsiChar): Boolean;
    function  IsAlpha(c: AnsiChar): Boolean;
    function  IsHex(c: AnsiChar): Boolean;
    function  GetColorTagAttributes: AnsiString;
    function  GetURLTagAttributes: AnsiString;
    procedure ParseTag;
    procedure ParseText;
  public
    { Public declarations }
    constructor Create;

    function Parse(aTextToParse: AnsiString): Boolean;

    property ErrorMsg: AnsiString read FErrorMsg;
    property OnBeginTag: TTagEvent read FOnBeginTag write FOnBeginTag;
    property OnEndTag: TTagEvent read FOnEndTag write FOnEndTag;
    property OnTextCharacter: TTextEvent read FOnTextCharacter write FOnTextCharacter;
  end;

implementation

constructor TBBCodeParser.Create;
begin
  inherited Create;

  FOnBeginTag      := nil;
  FOnEndTag        := nil;
  FOnTextCharacter := nil;
  FErrorMsg        := '';
end;

procedure TBBCodeParser.GetChar;
begin
  if FIndex <= Length(FBuffer) then
  begin
    FCharacter := FBuffer[FIndex];
    Inc(FIndex);
  end
  else
    FCharacter := #0;
end;

procedure TBBCodeParser.SkipWhiteSpaces;
begin
  while IsWhiteSpace(FCharacter) do
    GetChar; 
end;

function  TBBCodeParser.GetInteger: AnsiString;
begin
  Result := '';
  if not IsDigit(FCharacter) then
    Error('Expected Integer');
  while IsDigit(FCharacter) do
  begin
    Result := Result + FCharacter;
    GetChar;
  end;
  SkipWhiteSpaces;
end;

function  TBBCodeParser.GetIdentifier: AnsiString;
begin
  Result := '';
  if not IsAlpha(FCharacter) then
    Error('Expected Identifier');
  while IsAlpha(FCharacter) do
  begin
    Result := Result + FCharacter;
    GetChar;
  end;
  SkipWhiteSpaces;
end;

function  TBBCodeParser.GetHexNumber: AnsiString;
begin
  Result := '';
  if not IsHex(FCharacter) then
    Error('Expected Hexadecimal Number');
  while IsHex(FCharacter) do
  begin
    Result := Result + FCharacter;
    GetChar;
  end;
  SkipWhiteSpaces;
end;

function  TBBCodeParser.ReadUntil(chars: TCharSet): AnsiString;
begin
  Result := '';
  while (FCharacter <> #0) and not(FCharacter in chars) do
  begin
    Result := Result + FCharacter;
    GetChar;
  end;
end;

function  TBBCodeParser.IsWhiteSpace(c: AnsiChar): Boolean;
begin
  Result := c in[' ',^I,#10,#13];
end;

function  TBBCodeParser.IsDigit(c: AnsiChar): Boolean;
begin
  Result := c in['0'..'9'];
end;

function  TBBCodeParser.IsAlpha(c: AnsiChar): Boolean;
begin
  Result := c in['a'..'z','A'..'Z'];
end;

function  TBBCodeParser.IsHex(c: AnsiChar): Boolean;
begin
  Result := c in['a'..'f','A'..'F','0'..'9'];
end;

procedure TBBCodeParser.Error(aErrorMsg: AnsiString);
begin
  FErrorMsg := aErrorMsg + ' at character index: '+IntToStr(FIndex);
  raise BBCodeParseException.Create(aErrorMsg);
end;

procedure TBBCodeParser.Expected(aExpectedMsg: AnsiString);
begin
  Error('Expected: "'+aExpectedMsg+'"');
end;

procedure TBBCodeParser.Match(aMatchText: AnsiString);
var
  i: Integer;
begin
  for i := 1 to Length(aMatchText) do
  begin
    if FCharacter <> aMatchText[i] then
      Expected(aMatchText);
    GetChar;
  end;
  SkipWhiteSpaces;
end;

function  TBBCodeParser.GetColorTagAttributes: AnsiString;
begin
  Match('=');
  Result := ReadUntil([cEndTagChar,cClosingTagChar]);
end;

function  TBBCodeParser.GetURLTagAttributes: AnsiString;
begin
  Result := '';
  
  if FCharacter = '=' then
  begin
    Match('=');
    Result := ReadUntil([cEndTagChar,cClosingTagChar]);
  end;
end;

procedure TBBCodeParser.ParseTag;
var
  TagIdent: AnsiString;
  TagType: TBBCodeTagType;
  TagAttributes: AnsiString;
  IsEndTag: Boolean;
begin
  FParsingTag := True;
  IsEndTag    := False;
  TagType     := tagUnknown;
  
  Match(cBeginTagChar);
  // check if tag is end tag
  if FCharacter = cClosingTagChar then
  begin
    GetChar;
    IsEndTag := True;
  end;

  TagIdent      := LowerCase(GetIdentifier);
  TagAttributes := '';

  // read tag information
  if TagIdent = cColorTagIdent then
    TagType := tagColor
  else
  if TagIdent = cUrlTagIdent then
    TagType := tagUrl
  else
  if TagIdent = cImageTagIdent then
    TagType := tagImage
  else
    Error('Unknown tag "'+TagIdent+'"');

  if not IsEndTag then
  begin
    case TagType of
      tagColor : TagAttributes := GetColorTagAttributes;
      tagUrl   : TagAttributes := GetUrlTagAttributes;
    else
    end;
  end;

  Match(cEndTagChar);

  if not IsEndTag and Assigned(FOnBeginTag) then
    FOnBeginTag(TagType,TagAttributes)
  else
  if IsEndTag and Assigned(FOnEndTag) then
    FOnEndTag(TagType,TagAttributes);

  FParsingTag := False;
end;

procedure TBBCodeParser.ParseText;
begin
  if Assigned(FOnTextCharacter) then
    FOnTextCharacter(FCharacter);
  GetChar;
end;

function TBBCodeParser.Parse(aTextToParse: AnsiString): Boolean;
begin
  FParsingTag := False;
  FBuffer     := aTextToParse;
  FIndex      := 1;
  GetChar;

  try
    while FCharacter <> #0 do
    begin
      if not FParsingTag and (FCharacter = cBeginTagChar) then
        ParseTag
      else
        ParseText;
    end;
    Result := True;
  except
    Result := False;
  end;
end;

end.

The 'only' thing I might do is get rid of the events and make it return an array of tag and/or plain text bits in order to make it nicer to use IMO...

cheers,
Paul

**paul_nicholls** · 15-09-2010, 06:57 AM

Hi all,
there was a slight bug where the Match() routine was chopping off any spaces after the closing tag character ']'.

I have modified that routine now to make skipping white spaces optional (see the changes below)

Code:

unit unit_BBCode;
{$ifdef fpc}
{$mode Delphi}
{$endif}
{+H}
interface

uses
  SysUtils,
  Classes;
  
const
  cBeginTagChar    = '[';
  cEndTagChar      = ']';
  cClosingTagChar  = '/';

  cColorTagIdent   = 'color';
  cURLTagIdent     = 'url';
  cImageTagIdent   = 'img';

type
  TCharSet             = set of AnsiChar;
  BBCodeParseException = class(Exception);
  TBBCodeTagType       = (tagUnknown,tagColor,tagURL,tagImage);

const
  cBBCodeTagType: array[TBBCodeTagType] of AnsiString = (
    'unknown',
    'color',
    'url',
    'img'
  );

type
  TTagEvent  = procedure(Tag: TBBCodeTagType; const Attribute: AnsiString) of object;
  TTextEvent = procedure(c: AnsiChar) of object;

  TBBCodeParser = class(TObject)
  private
    FErrorMsg: AnsiString;
    FBuffer: AnsiString;
    FIndex: Integer;
    FCharacter: AnsiChar;
    FOnBeginTag: TTagEvent;
    FOnEndTag: TTagEvent;
    FOnTextCharacter: TTextEvent;
    FParsingTag: Boolean;
    procedure Error(aErrorMsg: AnsiString);
    procedure Expected(aExpectedMsg: AnsiString);
    procedure GetChar;
    procedure SkipWhiteSpaces;
    function  GetInteger: AnsiString;
    function  GetIdentifier: AnsiString;
    function  GetHexNumber: AnsiString;
    function  ReadUntil(chars: TCharSet): AnsiString;
    procedure Match(aMatchText: AnsiString; aDoSkipWhiteSpaces: Boolean = True);
    function  IsWhiteSpace(c: AnsiChar): Boolean;
    function  IsDigit(c: AnsiChar): Boolean;
    function  IsAlpha(c: AnsiChar): Boolean;
    function  IsHex(c: AnsiChar): Boolean;
    function  GetColorTagAttributes: AnsiString;
    function  GetURLTagAttributes: AnsiString;
    procedure ParseTag;
    procedure ParseText;
  public
    { Public declarations }
    constructor Create;

    function Parse(aTextToParse: AnsiString): Boolean;

    property ErrorMsg: AnsiString read FErrorMsg;
    property OnBeginTag: TTagEvent read FOnBeginTag write FOnBeginTag;
    property OnEndTag: TTagEvent read FOnEndTag write FOnEndTag;
    property OnTextCharacter: TTextEvent read FOnTextCharacter write FOnTextCharacter;
  end;

implementation

constructor TBBCodeParser.Create;
begin
  inherited Create;

  FOnBeginTag      := nil;
  FOnEndTag        := nil;
  FOnTextCharacter := nil;
  FErrorMsg        := '';
end;

procedure TBBCodeParser.GetChar;
begin
  if FIndex <= Length(FBuffer) then
  begin
    FCharacter := FBuffer[FIndex];
    Inc(FIndex);
  end
  else
    FCharacter := #0;
end;

procedure TBBCodeParser.SkipWhiteSpaces;
begin
  while IsWhiteSpace(FCharacter) do
    GetChar; 
end;

function  TBBCodeParser.GetInteger: AnsiString;
begin
  Result := '';
  if not IsDigit(FCharacter) then
    Error('Expected Integer');
  while IsDigit(FCharacter) do
  begin
    Result := Result + FCharacter;
    GetChar;
  end;
  SkipWhiteSpaces;
end;

function  TBBCodeParser.GetIdentifier: AnsiString;
begin
  Result := '';
  if not IsAlpha(FCharacter) then
    Error('Expected Identifier');
  while IsAlpha(FCharacter) do
  begin
    Result := Result + FCharacter;
    GetChar;
  end;
  SkipWhiteSpaces;
end;

function  TBBCodeParser.GetHexNumber: AnsiString;
begin
  Result := '';
  if not IsHex(FCharacter) then
    Error('Expected Hexadecimal Number');
  while IsHex(FCharacter) do
  begin
    Result := Result + FCharacter;
    GetChar;
  end;
  SkipWhiteSpaces;
end;

function  TBBCodeParser.ReadUntil(chars: TCharSet): AnsiString;
begin
  Result := '';
  while (FCharacter <> #0) and not(FCharacter in chars) do
  begin
    Result := Result + FCharacter;
    GetChar;
  end;
end;

function  TBBCodeParser.IsWhiteSpace(c: AnsiChar): Boolean;
begin
  Result := c in[' ',^I,#10,#13];
end;

function  TBBCodeParser.IsDigit(c: AnsiChar): Boolean;
begin
  Result := c in['0'..'9'];
end;

function  TBBCodeParser.IsAlpha(c: AnsiChar): Boolean;
begin
  Result := c in['a'..'z','A'..'Z'];
end;

function  TBBCodeParser.IsHex(c: AnsiChar): Boolean;
begin
  Result := c in['a'..'f','A'..'F','0'..'9'];
end;

procedure TBBCodeParser.Error(aErrorMsg: AnsiString);
begin
  FErrorMsg := aErrorMsg + ' at character index: '+IntToStr(FIndex);
  raise BBCodeParseException.Create(aErrorMsg);
end;

procedure TBBCodeParser.Expected(aExpectedMsg: AnsiString);
begin
  Error('Expected: "'+aExpectedMsg+'"');
end;

procedure TBBCodeParser.Match(aMatchText: AnsiString; aDoSkipWhiteSpaces: Boolean = True);
var
  i: Integer;
begin
  for i := 1 to Length(aMatchText) do
  begin
    if FCharacter <> aMatchText[i] then
      Expected(aMatchText);
    GetChar;
  end;
  if aDoSkipWhiteSpaces then
    SkipWhiteSpaces;
end;

function  TBBCodeParser.GetColorTagAttributes: AnsiString;
begin
  Match('=');
  Result := ReadUntil([cEndTagChar,cClosingTagChar]);
end;

function  TBBCodeParser.GetURLTagAttributes: AnsiString;
begin
  Result := '';
  
  if FCharacter = '=' then
  begin
    Match('=');
    Result := ReadUntil([cEndTagChar,cClosingTagChar]);
  end;
end;

procedure TBBCodeParser.ParseTag;
var
  TagIdent: AnsiString;
  TagType: TBBCodeTagType;
  TagAttributes: AnsiString;
  IsEndTag: Boolean;
begin
  FParsingTag := True;
  IsEndTag    := False;
  TagType     := tagUnknown;
  
  Match(cBeginTagChar);
  // check if tag is end tag
  if FCharacter = cClosingTagChar then
  begin
    GetChar;
    IsEndTag := True;
  end;

  TagIdent      := LowerCase(GetIdentifier);
  TagAttributes := '';

  // read tag information
  if TagIdent = cColorTagIdent then
    TagType := tagColor
  else
  if TagIdent = cUrlTagIdent then
    TagType := tagUrl
  else
  if TagIdent = cImageTagIdent then
    TagType := tagImage
  else
    Error('Unknown tag "'+TagIdent+'"');

  if not IsEndTag then
  begin
    case TagType of
      tagColor : TagAttributes := GetColorTagAttributes;
      tagUrl   : TagAttributes := GetUrlTagAttributes;
    else
    end;
  end;

  Match(cEndTagChar,False);

  if not IsEndTag and Assigned(FOnBeginTag) then
    FOnBeginTag(TagType,TagAttributes)
  else
  if IsEndTag and Assigned(FOnEndTag) then
    FOnEndTag(TagType,TagAttributes);

  FParsingTag := False;
end;

procedure TBBCodeParser.ParseText;
begin
  if Assigned(FOnTextCharacter) then
    FOnTextCharacter(FCharacter);
  GetChar;
end;

function TBBCodeParser.Parse(aTextToParse: AnsiString): Boolean;
begin
  FParsingTag := False;
  FBuffer     := aTextToParse;
  FIndex      := 1;
  GetChar;

  try
    while FCharacter <> #0 do
    begin
      if not FParsingTag and (FCharacter = cBeginTagChar) then
        ParseTag
      else
        ParseText;
    end;
    Result := True;
  except
    Result := False;
  end;
end;

end.

I can now read in my credits text file successfully using the above parser (including the BBCode colour formatting) and build up my coloured credit parts! Yay!

See the attachment file credits.txt to see the formatting.

As I receive text character by character from the parser, I build up a text string.

Depending on the tag I receive, I add the concatenated text string to the list using the current colour from a colour stack, and then push the received colour onto the stack or pop a colour off the stack.

See the code snippet below:

Code:

procedure TDocumentLine.OnBeginTag(Tag: TBBCodeTagType; const Attribute: AnsiString);
begin
  // add any plain text element that is there using the current colour to the list
  if FBBCodeText <> '' then
  begin
    AddText(FBBCodeFont,FBBCodeText,Cardinal(FBBCodeColorStack.Peek));
    FBBCodeText := '';
  end;

  if Tag = tagColor then
    FBBCodeColorStack.Push(Pointer(GetHGEColorByName(Attribute)));
end;

procedure TDocumentLine.OnEndTag(Tag: TBBCodeTagType; const Attribute: AnsiString);
begin
  // add any plain text element that is there using the current colour to the list
  if FBBCodeText <> '' then
  begin
    AddText(FBBCodeFont,FBBCodeText,Cardinal(FBBCodeColorStack.Peek));
    FBBCodeText := '';
  end;

  if Tag = tagColor then
    FBBCodeColorStack.Pop;
end;

procedure TDocumentLine.OnText(c: AnsiChar);
begin
  FBBCodeText := FBBCodeText + c;
end;

function  TDocumentLine.ParseBBCodeText(aFont: Integer; aBBCodeText: AnsiString; var aErrorMsg: AnsiString): Boolean;
var
  BBCodeParser: TBBCodeParser;
begin
  BBCodeParser := TBBCodeParser.Create;
  FBBCodeColorStack := TStack.Create;
  try
    FBBCodeText := '';
    FBBCodeFont := aFont;
    BBCodeParser.OnBeginTag      := OnBeginTag;
    BBCodeParser.OnEndTag        := OnEndTag;
    BBCodeParser.OnTextCharacter := OnText;

    // add default starting colour
    FBBCodeColorStack.Push(Pointer(White));

    Result := BBCodeParser.Parse(aBBCodeText);
    if not Result then
      aErrorMsg := BBCodeParser.ErrorMsg
    else
    begin
      // add any plain text element that is there using the current colour to the list
      if FBBCodeText <> '' then
      begin
        AddText(FBBCodeFont,FBBCodeText,Cardinal(FBBCodeColorStack.Peek));
        FBBCodeText := '';
      end;
    end;
  finally
    BBCodeParser.Free;
    FBBCodeColorStack.Free;
  end;
end;

cheers,
Paul