[Snippet] Unit para criar menus com renderers

[thoga31 571]

Lembrei-me desta mini-framework criada pelo @pwseo para criar menus com possibilidade de modificar o seu aspecto.

Decidi então fazer aquilo que há muito andava para fazer: criar o rascunho daquela que seria uma classe que permite a criação destes menus.

A minha mini-framework diferencia-se da do @pwseo pelos seguintes aspectos:

• Está implementada com OOP (Object Pascal);
  
• O rendering é feito através de uma property da classe, a qual possui uma sintaxe e funcionamento específicos;
  
• Permite organizar o menu por teclas;
  
• Tem um código bem mais complexo e muito menos elegante
  

Os métodos públicos para manipular o menu:

• Create - cria uma instância, ou seja, um menu. Argumento opcional - define se é Sorted ou não (default = não). Não é definitivo, pode-se alterar com a propriedade sorted a qualquer momento.
  
• Destroy - destrói todos os recursos associados à instância.
  
• Add - adiciona um novo item ao menu. Recebe, por ordem, 1) o texto associado, 2) a tecla a premir, 3) o Procedure a executar.
  
• Show - mostra o menu no monitor. Se render não for uma String nula, o output terá rendering, caso contrário será simples. Argumento opcional: título. NB: não lida com erros associados a uma má definição do rendering!
  
• GetChoice - espera pela opção do utilizador e devolve a tecla (caracter) correspondente. Argumento opcional: define se executa logo a Procedure (default = sim).
  
• KEYS - propriedade read-only que possui uma colecção de todas as opções (teclas/caracteres) do menu.
  
• sorted - propriedade que define se o menu é mostrado organizado por teclas (caracteres).
  
• render - propriedade write-only que define o rendering do menu. Sintaxe:
  

  §        -> define uma nova linha
  #TITLE   -> indica que aqui se deve escrever o título
  #OPTION  -> indica que aqui se devem escrever as opções. Assim que isto aparece, TODAS as opções serão escritas. Isto implica que não há separadores entre cada opção!
  @CENTER  -> define que deve ser escrito centrado
  

  
  Um exemplo será dado mais à frente, e será explicado, com o output respectivo.
  

Aqui fica a minha classe:

(*                                   === UNIT THOGA31.PAS ===                                   *
* By: Igor Nunes, aka thoga31 @ Portugal-a-Programar                                           *
* Date: November 30th, 2013                                                                    *
* Description:                                                                                 *
*    This unit contains a useful class which allows to create menus very easily with rendering *)

{$mode objfpc}
unit UFancyMenu;

interface
uses crt, sysutils, strutils;

(* Some useful constants *)
const sys : record   // cannot be used to define other constants 
        KEY_ENTER : char;
        KEY_ESC : char;
        NEWLINE : ShortString;
     end = (KEY_ENTER:#13; KEY_ESC:#27; NEWLINE:#13+#10);

type TStrArr = array of string;  // used for renderers
    TMenu = class(TObject)  // Procedures and Functions described on their implementation
       private
           type TProc = procedure;  
                TOption = record
                   prompt : string;  // Text to write
                   key : char;       // Key that must be pressed for this option
                   action : TProc;   // Procedure associated with this option
                end;
                TKeysSet = set of char;
                TOptList = array of TOption;

           var VMenu : TOptList;        // contains all the options of the menu
               VMenuSorted : TOptList;  // a sorted version of the menu, by keys
               VKeys : TKeysSet;        // a set of all keys used in this menu
               VSorted : boolean;       // informs if this menu must be shown sorted
               VRender : string;        // defines the renderer of the menu
               VMaxLength : word;       // helps to calculate the size of the menu with renderer

           procedure Sort;

       public
           constructor Create(mysorted : boolean = false);

           procedure Add(myprompt : string; mykey : char; myproc : TProc);
           procedure Show(title : string = '');
           function GetChoice(performAction : boolean = true) : char;

           property KEYS : TKeysSet read VKeys;                   // Gets the set of keys
           property sorted : boolean read VSorted write VSorted;  // Defines if the menu must be shown sorted by keys
           property render : string write VRender;                // Defines the render of the menu - '' for no render. Errors by misuse not controlled!
    end;

function SplitAtChar(const S : string; const CH : char = ' ') : TStrArr;


implementation

function SplitAtChar(const S : string; const CH : char = ' ') : TStrArr;
(* Splits a string by a char, returning the substrings, without the char, in a dynamic array of strings. *)
var i : integer;
   t : string = '';
begin
   SetLength(SplitAtChar, 0);
   for i := 1 to length(S) do begin
       if (S[i] = CH) or (i = length(S)) then begin
           SetLength(SplitAtChar, length(SplitAtChar)+1);
           SplitAtChar[high(SplitAtChar)] := t + IfThen(i = length(S), s[i], '');
           t := '';
       end else begin
           t := t + s[i];
       end;
   end;
end;

constructor TMenu.Create(mysorted : boolean = false);
(* Initialize the variants of the class *)
begin
   inherited Create;
   SetLength(self.VMenu, 0);
   self.VKeys := [];
   self.VSorted := mysorted;
   self.VRender := '';
   self.VMaxLength := 0;
end;

procedure TMenu.Sort;
(* Sorts the menu by keys in a second variant, "VMenuSorted". *)
var temp : TOption;
   i, j : integer;
begin
   self.VMenuSorted := self.VMenu;
   for i := 0 to high(self.VMenuSorted)-1 do
       for j := i to high(self.VMenuSorted) do
           if self.VMenuSorted[i].key > self.VMenuSorted[j].key then begin
               temp := self.VMenuSorted[i];
               self.VMenuSorted[i] := self.VMenuSorted[j];
               self.VMenuSorted[j] := temp;
           end;
end;

procedure TMenu.Add(myprompt : string; mykey : char; myproc : TProc);
(* Add a new item to the menu. *)
begin
   SetLength(self.VMenu, length(self.VMenu)+1);
   with self.VMenu[high(self.VMenu)] do begin
       prompt := myprompt;
       if self.VMaxLength < length(myprompt) then
           self.VMaxLength := length(myprompt);
       key := mykey;
       Include(self.VKeys, mykey);
       action := myproc;
   end;
end;

procedure TMenu.Show(title : string = '');
(* Displays the menu with the renderer. *)
var menu_to_show : TOptList;
   option : TOption;
   renderer : TStrArr;
   r : string;
   i : integer;
   maxlen : word;
begin
   if self.VSorted then begin
       self.Sort;
       menu_to_show := self.VMenuSorted;
   end else
       menu_to_show := self.VMenu;

   if self.VRender <> '' then begin  // we have renderer
       // Gets the renderers:
       renderer := SplitAtChar(self.VRender, '§');

       // Recalculate the maximum length, given the renderer:
       maxlen := VMaxLength;
       if length(title) > maxlen then begin
           for r in renderer do
               if AnsiContainsText(r, '#TITLE') then begin
                   inc(maxlen, length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#TITLE', '')));
                   break;
               end;
       end else begin
           for r in renderer do
               if AnsiContainsText(r, '#OPTION') then begin
                   inc(maxlen, length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#OPTION', '')));
                   break;
               end;
       end;

       // displays the menu with the application of the renders:
       for r in renderer do begin
           if AnsiContainsText(r, '#TITLE') then
               writeln(AnsiReplaceText(AnsiReplaceText(r, '#TITLE', IfThen(AnsiContainsText(r, '@CENTER'), PadCenter(title, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#TITLE', ''))), PadRight(title, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#TITLE', ''))))), '@CENTER', ''))
           else if AnsiContainsText(r, '#OPTION') then
               for option in menu_to_show do
                   writeln(AnsiReplaceText(AnsiReplaceText(r, '#OPTION', IfThen(AnsiContainsText(r, '@CENTER'), PadCenter(option.prompt, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#OPTION', ''))), PadRight(option.prompt, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#OPTION', ''))))), '@CENTER', ''))
           else begin
               write(r[1]);
               for i:=2 to maxlen-1 do
                   write(r[2]);
               writeln(r[3]);
           end;
       end;

   end else begin // we have no renderer... simple output
       if title <> '' then
           writeln(title);
       for option in menu_to_show do
           writeln(option.prompt);
   end;
end;

function TMenu.GetChoice(performAction : boolean = true) : char;
(* Waits for the user's option. *)
var option : TOption;
begin
   repeat
       GetChoice := upcase(ReadKey);
   until GetChoice in self.VKeys;

   if performAction then
       for option in self.VMenu do
           if GetChoice = option.key then begin
               if option.action <> nil then
                   option.action;
               break;
           end;
end;

end.

Exemplo de aplicação:

{$mode objfpc}
program apostas;
uses crt, sysutils, strutils, thoga31;

procedure Pause;
(* Pauses the program until ENTER is pressed *)
begin
   repeat
   until readkey = sys.KEY_ENTER;
end;

procedure Totoloto;
begin
   clrscr;
   writeln('TOTOLOTO');
   Pause;
   clrscr;
end;

procedure Euromillions;
begin
   clrscr;
   writeln('EUROMILLIONS');
   Pause;
   clrscr;
end;


const EXIT_OPTION = #27;
var main_menu : TMenu;

begin
   main_menu := TMenu.Create();
   with main_menu do begin
       Add('  1 > Totoloto', '1', @Totoloto);
       Add('  2 > Euromillions', '2', @Euromillions);
       Add('ESC > Exit', EXIT_OPTION, nil);
       render := '+-+§| #TITLE@CENTER |§+-+§| #OPTION |§+-+';
   end;

   repeat
       main_menu.Show('Choose an option:');
   until main_menu.GetChoice = EXIT_OPTION;

   main_menu.destroy;
end.

Output do menu com rendering:

+--------------------+
|  Choose an option: |
+--------------------+
|   1 > Totoloto     |
|   2 > Euromillions |
| ESC > Exit         |
+--------------------+

Explicação do rendering:

main_menu.render := '+-+§| #TITLE@CENTER |§+-+§| #OPTION |§+-+';

Será mais fácil ver isto separado por linhas (caracter §):

+-+
| #TITLE@CENTER |
+-+
| #OPTION |
+-+

O método Show vai analisar cada linha do render e executa uma série de acções conforme o seu conteúdo.

• 1ª, 3ª e 5ª linhas, +-+: se não há #TITLE nem #OPTION, terá de ter obrigatoriamente 3 caracteres! Neste caso, o primeiro e o último são os caracteres das pontas, e o caracter do meio é repetido até ao comprimento máximo, definido pelo título e/ou pelo item do menu mais comprido.
  
• 2ª linha, | #TITLE@CENTER |: entre #TITLE e @CENTER não deverá haver espaços nem outros caracteres. Neste caso #TITLE@CENTER é substituído pelo título do menu e centrado conforme o comprimento máximo, descrito no ponto anterior. Defini esta sintaxe pois lê-se mesmo "title at center".
  
• 4ª linha, | #OPTION |: é substituído pelas opções todas, uma por linha. Não é possível criar separadores entre opções.
  

Usem e modifiquem a classe para ficar melhor.

O que acham? Reconheço que este não é dos meus melhores códigos, mas é um princípio

Saudações pascalianas!

Edited December 5, 2014 by thoga31