Текстовый движок! Опции

[GLuk]

Не знал куда запихать. Вот тут появились мысли по поводу текстового движка для форума, в каком-то смысле. И вот краснея/бледнея от стыда, с криками/стонами вампиров, кидаю тебе народ свои иЦходники...
для того чтобы заработало уберите восклицательные знаки из описания цветов в константах...

см. ниже

Решил тут поправить исходник - поправил, привел примеры работы, а когда решил изменить исходник - злой/вонючий/говенный провайдер выкинул меня из инета, изменения как таковые - это цветовая гамма

[GLuk]

Uses
   Crt;

Const
    N = 32;
    a: array [1..N] of String = ('BEGIN', 'PROCEDURE','STRING','VAR',
                                 'ELSE','FOR','TO','DO','IF','THEN','USES',
                                 'CONST','WHILE','NOT','END','ARRAY','OF',
                                 'REPEAT','UNTIL','WITH','CASE','DOWNTO',
                                 'GOTO','INLINE','ASM','TYPE','IMPLEMENTATION',
                                 'INTERFACE','ASSEMBLER','EXTERNAL','INTERRUPT',
                                 'LABEL');
    GrayFlag1:Boolean = False;
    GrayFlag2:Boolean = False;
    AsmFlag:Boolean   = False;
    TextFlag:Boolean  = False;
    AsmColor:String   = '[colo!r=Green]';
    ReservedColor : String = '[colo!r=White]';
    GrayColor1 : String = '[colo!r=Black]';
    GrayColor2 : String = '[colo!r=Teal]';
    StandartColor : String = '[colo!r=Yellow]';
    EndColor : String = '[/colo!r]';

Procedure CheckForReservedWords(var W : String);
var
  i,j,Si:Integer;
  Process:Boolean;
  L:Byte;
  T:String;
begin
    i:=1;
    While i<=Length(W) do
    begin
         Case W[i] of
         {RESERVED WORDS}
         {Џ®вҐ­жЁ «м­ п ў®§¬®¦­®бвм ўбваҐзЁ § аҐ§ҐаўЁа®ў ­­®Ј® б«®ў }
         'A'..'Z','a'..'z':If (not GrayFlag1) and (not GrayFlag2) and (not TextFlag) then
         If Ord(W[i+1]) in [65..90, 97..122] then
         {…¦Ґ«Ё нв® ­Ґ ®¤Ё­®з­л© бЁ¬ў®«, Їа®ўҐа塞 ¤ «миҐ}
         begin
              Si:=i;
              While Ord(W[i]) in [65..90, 97..122] do Inc(i);
              T:=Copy(W,Si,i-Si); {‚뤥«пҐ¬ б«®ў®}
              For j:=1 to Length(T) do T[j]:=UpCase(T[j]); {‚ ўҐае­Ё© ॣЁбва}
              j:=1;
              While (j<=N) do
              begin
                   If a[j]=T then
                   begin
                        Insert(EndColor,W,Si+Length(T));
                        Insert(ReservedColor,W,Si);
                        Inc(i,Length(EndColor)+Length(ReservedColor)-1);
                        j:=N;
                   end;
                   Inc(j);
              end;
              If T='ASM' then
              begin
                   AsmFlag:=True;
                   Insert(AsmColor,W,i);
                   Inc(i,Length(AsmColor));
              end;
              If (T='END') and (AsmFlag) then
              begin
                   AsmFlag:=False;
                   Insert(EndColor,W,i+1);
                   Inc(i,Length(EndColor));
              end;
         end;
         ' ':begin end; {iret/§ Ј«гиЄ  ¤«п Їа®ЎҐ«  - ¤ Ўл Ўлбв॥ Їа®бЄ ЄЁў «}
         {--------------}
         {COMMENTS}
         '{':begin
                  Insert(GrayColor1,W,i);
                  Inc(i,Length(GrayColor1));
                  GrayFlag1:=True;
             end;
         '}':begin
                  Insert(EndColor,W,i+1);
                  Inc(i,Length(EndColor));
                  GrayFlag1:=False;
             end;
         '(':If W[i+1]='*' then
             begin
                  GrayFlag2:=True;
                  Insert(GrayColor2,W,i);
                  Inc(i,Length(GrayColor2));
                  Inc(i); {Џа®ЇгбЄ Ґ¬ §ўҐ§¤г}
             end; {Їа®ўҐаЄ  ­  (**) }
         '*':If (W[i+1]=')') and (GrayFlag2) then
             begin
                  GrayFlag2:=False;
                  Insert(EndColor,W,i+2);
                  Inc(i,Length(EndColor));
                  Inc(i); {Џа®ЇгбЄ Ґ¬ § Єалў ойго бЄ®ЎЄг}
             end;
         #39:If not TextFlag then TextFlag:=True {ЂЇ®бва®д}
             else TextFlag:=False;
         {--------}
         {DOS -> WIN}
         #128..#175:W[i]:=Chr(Ord(W[i])+64); {'Ђ'-'Ї'}
         #224..#239:W[i]:=Chr(Ord(W[i])+16); {'а'-'п'}
         'с':begin end; {с - Ў®«м讥 Ё ¬ «Ґ­мЄ®Ґ}
         'р':begin end;
         {----------}
         {MISC}
         '[':begin end;          ']':begin end;
         end;
         Inc(i);
    end;
end;

Var
  T,F:Text;
  S,Ts:String;
  M:Byte;
  C:LongInt;

Begin
    ClrScr;
    If ParamStr(1)='' then
    begin
         WriteLn('?бЇ®«м§®ў ­ЁҐ: forum_t.exe [Ё¬п_д ©« ]');
         Halt(1);
    end;
    S:=ParamStr(1);
    Assign(T,S);
    Reset(T);
    S:=Copy(S,1,Pos('.',S))+'TXT';
    Assign(F,S);
    ReWrite(F);
    {WriteLn(F,StandartColor);}
    C:=0;
    While not Eof(T) do
    begin
    {ЏаЁ¤Ґвбп а §ЎЁў вм Ї® 4800 бЁ¬ў®«®ў :( }
         ReadLn(T,S);
         CheckForReservedWords(S);
         GotoXY(1,1); Write©;
         Inc(C,Length(S));
         If C>=4800 then
         begin
              C:=0;
              WriteLn(F,'---------------cut here---------------');
         end;
         WriteLn(F,S);
    end;
    {WriteLn(F,EndColor);}{‡ Єа. ⥣ ¤«п StandartColorTeg}
    Close(T);
    Close(F);
End.

[GLuk]

{До изнасилования...}
(*------------------------------*)
{’Ґбв дг­ЄжЁ®­ «м­ле ў®§¬®¦­®б⥩}
(*------------------------------*)
Uses
   Crt;
Label
    Metka;
Var
  i:Integer;
Const
    N = 5;
Type
   AOB = array[1..70] of Byte;
Begin
    asm
       mov ah,02
       int 16h
    end;
    ClrScr;
    {?­Є ¤® ЇпвЁ}
    While i<>5 do Inc(i);
    Repeat {Ћ¦Ё¤ Ґ¬ ­ ¦ вЁп Є« ўЁиЁ}
    Until KeyPressed;
    For i:=1 to 5 do Inc(i);
    For i:=1 downto 5 do i:=not i;
    Goto Metka;
    asm
       and al,40h      {Џа®ўҐа塞 ўЄ«о祭 «Ё Caps-Lock}
       cmp al,40h
       je  @AlreadyOn
       mov ax,40h (* ’Ґбв дг­ЄжЁ®­ «м­ле ў®§¬®¦­®б⥩ *)
       mov es,ax
    {†Ґ« вҐ«м­® ®вбгвбвўЁҐ ў«®¦Ґ­­ле н«Ґ¬Ґ­в®ў, Є®¬ЎЁ­Ёа®ў ­ЁҐ
    ®Ја ­ЁзЁвҐ«Ґ© Є®¬¬Ґ­в аЁҐў}
       mov di,17h
       mov al,40h
       or  byte ptr es:di,al
@AlreadyOn:
    end;
{ќв®в ⥪б⠡㤥⠯ҐаҐЄ®¤Ёа®ў ­:
ЂЃ‚ѓ„…†‡?‰Љ‹ЊЌЋЏђ‘’“”•–—?™љ›њќћџ
 ЎўЈ¤Ґ¦§Ё©Є«¬­®Їабвгдежзийклмноп}
End.

[AlaRic]

Очень интересно, но я не пойму, что с этим делать!

[GLuk]

Предположим, у тебя есть исходник, на паскале в ДОС-кодировке. Эта прога добавляет цветов и перекодирует его в Win. А заодно и делит его на 4800 символов, вставляя в нужном месте мессагу -------------cut here-----------------, из-за ограничений объема мессаг в топике. А так - реальная необходимость - для красоты, после помещения на форуме  :)

[AlaRic]

Штука полезная, но больше заданного кол-ва символов будет не слишком часто(движок не в счет )!
PS.5000 символов!

[GLuk]

Штука полезная, но больше заданного кол-ва символов будет не слишком часто(движок не в счет )!
PS.5000 символов!

Прости глупого, чего-то не въехал  :P

[AlaRic]

Скажу короче: штука полезная!!  ;D

[Slam]

Классная штука!

[GLuk]

(*------------------------------*)
{Тест функциональных возможностей}
(*------------------------------*)
Uses
Crt;
Label
Metka;
Var
i:Integer;
Const
N = 5;
Type
AOB = array[1..70] of Byte;
Begin
asm
mov ah,02
int 16h
end;
ClrScr;
{Инк до пяти}
While i<>5 do Inc(i);
Repeat {Ожидаем нажатия клавиши}
Until KeyPressed;
For i:=1 to 5 do Inc(i);
For i:=1 downto 5 do i:=not i;
Goto Metka;
asm
and al,40h {Проверяем включен ли Caps-Lock}
cmp al,40h
je @AlreadyOn
mov ax,40h (* Тест функциональных возможностей *)
mov es,ax
{Желательно отсутствие вложенных элементов, комбинирование ограничителей комментариев}
mov di,17h
mov al,40h
or byte ptr es:di,al
@AlreadyOn:
end;
{Этот текст будет перекодирован: АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя}
End.

[mj]

А слабо такой на Perl написать для форума ???
(чтобы форум сам перекодировал между тегами <pas></pas>)

Я лично ни С, ни Perl особо не любил, так что не смогу такое написать...

[GLuk]

Можно попробовать...

[AlaRic]

Подниму старую тему:
1)GLuk с твоего разрешения добавлю в исходники твой движок
2)может кто-нибудь действительно сможет что-то написать для форума?

[GLuk]

1) Давай я хоть оформлю его по-человечески!
2) На паскале и асме написал-бы, вот бы кто сконвертил...??! А перлом заниматься не хочется.
3) Где MJ и какие есть идеи по поводу модернизации форума??

[AlaRic]

1)ну и как?
2)ты напиши, а там видно будет  ;D
3)это к MJ, да и вроде второй форум открылся!