Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.02.06;
Скачать: CL | DM;

Вниз

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;
Скачать: CL | DM;

Наверх




Память: 0.52 MB
Время: 0.041 c
1-1106148891
acc15
2005-01-19 18:34
2005.02.06
Иконка


11-1089658722
AlexR
2004-07-12 22:58
2005.02.06
RichEdit и scrollbar


14-1105682879
syte_ser78
2005-01-14 09:07
2005.02.06
Гигантомания и микронезия


8-1095860482
Nic2
2004-09-22 17:41
2005.02.06
Снимок экрана


4-1103123840
sirsergio
2004-12-15 18:17
2005.02.06
Состояние принтера. Как определить?