PasMenu

{$MODE OBJFPC}
unit PasMenu;

interface

type
  TMenuAction = procedure;
  TTitleRenderer = procedure(t: string);
  TItemRenderer  = procedure(t: string; i: integer);
  TMenuEntry = record
    title: string;
    proc:  TMenuAction;
  end;
  TMenu = record
    title: string;
    items: array of TMenuEntry;
    internal: record
      TitleRenderer: TTitleRenderer;
      ItemRenderer:  TItemRenderer;
    end;
  end;

procedure MenuSetup(var menu: TMenu; title: string);
procedure MenuRender(var m: TMenu);
procedure MenuChoose(var m: TMenu);
procedure MenuAddItem(var m: TMenu; title: string; action: TMenuAction);
procedure MenuSetTitleRenderer(var m: TMenu; renderer: TTitleRenderer);
procedure MenuSetItemRenderer(var m: TMenu; renderer: TItemRenderer);

implementation

procedure MenuRenderTitle(title: string);
begin
  WriteLn(title);
end;

procedure MenuChoose(var m: TMenu);
var
  s: string;
  e, i: integer;
begin
  repeat
    write('> ');
    readln(s);
    val(s, i, e);
  until (e <= 0) and (i >= 0);
  if (i <> 0) then
    m.items[pred(i)].proc();
end;

procedure MenuAddItem(var m: TMenu; title: string; action: TMenuAction);
begin
  setlength(m.items, succ(length(m.items)));
  m.items[pred(length(m.items))].title := title;
  m.items[pred(length(m.items))].proc  := action;
end;

procedure MenuRenderItem(title: string; number: integer);
begin
  WriteLn(number, '. ', title);
end;

procedure MenuRender(var m: TMenu);
var
  i: integer;
begin
  m.internal.TitleRenderer(m.title);
  for i := 0 to pred(length(m.items)) do
    m.internal.ItemRenderer(m.items[i].title, succ(i));
end;

procedure MenuSetup(var menu: TMenu; title: string);
begin
  menu.title := title;
  menu.internal.TitleRenderer := @MenuRenderTitle;
  menu.internal.ItemRenderer  := @MenuRenderItem;
end;

procedure MenuSetTitleRenderer(var m: TMenu; renderer: TTitleRenderer);
begin
  if renderer = nil then
    m.internal.TitleRenderer := @MenuRenderTitle
  else
    m.internal.TitleRenderer := renderer;
end;

procedure MenuSetItemRenderer(var m: TMenu; renderer: TItemRenderer);
begin
  if renderer = nil then
    m.internal.ItemRenderer := @MenuRenderItem
  else
    m.internal.ItemRenderer := renderer;
end;

end.