[futurebasic] Re: [FB] Sound frequency generation

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : February 2001 : Group Archive : Group : All Groups

From: Alain Pastor <apastor@...>
Date: Mon, 26 Feb 2001 14:00:31 +0100

Alain Pastor wrote:

> Ken Shmidheiser wrote:
>
> >
> >
> > Thanks so much for the demo. This function:
> >
> > err = FN SndRecord( _nil,pt,sndQual,sndH )
> >
> > gets an undefined function error when I try to run the demo. Do I
> > need any special kind of header? (I'm using FB^3 Release 3).
>
> Hi Ken,
>
> You're right the following declaration is required with the Release 3:
>
> TOOLBOX FN SndRecord (PROC filterProc,Point corner,OSType quality,@Handle) =
> OSErr `0x203C, 0x0804, 0x0014, 0xA800
>
> >
> >
> > I'm sure with some work we'll be able to make it stable.
>
> Yes, I believe the little demo is close to be OK, I'm not sure that the steps
> taken are correct. Maybe there is a problem in the callback procedure because the
> sound is recorded then played at a higher pitch, but the program hangs when the
> sound is done.
>

Hi,

I have reworked the demo and it seems to be OK now:


'~Header

BEGIN RECORD SndCommand
DIM cmd    AS UNSIGNED SHORT
DIM param1 AS SHORT
DIM param2 AS LONG
END RECORD

BEGIN RECORD SndChannel
DIM nextChan      AS PTR
DIM firstMod      AS PTR
DIM callBack      AS PROC
DIM userInfo      AS LONG
DIM wait          AS LONG
DIM cmdInProgress AS SndCommand
DIM flags         AS SHORT
DIM qLength       AS SHORT
DIM qHead         AS SHORT
DIM qTail         AS SHORT
DIM queue[126]    AS SndCommand
END RECORD

_rateMultiplierCmd = 86

BEGIN ENUM
_defaultPicth  = 0x00010000
_up1Octave     = 0x00030000
_down1Octave   = 0x00005000
_up1halfOctave = 0x00015000
END ENUM

BEGIN GLOBALS
DIM gIsPlaying AS INT
DIM gChan      AS ^SndChannel
END GLOBALS

'~Functions

'~'8
LOCAL FN ChangeChannelPitch(chan as ^SndChannel, how as long)
'~'9
DIM cmd AS SndCommand

cmd.cmd    = _rateMultiplierCmd
cmd.param1 = 0
cmd.param2 = how

END FN = FN SndDoImmediate(chan, cmd)

'~'8
LOCAL FN DoRecordSound(sndQual AS LONG)
'~'9
DIM pt        AS POINT
DIM @ sndH    AS HANDLE
DIM @ sndAttr AS LONG

sndH = _nil
LONG IF SYSTEM (_sysVers) > 699
LONG IF FN Gestalt (_gestaltSoundAttr,sndAttr) = _noErr
LONG IF (sndAttr AND _gestaltHasSoundInputDevice%)
SetPt(pt, 100, 75)
SELECT FN SndRecord (_nil,pt,sndQual,sndH)
CASE _noErr,_userCanceledErr
CASE ELSE
PRINT "Error getting sound"
END SELECT
XELSE
PRINT "Sound input device not available!"
END IF
XELSE
PRINT "Sound Mgr. not available!"
END IF
XELSE
PRINT "Requires System 7.x to work!"
END IF
END FN = sndH


'~Main
DIM @ cmde AS SHORT
DIM   sndH AS HANDLE

WINDOW 1

gChan = FN NewPtrClear(SIZEOF(SndChannel))
LONG IF gChan
gChan.qLength = _stdQLength
LONG IF FN SndNewChannel(gChan,_SampledSynth,_initMono,PROC "SoundDoneProc")= _noErr

sndH = FN DoRecordSound(_"good")'_"none",_"good",_"betr",_"best"
LONG IF sndH
FN ChangeChannelPitch(gChan, _up1Octave)
HLock(sndH)
LONG IF FN SndPlay(gChan,sndH,_zTrue)= _noErr
gIsPlaying = _zTrue
cmde       = _callBackCmd
LONG IF FN SndDoCommand(gChan,cmde,_zTrue) = _noErr
PRINT "Sound is playing, please wait..."
XELSE
PRINT "Unable to call the callback proc"
END IF
END IF
XELSE
PRINT "No Sound handle to play with!"
END IF
XELSE
PRINT "Can't initialize the channel"
END IF
XELSE
PRINT "Can't allocate memory for the channel"
END IF

WHILE gIsPlaying
HANDLEEVENTS
WEND

PRINT "Click mouse to quit."
'
DO
UNTIL FN Button
IF sndH THEN HUnLock(sndH) : DisposeHandle(sndH)
LONG IF FN SndDisposeChannel(gChan,_zTrue)
END IF

'
END
"SoundDoneProc"
ENTERPROC SoundDoneProc(sndChanPtr as long,sndCmd as long)
gIsPlaying = _false
EXITPROC


--

Cheers

Alain

-----------------------------------------------------
FB^3 in Europe:  http://euro.futurebasic.com/
FB II Pouch:     http://www.pixmix.com/FB/outils.html
-----------------------------------------------------