(**************************************************************************)
(*  Tento program je urcen k vypisu obsahu souboru na obrazovku. Umoznuje *)
(* - posouvani textu pomoci sipek nahoru a dolu o jeden radek             *)
(* - posouvani textu po strankach pomoci klaves PageUp a PageDown         *)
(* - presun na zacatek nebo konec souboru pomoci klaves Home a End        *)
(* Program konci stisknutim klavesy ESC nebo ENTER.                       *)
(* Jestlize je delka radku v souboru delsi nez 79 znaku, program z tohoto *)
(* radku nacte pouze prvnich 79 znaku, zbytek radku ignoruje.             *)
(**************************************************************************)

program vypis;

uses
  crt, dos;

const
  klUp     = 72;  { kody neznakovych klaves, nutno nejdrive nacist cislo 0 }
  klDown   = 80;
  klHome   = 71;
  klEnd    = 79;
  klPgUp   = 73;
  klPgDown = 81;

  klEsc   = #27;  { znakove klavesy ESC a ENTER, primo typ char }
  klEnter = #13;

type
  rad = string[79];    { jeden radek textu }

const
  MaxPocet     = 100;  { maximalni pocet zobrazenych radku }
  MaxZobrazeno =  23;  { maximalni pocet radku, ktere lze najednou zobrazit }

var
  p: array[1..MaxPocet] of ^rad;  { promenna na ulozeni textu }
  PocetRadku: word;               { pocet nactenych radku textu }
  Prvni:      word;               { prvni zobrazeny radek }
  nazev:      string;             { nazev souboru }
  zn: char;                       { promenna pro nacitani klaves }


procedure SchovejKurzor;
{ procedura pro zneviditelneni kurzoru jeho nastavenim na nulovou velikost,
  pouzije se pouze jednou }
var
  r: Registers;
begin
  with r do begin
    ah := 1;
    ch := $20;
    cl := $1F;
  end;
  Intr($10, r);
end;

procedure ZobrazStranku;
{ procedura na zobrazeni jedne stranky textu na obrazovce }
var
  Posledni, i: word;
begin
  if PocetRadku <= (Prvni + MaxZobrazeno-1) then
    Posledni := PocetRadku
  else                            { vypocteme, ktere radky se zobrazi }
    Posledni := Prvni + MaxZobrazeno -1;

  for i := Prvni to Posledni do
    writeln(p[i]^);
end;


procedure inicializace;
{ procedura provede nacteni obsahu souboru, upravi obrazovku a vypise
  prvni stranku }

  procedure NactiSoubor;
  { vnorena procedura, nacte nazev souboru, otevre ho, nacte jeho obsah
    a soubor uzavre }
  var
    f: text;
    i: word;
    pokusy: byte;
  begin
    PocetRadku := 0;
    pokusy := 0;

    repeat
      if (pokusy > 5) then begin
        writeln;
        write('Pocet pokusu o zadani souboru prekrocil unosnou mez (5 souboru),'
               + #13#10'proto koncim.');
        readln;
        halt;
      end;
      clrscr;
      write('Zadejte nazev souboru (cela cesta): ');
      readln(nazev);
      inc(pokusy);
      assign(f, nazev);
      {$I-}
      reset(f);
      {$I+}
    until (IOResult = 0);

    while (not eof(f)) and (PocetRadku < MaxPocet) do begin
      inc(PocetRadku);
      New(p[PocetRadku]);
      readln(f, p[PocetRadku]^);
    end;
    close(f);

    if PocetRadku = 0 then begin
      PocetRadku := 1;
      New(p[1]);
      p[1]^ := 'Soubor je prazdny';
    end;

    if PocetRadku < MaxPocet then
      for i := PocetRadku+1 to MaxPocet do p[i] := nil;
  end;

begin  { procedure inicializace }
  NactiSoubor;
  window(1,1,80,1);
  textcolor(white);
  textbackground(blue);
  clrscr;
  write('Soubor:   ', nazev);

  window(1,2,80,25);
  textcolor(lightcyan);
  textbackground(black);
  clrscr;

  Prvni := 1;
  ZobrazStranku;
  SchovejKurzor;
end;

procedure konec;
{ procedura provede uklid obrazovky, je volana pred ukoncenim programu }
var
  i: word;
begin
  if PocetRadku > 0 then
    for i := 1 to PocetRadku do
      Dispose(p[i]);

  window(1,1,80,25);
  textcolor(lightgray);
  textbackground(black);
  clrscr;
end;


procedure Nahoru;
{ reakce na stisknuti klavesy sipka nahoru, posune text o 1 radek nahoru }
begin
  if Prvni > 1 then begin
    dec(Prvni);
    ZobrazStranku;
  end;
end;

procedure Dolu;
{ reakce na stisknuti klavesy sipka dolu, posune text o 1 radek dolu }
begin
  if PocetRadku >= (Prvni+MaxZobrazeno) then begin
    inc(Prvni);
    ZobrazStranku;
  end;
end;

procedure StrNahoru;
{ reakce na stisknuti klavesy PgUp, posune text o stranku nahoru }
begin
  if Prvni > 1 then begin
    if (Prvni > MaxZobrazeno) then dec(Prvni, MaxZobrazeno)
                              else Prvni := 1;
    ZobrazStranku;
  end;
end;

procedure StrDolu;
{ reakce na stisknuti klavesy PgDown, posune text o stranku dolu }
begin
  if PocetRadku >= (Prvni + MaxZobrazeno) then begin
    inc(Prvni, MaxZobrazeno);
    ZobrazStranku;
  end;
end;

procedure NaZacatek;
{ reakce na stisknuti klavesy Home, zobrazi se prvni stranka textu }
begin
  if (Prvni > 1) and (PocetRadku > MaxZobrazeno) then begin
    Prvni := 1;
    ZobrazStranku;
  end;
end;

procedure NaKonec;
{ reakce na stisknuti klavesy END, zobrazi se posledni stranka textu }
begin
  if (PocetRadku > MaxZobrazeno) then begin
    Prvni := PocetRadku + 1 - MaxZobrazeno;
    ZobrazStranku;
  end;
end;


begin  { hlavni program }
  inicializace;
  repeat
    zn := readkey;
    if zn = #0 then begin
      zn := readkey;
      case ord(zn) of
        klUp:     Nahoru;
        klDown:   Dolu;
        klHome:   NaZacatek;
        klEnd:    NaKonec;
        klPgUp:   StrNahoru;
        klPgDown: StrDolu;
      end;
    end;
  until zn in [klEsc, klEnter];
  konec;
end.