unit menu_1_1;
{Реализация меню игры}
{Автор: Коновалов Кирилл 3ВТИ-1ДБ-123, 18.05.2005}
interface
uses crt,graph;
const button_h=20;        {Высота кнопки}
      button_w=160;       {Ширина кнопки}
type pitem=^titem;        {Указатель на элемент меню}
     titem=record
        key:string;       {Ключевое слово}
        code:integer;     {Возвращаемый код}
        active:boolean;   {Признак активности}
        x,y:integer;      {Координаты для вывода}
        prev,next:pitem;  {Указатели на предыдущий и следующий элементы}
     end;
     pmenu=^tmenu;        {Указатель на меню}
     tmenu=record
        head:pitem;       {Указатель на первый элемент}
        x0,y0:integer;    {Координаты для вывода очередного элемента}
     end;
var
   m:pmenu;
   cod:integer;
   i:byte;
function init(xn,yn:byte):pmenu;
{Инициализация меню с заданными координатами вывода}
procedure add(newkey:string; newcode:integer; var p:pmenu);
{Добавление в меню P нового элемента с ключевым словом newkey и возвращаемым кодом newcode}
procedure show(p:pmenu);
{Отображение меню P на экране}
function choice(p:pmenu):integer;
{С помощью управляющих клавиш выбрать необходимый пункт и с помощью клавиши Enter
вернуть значение кода}
procedure done(var p:pmenu);
{Уничтожение меню из памяти}
procedure showmenu;
{Показ меню}
implementation
function init;
var p:pmenu;
begin {init}
     new(p);
     with p^ do
          begin
               head:=nil;
               x0:=xn;
               y0:=yn
          end;
     init:=p
end;  {init}
procedure add;
var pnew,cur:pitem;
begin {add}
     new(pnew);
     with pnew^ do
          begin
               key:=newkey;
               code:=newcode;
               active:=false;
               x:=p^.x0;
               y:=p^.y0;
               inc(p^.y0,button_h+8);         {Изменение координат вывода}
               next:=nil;
          end;
     with p^ do
          if head=nil then                     {Первый элемент}
             begin
                  head:=pnew;
                  pnew^.active:=true;
                  pnew^.prev:=nil;
             end
          else                                 {Не первый элемент}
              begin
                   cur:=head;
                   while cur^.next<>nil do cur:=cur^.next;
                   cur^.next:=pnew;
                   pnew^.prev:=cur;
              end;
end;  {add}
procedure showitem(cur:pitem; p:pmenu);
var oldtext:integer;
procedure button(x,y:integer;st:string;active:boolean);
{Рисование кнопки}
var i:byte;
begin {button}
     setcolor(0);
     if active then
        begin
             setfillstyle(1,green);
             bar(x-3,y-3,x+button_w+3,y+button_h+3);
             setfillstyle(1,0);
             bar(x-1,y-1,x+button_w+1,y+button_h+1)
        end
     else
         begin
              setfillstyle(1,0);
              bar(x-3,y-3,x+button_w+3,y+button_h+3)
         end;
     bar(x,y,x+button_w,y+button_h);
     settextstyle(0,0,1);
     setfillstyle(1,7);
     settextjustify(1,0);
     bar(x,y,x+button_w,y+button_h);
     setcolor(1);
     settextjustify(1,1);
     settextstyle(0,0,1);
     while textwidth(st)>button_w do st:=copy(st,1,length(st)-1);
     outtextxy(x+(button_w div 2),y+1+(button_h div 2),st);
end;  {button}
begin {showitem}
     oldtext:=getcolor;
     with cur^ do button(x,y,key,active);
     setcolor(oldtext);
end;  {showitem}
procedure show;
var p1:pitem;
begin {show}
      p1:=p^.head;
      while p1<>nil do
            begin
                 showitem(p1,p);
                 p1:=p1^.next;
            end;
end;  {show}
function choice;
const enter=#13;
      kbup=#72;
      kbdown=#80;
var act,cur:pitem; ok:boolean; ch:char;
begin {choice}
      cur:=p^.head;
      while not cur^.active do                 {Поиск активного элемента}
            cur:=cur^.next;
      act:=cur;
      ok:=false;
      repeat
            ch:=readkey;
            if ch=enter then ok:=true          {Пункт выбран}
            else if ch=#0 then                 {Перемещение по меню}
                 begin
                      ch:=readkey;
                      if (ch=kbdown) and (act^.next<>nil) then
                         begin
                              act^.active:=false;
                              showitem(act,p);
                              act:=act^.next;
                              act^.active:=true;
                              showitem(act,p);
                         end
                      else if (ch=kbup) and (act^.prev<>nil) then
                           begin
                                act^.active:=false;
                                showitem(act,p);
                                act:=act^.prev;
                                act^.active:=true;
                                showitem(act,p);
                           end
                 end;
      until ok;
      choice:=act^.code;
end;  {choice}
procedure done;
var cur:pitem;
begin {done}
      with p^ do
           while head<>nil do
                 begin
                      cur:=head;
                      head:=head^.next;
                      dispose(cur);
                 end;
           dispose(p);
end;  {done}
procedure showmenu;
var a:string;
begin {showmenu}
     setbkcolor(blue);
     setcolor(white);
     settextjustify(1,1);
     outtextxy(320,116,'ШАРИКИ');
     outtextxy(320,446,'Автор: Апарин Олег,  3АСУ-1ДС-145,  2007');
     show(m);
end;  {showmenu}
end.