Program for make sound (beeper) in your program.

Delphi & Pascal (Ŕeskß wiki)
P°ejÝt na: navigace, hledßnÝ
Category: Source in Pascal
sounder.pngProgram: Sounder.pas
File exe: Sounder.exe
need: Trsek.pas
Example: Chaos.sndClassic.sndDlhy.sndMore.sndStupnica.snd

This program was created to meet the demands of music production using a special device called beeper. It is actually the editor which allows to lay the notes on the visual basis, to repeat playing of the music product and to store it finally in the file. The output is then used in your own program. It features a perfect design and mouse manipulation.

The program can hardly be reproached for any imperfections. I must not forget to mention the original author of this program - Tibor Kulcar. I made a couple of changes and checked on some of the faults which emerged from time to time.
{ 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.