(*******************************************************)
       (* Zjisteni udaju o pointeru na prvek dynamickeho pole *)
       (*******************************************************)

program DemoDDS5;
uses CRT;

const
  MaxDelkaPole = 10000;

  KlDoprava = 77;   {0+}
  KlDoleva  = 75;   {0+}
  KlESC     = 27;
  KlEnter   = 13;

type
  TPole = array[1..MaxDelkaPole] of integer;

var
  PPole: ^TPole;       { PPole je pointer na typ TPole, dynamicke pole }
  Aktivni: ^integer;   { prvek pole PPole, se kterym momentalne pracujeme }
  IndexA: word;        { index zachycujici aktivni prvek pole }
  zn: char;

procedure VypisDataPointeru;
{ pomocna procedura; vypisuje na obrazovku momentalni stav pointeru Aktivni:
  - adresu, kterou obsahuje (kam ukazuje)
  - hodnotu, ktera je na teto adrese ulozena (typu integer) }
var
  segx,ofsx: word;
begin
  { Hodnota pointeru Aktivni: }
  gotoxy(35,17);           { umistime kurzor na obrazovce }
  write('              '); { pokud na tomto miste uz neco bylo, vymazeme to }
  segx := Seg(Aktivni^);
  ofsx := Ofs(Aktivni^);
  gotoxy(35,17);
  if (segx = 0) and (ofsx = 0) then write('nil')
                               else write(segx,':',ofsx);
  gotoxy(35,18);
  write('              ');
  { Adresa pointeru Aktivni: }
  gotoxy(35,18); write( Seg(Aktivni), ':', Ofs(Aktivni));

  gotoxy(35,21); write('              ');
  gotoxy(35,20); write('              ');
  if Aktivni<>nil then begin
    { Hodnota dynamicke promenne, na kterou ukazuje Aktivni: }
    gotoxy(35,20);
    write(Aktivni^);
    { Adresa dynamicke promenne, na kterou ukazuje Aktivni: }
    gotoxy(35,21);
    write(Seg(Aktivni^),':',Ofs(Aktivni^));
  end;
  { adresa pointeru se sklada ze dvou casti: segmentu a offsetu.
    Segment: operacni pamet (RAM) je rozdelena na casti, segmenty
    Offset: v kazdem segmentu je pamet razena "za sebou"
      a offset udava, jak daleko (kolik B) je dane misto v pameti vzdaleno
      od zacatku prislusneho segmentu
    funkce Seg(x) vraci segment adresy promenne x (musime se na ni dostat ^)
    funkce Ofs(x) vraci offset adresy promenne x }
  gotoxy(1,1); { odsuneme kurzor do leveho horniho rohu obrazovky }
end;

procedure AlokovatPole;
begin
  if (PPole = nil) and (MaxAvail > MaxDelkaPole) then begin
  { pokud je pointer PPole zaparkovany - volny a pokud je dost pameti }
    New(PPole);
    Aktivni := @ PPole^[1];
    IndexA := 1;
    VypisDataPointeru;  { vypiseme vse, co vime o pointeru Aktivni }

    gotoxy(55,18); write(MaxAvail:10);
    gotoxy(55,21); write(MemAvail:10);
    gotoxy(1,1);
  end;
end;

procedure UvolnitPole;
begin
  if PPole<>nil then begin    { uvolneny pointer uz nemuzeme uvolnit }
    Dispose(PPole);
    PPole := nil;             { zaparkujeme vsechny pointery }
    Aktivni := nil;

    { vymazeme z obrazovky vsechny informace o pointeru PInt: }
    VypisDataPointeru;
    gotoxy(55,18); write(MaxAvail:10);
    gotoxy(55,21); write(MemAvail:10);
    gotoxy(1,1);
  end;
end;

procedure NacistHodnotu;
begin
  if Aktivni <> nil then begin
    gotoxy(35,20);
    write('             ');{ pokud je tam neco napsano, vymazeme to }
    gotoxy(35,20);    { nacteme hodnotu }
    read(Aktivni^);   { na misto, kam ukazuje pointer Aktivni, nacteme cislo }
    gotoxy(1,1);      { umistime kurzor do leveho horniho rohu }
  end;
end;

procedure PosunoutDal;
begin
  if (Aktivni <> nil) and (IndexA < MaxDelkaPole) then begin
  { muzeme se pohybovat jen v te pameti, ktera nam patri }
  { nejdriv otestujeme, jestli muzeme PInt pouzivat, potom teprve porovnavame }
     inc(Aktivni);    { posuneme se o 1 prvek (2 B) dale v pameti }
     inc(IndexA);     { IndexA zachycuje, kde v poli prave jsme }
     VypisDataPointeru;
   end;
end;

procedure PosunoutZpet;
begin
  if (Aktivni <> nil) and (IndexA > 1) then begin
  { muzeme se pohybovat jen v te pameti, ktera nam patri }
  { nejdriv otestujeme, jestli muzeme PInt pouzivat, potom teprve porovnavame }
     dec(Aktivni);    { posuneme se o 1 prvek (2 B) zpet v pameti }
     dec(IndexA);
     VypisDataPointeru;
   end;
end;

procedure VypisMenu;
begin
  TextColor(YELLOW);
  clrscr;
  writeln;
  writeln('                      ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  writeln('                      ş   Pr ce s dynamickěm polem   ş');
  writeln('                      ş  a pointerem do tohoto pole  ş');
  writeln('                      ČÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍĽ');

  writeln;
  writeln('              Alokovat pole ................................. a');
  writeln('              Uvolnit pole .................................. u');
  writeln('              Nacist hodnotu tam, kam ukazuje pointer ......Enter');
  writeln('              Posunout pointer v poli dal ................... Ż');
  writeln('              Posunout pointer v poli zpet .................. ®');
  writeln('              Konec .........................................ESC');
  TextColor(WHITE);
  writeln; writeln;
  writeln('                    Pointer Aktivni:');
  writeln;
  writeln('      Hodnota pointeru:');
  writeln('      Adresa pointeru:');
  writeln;
  writeln('      Hodnota dynamick‚ promŘnn‚:');
  writeln('      Adresa dynamick‚ promŘnn‚:');

  gotoxy(52,17); write('Volně prostor v Heapu:');
  gotoxy(55,18); write(MaxAvail:10);
  gotoxy(52,20); write('Nejdelçˇ volně blok:');
  gotoxy(55,21); write(MemAvail:10);
  VypisDataPointeru;
end;

begin
  PPole := nil;
  TextBackground(BLUE);
  VypisMenu;
  repeat
    zn := readkey;            { nacteme stisknutou klavesu a pak ji testujeme }
    if ord(zn) = 0 then begin { stisknuta sipka doprava nebo sipka doleva }
      zn := readkey;
      case ord(zn) of
        KlDoleva:  PosunoutZpet;
        KlDoprava: PosunoutDal;
      end;
    end else
      case zn of
        'a': AlokovatPole;
        'u': UvolnitPole;
        chr(KlEnter): NacistHodnotu;
      end;
  until ord(zn) = KlESC;

  if PPole <> nil then Dispose(PPole);
  TextBackground(BLACK);   { uklidime prostredi DOSu }
  TextColor(WHITE);
  clrscr;
end.