Editor hudby pre programy v pascale
Delphi & Pascal (èeská wiki)
Category: KMP (Club of young programmers)
Author: Martin Koleèek
Program: Editsnd.pas, Speaker.pas
need: Manual_snd.txt
Author: Martin Koleèek
Program: Editsnd.pas, Speaker.pas
need: Manual_snd.txt
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.
{ 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.