Форум: "Основная";
Текущий архив: 2005.02.06;
Скачать: [xml.tar.bz2];
Вниз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] излишне.
← →
begin...end © (2005-01-14 20:45) [9]> [7] GrayFace © (14.01.05 20:37)
А чего RSCopyMem тут не выложил? Надо понимать, это аналог CopyMemory или Move?
← →
SpiDeR © (2005-01-18 23:11) [10]Это канешна фсё крута, но по-моему Тпарсер рулит :)
← →
jack128 © (2005-01-18 23:21) [11]SpiDeR © (18.01.05 23:11) [10]
крута, но по-моему Тпарсер рулит :)
TParser не может обработать такую простейшую конструкцию
1..6 Он почему то(ну тоесть понятно почему ;-)) считает, что это вещественное число..
← →
GrayFace © (2005-01-23 00:55) [12]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?
Да. Это я делал это из-за того, что стандартные функции почему-то работают медленнее (медленнее на малых объемах и так же на больших).
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2005.02.06;
Скачать: [xml.tar.bz2];
Память: 0.51 MB
Время: 0.037 c