{ EDITSND.PAS                          Copyright (c) Martin Kolecek }
{ S programem EditSnd.exe je mozne generovat soubory s priponou SND.}
{ Tyto soubory maji slouzit k ozvuceni programu na profesionalni    }
{ urovni pomoci PC Speakeru. Vyuziva se k tomu preruseni od casovace}
{ nastavene na 100Hz tzn. vzorkovaci frekvence prehravanych zvuku   }
{ je 100Hz. Nedochazi ke zhrouceni hodin vse je osetreno tak aby sly}
{ prehravat zvuky, aby spravne sly hodiny a zaroven aby program mohl}
{ vykonavat jine ulohy. Vse bezi na pozadi pres int8                }
{ viz. unit speaker.pas                                             }
{                                                                   }
{ Author: Martin Kolecek                                            }
{ Datum: 18.05.2009                           http://www.trsek.com  }

Program EditSND;
Uses CRT,DOS,Texter;


Const
  FileNamePripona: string[4] = '.snd';

Var
  MMSelect: Byte;
  EditSelect: Byte;
  Sloupec: Byte;
  Posuv: Word;
  Xa: Word;

  F: File;
  DirInfo: SearchRec;
  FileName: string[12];
  FileNameJmeno: string[8];
  FileNameDialogOK: Boolean;
  Loading: Boolean;

  SoundData: array[0..1999] of Word;
  ZvukTab: array[0..99] of Word;

{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
Procedure NoBeep;
Begin
  While KeyPressed do ReadKey;
End;


Procedure Init320x200; Assembler;
Asm
  Mov AH, 00h
  Mov AL, 13h
  Int 10h
End;


Procedure Init80x25; Assembler;
Asm
  Mov AH, 00h
  Mov AL, 03h
  Int 10h
End;


Procedure WaitRetrace; Assembler;
Asm
    Mov dx,3DAh
@l1:
    In al,dx
    And al,08h
    Jnz @l1
@l2:
    In al,dx
    And al,08h
    Jz  @l2
End;


Procedure WritePixel (X:Word;Y:Byte;Barva:Word);
Begin
  MEM[$A000:X+Y*320]:=Barva;
End;


Procedure Blok(x1,y1,x2,y2,Barva:Word);
Var x,y: Word;
Begin
   For y:=y1 to y2 do
   For x:=x1 to x2 do WritePixel(x,y,Barva);
End;


Procedure Ramecek (X1,Y1,X2,Y2,Barva: Word);
Var DelkaX,DelkaY,I: Word;
Begin
 DelkaX:=X2-X1; DelkaY:=Y2-Y1;
 For I:=0 to DelkaX do WritePixel (X1+I,Y1,Barva);
 For I:=0 to DelkaX do WritePixel (X1+I,Y2,Barva);
 For I:=0 to DelkaY do WritePixel (X1,Y1+I,Barva);
 For I:=0 to DelkaY do WritePixel (X2,Y1+I,Barva);
End;


Procedure SoundStorno;
Var I,I2:Word;
Begin
  I2:=350;
  For I:=0 to 3 do
  Begin
    Sound(I2);
    Delay(20);
    NoSound;
    Dec(I2,50);
  End;
End;


Procedure SoundDone;
Var I,I2:Word;
Begin
  I2:=200;
  For I:=0 to 5 do
  Begin
    Sound(I2);
    Delay(20);
    NoSound;
    Inc(I2,50);
  End;
End;


Procedure InitArrays;
Var I: Word;
Begin
  For I:=0 to 1999 do SoundData[I]:=0;
  For I:=0 to 99 do ZvukTab[I]:=0;
End;


Procedure FnSave;
Begin
  Assign(F,Filename);
  Reset(F,1);
  BlockWrite(F,SoundData,4000);
  BlockWrite(F,ZvukTab,200);
  Close(F);
  SoundDone;
End;


Procedure PlaySample;
Begin
  For Posuv:=0 to ZvukTab[EditSelect*2+1] do
  Begin
    Sound(SoundData[ZvukTab[EditSelect*2]+Posuv]);
    Delay(10);
    NoSound;
  End;
End;


Procedure WriteEditSoundDataScreen;
var x,y,I,Vyska: Word;
Begin
  x:=0; y:=0;
  Blok(x+1,y+1,x+317,y+197,0);
  Ramecek(x,y,x+318,y+198,50);

  {kreslime zaznam zvukove stopy}
  x:=10; y:=180;
  For Posuv:=0 to ZvukTab[EditSelect*2+1] do {Posuv:= 0 to Delka}
  Begin
   For Vyska:=0 to Trunc(SoundData[ZvukTab[EditSelect*2]+Posuv]/10) do
   Begin
     WritePixel(x,y,56);
     Dec(y);
   End;
   y:=180;
   Inc(x);
  End;

  {kreslime sipku}
  x:=10+Xa; y:=181;
  WritePixel(x,y,60);
  WritePixel(x,y+1,60);
  WritePixel(x,y+2,60);
  WritePixel(x,y+3,60);
  WritePixel(x,y+4,60);
  WritePixel(x,y+5,60);
  WritePixel(x-1,y+1,60);
  WritePixel(x+1,y+1,60);
  WritePixel(x-2,y+2,60);
  WritePixel(x+2,y+2,60);

  {vypisujeme hodnotu zvuku}
  x:=2; y:=2;
  WriteNumber(x,y,SoundData[ZvukTab[EditSelect*2]+Xa],False);
End;


Procedure EditSoundData;
var Ending: Boolean;
Begin
  Posuv:=0;
  Xa:=0;
  Ending:=False;
  Repeat
    WaitRetrace;
    WriteEditSoundDataScreen;
    ReadKey; Delay(100); NoBeep;
    Case Port[$60] of
{Insert}   82: Begin
                 If SoundData[ZvukTab[EditSelect*2]+Xa]<1000 then
                 Inc(SoundData[ZvukTab[EditSelect*2]+Xa]);
               End;
{Delete}   83: Begin
                 If SoundData[ZvukTab[EditSelect*2]+Xa]>0 then
                 Dec(SoundData[ZvukTab[EditSelect*2]+Xa]);
               End;
{Home}     71: Begin
                 If SoundData[ZvukTab[EditSelect*2]+Xa]<990 then
                 Inc(SoundData[ZvukTab[EditSelect*2]+Xa],10);
               End;
{End}      79: Begin
                 If SoundData[ZvukTab[EditSelect*2]+Xa]>10 then
                 Dec(SoundData[ZvukTab[EditSelect*2]+Xa],10);
               End;
{PageUp}   73: Begin
                 If SoundData[ZvukTab[EditSelect*2]+Xa]<900 then
                 Inc(SoundData[ZvukTab[EditSelect*2]+Xa],100);
               End;
{PageDown} 81: Begin
                 If SoundData[ZvukTab[EditSelect*2]+Xa]>100 then
                 Dec(SoundData[ZvukTab[EditSelect*2]+Xa],100);
               End;
{Left}     75: Begin If Xa>0 then Dec(Xa); End;
{Right}    77: Begin If Xa<ZvukTab[EditSelect*2+1] then Inc(Xa); End;
{P=Play}   25: Begin PlaySample; End;
{F2}       60: Begin FnSave; End;
{F5}       63: Begin Ending:=True; End;
{Esc}       1: Begin Ending:=True; End;
    End; {Case End}
  Until Ending=True;
End;


Procedure WriteEditScreen;
Var x,y,I,A: Word;
    ZacatekZvuku: Word;
    DelkaZvuku: Word;
    CisloZvuku: Byte;

    Procedure VipisRadky;
    Begin
      {Cislo zvuku}
      WriteText(x,y,'ZVUK: ');
      WriteNumber(x+30,y,CisloZvuku,False);

      {ZacatekZvuku}
      ZacatekZvuku:=ZvukTab[A];
      WriteText(x+52,y,'ZACATEK=');
      WriteNumber(x+100,y,ZacatekZvuku,False);

      {DelkaZvuku}
      DelkaZvuku:=ZvukTab[A+1];
      WriteText(x+130,y,'DELKA=');
      WriteNumber(x+166,y,DelkaZvuku,False);

      {Rozsah}
      WriteText(x+208,y,'ROZSAH:');
      WriteNumber(x+249,y,ZacatekZvuku,False);
      WriteText(x+274,y,'-');
      WriteNumber(x+281,y,ZacatekZvuku+DelkaZvuku,False);

      Inc(A,2);
      Inc(CisloZvuku);
      Inc(y,10);
    End;

Begin
  x:=0; y:=0;
  Blok(x,y,x+318,y+198,0);

  If EditSelect in [ 0..19] then
  Begin
    Blok(x,EditSelect*10,x+318,EditSelect*10+6,55);
    If Sloupec=0 then Blok(x+52,EditSelect*10,x+122,EditSelect*10+6,56)
                 else Blok(x+130,EditSelect*10,x+130+52,EditSelect*10+6,56);
  End;

  If EditSelect in [20..39] then
  Begin
    Blok(x,EditSelect*10-200,x+318,EditSelect*10-200+6,55);
    If Sloupec=0 then Blok(x+52,EditSelect*10-200,x+122,EditSelect*10-200+6,56)
                 else Blok(x+130,EditSelect*10-200,x+130+52,EditSelect*10-200+6,56);
  End;

  If EditSelect in [40..49] then
  Begin
    Blok(x,EditSelect*10-400,x+318,EditSelect*10-400+6,55);
    If Sloupec=0 then Blok(x+52,EditSelect*10-400,x+122,EditSelect*10-400+6,56)
                 else Blok(x+130,EditSelect*10-400,x+130+52,EditSelect*10-400+6,56);
  End;

  If EditSelect in [ 0..19] then Begin
                                   CisloZvuku:=0;  A:=0;
                                   For I:=0 to 19 do VipisRadky;
                                 End;
  If EditSelect in [20..39] then Begin
                                   CisloZvuku:=20; A:=40;
                                   For I:=0 to 19 do VipisRadky;
                                 End;
  If EditSelect in [40..49] then Begin
                                   CisloZvuku:=40; A:=80;
                                   For I:=0 to  9 do VipisRadky;
                                 End;
End;


Procedure FnEditor;
Var Ending:Boolean;
Begin
  Ending:=False;
  EditSelect:=0;
  Sloupec:=0;
  Init320x200;
  InitTexter(50);
  Repeat
    WaitRetrace;
    WriteEditScreen;
    ReadKey; Delay(100); NoBeep;
    Case Port[$60] of
{Insert}   82: Begin
                 If Sloupec=0 then { Zacatek [0..1999] }
                 Begin
                   If ZvukTab[EditSelect*2]+ZvukTab[EditSelect*2+1]<1999 then
                   If ZvukTab[EditSelect*2]<1999 then Inc(ZvukTab[EditSelect*2]);
                 End;
                 If Sloupec=1 then { Delka [0..300] }
                 Begin
                   If ZvukTab[EditSelect*2]+ZvukTab[EditSelect*2+1]<1999 then
                   If ZvukTab[EditSelect*2+1]<300 then Inc(ZvukTab[EditSelect*2+1]);
                 End;
               End;
{Delete}   83: Begin
                 If Sloupec=0 then { Zacatek [0..1999] }
                 If ZvukTab[EditSelect*2]>0 then Dec(ZvukTab[EditSelect*2]);
                 If Sloupec=1 then { Delka [0..300] }
                 If ZvukTab[EditSelect*2+1]>0 then Dec(ZvukTab[EditSelect*2+1]);
               End;
{Home}     71: Begin
                 If Sloupec=0 then { Zacatek [0..1999] }
                 Begin
                   If ZvukTab[EditSelect*2]+ZvukTab[EditSelect*2+1]<1989 then
                   If ZvukTab[EditSelect*2]<1989 then Inc(ZvukTab[EditSelect*2],10);
                 End;
                 If Sloupec=1 then { Delka [0..300] }
                 Begin
                   If ZvukTab[EditSelect*2]+ZvukTab[EditSelect*2+1]<1989 then
                   If ZvukTab[EditSelect*2+1]<290 then Inc(ZvukTab[EditSelect*2+1],10);
                 End;
               End;
{End}      79: Begin
                 If Sloupec=0 then { Zacatek [0..1999] }
                 If ZvukTab[EditSelect*2]>10 then Dec(ZvukTab[EditSelect*2],10);
                 If Sloupec=1 then { Delka [0..300] }
                 If ZvukTab[EditSelect*2+1]>10 then Dec(ZvukTab[EditSelect*2+1],10);
               End;
{PageUp}   73: Begin
                 If Sloupec=0 then { Zacatek [0..1999] }
                 Begin
                   If ZvukTab[EditSelect*2]+ZvukTab[EditSelect*2+1]<1899 then
                   If ZvukTab[EditSelect*2]<1899 then Inc(ZvukTab[EditSelect*2],100);
                 End;
                 If Sloupec=1 then { Delka [0..300] }
                 Begin
                   If ZvukTab[EditSelect*2]+ZvukTab[EditSelect*2+1]<1899 then
                   If ZvukTab[EditSelect*2+1]<200 then Inc(ZvukTab[EditSelect*2+1],100);
                 End;
               End;
{PageDown} 81: Begin
                 If Sloupec=0 then { Zacatek [0..1999] }
                 If ZvukTab[EditSelect*2]>100 then Dec(ZvukTab[EditSelect*2],100);
                 If Sloupec=1 then { Delka [0..300] }
                 If ZvukTab[EditSelect*2+1]>100 then Dec(ZvukTab[EditSelect*2+1],100);
               End;
{Up}       72: Begin If EditSelect>0  then Dec(EditSelect); End;
{Down}     80: Begin If EditSelect<49 then Inc(EditSelect); End;
{Left}     75: Begin If Sloupec>0 then Dec(Sloupec); End;
{Right}    77: Begin If Sloupec<1 then Inc(Sloupec); End;
{P=Play}   25: Begin PlaySample; End;
{F6}       64: Begin EditSoundData; End;
{Enter}    28: Begin EditSoundData; End;
{F2}       60: Begin FnSave; End;
{Esc}       1: Begin Ending:=True; End;
    End; {Case End;}
  Until Ending=True;
  ShutdownTexter;
  Init80x25;
End;


{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
Procedure LoadError(CisloChyby:Byte);
Var ErrorMSG: array[1..8] of String;
    X,Y,I,I2:Byte;
Begin
  ErrorMSG[1]:='Nenalezen soubor';
  ErrorMSG[2]:='Nenalezena cesta';
  ErrorMSG[3]:='Pý¡stup zam¡tnut';
  ErrorMSG[4]:='Neplatnì deskriptor';
  ErrorMSG[5]:='Nedostatek pamØti';
  ErrorMSG[6]:='Neplatn‚ prostýed¡';
  ErrorMSG[7]:='Neplatnì form t';
  ErrorMSG[8]:='Soubor nenalezen';
  {Vypisujeme Error MSG yellow}
  X:=27; Y:=12; {souradnice ErrorMSG}
  TextColor(14); {Zluty ramecek ErrorMSG}
  For I:=0 to 22 do Begin GotoXY(X+I,Y); Write('Ü'); End;
  For I:=0 to 22 do Begin GotoXY(X+I,Y+3); Write('ß'); End;
  GotoXY(X,Y+1);     Write('Û');
  GotoXY(X+22,Y+1);  Write('Û');
  GotoXY(X,Y+2);     Write('Û');
  GotoXY(X+22,Y+2);  Write('Û');
  TextBackground(4); {Cervene pozadi ramecku}
  For I2:=1 to 2 do {vypln}
  For I:=0 to 20 do Begin GotoXY(X+1+I,Y+I2); Write(' '); End;
  GotoXY(X+2,Y+1); Write('CHYBA      ESC=EXIT');
  {Vypisujeme vzniklou chybu}
  GotoXY(X+2,Y+2);
  Case CisloChyby of
    1: Write(ErrorMSG[1]);
    2: Write(ErrorMSG[2]);
    3: Write(ErrorMSG[3]);
    4: Write(ErrorMSG[4]);
    5: Write(ErrorMSG[5]);
    6: Write(ErrorMSG[6]);
    7: Write(ErrorMSG[7]);
    8: Write(ErrorMSG[8]);
  End;
  Repeat Until Port[$60]=1; {Cekej na ESC}
  TextColor(7); TextBackground(0); {Set puvodni}
  GotoXY(X,Y);    ClrEol; {Smazat ErrorMSG Okno}
  GotoXY(X,Y+1);  ClrEol; {Smazat ErrorMSG Okno}
  GotoXY(X,Y+2);  ClrEol; {Smazat ErrorMSG Okno}
  GotoXY(X,Y+3);  ClrEol; {Smazat ErrorMSG Okno}
End;


Procedure FileNameDialog;
Begin
  TextColor(7); TextBackground(0);
  GotoXY(41,3); Write('ÄÄÄÄÄÄÄÄ');
  GotoXY(27,2); Write('jmeno souboru=');
  ReadLN(FileNameJmeno);
  FileName:=FileNameJmeno+FileNamePripona;
  If Loading=True then
  Begin
    FindFirst(FileName,Archive,DirInfo);
    If DosError>0 then Begin
                         FileNameDialogOK:=False;
                         Case DosError of
                           2: LoadError(1); {Nenalezen soubor}
                           3: LoadError(2); {Nenalezena cesta}
                           5: LoadError(3); {Pý¡stup zam¡tnut}
                           6: LoadError(4); {Neplatnì deskriptor}
                           8: LoadError(5); {Nedostatek pamØti}
                          10: LoadError(6); {Neplatn‚ prostýed¡}
                          11: LoadError(7); {Neplatnì form t}
                          18: LoadError(8); {Soubor nenalezen}
                         End;
                       End
                  else FileNameDialogOK:=True; {DosError=0 tzn. zadna chyba}
  End;
  Loading:=False;
  GotoXY(41,3); ClrEol;
  GotoXY(27,2); ClrEol;
End;


Procedure FnLoad;
Begin
  Loading:=True;
  FileNameDialog;
  If FileNameDialogOK=True then
  Begin
    Assign(F,Filename);
    Reset(F,1);
    BlockRead(F,SoundData,4000);
    BlockRead(F,ZvukTab,200);
    Close(F);
    SoundDone;
  End
  else FileName:='none';
End;


Procedure FnCreate;
Var I: Byte;
Begin
  FileNameDialog;
  Assign(F,Filename);
  ReWrite(F,1);
  BlockWrite(F,SoundData,4000);
  BlockWrite(F,ZvukTab,200);
  Close(F);
  SoundDone;
End;


Procedure FnHelp;
Var I: Byte;
    Ending: Boolean;
Begin
  GotoXY(1,8);  For I:=1 to 80 do Write('Ü');
  GotoXY(1,24); For I:=1 to 80 do Write('ß');
  GotoXY(1,9);  For I:=9 to 23 do Begin GotoXY(1,I); Write('Û'); End;
  GotoXY(80,9); For I:=9 to 23 do Begin GotoXY(80,I); Write('Û'); End;
  GotoXY(3,9);  Write('                                                                    Esc=ZpØt');
  GotoXY(3,10); Write(' Hlavn¡ nab¡dka (textov‚ menu):                                             ');
  GotoXY(3,11); Write(' F1=Help, F2=Save, F3=Load, F4=New File, F5=Editor zvuk…                    ');
  GotoXY(3,13); Write(' Editor zvuk…:                                                              ');
  GotoXY(3,14); Write(' çipky nahoru dol… = vìbØr zvuku, doleva doprava = editace ZaŸ tku / D‚lky  ');
  GotoXY(3,15); Write(' F6 nebo ENTER = editovat vybranì zvuk, Esc nebo F5 = ZpØt                  ');
  GotoXY(3,16); Write('                                                                            ');
  GotoXY(3,17); Write(' Insert Delete = pýidat ubrat jednotky                                      ');
  GotoXY(3,18); Write(' Home End = pýidat ubrat des¡tky                                            ');
  GotoXY(3,19); Write(' PgUp PgDn = pýidat ubrat stovky                                            ');
  GotoXY(3,20); Write('                                                                            ');
  GotoXY(3,21); Write(' F10 v textov‚m menu = Exit                                                 ');
  Ending:=False;
  Repeat
    ReadKey; Delay(100); NoBeep;
    Case Port[$60] of
{ESC}    1: Begin Ending:=True; End;
    End; {Case End}
  Until Ending=True;
  For I:=8 to 24 do Begin GotoXY(1,I); ClrEol; End;
End;


Procedure MMFunction; {enter in menu function}
Begin
  Case MMSelect of
    0: Begin SoundStorno;                                       End; {NIC}
    1: Begin If FileName='none' then FnCreate Else SoundStorno; End; {NEW}
    2: Begin If FileName='none' then SoundStorno Else FnSave;   End; {SAVE}
    3: Begin If FileName='none' then FnLoad Else SoundStorno;   End; {OPEN}
    4: Begin If FileName='none' then SoundStorno Else FnEditor; End; {EDITOR}
    5: Begin FnHelp;                                            End; {HELP}
  End;
End;


Procedure WriteNabidka;
Begin
  TextColor(14); TextBackground(1);
  GotoXY(1,2); Write('vytvoýit F4');
  GotoXY(1,3); Write('ulo§it   F2');
  GotoXY(1,4); Write('otevý¡t  F3');
  GotoXY(1,5); Write('editor   F5');
  GotoXY(1,6); Write('n povØda F1');
  TextColor(7); TextBackground(0);
  GotoXY(80,25);
End;



Procedure WriteLista;
Var I: Byte;
Begin
  TextColor(14); TextBackground(1);
  GotoXY(1,1); For I:=1 to 79 do Write(' ');
  GotoXY(2,1); Write('ÉMENU»');
  GotoXY(14,1); Write('EDITOR ZVUKU');
  GotoXY(34,1); Write('soubor=',FileName);
  GotoXY(73,1); Write('F10=EXIT');
  TextColor(7); TextBackground(0);
  GotoXY(80,25);
End;


Procedure WriteMenu;
Begin
  WriteLista; If MMSelect>0 then WriteNabidka;
  Case MMSelect of
    0: Begin
         TextColor(7); TextBackground(0);
         GotoXY(1,2); ClrEol;
         GotoXY(1,3); ClrEol;
         GotoXY(1,4); ClrEol;
         GotoXY(1,5); ClrEol;
         GotoXY(1,6); ClrEol;
         GotoXY(80,25);
       End;
    1: Begin
         TextColor(2); TextBackground(4);
         GotoXY(1,2); Write('vytvoýit F4');
         TextColor(7); TextBackground(0);
       End;
    2: Begin
         TextColor(2); TextBackground(4);
         GotoXY(1,3); Write('ulo§it   F2');
         TextColor(7); TextBackground(0);
       End;
    3: Begin
         TextColor(2); TextBackground(4);
         GotoXY(1,4); Write('otevý¡t  F3');
         TextColor(7); TextBackground(0);
       End;
    4: Begin
         TextColor(2); TextBackground(4);
         GotoXY(1,5); Write('editor   F5');
         TextColor(7); TextBackground(0);
       End;
    5: Begin
         TextColor(2); TextBackground(4);
         GotoXY(1,6); Write('n povØda F1');
         TextColor(7); TextBackground(0);
       End;
  End;{Case End}
End;


Procedure MainMenu;
Var Ending: Boolean;
Begin
  ClrScr;
  MMSelect:=0;
  Ending:=False;
  Repeat
    WriteMenu;
    ReadKey; Delay(100); NoBeep;
    Case Port[$60] of
{ESC}    1: Begin MMSelect:=0; End;
{UP}    72: Begin If MMSelect>1 then Dec(MMSelect) Else MMSelect:=5; End;
{DOWN}  80: Begin If MMSelect<5 then Inc(MMSelect) Else MMSelect:=1; End;
{ENTER} 28: Begin MMFunction; End;
{F1}    59: Begin FnHelp; End;
{F2}    60: Begin If FileName='none' then SoundStorno Else FnSave; End;
{F3}    61: Begin If FileName='none' then FnLoad Else SoundStorno; End;
{F4}    62: Begin If FileName='none' then FnCreate Else SoundStorno; End;
{F5}    63: Begin If FileName='none' then SoundStorno Else FnEditor; End;
{F10}   68: Begin Ending:=True; End;
    End; {Case End}
  Until Ending=True;
End;


Procedure Main;
Begin
  InitArrays;
  FileName:='none';
  Loading:=False;
  MainMenu;
  ClrScr;
End;


{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
Begin Main; End.