Textový editor na tvorbu hudby pre speaker v pascale pre pascal

{ SOUNDER.PAS         Copyright (c) Tibor Kulcar & TrSek alias Zdeno Sekerak }
{ Program sluzi na editaciu a vytvarania zvukovych efektov                   }
{                                                                            }
{ PODAKOVANIE:                                                               }
{ Aspon takto by som chcel podakovat spoluautorovi Tiborovi za to, ze        }
{ program vobec existuje. Povodne bol jeho dielom. Ako autor som sa dovolil  }
{ pripisat preto, ze som urobil viacej hlavne vizualnych a GUI uprav.        }
{                                                                            }
{ Datum:01.05.2000                                      http://www.trsek.com }
 
{$M 21192,0,55360}
Program Sounder;
Uses crt,dos,trsek;
 
Const
  Max_noty = 1600;
  noty:array[0..23] of word=
      (0,67,78,87,98,110,124,131,147,165,175,196,220,247,262,294,330,
      349,392,440,494,523,587,659);
 
  textnoty:array[1..23] of string=
      ('d2','e2','f2','g2','a2','h2','c3','d3','e3','f3','g3','a3','h3',
       'c4','d4','e4','f4','g4','a4','h4','c5','d5','e5');
 
  wiew:array[1..8] of string=
      (' Help                   (F1) ',
       ' Save                   (F2) ',
       ' Load                   (F3) ',
       ' Clean                  (F4) ',
       ' Cela skladba           (F5) ',
       ' Hra tuto stranu        (F6) ',
       ' Rychlost hrania        (F9) ',
       ' Exit                  (ESC) ');
 
Var k,ch:char;
    kulti,x1,x2,a,b,i,dlz,but,list,z:integer;
    xm,ym:integer;                   { aktualne suradnice mysi }
    xk,yk:integer;                   { aktualne suradnice kurzora }
    xo,yo:integer;                   { suradnice kde stal kurzor }
    znako:byte;                      { aky bol znak kde teraz stoji kurzor }
    col:byte;
    hudba:array[1..Max_noty] of word;
    subory:array[1..255] of string[13];
    sp:text;
    meno:string;
    finish:boolean;                  { koniec prace s programom }
    refresh:boolean;                 { potrebujem zobrazit aj ked sa nepohol kurzor }
    mouse,amenu,astrana:boolean;
 
Procedure Init_Mys;
var reg:registers;
begin
 reg.ax:=$0000;
 intr($33,reg);
 if (reg.ax=0) then mouse:=false
               else begin
                { predefinuj kurzor mysi }
                mouse:=true;
                reg.ax:=$01;
                intr($33,reg);
               end;
end;
 
Procedure Zisti_Mys(var x,y,but:integer);
var reg:registers;
begin
 if not( mouse ) then exit;
 
 reg.ax:=$03;
 intr($33,reg);
 x:=trunc(reg.cx/8)+1;
 y:=trunc(reg.dx/8)+1;
 but:=reg.bx;
end;
 
Procedure Nastav_Mys(var x,y:integer);
var reg:registers;
begin
 if not( mouse ) then exit;
 
 reg.ax:=$04;
 reg.cx:=(x-1)*8;
 reg.dx:=(y-1)*8;
 intr($33,reg);
end;
 
Procedure Zobraz_Mys(zobraz:boolean);
var reg:registers;
begin
 if not( mouse ) then exit;
 if zobraz then reg.ax:=$01
           else reg.ax:=$02;
 intr($33,reg);
end;
 
Procedure Pust_Mys;
var reg:registers;
begin
 if not( mouse ) then exit;
 
 repeat
  reg.ax:=$06;
  reg.bx:=$03;
  intr($33,reg);
 until (reg.ax=0);
end;
 
 
Procedure WriteXYM(x,y:integer;v_text:string);
begin
 if mouse and (y=ym) and (x<=xm) and ( (x+Length(v_text))>=xm) then
    begin
     Zobraz_Mys(false);
     WriteXY(x,y,v_text);
     Zobraz_Mys(true);
    end
   else WriteXY(x,y,v_text);
end;
 
 
procedure VypisO(t,poc_o,poc:integer);
var i:integer;
begin
 i:=t;
 farba(blue,white);
 while ((i<poc) and ((i-t)<poc_o) ) do begin
   Inc(i);
   WriteXYM(2,i-t,subory[i]+nothing(13-Length(subory[i]) ) );
  end;
end;
 
 
Procedure poloz(x,y:integer;refresh:boolean);
var yo:byte;
begin
 { je polozena nota, zrusime ju (ale len v zapisovacom rezime) }
 yo:=25-hudba[x+(list*80)];
 
 if( not(refresh) and (yo<>25))then begin
    farba(Black,Red);
    WriteXYM(x,23,' ');
    WriteXYM(x,24,' ');
    if(yo in [8,10,12,14,16]) then WriteXYM(x,yo,'Ä')
                              else WriteXYM(x,yo,' ');
    hudba[x+(list*80)]:=0;
  end;
 
  { polozime notu }
  if( refresh or (yo=25) or (yo<>y)) then begin
   farba(Black,LightGreen);
   hudba[x+(list*80)]:=25-y;
   WriteXYM(x,y,chr(9));
   WriteXYM(x,23,textnoty[25-y][1]);
   WriteXYM(x,24,textnoty[25-y][2]);
  end;
end;
 
 
Procedure NotOsnova;
var x,y:byte;
begin
 farba(Black,Red);
 for x:=1 to 80 do
  for y:=4 to 8 do WriteXYM(x,y*2,'Ä');
end;
 
Procedure Obnov;
var pis:string;
begin
 window(1,1,80,25);
 farba(DarkGray,-1);
 clrscr;
 farba(LightBlue,LightGray);
 WriteXYM(1,25,nothing(79));
 WriteXYM(12,25,'Software by KULTI (Tibor KULCAR) & TrSek (Zdeno Sekerak).');
 NotOsnova;
 for i:=1 to 80 do
  if hudba[i+(list*80)]<>0 then poloz(i,25-hudba[i+(list*80)], true);
 
 farba(-1,green);
 if meno='' then meno:='NONAME.SND';
 farba(LightBlue,LightGray);
 WriteXYM(1,1,nothing(80));
 
 WriteXYM(2,1,'F10-MENU');
 farba(-1,White);
 WriteXYM(35,1,meno);
 str(list:2,pis);
 farba(LightGray,Blue);WriteXYM(63,1,chr(30)+chr(30));
 farba(Blue,Lightgray);WriteXYM(66,1,'Strana:'+'['+pis+'] ');
 farba(LightGray,Blue);WriteXYM(78,1,chr(31)+chr(31));
end;
 
 
function Citaj_file:integer;
var poc:integer;
    sub:SearchRec;
begin
 poc:=0;
 
 FindFirst('*',Directory,sub);
 while (doserror=0) do begin
   poc:=poc+1;
   subory[poc]:=sub.name;
   if (sub.name='.') then dec(poc);
   findnext(sub);
  end;
 
 FindFirst(meno,Archive or AnyFile,sub);
 while (doserror=0) do begin
   poc:=poc+1;
   subory[poc]:=sub.name;
   for i:=1 to Length(subory[poc]) do
       if (subory[poc][i] in ['A'..'Z']) then
          subory[poc][i]:=chr( ord(subory[poc][i])+( ord('a')-ord('A') ) );
   findnext(sub);
  end;
 Citaj_file:=poc;
end;
 
 
function Files(x,y:integer;meno:string):string;
var w:char;
    poc,t,tr:integer;
Begin
 KurzorZap(false);
 poc:=Citaj_file;
 
 farba(Blue,White);
 open_win(x,y,x+16,y+22,'Load',1);
 
 VypisO(0,21,poc);
 farba(Cyan,White);
 t:=1;tr:=t;            { pozicia , relativna pozicia v okne }
 WriteXYM(2,tr,subory[t]+nothing(12-Length(subory[t]) ) );
 
 repeat
  w:=readkey;
  if (w=#13) then
     if (subory[t][1] in ['.','A'..'Z']) then begin
        ChDir(subory[t]);
        poc:=Citaj_file;
        farba(Blue,White);
        clrscr;
        VypisO(0,21,poc);
        t:=1;tr:=t; w:=#10;    { pozicia , relativna pozicia v okne }
       end;
 
  if (w=#0) then begin
     w:=readkey;
     if (w=#80) then begin
        farba(Blue,White);
        WriteXYM(2,tr,subory[t]+nothing(12-Length(subory[t]) ) );
 
        if (t <poc) then begin
           Inc(t);
           if (tr<21) then Inc(tr)
                      else VypisO(t-tr,21,poc);
          end;
       end;
 
     if (w=#72) then begin
        farba(Blue,White);
        WriteXYM(2,tr,subory[t]+nothing(12-Length(subory[t]) ) );
 
        if (t >1) then begin
           Dec(t);
           if (tr>1) then Dec(tr)
                     else VypisO(t-tr,21,poc);
          end;
       end;   { if (w=#72) then begin }
     end;     { if (w=#0) then begin }
 
   farba(Cyan,White);
   WriteXYM(2,tr,subory[t]+nothing(12-Length(subory[t]) ) );
  until (w in [#27,#13]);
 
  if (w=#27) then Files:=''
             else Files:=subory[t];
end;
 
 
Procedure Clean;
begin
 farba(LightRed,White);
 open_win(16,10,60,17,' CLEAN ',1);
 WriteXYM(2,2,'Tymto si pohnojis svoj vytvor (zmazes ho)');
 WriteXYM(15,3,'Si si isty ?');
 
 if (otazka(15,5,'Ano','Nie','',Cyan,1)=1) then begin
   list:=0;
   for i:=1 to Max_noty do hudba[i]:=0;
   meno:='NONAME.SND';
  end;
end;
 
 
Function Dlzka(dlz:integer):integer;
var s:string;
    cw:byte;
begin
 farba(Blue,White);
 cw:=get_window(18,10,62,14);
 open_win(18,10,62,14,'Rychlost',1);
 WriteXYM(2,2,'Zadaj hodnotu v mikrosekundach:');
 str(dlz,s);
 farba(Black,White);
 s:=tread(34,2,5,s,#0,#0);
 val(s,dlz,i);
 
 while ( (i>0) and (s<>'') ) do begin
  delete(s,i,1);
  val(s,dlz,i);
 end;
 dlzka:=dlz;
 cw:=put_window(cw,18,10,62,14);
end;
 
Procedure Save;
var x1,x2:integer;
begin
 farba(Blue,White);
 open_win(3,9,43,15,'  Save  ',1);
 WriteXYM(7,1,'Napis mi ako by sa mal tvoj');
 WriteXYM(10,2,'vytvor volat,priatelu!');
 delete(meno,pos('.',meno),length(meno)-pos('.',meno)+1);
 
 farba(Black,White);
 meno:=tread(5,4,30,meno,#0,#0);
 if meno='' then begin
    meno:='NONAME.SND';
    exit;
   end;
 
 while ( pos(' ',meno)<>0 ) do delete(meno,pos(' ',meno),1);
 if( pos('.',meno)=0 )then meno:=meno+'.snd';
 for i := 1 to Length(meno) do meno[i] := UpCase(meno[i]);
 
 x1:=1; x2:=0;
 for i:=1 to Max_noty do begin
     if(( hudba[i]<>0 ) and ( x1=1 )) then x1:=i;
     if( hudba[i]<>0 ) then x2:=i;
    end;
 
 Assign(sp,meno);
 ReWrite(sp);
 for i:=x1 to x2 do
   WriteLn(sp,noty[hudba[i]]:3,' -',dlz:4,' ms');
 Close(sp);
end;
 
 
Procedure Nahraj;
var line:string;
    snum:string;
    y,p:word;
begin
 assign(sp,meno);
 {$I-}
 ReSet(sp);
 {$I+}
 
 if IOResult=0 then begin
    i:=1;
    while( not(eof(sp)) and (i<Max_noty)) do
      begin
        Readln(sp,line);
        i:=i+1; y:=1; snum:='';
        while((Length(line)>=y) and (line[y] in ['0'..'9',' '])) do begin
          if( line[y] in ['0'..'9'] )then
            snum:=snum+line[y];
          y:=y+1;
         end;
        val(snum,p,y);
        for y:=0 to 23 do
          if( p>=noty[y] ) then hudba[i]:=y;
      end;
 
    { aka je dlzka hrania noty }
    y:=1;
    while((Length(line)>=y) and (line[y]<>'-')) do y:=y+1;
    delete(line,1,y);
    repeat
      val(line,dlz,y);
      if( y<>0 )then delete(line,y,1);
    until((y=0) or (Length(line)=0));
    if( dlz=0 )then dlz:=100;
 
    close(sp);
   end
  else begin
    farba(LightRed,White);
    open_win(18,10,32,16,' Chyba ',1);
    WriteXYM(27,11,'Ty error! Takyto subor');
    WriteXYM(32,13,'NEEXISTUJE!!!');
    farba(Cyan,White);
    WriteXYM(36,15,'  OK  ');
    meno:='';
    readln;
   end;
 
 for i := 1 to Length(meno) do meno[i] := UpCase(meno[i]);
end;
 
 
Procedure Load;
var menop:string;
begin
 menop:=meno;
 farba(Blue,White);
 open_win(27,9,80,16,' Load ',1);
 WriteXYM(3,2,'   Napis mi meno dristu, ktory chces nahrat.');
 WriteXYM(3,3,'Alebo stlac ENTER pre vypis vsetkych. (Dristov)');
 farba(Black,White);
 meno:=tread(5,5,40,'*.SND',#0,#0);
 while( pos(' ',meno )<>0) do delete(meno, pos(' ',meno), 1);
 
 Assign(sp,meno);
 {$I-}
 ReSet(sp);
 Close(sp);
 {$I-}
 
 if IOResult<>0 then meno:=files(64,2,meno);
 if( meno='' )then meno:=menop
              else nahraj;
 list:=0;
end;
 
 
Procedure StranaDole;
begin
 list:=list+1;
 if list>(Max_noty/80-1) then list:=round(Max_noty/80)-1;
 obnov;
end;
 
Procedure StranaHore;
begin
 list:=list-1;
 if list<0 then list:=0;
 obnov;
end;
 
Procedure Hraj( x_od,x_do:integer );
var i,x1,x2:integer;
    pis:string;
begin
 x1:=1; x2:=0;
 obnov;
 
 for i:=x_od+1 to x_do do begin
     if(( hudba[i]<>0 ) and ( x1=1 )) then x1:=i;
     if( hudba[i]<>0 ) then x2:=i;
    end;
 
 for i:=x1 to x2 do begin
  farba(Blue,Lightgray);
  if( round( int(i/80)) <> list )then begin
    list:=round( int(i/80) );
    obnov;
   end;
 
  farba(Black,Cyan);
  if( hudba[i]<>0 ) then sound( noty[ hudba[i] ] )
                    else nosound;
 
  if ( hudba[i]<>0 ) then begin
      WriteXYM(i-(list*80),25-hudba[i],chr(9));
      if keypressed then
         if (readkey=#27) then begin nosound; obnov; exit; end;
     end;
  delay(dlz);
  end;
 nosound;
end;
 
 
Procedure Koniec;
begin
 farba(black,white);
 window(1,1,80,25);
 clrscr;
 farba(blue,lightgray);
 WriteXYM(1,1,'  SOUND PLAYER  verion 2.0  Copyright (c) 1990,1994  Software by KULTI & TRSEK. ');
 halt(0);
end;
 
 
Procedure AppExit;
begin
 farba(LightRed,White);
 open_win(19,10,63,14,'Chces zdrhnut ?!!',1);
 if (otazka(16,2,'Ano','Nie','',Cyan,1)=1) then Koniec;
end;
 
Procedure Help;
var cw:byte;
    kl:char;
begin
 farba(Blue,White);
 cw:=get_window(10,3,70,23);
 open_win(10,2,70,24,'Help (ESC-koniec)',1);
 
 WriteXYM(2, 1,'SOUND PLAYER  verion 2.0');
 WriteXYM(2, 2,'------------------------');
 WriteXYM(2, 3,' F1 - tento help');
 WriteXYM(2, 4,' F2 - uloz na disk svoj vytvor');
 WriteXYM(2, 5,' F3 - nahraj zo suboru');
 WriteXYM(2, 6,' F4 - zmaz cely vytvor');
 WriteXYM(2, 7,' F5 - hraj celu skladbu');
 WriteXYM(2, 8,' F6, medzera, prave tlacitko mysi - hraj aktualnu stranu');
 WriteXYM(2, 9,' F9 - zmen dlzku hrania jednej noty');
 WriteXYM(2,10,' F10 - menu');
 WriteXYM(2,11,' PgUp (ikona vpravo hore) - posun sa o stranu hore');
 WriteXYM(2,12,' PgDn (ikona vpravo hore) - posun sa o stranu dole');
 WriteXYM(2,13,' Home - posun o toninu vyssie');
 WriteXYM(2,14,' End - posun skladbu o toninu nizsie');
 WriteXYM(2,15,' Ctrl+left - prisun skladbu zlava k pozicii kurzora');
 WriteXYM(2,16,' Ctrl+right - prisun skladbu zprava k pozicii kurzora');
 WriteXYM(2,17,' ESC - Koniec programu');
 WriteXYM(2,18,' Enter, prave tlacitko mysi - poloz notu');
 WriteXYM(2,19,' sipky, mys - pohyb kurzora po notovej osnove');
 WriteXYM(2,21,'Copyright (c) 1990,1994,2000  Software by KULTI & TRSEK. ');
 
 repeat
  kl:=readkey;
 until( kl in [#13,#32,#27]);
 
 cw:=put_window(cw,10,3,70,23);
end;
 
Procedure Menu;
var x,y,i:integer;
    xm,ym,but:integer;
    e:char;
begin
  x:=20;y:=5;i:=1;
  farba(Blue,White);
  WriteXYM(x,y   ,'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ MENU ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍť');
  WriteXYM(x,y+ 1,'ş   '+wiew[1]+'    ş');
  WriteXYM(x,y+ 2,'ş   '+wiew[2]+'    ş');
  WriteXYM(x,y+ 3,'ş   '+wiew[3]+'    ş');
  WriteXYM(x,y+ 4,'ş   '+wiew[4]+'    ş');
  WriteXYM(x,y+ 5,'ş   '+wiew[5]+'    ş');
  WriteXYM(x,y+ 6,'ş   '+wiew[6]+'    ş');
  WriteXYM(x,y+ 7,'ş   '+wiew[7]+'    ş');
  WriteXYM(x,y+ 8,'ş   '+wiew[8]+'    ş');
  WriteXYM(x,y+ 9,'ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄś');
  WriteXYM(x,y+10,'ş    Polozenie noty        (Enter)   ş');
  WriteXYM(x,y+11,'ş                                    ş');
  WriteXYM(x,y+12,'ş    Ovladanie             '+chr(27)+' '+chr(24)+' '+chr(25)+' '+chr(26)+'   ş');
  WriteXYM(x,y+13,'ş                                    ş');
  WriteXYM(x,y+14,'ČÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍź');
  window(20,10,18,48);
  farba(cyan,-1);
  WriteXYM(24,y+i,wiew[i]);
 
  repeat
   e:=#10;
   if mouse then begin
      zisti_mys(xm,ym,but);
      if (but=2) then e:=#27;
      if (but=1) and (xm>x) and ((x+36)>xm) and (ym in [6..13]) then begin
          Zobraz_mys(false);
          farba(Blue,-1);
          WriteXYM(24,y+i,wiew[i]);
{          if (i=(ym-5)) then e:=#13
                        else i:=ym-5;}
          e:=#13; i:=ym-5;
          farba(Cyan,-1);
          WriteXYM(24,y+i,wiew[i]);
         end;
        pust_mys;
     end;
 
   if keypressed then begin
      e:=readkey;
 
      if (e=#0) then begin
         e:=readkey;
         if (e=#80) then begin
            farba(blue,-1);
            WriteXYM(24,y+i,wiew[i]);
            i:=i+1;
            if (i>8) then i:=1;
           end;
 
         if (e=#72) then begin
            farba(Blue,-1);
            WriteXYM(24,y+i,wiew[i]);
            i:=i-1;
            if i<1 then i:=8;
           end;
        end;
     end;
 
  farba(cyan,-1);
  WriteXYM(24,y+i,wiew[i]);
  if (e=#13) then begin
      case i of
       1 :help;
       2 :save;
       3 :load;
       4 :clean;
       5 :hraj(0, Max_noty);
       6 :hraj(list*80, (list+1)*80);
       7 :dlz:=dlzka(dlz);
       8 :AppExit;
      end;
     end;
 
   Zobraz_mys(true);
 until (e in [#13,#27]);
 KurzorZap(false);
 Zobraz_mys(false);
end;
 
Procedure MysMenu(but:byte;var amenu:boolean);
begin
 amenu:=not(amenu);
 if (amenu) then farba(LightGray,Blue)
            else farba(Blue,LightGray);
 WriteXYM(1,1,' F10-MENU ');
end;
 
 
Procedure HoreJeden;
var x_od,x_do:integer;
begin
  x_od:=list*80; x_do:=(list+1)*80;
 
  for i:=1 to Max_noty do begin
    { ak uz je tak vysoko ze ju treba zrusit }
    if( hudba[i]=23 )then begin
       if( (i>=x_od) and (i<=x_do) )then
          poloz(i-x_od,25-hudba[i],false)
        else
          hudba[i]:=0;
     end;
    { treba vykreslit vyssie }
    if( hudba[i]<>0 )then begin
       if( (i>=x_od) and (i<=x_do) )then
          poloz(i-x_od,25-hudba[i]-1,false)
        else
          hudba[i]:=hudba[i]+1;
     end;
 
  end;
 
end;
 
 
Procedure DoleJeden;
var x_od,x_do:integer;
begin
  x_od:=list*80; x_do:=(list+1)*80;
 
  for i:=1 to Max_noty do begin
    { ak uz je tak nizko ze ju treba zrusit }
    if( hudba[i]=3 )then begin
       if( (i>=x_od) and (i<=x_do) )then
          poloz(i-x_od,25-hudba[i],false)
        else
          hudba[i]:=0;
     end;
    { treba vykreslit vyssie }
    if( hudba[i]<>0 )then begin
       if( (i>=x_od) and (i<=x_do) )then
          poloz(i-x_od,25-hudba[i]+1,false)
        else
          hudba[i]:=hudba[i]-1;
     end;
 
  end;
end;
 
 
Procedure VlavoJeden(xk:integer);
var x_od,x_do:integer;
begin
  x_od:=list*80; x_do:=(list+1)*80+1;
 
  for i:=x_od+xk+1 to Max_noty do begin
    { treba vizualne ??? }
    if( i<=x_do )then begin
      if(hudba[i-1]<>0) then poloz(i-x_od-1,25-hudba[i-1],false);
      if(hudba[i]<>0)   then poloz(i-x_od-1,25-hudba[i],false);
     end;
    hudba[i-1]:=hudba[i];
  end;
 
  { nakoniec poslednu notu }
  if(i<=x_do)then
    if(hudba[i]<>0) then poloz(i-x_od,25-hudba[i],false);
end;
 
 
Procedure VpravoJeden(xk:integer);
var x_od,x_do:integer;
begin
  x_od:=list*80; x_do:=(list+1)*80;
 
  for i:=x_od+xk downto 2 do begin
    { treba vizualne ??? }
    if( i>x_od )then begin
      if(hudba[i]<>0)   then poloz(i-x_od,25-hudba[i],false);
      if(hudba[i-1]<>0) then poloz(i-x_od,25-hudba[i-1],false);
     end;
    hudba[i]:=hudba[i-1];
  end;
 
  { nakoniec prvu notu }
  if(1>x_od)then
    if(hudba[i]<>0) then poloz(1,25-hudba[1],false);
end;
 
 
BEGIN
 meno:='';
 nosound;
 for i:=1 to Max_noty do hudba[i]:=0;
 if( paramcount > 0 )then begin meno:=paramstr(1); nahraj; end;
 
 obnov;
 xk:=77; yk:=11; z:=10; dlz:=100; list:=0;
 finish:=false; refresh:=true;
 xo:=xk; yo:=yk; znako:=get_znak( xo, yo, col );
 Init_mys;
 Zobraz_Mys(true);
 
 repeat
 
   if( refresh or (xk<>xo) or (yk<>yo)) then begin
     farba(Black,col);
     WriteXYM(xo,yo, char(znako) );
     xo:=xk; yo:=yk;
     znako:=get_znak( xo, yo, col );
     { nova pozicia }
     farba(Black,Cyan);
     WriteXYM(xk,yk,chr(14));
     KurzorZap(false);
     refresh:=false;
   end;
 
   if mouse then begin
      zisti_mys(xm,ym,but);
      if (xm in [0..10]) and (ym=1) then begin
         if not(amenu) then MysMenu(but,amenu);
        end else
         if amenu then MysMenu(but,amenu);
   end;
 
   { Chce neaku cinnost mysou }
   if( but<>0 )then begin
      Zobraz_mys(false);
      if (but=1) and (xm in [63..64]) and (ym=1) then stranahore;
      if (but=1) and (xm in [78..79]) and (ym=1) then stranadole;
      if (but=2) then hraj(list*80, (list+1)*80);             { medzera }
      if (but=3) then AppExit;                                { ESC }
      if (but=1) and amenu then menu;
      if (but<>0) then Pust_Mys;
      if (but=1) and (ym in [2..22]) then poloz(xm,ym,false)  { enter }
                                     else obnov;
      Zobraz_mys(true);
     end;
 
      { Dobyva sa klavesou }
   if( keypressed ) then begin
      k:=readkey;
      if (k=#0) then k:=readkey;
      Zobraz_mys(false);
 
      if (k=#75) then xk:=xk-1;    { sipka vlavo  }
      if (k=#77) then xk:=xk+1;    { sipka vpravo }
      if (k=#72) then yk:=yk-1;    { sipka hore   }
      if (k=#80) then yk:=yk+1;    { sipka dole   }
 
      { ine znaky }
      if (k=#27) then finish:=true;     { ESC   }
      if (k=#13) then begin             { Enter }
          poloz(xk,yk,false);
          znako:=get_znak( xo, yo, col );
          xk:=xk+1;
        end;
 
      { Znaky F1-F9, PgUp, PgDn, Home, End, Ctrl+sipky }
      if (k=#59) then help;               { F1 }
      if (k=#60) then save;               { F2 }
      if (k=#61) then load;               { F3 }
      if (k=#62) then clean;              { F4 }
      if (k=#63) then hraj(0, Max_noty);  { F5 }
      if (k in [#64,#32]) then hraj(list*80, (list+1)*80); { F6 }
      if (k=#67) then dlz:=dlzka(dlz);    { F9 }
      if (k=#68) then menu;               { F10 }
      if (k=#73) then stranahore;         { PgUp }
      if (k=#81) then stranadole;         { PgDn }
      if (k=#55) then HoreJeden;          { Home }
      if (k=#49) then DoleJeden;          { End }
      if (k=#115) then VlavoJeden(xk);    { Ctrl+left }
      if (k=#116) then VpravoJeden(xk);   { Ctrl+right }
 
      if( k in [#59,#60,#61,#62,#63,#64,#32,#67,#68] )then Obnov;
      refresh:=true;
      Zobraz_mys(true);
 
      { kontroly }
      if (yk<2)  then yk:=2;
      if (yk>22) then yk:=22;
      if (xk<1)  then begin
         xk:=80; stranahore;
         znako:=get_znak( xo, yo, col );
      end;
      if (xk>80) then begin
         xk:=1;  stranadole;
         znako:=get_znak( xo, yo, col );
      end;
   end;                { if( keypressed ) then begin }
 
   if( finish )then begin AppExit; finish:=false; obnov; end;
 until (false);
 
END.