Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DBT10.ZIP
Filename : DBTAUDIO.PRG

 
Output of file : DBTAUDIO.PRG contained in archive : DBT10.ZIP

*=====================================================================
* DBTAUDIO.PRG - demo of sound functions
* (c) 1989 BERNATH COMPUTER
* 13:57:05 11/1/1989
*=====================================================================
PARAMETERS CHOICE

CALL DBTOOLS WITH "15,3" && save screen
CALL DBTOOLS WITH "4,0,0" && cursor off
CALL DBTOOLS WITH "7,3,9,4,0" && dither background
CALL DBTOOLS WITH "3,3,5,11,53,15,5,2,0,1" && draw box

DO CASE CHOICE
CASE CHOICE = 1 .OR. CHOICE = 3
CALL DBTOOLS WITH "1,4,10,15,5,0,B L A T - function 2"
CALL DBTOOLS WITH "1,5,10,15,5,0,T W I D D L E - function 18"
set color to w/rb
@ 5,8 SAY "BLAT and TWIDDLE provide an alternative"
@ 6,8 SAY "to ? CHR(7) (ie, a beep). BLAT gives the"
@ 7,8 SAY "computer equivalent of a bronx cheer,"
@ 8,8 SAY "useful for indicating wrong responses,"
@ 9,8 SAY "while TWIDDLE indicates a positive reponse."
CALL DBTOOLS WITH "10,10,10,15,5"
CALL DBTOOLS WITH "3,6,10,16,65,15,4,2,0,1"
CALL DBTOOLS WITH "1,7,13,15,4,0,Syntax:"
SET COLOR TO +W/R
@ 8,13 SAY "CALL DBTOOLS WITH "+CHR(34)+"2"+ CHR(34)+" (BLAT)"
@ 9,13 SAY "CALL DBTOOLS WITH "+CHR(34)+"18"+CHR(34)+" (TWIDDLE)"
SET COLOR TO W/R
@ 11,13 SAY "The only parameters BLAT and TWIDDLE need are the"
@ 12,13 SAY "function numbers."
CALL DBTOOLS WITH "10,15,25,15,4"

* ------ phony questionnaire example ---------
CALL DBTOOLS WITH "7,2,14,4,0"
CALL DBTOOLS WITH "3,7,20,20,55,15,1,1,0,1"
CALL DBTOOLS WITH "1,S,8,30,15,2,0,QUESTIONNAIRE"
SET COLOR TO +W/B,+BG/N,,B
@ 10,24 SAY "Who is buried in Grant's Tomb?"
SET COLOR TO W/B
@ 12,26 SAY "1. Federal Grant"
@ 13,26 SAY "2. Ulysses S. Grant"
@ 14,26 SAY "3. Cary Grant"
@ 15,26 SAY "4. None of the above"
@ 16,26 say "5. Quit asking me such"
@ 17,26 say " fool questions!"
CALL DBTOOLS WITH "1,19,29,15,1,0,Select an answer:"
mSEL = 0
DO WHILE mSEL <> 5
@ 19,47 GET mSEL PICTURE "9" RANGE 1,5
READ
DO CASE mSEL
CASE mSEL = 2
CALL DBTOOLS WITH "21,1,12,45,15,76,10,2,4,1"
CALL DBTOOLS WITH "1,13,50,15,2,0,That's Right!!"
CALL DBTOOLS WITH "18"
CALL DBTOOLS WITH "10,14,47,10,2"
CALL DBTOOLS WITH "19,1"
CASE mSEL = 5

OTHERWISE
DO ERRMSG WITH "Guess again, turkey!"
ENDCASE
ENDDO
CASE CHOICE = 2
CALL DBTOOLS WITH "1,4,8,15,5,0,SOUND - function 17"
SET COLOR TO W/RB
@ 6,8 SAY "The SOUND function allows you to play"
@ 7,8 SAY "musical tones of a specified frequency"
@ 8,8 SAY "and duration. Simple tunes may be pro-"
@ 9,8 SAY "grammed."
CALL DBTOOLS WITH "10,10,8,15,5"
CALL DBTOOLS WITH "3,6,10,14,65,14,4,2,0,1"
mPARM = "CALL DBTOOLS WITH "+CHR(34)+"17,frequency,duration"+CHR(34)
SET COLOR TO +W/R
@ 7,13 SAY mPARM
SET COLOR TO W/R
@ 9,13 SAY "where: Frequency is between 50 and 17000 cps"
@ 10,13 say " Duration is in clock tics, 1/18th second."
@ 11,13 say " (ie, 18 = one second)"
CALL DBTOOLS WITH "10,13,20,14,4"

* note: The even tempered scale is based on the 12th root of 2, ie
* each note is a multiple of 1.0594631 of the previous note

mFREQ = 440
mMULT = 1.0594631
KOUNT = 0
DO WHILE KOUNT < 16
mPARM = "17,"+STR(mFREQ,4)+",5"
CALL DBTOOLS WITH mPARM
mFREQ = mFREQ * mMULT
KOUNT = KOUNT + 1
ENDDO
CALL DBTOOLS WITH "6,48"
CALL DBTOOLS WITH "3,10,15,15,45,5,3,1,0,1"
SET COLOR TO RB/BG
@ 11,17 SAY "This is part of a Rondo I"
@ 12,17 SAY "wrote as an assignment in"
@ 13,17 SAY "a music theory class in "
@ 14,17 SAY "college."
KOUNT = 1
DO WHILE KOUNT < 3

CALL DBTOOLS WITH "17,740,2" && F#m
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,880,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,554,2"

CALL DBTOOLS WITH "17,740,2" && F#m
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,880,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,554,2"

CALL DBTOOLS WITH "17,698,2" && C#m
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,698,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,831,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,698,2"
CALL DBTOOLS WITH "17,554,2"

CALL DBTOOLS WITH "17,698,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,987,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,880,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,831,2"
CALL DBTOOLS WITH "17,554,2"
KOUNT = KOUNT + 1 && repeat
ENDDO

CALL DBTOOLS WITH "17,740,2" && F#m
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,880,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,554,2"

CALL DBTOOLS WITH "17,740,2" && F#m
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,880,2"
CALL DBTOOLS WITH "17,554,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,554,2"

CALL DBTOOLS WITH "17,740,2" && D
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,880,2"
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,587,2"

CALL DBTOOLS WITH "17,740,2" && D
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,880,2"
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,587,2"

CALL DBTOOLS WITH "17,740,2" && Bm
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,987,2"
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,587,2"

CALL DBTOOLS WITH "17,740,2" && Edim
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,1047,2"
CALL DBTOOLS WITH "17,587,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,587,2"

CALL DBTOOLS WITH "17,880,2" && F#m
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,880,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,1109,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,880,2"
CALL DBTOOLS WITH "17,740,2"

CALL DBTOOLS WITH "17,880,2" && F#m
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,880,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,1109,2"
CALL DBTOOLS WITH "17,740,2"
CALL DBTOOLS WITH "17,880,2"
CALL DBTOOLS WITH "17,740,2"

CALL DBTOOLS WITH "17,831,2" && C#m
CALL DBTOOLS WITH "17,698,2"
CALL DBTOOLS WITH "17,831,2"
CALL DBTOOLS WITH "17,698,2"
CALL DBTOOLS WITH "17,1109,2"
CALL DBTOOLS WITH "17,698,2"
CALL DBTOOLS WITH "17,831,2"
CALL DBTOOLS WITH "17,698,2"

CALL DBTOOLS WITH "17,831,2" && C#m
CALL DBTOOLS WITH "17,698,2"
CALL DBTOOLS WITH "17,831,2"
CALL DBTOOLS WITH "17,698,2"
CALL DBTOOLS WITH "17,1109,2"
CALL DBTOOLS WITH "17,698,2"
CALL DBTOOLS WITH "17,831,2"
ENDCASE


CALL DBTOOLS WITH "14,3,0"
RETURN