unit menuunit;

interface
type
   tdatafunc = function (i : integer; var optional;
                         var finished : boolean) : string;

function menu (py, height : integer;
               searchfunc : tdatafunc;
               var optional) : integer;

implementation
uses Crt;

const
   maxitems = 1000;
type
   stringptr = ^string;
   psptrarray = ^sptrarray;
   sptrarray = array[1 .. maxitems] of stringptr;

function min(A, B : Integer) : Integer;
begin
   if A < B then min := A else min := B
end;

function init (f : tdatafunc; var optional;
               var count : Integer) : psptrarray;
var
   b : boolean;
   s : string;
   p : psptrarray;
begin
   new (p);
   count := 0;
   repeat
      inc (count);
      s := f (count, optional, b);
      if s <> '' then
      begin
         new (p^[count]);
         p^[count]^ := s;
      end;
   until b;
   init := p;
end;

procedure done (p : psptrarray; count : integer);
var i : integer;
begin
   for i := 1 to count do
      dispose (p^[i]);
   dispose (p);
end;

function menu (py, height : Integer;
               searchfunc : tdatafunc;
               var optional) : Integer;

var
   p : psptrarray;
   count : integer;

   function WhereY : Integer;
   begin
      WhereY := Crt.WhereY - py;
   end;

   var
      scrolled_up : integer;

   procedure SetLine (index : Integer);
   begin
      TextAttr := White + 16 * Red;
      GotoXY (1, py + index);
      write (p^[scrolled_up + index]^);
      ClrEOL;
   end;
   procedure ResetLine (index : integer);
   begin
      TextAttr := LightGray + 16 * Black;
      GotoXY (1, py + index);
      write (p^[scrolled_up + index]^);
      ClrEOL;
   end;

   procedure DrawLines;
   var i : Integer;
   begin
      for i := 1 to min (height, Pred (count)) do
      begin
         ResetLine (i);
      end;
   end;

var
   i, menu_result : Integer;
   ch : Char;
begin
   p := init (searchfunc, optional, count);

   for i := 0 to height - 1 do
   begin
      GotoXY (1, py + i); ClrEOL;
   end;

   scrolled_up := 0;
   DrawLines;
   menu_result := 1;

   SetLine (menu_result);
   repeat

      ch := ReadKey;
      case ch of
         #0 :
         { Extended Case }
         case ReadKey of
            #72 : { up }
            begin
               if WhereY > 1 then
               begin
                  ResetLine (WhereY);
                  Dec (menu_result);
                  SetLine (WhereY - 1);
               end
               else
                  if scrolled_up > 0 then
                  begin
                     Dec (scrolled_up);
                     DrawLines;
                     Dec (menu_result);
                     SetLine(1);
                  end;
            end;
            #80 : { dn }
            begin
               if count - 1 > height then
               begin
                  if WhereY < height then
                  begin
                     ResetLine (WhereY);
                     Inc (menu_result);
                     SetLine (WhereY + 1);
                  end
                  else
                     if menu_result < count then
                     begin
                        ResetLine (height);
                        Inc (scrolled_up);
                        DrawLines;
                        Inc (menu_result);
                        SetLine (height);
                     end;
               end
               else
                  if WhereY < count - 1 then
                  begin
                     ResetLine (WhereY);
                     Inc (menu_result);
                     SetLine (WhereY + 1)
                  end;
            end;
         end; { Extended Case }
      end; { case }

   until ch = #13;
   TextAttr := LightGray + 16 * Black;
   done (p, pred (count));
   menu := menu_result;
end;

end.