parser

← →
SpiDeR © (2005-01-14 18:37) [0]

Как оно работает??
procedure TMessengerMainForm.ParseString(const S: string);
var
P, Q: PChar;
State: Integer;

procedure AddImage(const SmileIndex, SmileLength: Integer);
begin
AddTextToRichEdit(Q, P - Q - SmileLength + 1, FCurrentFont);
AddImageToRichEdit(SmileIndex);

State := 0;
Q := P + 1;
end;
begin
P := PChar(S);
Q := P;

State := 0;

// State = 1.. then looking at ":-A" with A = @x)( etc.
// 10.. "LOL"
// 20.. "O :-)"
// 30.. "(blush)"
// 40.. ":"-("
// 50.. "8-)"
// 60.. ";-)"
// 70.. "readonly"
// 80.. "read-only on" or "read-only off"
//
// State = 1 -> ":" read
// State = 2 -> ":-" read
// State = 11 -> "LO" read
// State = 22 -> "O :" read
// State = 23 -> "O :-" read
//
// etc.

while P^ <> #0 do
begin
case P^ of
"$":
if State in [2, 23] then
AddImage(9, 3) // :-$
else
State := 0;
"&":
if State in [2, 23] then
AddImage(4, 3) // :-&
else
State := 0;
"(":
case State of
1, 22: AddImage(5, 2); // :(
2, 23: AddImage(5, 3); // :-(
40: AddImage(2, 3); // :,(
41: AddImage(2, 4); // :"-(
else
State := 30;
end;
")":
case State of
1, 22: AddImage(11, 2); // :)
2: AddImage(11, 3); // :-)
23: AddImage(6, 5); // O :-)
35: AddImage(3, 7); // (blush)
51: AddImage(1, 3); // 8-)
61: AddImage(15, 3); // ;-)
else
State := 0;
end;
"*":
if State = 1 then
AddImage(7, 2) // :*
else
State := 0;
",":
if State in [1, 22] then
State := 40
else
State := 0;
"-":
case State of
1, 22, 40, 50, 60: Inc(State);
73: State := 80;
else
State := 0;
end;
"8": State := 50;
""": State := -1; // to prevent "read.." etc will be triggered by the program
":":
if State = 21 then
State := 22
else
State := 1;
";": State := 60;
"@":
case State of
1, 22: AddImage(0, 2); // :@
2, 23: AddImage(0, 3) // :-@
else
State := 0;
end;
"D":
case State of
1, 22: AddImage(8, 2); // :D = LOL
2, 23: AddImage(8, 3) // :-D = LOL
else
State := 0;
end;
"L":
if State = 11 then
AddImage(8, 3) // LOL
else
State := 10;
"O":
if State = 10 then
State := 11
else
State := 20;
"\", "/":
if State in [2, 23] then
AddImage(14, 3) // :-\
else
State := 0;
"a":
if State = 71 then
State := 72
else
State := 0;
"b":
if State = 30 then
State := 31
else
State := 0;
"d":
if State = 72 then
State := 73
else
State := 0;
"e":
if State = 70 then
State := 71
else
State := 0;
"f":
case State of
86: State := 87;
87: HandleReadOnlyOff;
else
State := 0;
end;
"h":
if State = 34 then
State := 35
else
State := 0;
"l":
if State in [31, 75, 82] then
Inc(State)
else
State := 0;
"n":
case State of
74, 81: Inc(State);
86: HandleReadOnlyOn;
else
State := 0;
end;
"o":
case State of
2, 23: AddImage(12, 3); // :-o
73, 80, 85: Inc(State);
else
State := 0;
end;
"p":
if State in [2, 23] then
AddImage(13, 3) // :-p
else
State := 0;
"r":
if State <> -1 then
State := 70
else
State := 0;
"s":
if State = 33 then
State := 34
else
State := 0;
"u":
if State = 32 then
State := 33
else
State := 0;
"x", "X":
if State in [2, 23] then
AddImage(10, 3) // :-x
else
State := 0;
"y":
case State of
76: HandleReadOnly;
83: State := 84;
else
State := 0;
end;
" ":
case State of
20, 84: Inc(State);
11: State := 21;
else
State := 0;
end;
end;
Inc(P);
end;

if Q < P then
AddTextToRichEdit(Q, P - Q, FCurrentFont);
end;

← →
begin...end © (2005-01-14 18:40) [1]

Конечный автомат.

← →
begin...end © (2005-01-14 18:58) [2]

Например, в самом начале текста встречается слово LOL.

Первая буква - "L". Смотрим на код:

> "L":
> if State = 11 then
> AddImage(8, 3) // LOL
> else
> State := 10;

В начале работы автомат находился в состоянии 0. Теперь (после прочтения L) он находится в состоянии 10.

Идём дальше: следующая буква - "O". Код:

> "O":
> if State = 10 then
> State := 11
> else
> State := 20;

Смысл этого кода: если предыдущая буква была "L" (предыдущее состояние State = 10), а теперь мы прочитали "O", то переходим в состояние 11. Т.е., состояние 11 означает, что мы уже прочитали "LO". Про ветку else ничего говорить не буду.

Идём дальше: следующая буква - "L". Код:

> "L":
> if State = 11 then
> AddImage(8, 3) // LOL
> else
> State := 10;

Смысл: если до этого прочитали буквосочетание "LO" (находимся в состоянии 11), и очередная прочитанная буква - "L", то это означает, что мы только что нашли слово "LOL", и по этому поводу добавляем куда-то там какую-то там картинку.

С ветвлениями else и со всем остальным попробуйте разобраться сами :-)

Сделайте поиск в Яндексе по словосочетанию "конечный автомат".

← →
GrayFace © (2005-01-14 19:06) [3]

Если, например, :MySmile: не должен считаться смайликом, то все очень просто.

← →
GrayFace © (2005-01-14 20:00) [4]

Вот мой эквивалент данного кода.
// Проверяем наличие подстроки s по адрессу a function IsThere1(a:PChar; s:string):boolean; begin if s="" then begin result:=false; exit; end; Result:=RSCompareMem(a,PChar(s),length(s)); end; // Проверяем наличие подстроки s по адрессу a и "перепрыгиваем" ее function IncThere1(var a:PChar; s:string):boolean; begin Result:=IsThere1(a,s); if Result then inc(a,length(s)); end; // Почти то же самое, что IsThere1, но не чувствительная к регистру. IsThere1 = (IsThere=0) function IsThere(a:PChar; s:string):integer; var s1:string; begin if s="" then begin result:=-1; exit; end; SetLength(s1,length(s)); RSCopyMem(@s1[1],a,length(s)); Result:=AnsiCompareText(s1,s); end; // IsThere1 с "перешагиванием" function IncThere(var a:PChar; s:string):integer; begin Result:=IsThere(a,s); if Result=0 then inc(a,length(s)); end; procedure TMessengerMainForm.ParseString(const Str: string); const a:array[1..8] of string=("LOL", "O :-)", "(blush)" и т.д.); var s:PChar; i,j:integer; begin s:=PChar(Str); j:=high(a); while s^<>#0 do // s^ - "текущий" символ строки begin i:=low(a); // устраиваем цикл, аналогичный for i:=low(a) to high(a) while i<=j do // high(a) заменил на j для оптимизации if IncThere1(s,a[i]) then //ищем здесь строку и "перешагиваем" ее begin if i=8 then HandleReadOnlyOn else // и т.д. обрабатываем случаи, когда вместо добавления каринки надо что-то делать AddImageToRichEdit(i); // ставим на место текста картинку break; end else inc(i); if i>high(a) then // если смайликов не нашли, то i>high(a) - для этого мы превращали for в while begin AddTextToRichEdit(s, 1, FCurrentFont); // если я правильно понял смысл этой процедуры, так добавим 1 символ в RichEdit inc(s); end; end; end;

← →
GrayFace © (2005-01-14 20:06) [5]

Ой. Тут RSCompareMem используется.
Вот еще дополнение:
function RSCompareMem(Mem1,Mem2:pointer; count:integer):boolean; var i:integer; c,d:^integer; begin c:=Mem1; d:=Mem2; Result:=true; for i:=1 to count shr 2 do begin Result:=c^=d^; if not Result then exit; inc(c); inc(d); end; if count and 2<>0 then begin Result:=pWord(c)^=pWord(d)^; if not Result then exit; inc(pWord(c)); inc(pWord(d)); end; if count and 1<>0 then Result:=pByte(c)^=pByte(d)^; end;

← →
begin...end © (2005-01-14 20:16) [6]

> GrayFace © (14.01.05 20:06) [5]

> Тут RSCompareMem используется.

А ЗАЧЕМ оно там используется при наличии стандартной CompareMem?

← →
GrayFace © (2005-01-14 20:37) [7]

begin...end © (14.01.05 20:16) [6]
Не знал.

← →
begin...end © (2005-01-14 20:38) [8]

Я уж не говорю про функции типа IsThere1 (кстати, зачем там begin, end и Exit - для "удобочитаемости"?). Стиль написания ParseString тоже вызывает много вопросов - например, там нижняя граница массива-константы вычисляется в цикле.

Насколько я знаю, использование конечного автомата является стандартным решением такого рода задач. На мой взгляд, придумывание чего-то типа [4] излишне.

Это канешна фсё крута, но по-моему Тпарсер рулит :)

SpiDeR © (18.01.05 23:11) [10]
крута, но по-моему Тпарсер рулит :)
TParser не может обработать такую простейшую конструкцию

1..6 Он почему то(ну тоесть понятно почему ;-)) считает, что это вещественное число..

begin...end © (14.01.05 20:38) [8]
Насколько я знаю, использование конечного автомата является стандартным решением такого рода задач. На мой взгляд, придумывание чего-то типа [4] излишне.
ИМХО, [4] сделать гораздо проще, чем конечный автомат из сабжа. А уж если надо не 10 смайликов, а 20 - это вообще ужас будет! IsThere и т.д. я еще раньше сделал, так что ParseString я бы сделал очень быстро, если бы не решил его откомментировать.

begin...end © (14.01.05 20:45) [9]
А чего RSCopyMem тут не выложил? Надо понимать, это аналог CopyMemory или Move?
Да. Это я делал это из-за того, что стандартные функции почему-то работают медленнее (медленнее на малых объемах и так же на больших).

parser Найти похожие ветки