Pascal Sound Question

[xneoangel]

Hey guys long time no see How are you all doing?

Well here i go, i'm currently studying to be an informatic engineer, i'm on my second semester and i'm learning pascal.

But i have a problem with the sound(hz); command, apparently on windows XP if you have a sound card connected instead of getting the audio frequency you set for the internal PC speaker, you get the default windows beep through the sound card.

Is there a way to make the sound command work?

I found a little music maker made in pascal that does work but i dont understand the code.

Well here's the code, any ideas? I only want to be able to use the sound command properly to add some simple tunes to my programs.

(*************************************)
(* Programa Music Maker *)
(* Permite componer, reproducir y *)
(* almacenar tus propias melodías. *)
(* *)
(* Realizado por Jes£s Arroyo: *)
(* [email protected] 02/2008 *)
(* *)
(*************************************)

Program Music_Maker;

uses crt;

type indice='1'..'9';
puntero=^elemento;
elemento=record
nota : indice;
dur : indice;
sig : puntero;
end;

const d0 = 264 ;
re = 297;
mi = 330;
fa = 352;
sol = 396;
la = 440 ;
si = 495 ;
d = 528 ;


(******************************************************************************)

procedure inicio(s:string);
var i : integer;
c : string;
begin
c:='';
for i:=1 to length(s) do
begin
clrscr;
c:=c+s;
write(c);
delay(50);
end;
end;

(******************************************************************************)

procedure Music;
begin
textcolor(2);
highvideo;
window(6,4,49,5);
inicio(' /\ /\ ___ <> ___ ');
window(6,5,49,6);
inicio(' //\\//\\ || || // \\ /___|');
window(6,6,49,7);
inicio(' ///\\//\\\ || || \\__ || // ');
window(6,7,49,8);
inicio(' /// \/ \\\ || || \\ || \\___ ');
window(6,8,49,9);
inicio('/// \\\ ||____|| \\_// || \___|');
end;

(******************************************************************************)

procedure Maker;
begin
textcolor(2);
highvideo;
window(14,11,62,12);
inicio(' _____ ____ ');
window(14,12,62,13);
inicio(' /\ /\ /\ || // |____| || \\');
window(14,13,62,14);
inicio(' //\\//\\ //\\ ||// ||___ || //');
window(14,14,62,15);
inicio(' ///\\//\\\ // \\ | / | ___| ||// ');
window(14,15,62,16);
inicio(' /// \/ \\\ //\/\/\\ | \ ||___ ||\\ ');
window(14,16,62,17);
inicio('/// \\\ // \\ ||\\ |____| || \\');
end;

(******************************************************************************)

procedure MM;
begin
Music;
Maker;
delay(1000);
window(1,1,80,22);
end;

(******************************************************************************)

function listaCargada(t:string;var error0:boolean)untero;
var n,d : indice;
prim,p,q : puntero;
f : text;
begin
assign(f,'Melodias\'+t+'.txt');
{$I-}
reset(f);
{$I+}
if ioresult<>0 then begin
textcolor(10);
gotoxy(28,11);
writeln('El archivo no existe');
listaCargada:=nil;
error0:=true;
readln;
end
else
if eof(f) then
begin
textcolor(10);
gotoxy(28,11);
writeln('El archivo est vac¡o');
listaCargada:=nil;
error0:=true;
readln;
end
else
begin
new(p);
prim:=p;
readln(f,n);
p^.nota:=n;
readln(f,d);
p^.dur:=d;
if eof(f) then p^.sig:=nil
else
while not eof(f) do
begin
new(p^.sig);
p:=p^.sig;
readln(f,n);
p^.nota:=n;
readln(f,d);
p^.dur:=d;
end;
p^.sig:=nil;
listaCargada:=prim;
end;
end;

(******************************************************************************)

procedure reproductor(var error0:boolean);
var p : puntero;
v : word;
t : string;
begin
textcolor(10);
gotoxy(18,5);
write('Escribe el nombre de la melod¡a: ');
textcolor(11);
readln(t);
p:=listaCargada(t,error0);
if p<>nil then
begin
textcolor(10);
gotoxy(18,8);
write('Escribe la velocidad de la melod¡a: ');
textcolor(11);
readln(v);
end
else error0:=true;
textcolor(10);
gotoxy(28,14);
writeln('*Reproduciendo!');
while p<>nil do
begin
case p^.nota of
'1' : sound(d0);
'2' : sound(re);
'3' : sound(mi);
'4' : sound(fa);
'5' : sound(sol);
'6' : sound(la);
'7' : sound(si);
'8' : sound(d);
'9' : nosound
else begin
gotoxy(23,14);
writeln('Existe un error en el archivo');
end;
end;
case p^.dur of
'1' : delay(16*v);
'2' : delay(8*v);
'3' : delay(4*v);
'4' : delay(2*v);
'5' : delay(1*v)
else begin
gotoxy(23,14);
writeln('Existe un error en el archivo');
end;
end;
p:=p^.sig;
nosound;
end;
error0:=true;
end;

(******************************************************************************)

procedure pant_not_dur;
begin
textbackground(1);
textcolor(15);
window(40,4,75,20);
writeln(' ______________________________ ');
writeln(' | | | ');
writeln(' | 1. Do | 1. Redonda | ');
writeln(' | 2. Re | 2. Blanca | ');
writeln(' | 3. Mi | 3. Negra | ');
writeln(' | 4. Fa | 4. Corchea | ');
writeln(' | 5. Sol | 5. Semicorchea | ');
writeln(' | 6. La |________________| ');
writeln(' | 7. Si | ');
writeln(' | 8. Do* | ');
writeln(' | 9. Silencio | ');
writeln(' |_____________| ');
writeln(' ');
end;

(******************************************************************************)

procedure crear(var primuntero);

var p,q : puntero;
opcion,rep,notabool,durbool : boolean;
op : char;

begin
pant_not_dur;
textbackground(0);
textcolor(15);
window(5,2,35,20);
new(prim);

repeat
write('Escribe la nota: '); readln(prim^.nota);
case prim^.nota of
'1'..'9' : notabool:=true
else begin
gotoxy(wherex,wherey-1);
clreol;
notabool:=false;
end;
end;
until notabool=true;

repeat
write('Escribe la duraci¢n: '); readln(prim^.dur);
case prim^.dur of
'1'..'5' : durbool:=true
else begin
gotoxy(wherex,wherey-1);
clreol;
durbool:=false;
end;
end;
until durbool=true;

p:=prim;
rep:=true;
repeat
textcolor(11);
write('¨Quieres continuar? (s/n): '); readln(op);
case op of
's','S' : begin
opcion:=true;
rep:=true;
end;
'n','N' : begin
opcion:=false;
rep:=true;
p^.sig:=nil;
end;
else begin
rep:=false;
gotoxy(1,wherey-1);
end;
end;
until rep=true;
gotoxy(wherex,wherey-1);
clreol;
writeln('');

while opcion<>false do
begin
textcolor(15);
new(q);

repeat
write('Escribe la nota: '); readln(q^.nota);
case q^.nota of
'1'..'9' : notabool:=true
else begin
gotoxy(wherex,wherey-1);
clreol;
notabool:=false;
end;
end;
until notabool=true;

repeat
write('Escribe la duraci¢n: '); readln(q^.dur);
case q^.dur of
'1'..'5' : durbool:=true
else begin
gotoxy(wherex,wherey-1);
clreol;
durbool:=false;
end;
end;
until durbool=true;

p^.sig:=q;
p:=q;
repeat
textcolor(11);
write('¨Quieres continuar? (s/n): '); readln(op);
case op of
's','S' : begin
opcion:=true;
rep:=true;
end;
'n','N' : begin
opcion:=false;
rep:=true;
p^.sig:=nil;
end;
else begin
rep:=false;
gotoxy(1,wherey-1);
end;
end;
until rep=true;
gotoxy(wherex,wherey-1);
clreol;
writeln('');
end;
end;

(******************************************************************************)

procedure crear_archivo(Puntero);
var f : text;
t : string;
begin
window(1,1,80,22);
clrscr;
textcolor(10);
gotoxy(18,7);
write('Escribe el nombre de la melod¡a: ');
textcolor(11);
readln(t);
assign(f,'Melodias\'+t+'.txt');
rewrite(f);
if p<>nil then begin
while p<>nil do
begin
writeln(f,p^.nota);
writeln(f,p^.dur);
p:=p^.sig;
end;
end;
close(f);
textcolor(10);
gotoxy(28,12);
writeln('*Melod¡a guardada!');
end;

(******************************************************************************)

procedure borrar_archivo;
var f : text;
t : string;
begin
window(1,1,80,22);
clrscr;
textcolor(10);
gotoxy(10,7);
write('Escribe el nombre de la melod¡a que deseas borrar: ');
textcolor(11);
readln(t);
assign(f,'Melodias\'+t+'.txt');
{$I-}
reset(f);
{$I+}
if ioresult<>0 then begin
textcolor(10);
gotoxy(28,11);
writeln('El archivo no existe');
end
else begin
assign(f,'Melodias\'+t+'.txt');
erase(f);
textcolor(10);
gotoxy(28,11);
writeln('*Melod¡a eliminada!');
end;
end;

(******************************************************************************)

procedure menu;

var op:char;
t : string;
p : puntero;
error0,error1:boolean;
me:string;

begin
textcolor(11);
repeat
clrscr;
error0:=false;
gotoxy(4,4);
writeln('1. Componer melod¡a');
gotoxy(4,7);
writeln('2. Reproducir melod¡a');
gotoxy(4,10);
writeln('3. Salir');
gotoxy(2,15);
write('Selecciona la una opci¢n: ');
readln(op);

case op of
'1' : begin
clrscr;
repeat
error1:=false;
gotoxy(4,4);
writeln('1. Crear melod¡a');
gotoxy(4,7);
writeln('2. Eliminar melod¡a');
gotoxy(4,10);
writeln('3. Ir al men£');
gotoxy(2,15);
write('Selecciona la una opci¢n: '); readln(op);
case op of
'1' : begin
clrscr;
crear(p);
crear_archivo(p);
delay(1500);
error1:=true;
clrscr;
textcolor(11);
end;
'2' : begin
borrar_archivo;
delay(1000);
error1:=true;
clrscr;
textcolor(11);
end;
'3' : error0:=true;
else error1:=true;
end;
until error1<>true;
end;

'2' : begin
clrscr;
reproductor(error0);
textcolor(11);
end;

'3' : exit;
else error0:=true;
end;
until error0<>true;
end;

(******************************************************************************)

begin
MM;
menu;
end.

 

[Cyberman]

I suggest going through the code and tossing out on the 'pretty' code for window twiddling first. Then move to anything that looks like it's dealing with sound. rewrite each section of sound code in psuedo code as your best guess of what it is doing. Then examine what the program looks like as a result.

Do you know C/C++ or C#? <-- microsofts new version of BASIC LOL
I suggest moving it to a computer language you are familiar with and using 'fake subroutines'/functions/procedures to give yourself a clue what is going on.

Cyb

 

[xneoangel]

I suggest going through the code and tossing out on the 'pretty' code for window twiddling first. Then move to anything that looks like it's dealing with sound. rewrite each section of sound code in psuedo code as your best guess of what it is doing. Then examine what the program looks like as a result.

Do you know C/C++ or C#? <-- microsofts new version of BASIC LOL
I suggest moving it to a computer language you are familiar with and using 'fake subroutines'/functions/procedures to give yourself a clue what is going on.

Cyb

No i don't know any other programming language, i'm learning pascal ATM, oh well i guess i'll have to take another look at that code.

 

[Cyberman]

Ahh pascal then it is.
Isolate each procedure by what function it performs.
I'm trying to avoid doing your work for you. However that is the way you need to do it. Remove anything that has to do with windows or prompts and deal with what is left as the part that makes the music.

Unfortunately the pascal interface may be unique to the library it has and may use Direct X or something.

Cyb

 

[xneoangel]

Ook well then i guess i'll take a look at that code when i'm a bit more advanced, as of now there are some things i need to learn first like pointers and some functions.