program menu;

uses
  crt, dos;

const
{ klavesy: }
  klEnter  = 13;                { ascii kody, primo }
  klEsc    = 27;

  klNahoru = 72;                { rozsirene kody, 0 + kod }
  klDolu   = 80;
  klHome   = 71;
  klEnd    = 79;

{ barvy: }
  bPozadi   = black;            { barva pozadi programu }
  bMPozadi1 = cyan;             { barva pozadi nevybraneho textu v menu }
  bMPozadi2 = black;            { barva pozadi vybraneho textu v menu }
  bMText1   = black;            { barva nevybraneho textu v menu }
  bMText2   = cyan;             { barva vybraneho textu v menu }
  bInfoPoz  = lightgray;        { barva pozadi informacniho pruhu }
  bInfoText = red;              { barva textu informacniho pruhu }

  PocetPolozek    = 5;          { pocet polozek (radku) menu }
  MaxDelkaPolozky = 30;         { maximalni delka retezce jedne polozky menu }

type
  TPolozka = string[MaxDelkaPolozky];

const
  MenuText: array[1..PocetPolozek] of TPolozka
          = ('Prvni polozka',
             'Druha polozka',
             'Treti polozka',
             'Ctvrta polozka',
             'Pata polozka');

var
  pozX, pozY: integer;  { pozice leveho horniho rohu na obrazovce }
  vybrano:    byte;     { aktivni polozka, ktera je v seznamu vybrana }

  zn: char;             { promenna pro nacitani klaves }


procedure VykresliPolozku(ktera: byte; vybrana: boolean);
{ vykresli retezec jedne polozky, druhy parametr urcuje, zda ma byt vysvicena }
begin
  window(pozx, pozy+ktera-1, pozx+MaxDelkaPolozky-1, pozy+ktera-1);
  if vybrana then begin
    textbackground(bMPozadi2);
    textcolor(bMText2);
  end else begin
    textbackground(bMPozadi1);
    textcolor(bMText1);
  end;
  clrscr;       { tento prikaz se tyka pouze okna definovaneho
                  procedurou window o nekolik radku vyse }
  write(MenuText[ktera]);
end;

procedure SchovejKurzor;
{ uschova blikajici kurzor mimo obrazovku, kodu procedury si netreba vsimat }
var r: Registers;
begin
  with r do begin
    ah := 2;
    bh := 0;
    dh := 25;
    dl := 0;
  end;
  Intr($10, r);
end;

procedure Init;
{ inicializace obrazovky, vykresleni vsech potrebnych okynek, obsahuje
  dve vnorene procedury viditelne a pouzitelne pouze v teto procedure }
var i: byte;

  procedure KresliRamecek;
  { vnorena v procedure Init, vykresli vnejsi ramecek pro menu }
  var i: byte;
  begin
    textbackground(bMPozadi1);
    textcolor(bMText1);
    gotoxy(pozx-1, pozy-1);
    write('É');
    for i := 1 to MaxDelkaPolozky do write('Í');
    write('»');
    for i := 0 to PocetPolozek-1 do begin
      gotoxy(pozx-1, pozy+i);
      write('ş');
      gotoxy(pozx+MaxDelkaPolozky, pozy+i);
      write('ş');
    end;
    gotoxy(pozx-1, pozy+PocetPolozek);
    write('Č');
    for i := 1 to MaxDelkaPolozky do write('Í');
    write('Ľ');
  end;

  procedure KresliInfo;
  { vnorena v procedure Init, vykresli informacni pruh dole na obrazovce }
  begin
    window(1,25,80,25);
    textbackground(bInfoPoz);
    textcolor(bInfoText);
    write('  Pohyb mezi polozkami     ENTER Vybrat polozku a skoncit     ESC Skoncit');
    clreol;
  end;

begin
  textbackground(bPozadi);
  clrscr;
  textbackground(bMPozadi1);
  textcolor(bMText1);
  write('                      Jednoduche menu v textovem rezimu');
  clreol;

  pozx := (80-MaxDelkaPolozky) div 2;
  pozy := (25-PocetPolozek) div 2 -1;
  vybrano := 1;

  KresliRamecek;
  KresliInfo;

  VykresliPolozku(1, true);   { prvni polozka je na zacatku vybrana }
  for i := 2 to PocetPolozek do VykresliPolozku(i, false);
  SchovejKurzor;
end;


procedure Done(kod_konce: byte);
{ smaze obrazovku, uklidi ji a ukonci cely program procedurou halt, ktera
  jako svuj parametr muze mit navratovy kod programu. Tento kod se v ope-
  racnim systemu DOS ulozi do systemove promenne ErrorLevel, odkud ho lze
  po ukonceni programu ziskat }
begin
  window(1,1,80,25);
  textbackground(black);
  textcolor(lightgray);
  clrscr;
  halt(kod_konce);
end;

procedure Nahoru;
{ zajisti pohyb v menu o polozku vyse, pokud je na prvni, pak se presune
  na posledni polozku menu }
var nova: byte;
begin
  if vybrano > 1 then nova := vybrano-1
                 else nova := PocetPolozek;
  VykresliPolozku(vybrano, false);
  VykresliPolozku(nova, true);
  SchovejKurzor;
  vybrano := nova;
end;

procedure Dolu;
{ zajisti pohyb v menu o polozku nize, pokud je na posledni, pak se presune
  na prvni polozku menu }
var nova: byte;
begin
  if vybrano < PocetPolozek then nova := vybrano+1
                            else nova := 1;
  VykresliPolozku(vybrano, false);
  VykresliPolozku(nova, true);
  SchovejKurzor;
  vybrano := nova;
end;

procedure PrvniPolozka;
{ presun na prvni polozku menu }
begin
  if vybrano <> 1 then begin
    VykresliPolozku(vybrano, false);
    VykresliPolozku(1, true);
    SchovejKurzor;
    vybrano := 1;
  end;
end;

procedure PosledniPolozka;
{ presun na posledni polozku menu }
begin
  if vybrano <> PocetPolozek then begin
    VykresliPolozku(vybrano, false);
    VykresliPolozku(PocetPolozek, true);
    SchovejKurzor;
    vybrano := PocetPolozek;
  end;
end;

begin  { hlavni program }
  Init;
  repeat
    zn := readkey;
    case ord(zn) of
      klEnter: Done(vybrano);
      klEsc:   Done(0);
      0: begin
        zn := readkey;
        case ord(zn) of
          klNahoru: Nahoru;
          klDolu:   Dolu;
          klHome:   PrvniPolozka;
          klEnd:    PosledniPolozka;
        end;
      end;
    end;
  until false;
end.