[Exercício] Input com highlight

[thoga31]

Na sequência do exercício do @nunopicado "só porque sim", eu proponho um exercício "só porque me deu na real gana" 😄

Basicamente é suposto implementarem um procedimento ReadLight que lê uma String mas que faz highlight do input à medida que é escrito. Exemplo:

write('Introduza uma linha de codigo Pascal: ');
ReadLight(linha);
writeln('LINHA: ', linha);

https://dl.dropboxusercontent.com/u/30172141/P@P/T%C3%B3picos/exercicio_highlight.png

Como podem ver, há cores diferentes para coisas diferentes: palavras reservadas, símbolos, números... Usem cores à vossa escolha.

O procedimento ReadLight deverá funcionar como um ReadLn típico: por exemplo, deverá permitir backspace.

Ao que deverá fazer highlight? O que quiserem. Eu dei o exemplo do Pascal. Se quiserem fazer highlight de outra coisa qualquer, é à vontade do freguês.

Uma solução em Delphi utilizando Text Boxes ou Richtext Boxes também é muito bem-vinda 😉

Sejam criativos, adicionem coisas que vos passem pela cabeça, e venham daí esses códigos!

[nunopicado]

É naquela...

Eu não queria fazer batota, mas tu é que falaste em solução em Delphi, Text Boxes (TEdit e TMemo) e Richtext Boxes (TRichEdit)...

É naquela, dá para mostrar como isto em Delphi/Lazarus é uma linguagem atrasada que não dá para fazer nada:

unit uMain;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils, FileUtil, SynEdit, SynMemo, SynHighlighterPas,
 SynHighlighterCpp, SynHighlighterJava, SynHighlighterHTML, SynHighlighterXML,
 SynHighlighterSQL, SynHighlighterVB, Forms, Controls, Graphics, Dialogs,
 ExtCtrls, StdCtrls, Buttons, SynEditHighlighter;

type

 { TfMain }

 TfMain = class(TForm)
   bCpp: TSpeedButton;
   bBasic: TSpeedButton;
   bTerminar: TButton;
   bAbrir: TButton;
   bLimpar: TButton;
   bXML: TSpeedButton;
   bJava: TSpeedButton;
   bHTML: TSpeedButton;
   bSQL: TSpeedButton;
   dlgOpen: TOpenDialog;
   pnlCommand: TPanel;
   bPascal: TSpeedButton;
   synCpp: TSynCppSyn;
   synHTML: TSynHTMLSyn;
   synJava: TSynJavaSyn;
   SynMemo: TSynMemo;
   synPascal: TSynPasSyn;
   synSQL: TSynSQLSyn;
   synBasic: TSynVBSyn;
   synXML: TSynXMLSyn;
   procedure bAbrirClick(Sender: TObject);
   procedure bLimparClick(Sender: TObject);
   procedure bTerminarClick(Sender: TObject);
   procedure ChooseHighlighter(Sender: TObject);
 private
   { private declarations }
 public
   { public declarations }
 end;

var
 fMain: TfMain;

implementation

{$R *.lfm}

{ TfMain }

procedure TfMain.bTerminarClick(Sender: TObject);
begin
    Application.Terminate;
end;

procedure TfMain.bLimparClick(Sender: TObject);
begin
    SynMemo.Lines.Clear;
end;

procedure TfMain.bAbrirClick(Sender: TObject);
begin
    dlgOpen.Filter:=SynMemo.Highlighter.DefaultFilter;
    if dlgOpen.Execute
       then SynMemo.Lines.LoadFromFile(dlgOpen.FileName);
end;

procedure TfMain.ChooseHighlighter(Sender: TObject);
begin
    SynMemo.Highlighter:=FindComponent('syn'+(Sender AS TSpeedButton).Caption) AS TSynCustomHighlighter;
end;

end.

Claro que isto não mostra nada, e como tal, fica o link para a aplicação:

https://dl.dropboxusercontent.com/u/5146367/ReadLite.zip

[passarito]

É impressão minha ou isto necessita de se introduzir todas as palavras/códigos que queiramos fazer highlight?

[nunopicado]

É impressão minha ou isto necessita de se introduzir todas as palavras/códigos que queiramos fazer highlight?

Eu ia dizer que sim, mas...

Eu não introduzi nada! hehheheh

Só lá tenho 7 linguagens:

Pascal, C++, Java, HTML, XML, SQL e Basic

Se for preciso mais, arranjam-se!

Ainda tenho pr'aqui FreePascal, Perl, LFM, DIFF, Unix Shell, CSS, PHP, TEX, Python, Batch e INI, antes de ter de começar a escrever palavras à mão!

Edited July 12, 2013 at 02:53 PM by nunopicado

[thoga31]

É impressão minha ou isto necessita de se introduzir todas as palavras/códigos que queiramos fazer highlight?

Não necessariamente. Se exemplificares com duas ou três palavras, chega e sobra. O objectivo não é fazer um sistema de highlight completo, é só mesmo fazer um código-base que faça o que é proposto.

Mas se te quiseres divertir à grande, faz um completo para COBOL.

[nunopicado]

Mas se te quiseres divertir à grande, faz um completo para COBOL.

lol 😄 que mau!

[thoga31]

Este código ainda é rudimentar e já tem uns bons meses de existência. Foi ao vê-lo que me lembrei de propor o exercício.

Depois eu melhoro-o.

procedure ReadLight(var s : string);
const SymbolKeys : set of char = ['+','-','*','/','(',')','[',']','&','%','$','#',':',';',',','.','<','>','='];
     NumberKeys : set of char = ['0'..'9'];
     // LetterKeys : set of char = ['a'..'z','A'..'Z'];

var key : char;

begin
   s := '';
   repeat
       textcolor(15);
       key := ReadKey;
       if not(key = #8) then begin
           if not(key = #13) then begin
               GotoXY(WhereX, WhereY);
               if key in NumberKeys then textcolor(10)
               else if key in SymbolKeys then textcolor(12)
               else textcolor(15);

               write(char(key));
               s := s + char(key);

               if AnsiEndsText('DISP', s) then begin
                   GotoXY(WhereX - 4, WhereY);
                   textcolor(14);
                   write('DISP');
               end;

               if AnsiEndsText('PROGRAM', s) then begin
                   GotoXY(WhereX - 7, WhereY);
                   textcolor(14);
                   write('PROGRAM');
               end;

           end
       end else begin
           GotoXY(WhereX - 1, WhereY);
           write(' ');
           GotoXY(WhereX - 1, WhereY);
           Delete(s, length(s), 1);
       end;
   until key = #13;
   GotoXY(1, WhereY + 1);
   textcolor(7);
end;

[nunopicado]

Pronto, toma lá...

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
 System.SysUtils, Classes, crt;

var
  s:String;

procedure WriteXY(Text:String;X,Y:Byte;Color:Byte=7);
begin
    GotoXY(X,Y);
    TextColor(Color);
    Write(Text);
    if Color<>7
       then TextColor(7);
end;

function ReadLite:String;
const
    Words=';program;begin;end;if;then;else;for;to;downto;do;repat;until;while;';
    Opers=';+;-;*;/;<;>;<=;>=;<>;div;mod;';
var
  ch:Char;
  i:Byte;
  Last:String;
  Number,Err:Integer;

begin
    Result:='';
    Last:='';
    repeat
          repeat
                ch:=ReadKey;
          until Ord(ch) in [8,13,27,32..255];

          case ch of
               #8:if (Result<>'') or (WhereX=1)
                     then begin
                               Delete(Result,Length(Result),1);
                               WriteXY(' ',WhereX-1,WhereY);
                               GotoXY(WhereX-1,WhereY);
                          end;
          else begin
                    Result:=Result+Ch;
                    if ch in [#13,#32]
                       then begin
                                 if Pos(';'+Last+';',Words)>0
                                    then WriteXY(Last,WhereX-Length(Last),WhereY,14);
                                 if Pos(';'+Last+';',Opers)>0
                                    then WriteXY(Last,WhereX-Length(Last),WhereY,12);
                                 if (Last[1]='''') and (Last[Length(Last)]='''')
                                    then WriteXY(Last,WhereX-Length(Last),WhereY,13);
                                 Val(Last,Number,Err);
                                 if Err=0
                                    then WriteXY(Last,WhereX-Length(Last),WhereY,10);
                                 Last:='';
                            end
                       else Last:=Last+Ch;
                    if ch=#13
                       then GotoXY(1,WhereY+1);

                    if ord(ch)>=32
                      then Write(ch);
               end;
          end;

    until ch in [#27];
{     if ch=#27          Já não é preciso...
       then Result:='';} 
end;



begin
    ReadLite;
end.

Não me dei foi ao trabalho de fazer um parser como deve ser... É preciso o espaço ou o enter para separar as palavras e fazer o highlight...

Edited July 12, 2013 at 10:43 PM by nunopicado

[thoga31]

O teu código é mais difícil de ler, mas está aí tudo o que é preciso, excepto o facto de ReadLite não ser um procedimento que recebe por referência uma String (achei que estava implícito quando disse que devia funcionar como o readln e com o exemplo que dei). 🙂

[nunopicado]

Explicito estava...

Mas olha, foi naquela!

É que sendo função, posso usar directamente (stand alone), ou recolhendo o resultado.

O facto de ser multi-linha ajudou a complicar!

Edited July 12, 2013 at 10:36 PM by nunopicado

[thoga31]

O teu último If é redundante: se o ciclo só interrompe com ESC, não precisas de verificar se foi premido um ESC 😛

[nunopicado]

O teu último If é redundante: se o ciclo só interrompe com ESC, não precisas de verificar se foi premido um ESC 😛

Pois é... Ao inicio tinha o ciclo a terminar com #27 e #13, e aí o IF era necessário. Mas depois meti o #13 a fazer o multilinha, e não tirei aquilo de lá! bem notado.

[thoga31]

Pensas que eu não analiso os códigos? Ai não... 😄

Aprende-se imenso assim, vêem-se técnicas que nunca antes nos tinham passado pela cabeça... muito eu tenho aprendido convosco aqui, boa parte desta forma. In fact, a esmagadora maioria dos meus conhecimentos em Object Pascal e em boas práticas de programação e técnicas vem de vocês, guys. 🙂

Edited July 12, 2013 at 10:56 PM by thoga31

[nunopicado]

Uiiii... Tenho de ter mais cuidado com o que escrevo! hehehehe