HMGforum.com

Exclusive forum for HMG, a Free / Open Source xBase WIN32/64 Bits / GUI Development System
http://hmgforum.com/

SONIDO POR SPEAKERS

http://hmgforum.com/viewtopic.php?t=4455

Page 1 of 1

SONIDO POR SPEAKERS

Posted: Wed Aug 19, 2015 2:58 pm
by LOUIS
Hola Amigos, encontré por ahí un programita que primero lo hicieron en GWBasic, luego lo pasaron a Clipper, y bueno lo adapté a HMG bajo el modo de consola, lo compilé muy bien bajo la versión 3.0.46 y salió el ejecutable, pero al tocar las melodías, estas no se escuchan por los parlantes, esto se debe a que está dirigido a sonar en un pequeño speaker que antes venía dentro del CPU (lo recuerdan?) ... Alguien de Uds podría corregir el código para que suene por los parlantes externos ? ... Se os agradece mucho.

Code: Select all

* Programa: Music.prg
* Creditos: IBM, programa original en GWBASIC, 1981
* Dennis L. Dias, funcion TONE() en ensamblador 09/12/87
* Autor:    Juan Carlos Ocampo de la Cruz, Version en Clipper 04/11/93
*           e-mail: SodaStereano@hotmail.com
*           Acapulco, México


#include "HMG.CH"
#include "Inkey.ch"
#include 'hbclass.ch'
#include 'common.ch'

REQUEST HB_GT_WIN_DEFAULT

FUNCTION MAIN()
SET NAVIGATION EXTENDED

   DEFINE WINDOW PRINCIPAL;
      AT 0,0 WIDTH 0 HEIGHT 0 NOSHOW MAIN;
      ON INIT ENTRADA()
   END WINDOW

ACTIVATE WINDOW PRINCIPAL
RETURN NIL

*-------------------------
Procedure ENTRADA()
// Console-Part
PRINCIPAL.HIDE

SETCURSOR(0)
SETCOLOR("W+/B,W+/R,R")
SET WRAP ON
SET MESSAGE TO 24 CENTER

aColumna=Array(70)
nColumna=5

*** llena el arreglo de las columnas donde se colocara el simbolo musical
FOR nIndice=1 TO 70
    IF nIndice>39
       ++nColumna
    ENDIF
    IF nIndice=40 .OR. nIndice=45 .OR. nIndice=52 .OR. nIndice=57 .OR. nIndice=64 .OR. nIndice=70
       ++nColumna
    ENDIF
    aColumna[nIndice]=nColumna
NEXT

CLEAR
@0,0 TO 23,79
@03,0 SAY CHR(195)+REPLICATE(CHR(196),78)+CHR(180)
@21,0 SAY CHR(195)+REPLICATE(CHR(196),78)+CHR(180)
SETCOLOR("GR*+/B")
@0,34 SAY " Clipper M£sica "
SETCOLOR("BG+/B")
@02,1 SAY "(C) Copyright IBM & Juan Carlos Ocampo de la Cruz, 1982, 1993."
@22,1 SAY "["+CHR(25)+CHR(24)+"] Elige melodia  ["+CHR(17)+CHR(196)+CHR(217)+"] Toca   [Esc] Salir"

Piano()
cPantalla=SAVESCREEN(7,4,11,38)

WHILE .T.
  
  @04,40 PROMPT "A Yankee Doodle                   " MESSAGE "A n ¢ n i m o"
  @05,40 PROMPT "B La Cucaracha                    " MESSAGE "Melodia tradicional Mexicana"
  @06,40 PROMPT "C Vals del Danubio Azul           " MESSAGE "Johann Strauss (1825-1899)"
  @07,40 PROMPT "D Humoresque                      " MESSAGE "Anton Dvorak (1841-1904)"
  @08,40 PROMPT "E Pop! Goes The Weasel            " MESSAGE "A n ¢ n i m o"
  @09,40 PROMPT "F Sinfon¡a 40                     " MESSAGE "Wolfgang Amadeus Mozart (27/01/1756 - 05/12/1791)"
  @10,40 PROMPT "G Funeral March of a Marionette   " MESSAGE "Carlos Gounod (1818-1893)"
  @11,40 PROMPT "H Estrellas y barras para siempre " MESSAGE "John Philipp Sousa (1854-1932)"
  @12,40 PROMPT "I El Sombrero                     " MESSAGE "Melodia tradicional Mexicana"
  @13,40 PROMPT "J Sakura                          " MESSAGE "Melodia tradicional Japonesa"
  @14,40 PROMPT "K Escalas                         " MESSAGE "E s c a l a s"
  
  MENU TO nOpcion
  
  IF nOpcion=0
     EXIT
  ELSE 
     TOCA(nOpcion)
  ENDIF
  
ENDDO
CLEAR
quit
RETURN

*** Calcula las frecuencias de las melodias y coloca un simbolo musical en el teclado
PROCEDURE Sonido(aFrecDurac)
  lLinea11=.T.
  FOR nIndice=1 TO LEN(aFrecDurac) STEP 2
     IF INKEY()=27  // Esc 
	EXIT
     ENDIF
     *** coloca un simbolo musical en el teclado de piano
     IF lLinea11
       @11,aColumna[aFrecDurac[nIndice]] SAY CHR(14)
       lLinea11=.F.
     ELSE
       @07,aColumna[aFrecDurac[nIndice]] SAY CHR(13)
       lLinea11=.T.
     ENDIF
     *** Quien sabe que significa esta formula, pero funciona
     TONE(36.8*(2^(1/12))^(aFrecDurac[nIndice]-6),aFrecDurac[nIndice+1])
     RESTSCREEN(7,4,11,38,cPantalla)
  NEXT
RETURN

*** Toca la melodia
PROCEDURE Toca(nOpcion) 
  DO CASE
     CASE nOpcion=1  // Yankee Doodle
       aNotas={50,3,50,3,52,3,54,3,50,3,54,3,52,3,45,3,50,3,50,3,52,3,54,3,50,6,;
	       49,3,1,3,;
	       50,3,50,3,52,3,54,3,55,3,54,3,52,3,50,3,49,3,45,3,47,3,49,3,50,6,;
	       50,3,1,3,;
	       47,5,49,1,47,3,45,3,47,3,49,3,50,3,1,3,45,5,47,1,45,3,43,3,42,6,;
	       45,3,1,3,;
	       47,5,49,1,47,3,45,3,47,3,49,3,50,3,47,3,45,3,50,3,49,3,52,3,50,6,;
	       50,6}
     CASE nOpcion=2  // La Cucaracha
       aNotas={42,1,1,1,42,1,1,1,42,1,1,1,47,1,1,5,51,1,1,3,42,1,1,1,42,1,1,1,;
	       42,1,1,1,47,1,1,5,51,1,1,5,30,1,1,1,30,1,1,1,35,1,1,3,47,1,1,1,;
	       47,1,1,1,46,1,1,1,46,1,1,1,44,1,1,1,44,1,1,1,42,8,1,2,42,1,1,1,;
	       42,1,1,1,42,1,1,1,46,1,1,5,49,1,1,3,42,1,1,1,42,1,1,1,42,1,1,1,;
	       46,1,1,5,49,1,1,5,37,1,1,1,37,1,1,1,30,1,1,3,54,2,56,2,54,2,52,2,;
	       51,2,49,2,47,8}
     CASE nOpcion=3 // Blue Danube Waltz
       aNotas={42,4,46,4,49,4,49,4,1,4,61,2,1,2,61,2,1,6,58,2,1,2,58,2,1,6,42,4,42,4,;
	       46,4,49,4,;
	       49,4,1,4,61,2,1,2,61,2,1,6,59,2,1,2,59,2,1,6,41,4,41,4,44,4,51,4,51,4,;
	       1,4,63,2,1,2,63,2,1,6,59,2,1,2,;
	       59,2,1,6,41,4,41,4,44,4,51,4,51,4,1,4,63,2,1,2,63,2,1,6,58,2,1,2,58,2,;
	       1,6,42,4,;
	       42,4,46,4,49,4,54,4,1,4,66,2,1,2,66,2,1,6,61,2,1,2,61,2,1,6,42,4,;
	       42,4,46,4,49,4,54,4,1,4,66,2,1,2}
       *** Para evitar el error PARSE STACK OVERFLOW 
       aNotas2={66,2,1,6,63,2,1,2,63,2,1,6,44,4,44,4,47,4,51,2,1,2,51,14,1,2,48,4,;
		49,4,58,16,;
		54,4,46,4,46,8,44,4,51,8,49,4,42,4,1,2,42,2,42,4,1,8,49,2,1,2,47,2,;
		1,6,49,2,1,2,;
		47,2,1,6,49,4,58,16,56,4,49,2,1,2,46,2,1,6,49,2,1,2,46,2,1,6,49,4,;
		56,16,54,4,49,2,1,2,47,2,1,6,49,2,1,2,47,2,1,6,49,4,58,16,;
		56,4,49,4,54,4,56,4,58,4,61,8,59,4,58,2,58,2,58,4,58,2,1,2,54,4,1,8}
    CASE nOpcion=4  // Humoresque
       aNotas={47,3,1,2,49,1,47,3,1,2,49,1,51,3,1,2,54,1,56,3,1,2,54,1,;
	       59,3,1,2,58,1,61,3,1,2,59,1,58,3,1,2,61,1,59,3,1,2,56,1,;
	       54,3,1,2,54,1,56,3,1,2,54,1,59,3,1,2,56,1,54,3,1,2,51,1,;
	       49,24,47,3,1,2,49,1,47,3,1,2,49,1,51,3,1,2,54,1,56,3,1,2,54,1,;
	       56,3,1,2,58,1,61,3,1,2,59,1,58,3,1,2,61,1,59,3,1,2,56,1,;
	       54,3,1,2,54,1,59,3,1,2,47,1,49,6,54,6,47,18}
    CASE nOpcion=5 // Pop! Goes The Weasel
       aNotas={47,2,1,2,47,2,49,2,1,2,49,2,51,2,54,2,51,2,47,2,1,2,42,2,;
	       47,2,1,2,47,2,49,2,1,2,49,2,51,6,47,2,1,2,42,2,47,2,1,2,47,2,49,2,;
	       1,2,49,2,51,2,54,2,51,2,47,2,1,4,56,2,1,4,49,2,1,2,52,2,51,6,47,2,;
	       1,4,59,2,1,2,59,2,56,2,1,2,59,2,58,2,61,2,58,2,54,2,1,4,59,2,1,2,;
	       59,2,56,2,1,2,59,2,58,6,54,2,1,2,51,2,52,2,1,2,51,2,52,2,1,2,54,2,;
	       56,2,1,2,58,2,59,2,1,4,56,2,1,4,49,2,1,2,52,2,51,6,47,2}
    CASE nOpcion=6 // Symphony #40
      aNotas={55,2,54,2,54,4,55,2,54,2,54,4,55,2,54,2,54,4,62,4,1,4,;
	      62,2,61,2,59,4,59,2,57,2,55,4,55,2,54,2,;
	      52,4,52,4,1,4,54,2,52,2,52,4,54,2,52,2,52,4,54,2,52,2,;
	      52,4,61,4,1,4,61,2,59,2,58,4,58,2,55,2,54,4,54,2,52,2,;
	      50,4,50,4,1,4,62,2,61,2,61,4,64,4,58,4,61,4,;
	      59,4,54,4,1,4,62,2,61,2,61,4,64,4,58,4,61,4,;
	      59,4,62,4,61,2,59,2,57,2,55,2,54,4,46,4,47,4,49,4,;
	      50,4,52,2,50,2,49,4,47,4,54,4,1,4,65,8,;
	      66,2,1,6,65,8,66,2,1,6,65,8,;
	      66,4,65,4,66,4,65,4,66,4}
    CASE nOpcion=7 // Funeral March of a Marionette
      aNotas={37,1,1,2,30,1,1,5,42,3,42,3,41,3,39,3,41,3,1,3,42,3,44,3,1,3,37,1,1,2,;
	      30,1,1,5,42,3,42,3,41,3,39,3,41,3,1,3,42,3,44,3,1,3,37,3,42,3,1,3,45,3,;
	      49,6,47,3,45,3,1,3,49,3,52,6,50,3,49,3,1,3,53,3,56,6,54,3,53,3,50,3,;
	      49,3,47,3,45,3,44,3,30,1,1,5,42,3,42,3,41,3,39,3,41,3,1,3,42,3,44,3,;
	      1,3,37,1,1,2,30,1,1,5,42,3,42,3,41,3,39,3,41,3,1,3,42,3,44,3,1,3,;
	      37,3,45,3,1,3,49,3,52,6,50,3,49,3,47,3,45,3,43,3,47,3,50,3,42,3,;
	      41,3,42,3,44,3,1,3,45,1,1,2,44,9,42,1}
    CASE nOpcion=8 // Stars And Stripes Forever
      aNotas={54,6,54,6,52,3,51,3,51,6,50,3,51,3,51,16,1,2,50,3,;
	      51,3,51,6,50,3,51,3,;
	      54,6,51,3,54,3,52,12,49,6,1,3,49,3,49,6,48,3,49,3,;
	      49,6,48,3,49,3,;
	      52,16,1,2,51,3,49,3,51,3,54,9,56,9,56,3,49,16,1,2,54,6,;
	      54,6,52,3,51,3,51,6,50,3,51,3,51,16,1,2,50,3,51,3,51,6,50,3,51,3,;
	      52,3,51,3,49,5,46,1,49,12,47,6,1,3,47,3,47,6,46,3,47,3,50,6,49,3,47,3,;
	      59,15,1,3,47,3,49,3,51,3,54,1,1,2,47,3,49,3,51,3,54,1,1,2,42,3,44,5,;
	      51,1,49,12,47,1}
    CASE nOpcion=9 // El sombrero
      aNotas={52,2,57,2,1,2,52,2,57,2,1,2,52,2,57,6,1,4,52,2,57,2,59,2,57,2,56,4,;
	      57,2,59,2,1,8,52,2,56,2,1,2,52,2,56,2,1,2,52,2,56,6,1,4,52,2,;
	      56,2,57,2,56,2,54,4,56,2,57,2,1,6,64,2,63,2,64,2,61,2,60,2,61,2,;
	      57,2,56,2,57,2,52,2,1,4,49,2,50,2,52,2,54,2,56,2,57,2,59,2,61,2,;
	      62,2,59,2,1,4,62,2,61,2,62,2,59,2,58,2,59,2,56,2,55,2,56,2,52,2,;
	      1,4,64,2,63,2,64,2,66,2,64,2,62,2,61,2,59,2,57,2}
    CASE nOpcion=10 // Sakura
       aNotas={49,8,49,8,51,12,1,4,49,8,49,8,51,12,1,4,49,8,51,8,52,8,51,8,;
	       49,8,51,4,49,4,45,16,44,8,40,8,44,8,45,8,;
	       44,8,44,4,40,4,39,16,49,8,49,8,51,12,1,4,49,8,49,8,51,12,1,4,;
	       40,8,44,8,45,8,49,8,51,4,49,4,45,8,44,16}
    CASE nOpcion=11 // Escalas
      aNotas={38,1,39,1,40,1,41,1,42,1,43,1,44,1,45,1,46,1,47,1,;
	      48,1,49,1,50,1,51,1,52,1,53,1,54,1,55,1,56,1,;
	      57,1,58,1,59,1,60,1,61,1,62,1,63,1,64,1,65,8,1,4,;
	      65,8,64,1,63,1,62,1,61,1,60,1,59,1,58,1,57,1,;
	      56,1,55,1,54,1,53,1,52,1,51,1,50,1,49,1,48,1,;
	      47,1,46,1,45,1,44,1,43,1,42,1,41,1,40,1,39,1,38,8}
  ENDCASE
  Sonido(aNotas)      // Toca
  IF nOpcion=3 .AND. LASTKEY()#27
     Sonido(aNotas2) // Si es la melodia mas larga, toca la 2da. parte 
  ENDIF
RETURN

*** Dibuja teclado de piano
PROCEDURE Piano
  SETCOLOR("W+/N")
  FOR nColumna=0 TO 15
    FOR nLinea=0 TO 8
      @5+nLinea,5+nColumna*2 SAY CHR(219)+CHR(221)
    NEXT
  NEXT
  FOR nColumna=0 TO 12
    FOR nLinea=0 TO 4
      IF nColumna#2 .OR. nColumna#6 .OR. nColumna#9
	@5+nLinea,8+nColumna*2 SAY CHR(32)+CHR(222)
      ENDIF
    NEXT
  NEXT
  FOR nLinea=0 TO 9
    SETCOLOR("R/N")
    @4+nLinea,4  SAY CHR(221)
    SETCOLOR("W+/N")
    @4+nLinea,36 SAY CHR(221)
    SETCOLOR("R/B")
    ??CHR(221)
  NEXT
  SETPOS(4,4)
  FOR nColumna=0 TO 32
    ??CHR(219)
  NEXT
  ??CHR(221)
  SETPOS(13,4)
  FOR nColumna=0 TO 32
    ??CHR(219)
  NEXT
  ??CHR(221)
  SETCOLOR("W+/B")
RETURN

Re: SONIDO POR SPEAKERS

Posted: Thu Aug 20, 2015 6:43 am
by serge_girard
Louis,

Try tone(Frequency, Duration)


Serge

Re: SONIDO POR SPEAKERS

Posted: Thu Aug 20, 2015 5:11 pm
by srvet_claudio
Agrega el siguiente código al final de tu programa y cambia TONE por HMG_TONE

Code: Select all

#pragma BEGINDUMP
#include <windows.h>
#include "hbapi.h"

//        HMG_TONE ( nFrequency , nDuration )
HB_FUNC ( HMG_TONE )
{
   double dFrequency = hb_parnd (1);
   double dDuration  = hb_parnd (2);

/* Clipper
   TONE ( <nFrequency> , <nDuration> )
   
   <nFrequency> is a positive numeric value indicating the frequency of the tone to be sounded.
   The frequency is measured in hertz (cycles per second).

   <nDuration> is a positive numeric value indicating the duration of the tone to be sounded. 
   The duration is measured in increments of 1/18 of a second.
   For example, an <nDuration> value of 18 represents one second ( 18.2 ticks per seconds ).
   
   Table of Musical Notes
   ------------------------------------------------------------------------
   Pitch   Frequency    Pitch     Frequency
   ------------------------------------------------------------------------
   C       130.80       mid C     261.70
   C#      138.60       C#        277.20
   D       146.80       D         293.70
   D#      155.60       D#        311.10
   E       164.80       E         329.60
   F       174.60       F         349.20
   F#      185.00       F#        370.00
   G       196.00       G         392.00
   G#      207.70       G#        415.30
   A       220.00       A         440.00
   A#      233.10       A#        466.20
   B       246.90       B         493.90
                        C         523.30
   ------------------------------------------------------------------------
*/


/* Windows
WINAPI BOOL Beep(
    DWORD dwFrequency,  // sound frequency,  in hertz 
    DWORD dwDuration    // sound duration,   in milliseconds 
   );
*/

   // Convert from ticks to seconds ( 18.2 ticks per seconds )
   dDuration = ( HB_MIN( HB_MAX( 1.0, dDuration ), ULONG_MAX ) ) / 18.2;

   // keep the frequency in an acceptable range
   dFrequency = HB_MIN( HB_MAX( 0.0, dFrequency ), 32767.0 );

   if( dFrequency >= 37.0 )
      Beep( ( DWORD ) dFrequency, ( DWORD ) ( dDuration * 1000 ) );  // Beep wants Milliseconds
   else
      hb_idleSleep( dDuration );
}

#pragma ENDDUMP
PD: Esto seguro que funciona en WIN7 o superior, en WinXP y Vista depende del hardware del equipo.

Re: SONIDO POR SPEAKERS

Posted: Thu Aug 20, 2015 5:43 pm
by LOUIS
Mr. Serge, i don't understand your help ... sorry but thank you very much.

Dr. Claudio, sí funcionó, lamentablemente el sonido no es igual al original, es como si tuviera + pitch ... de igual modo muchas gracias por su aporte.

Louis.

Re: SONIDO POR SPEAKERS

Posted: Thu Aug 20, 2015 11:48 pm
by danielmaximiliano
Hola Louis : si el pitch es rapido intenta que sea mas alto el valor de "1000" creo esta ahi la correccion ...

Beep( ( DWORD ) dFrequency, ( DWORD ) ( dDuration * 1000 ) ); // Beep wants Milliseconds

Re: SONIDO POR SPEAKERS

Posted: Fri Aug 21, 2015 9:47 am
by mustafa
Hola LOUIS:
mira este sample "Music_Tone_New.zip"
en: viewtopic.php?f=8&t=1108&p=33140&hilit=mustafa#p33140
esta implementado sobre el sample de Clipper
Un saludo
Mustafa

Re: SONIDO POR SPEAKERS

Posted: Fri Sep 25, 2015 7:24 pm
by edufloriv
¡ Recuerdo muy bien esa aplicación ! - Que genial. Recuerdo que le agregué algunas canciones al listado. Si consiguen hacerlo funcionar con HMG sería excelente que lo compartan. Así me inicié en este fascinante mundo de la programación con "BASIC" ji ji ;)


Saludos cordiales a todos.


Eduardo Flores Rivas
LIMA - PERU

Re: SONIDO POR SPEAKERS

Posted: Thu Mar 24, 2016 5:37 pm
by mustafa
Hola Louis
el amigo Juan Carlos <sodastereano@hotmail.com>
me ha mandado un e-mail indicando que no puede entrar en la
Web , Ha modificado el Sample de Music_Tone
asunto: Funcion tone por tarjeta de sonido en harbour
Hola Mustafa:

Hace tiempo compartimos mensajes acerca de un programa musical con tone en Clipper.
Hace meses en el foro viewtopic.php?t=4455 el usuario LOUIS pregunto por un problema de que la función tone no funciona en algunos ordenadores porque ya no poseen el altavos interno.
No le pude responder porque no soy miembro del foro y las inscripciones están desabilitados por el admnistrador.
Pues bien, hace tiempo un desarrollador xHabour volvió escribir la función con salida a la tarjeta de sonido, te anexo el código hbtone.prg
Al programa en Clipper/harbour lo modifique para elegir la salida del sonido al altavos interno o a la tarjeta de sonido, anexo exe y prg, sonido suena como en este video que hice http://www.youtube.com/watch?v=1wQMHsqxo_s
Por si gustas modificar tu programa y compartirlo con LOUIS.
Saludos.
Te dejo el programa music.zip que me ha mandado Juan Carlos
un Saludo
Mustafa
All times are UTC
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited