diff --git a/harbour/ChangeLog b/harbour/ChangeLog index ebb91105bf..12dce11940 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,16 @@ +19990812-14:00 EDT David G. Holm + * source/rtl/Makefile + + Added tone.c + + source/rtl/tone.c + + New TONE() function supplied by Chen Kedem + I reorganized it so that Harbour C functions can generate tones + by callin hb_tone( , ) and I also added + DOS support for Borland and DJGPP. + * tests/working/Makefile + + Added sound.prg + + tests/working/sound.prg + + New test module to test TONE() function. + 19990812-14:10 GMT+2 Ryszard Glab *source/compiler/harbour.y diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 109806c854..431a922f0d 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -30,6 +30,7 @@ C_SOURCES=\ set.c \ setcolor.c \ strings.c \ + tone.c \ transfrm.c \ \ gtxxx.c \ diff --git a/harbour/source/rtl/tone.c b/harbour/source/rtl/tone.c new file mode 100644 index 0000000000..132e2bad1b --- /dev/null +++ b/harbour/source/rtl/tone.c @@ -0,0 +1,155 @@ +/* + * $Id$ + */ + +/* + Harbour Project source code + + Copyright 1999 by Chen Kedem + www - http://www.harbour-project.org + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version, with one exception: + + The exception is that if you link the Harbour Runtime Library (HRL) + and/or the Harbour Virtual Machine (HVM) with other files to produce + an executable, this does not by itself cause the resulting executable + to be covered by the GNU General Public License. Your use of that + executable is in no way restricted on account of linking the HRL + and/or HVM code into it. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + their web site at http://www.gnu.org/). + + V 1.1 David G. Holm Split machine dependent code into + hb_tone() function for internal use + by other Harbour C functions. + V 1.0 Chen Kedem Initial version (only OS/2 support). +*/ + +#if defined(__BORLANDC__) || defined(__DJGPP__) + #include +#endif +#if defined(__DJGPP__) + #include +#endif +#if defined(OS2) || defined(__BORLANDC__) + #include +#endif + +#include "extend.h" +#include "init.h" + +/* $DOC$ + * $FUNCNAME$ + * TONE() + * $CATEGORY$ + * Misc. + * $ONELINER$ + * Sound a tone with a specifies frequency and duration + * $SYNTAX$ + * TONE( , ) --> NIL + * $ARGUMENTS$ + * is a positive numeric value in the range of 37..32767 + * specifies the frequency of the tone in herts. + * + * is a positive numeric value which specifies the duration + * of the tone in 1/18 of a second units. + * $RETURNS$ + * TONE() always return NIL. + * $DESCRIPTION$ + * TONE() is a sound function that could be used to irritate the end + * user, his or her dog and the surrounding neighborhood. + * $EXAMPLES$ + * If lOk // Good Sound + * TONE( 500, 1 ) + * TONE( 4000, 1 ) + * TONE( 2500, 1 ) + * Else // Bad Sound + * TONE( 300, 1 ) + * TONE( 499, 5 ) + * TONE( 700, 5 ) + * EndIf + * $TESTS$ + * TONE( 800, 1 ) // same as ? CHR(7) + * TONE( 32000, 200 ) // any dogs around yet? + * TONE( 130.80, 1 ) // musical note - C + * TONE( 400, 0 ) // short beep in CA-Clipper + * TONE( 700 ) // short beep in CA-Clipper + * TONE( 10, 1 ) // do nothing in CA-Clipper + * TONE( -1 ) // do nothing in CA-Clipper + * TONE( ) // do nothing in CA-Clipper + * $STATUS$ + * + * $COMPLIANCE$ + * TONE() works exactly like CA-Clipper's TONE(). + * $SEEALSO$ + * CHR(), SET BELL + * $END$ + */ + + +HARBOUR HB_TONE(void); + +HB_INIT_SYMBOLS_BEGIN( Tone__InitSymbols ) +{ "TONE", FS_PUBLIC, HB_TONE, 0 } +HB_INIT_SYMBOLS_END( Tone__InitSymbols ); +#if ! defined(__GNUC__) +#pragma startup Tone__InitSymbols +#endif + +void hb_tone( double frequency, double duration ) +{ + /* platform specific code */ + /* + If duration is in ms, the conversion from + Clipper 1/18 sec is * 1000.0 / 18.0 + */ + /* TODO: add more platform support */ +#if defined(OS2) + frequency = MIN( MAX( 0.0, frequency ), 65535.0 ); + duration = duration * 1000.0 / 18.0; + duration = MIN( MAX ( 0.0, duration ), 65535.0 ); + DosBeep( ( USHORT ) frequency, ( USHORT ) duration ); +#elif defined(__BORLANDC__) + frequency = MIN( MAX( 0.0, frequency ), 65535.0 ); + duration = duration * 1000.0 / 18.0; + duration = MIN( MAX ( 0.0, duration ), 65535.0 ); + sound( ( unsigned ) frequency ); + delay( ( unsigned ) duration ); + nosound(); +#elif defined(__DJGPP__) + /* Note: delay() in does not work! */ + clock_t end_clock; + frequency = MIN( MAX( 0.0, frequency ), 32767.0 ); + duration = duration * CLOCKS_PER_SEC / 18.0 ; + duration = MIN( MAX ( 0.0, duration ), 65535.0 ); + sound( ( int ) frequency ); + end_clock = clock() + ( clock_t ) duration; + while( clock() < end_clock ); + sound( 0 ); +#endif +} + +HARBOUR HB_TONE(void) +{ + double frequency, duration; + if( PCOUNT > 0 && ISNUM( 1 ) ) + { + frequency = hb_parnd ( 1 ); + if( PCOUNT > 1 && ISNUM( 2 ) ) + duration = hb_parnd( 2 ); + else + duration = 1.0; + hb_tone( frequency, duration ); + } +} diff --git a/harbour/tests/working/Makefile b/harbour/tests/working/Makefile index acb27db746..42c9c0f1f9 100644 --- a/harbour/tests/working/Makefile +++ b/harbour/tests/working/Makefile @@ -107,6 +107,7 @@ PRG_SOURCES=\ seconds.prg \ set_num.prg \ set_test.prg \ + sound.prg \ statfun.prg \ statics.prg \ strcmp.prg \ diff --git a/harbour/tests/working/sound.prg b/harbour/tests/working/sound.prg new file mode 100644 index 0000000000..44a208021d --- /dev/null +++ b/harbour/tests/working/sound.prg @@ -0,0 +1,5 @@ +function main() + tone( 440, 9 ) + tone( 880, 9 ) + tone( 440, 9 ) +return nil