[futurebasic] Re: [FB] Okay, so I have dyslexia (was: AIFF)

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : October 1999 : Group Archive : Group : All Groups

From: Rick Brown <rbrown@...>
Date: Thu, 14 Oct 1999 19:41:34 -0500

BMichael@... wrote:

> >> Rick,
> >>
> >> Would you give away your code ?
> >
> >Sure.  It is about 370 lines.  If this is considered short enough (Bill?) I
> >will post it in a message to the whole group; otherwise, I will mail it to
> >you privately.
>
> The server limit on a message is 32K - if it'll fit as the body of an
> email, that'll be fine. Otherwise, or in-addition-to, if you'll email it
> to me or put it in the futurebasic.org dropbox, I'll be happy to post it!

Here it is.  The interface is crude, and I specifically designed it to record
sounds at 44.1kHz, 16-bit stereo (so they'd be suitable to burn onto an audio
CD).  Here are some suggested improvements:

 Allow user to adjust the sampling rate, sample size and number of channels
(and possibly other parameters like play-through volume);
 Test whether the machine actually has the desired hardware capabilities!
(There are Gestalt calls that can do this).
 Use an alert to report errors, rather than a plain window.
 Check the available space on disk before recording!  I arbitrarily hard-coded
the maximum file size as 500,000,000 bytes

You should also know that there are simpler ways to write a program that
records to disk.  I have a (much shorter) demo which calls SndRecordToFile to
do this.  SndRecordToFile is simpler to use, but doesn't give you as much
control over the sound parameters.

'======================================
' Demo for recording "CD quality" sound
'
' by Rick Brown
'======================================
COMPILE 0, _caseInsensitive _dimmedVarsOnly

'============ CONSTANTS =========
_siWritePermission = 1
_spbError = 32

_recWindow = 2

_recButton = 1
_pauseButton = 2
_saveButton = 3
_canclButton = 4

'Recording states:
_notStarted = 0
_recording = 1
_paused = 2
_stopped = 3
_cancelled = 4
'============= GLOBALS ============
DIM RECORD fsSpec
  DIM fsVRefNum%
  DIM fsParID&
  DIM 63 fsName$
DIM END RECORD _fsSpec

DIM gRecordingStatus
DIM gDevRefNum&
gDevRefNum& = 0
DIM gFRefNum%
gFRefNum% = 0
DIM gSpb.38
END GLOBALS
'--------------------------------------------------------------
LOCAL FN SPBOpenDevice(deviceName$, permission, inRefNumAddr&)
  'Call as follows:
  'OSErr = FN SPBOpenDevice(deviceName$, permission, @inRefNum&)
  DIM OSErr, namePtr&
  namePtr& = @deviceName$
  `     clr.w   -(sp)
  `     move.l  ^namePtr&,-(sp)
  `     move.w  ^permission,-(sp)
  `     move.l  ^inRefNumAddr&,-(sp)
  `     move.l  #$05180014,D0
  `     dc.w    $A800
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'--------------------------------------------------------------
LOCAL FN SPBCloseDevice(inRefNum&)
  DIM OSErr
  `     clr.w   -(sp)
  `     move.l  ^inRefNum&,-(sp)
  `     move.l  #$021C0014,D0
  `     dc.w    $A800
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'--------------------------------------------------------------
LOCAL FN SPBSetDeviceInfo(inRefNum&, infoType&, infoDataPtr&)
  DIM OSErr
  `     clr.w   -(sp)
  `     move.l  ^inRefNum&,-(sp)
  `     move.l  ^infoType&,-(sp)
  `     move.l  ^infoDataPtr&,-(sp)
  `     move.l  #$063C0014,D0
  `     dc.w    $A800
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'--------------------------------------------------------------
LOCAL FN SPBRecordToFile(fRefNum%, inParamPtr&, asyncFlag%)
  DIM OSErr
  `     clr.w   -(sp)
  `     move.w  ^fRefNum%,-(sp)
  `     move.l  ^inParamPtr&,-(sp)
  `     move.w  ^asyncFlag%,-(sp)
  `     move.l  #$04240014,D0
  `     dc.w    $A800
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'--------------------------------------------------------
LOCAL FN SPBPauseRecording(devRefNum&)
  DIM OSErr
  `     clr.w   -(sp)
  `     move.l  ^devRefNum&,-(sp)
  `     move.l  #$02280014,D0
  `     dc.w    $A800
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'--------------------------------------------------------
LOCAL FN SPBResumeRecording(devRefNum&)
  DIM OSErr
  `     clr.w   -(sp)
  `     move.l  ^devRefNum&,-(sp)
  `     move.l  #$022C0014,D0
  `     dc.w    $A800
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'--------------------------------------------------------
LOCAL FN SPBStopRecording(devRefNum&)
  DIM OSErr
  `     clr.w   -(sp)
  `     move.l  ^devRefNum&,-(sp)
  `     move.l  #$02300014,D0
  `     dc.w    $A800
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'--------------------------------------------------------
LOCAL FN SetupAIFFHeader(fRefNum%, numChannels%, sampleRate&, sampleSize%,
compressionType&, numBytes&, numFrames&)
  DIM OSErr
  `     clr.w   -(sp)
  `     move.w  ^fRefNum%,-(sp)
  `     move.w  ^numChannels%,-(sp)
  `     move.l  ^sampleRate&,-(sp)
  `     move.w  ^sampleSize%,-(sp)
  `     move.l  ^compressionType&,-(sp)
  `     move.l  ^numBytes&,-(sp)
  `     move.l  ^numFrames&,-(sp)
  `     move.l  #$0B4C0014,D0
  `     dc.w    $A800
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'--------------------------------------------------------
LOCAL FN FSMakeFSSpec(vRefNum, dirID&, filename$, specAddr&)
  'Call as follows:
  '  OSErr = FN FSMakeFSSpec(vRefNum, dirID&, filename$, @spec)
  'where spec is a 70-byte fsSpec record.
  DIM filenameAddr&, OSErr
  filenameAddr& = @filename$
  `     clr.w   -(sp)
  `     move.w  ^vRefNum,-(sp)
  `     move.l  ^dirID&,-(sp)
  `     move.l  ^filenameAddr&,-(sp)
  `     move.l  ^specAddr&,-(sp)
  `     move.w  #$0001,d0
  `     dc.w    $AA52
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'--------------------------------------------------------
LOCAL FN FSpCreate(@specAddr&, creator&, fileType&, scriptTag)
  'Call as follows:
  '  OSErr = FN FSpCreate(spec, creator&, fileType&, scriptTag)
  'where spec is a 70-byte fsSpec record.  In most cases it's
  'advisable to use _smSystemScript for the scriptTag.
  DIM OSErr
  `     clr.w   -(sp)
  `     move.l  ^specAddr&,-(sp)
  `     move.l  ^creator&,-(sp)
  `     move.l  ^fileType&,-(sp)
  `     move.w  ^scriptTag,-(sp)
  `     move.w  #$0004,d0
  `     dc.w    $AA52
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'-----------------------------------------------------------
LOCAL FN FSpDelete(@specAddr&)
  'Call as follows:
  'OSErr = FN FSpDelete(spec)
  'where spec is a 70-byte fsSpec record.
  DIM OSErr
  `     clr.w   -(sp)
  `     move.l  ^specAddr&,-(sp)
  `     move.w  #$0006,d0
  `     dc.w    $AA52
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'-----------------------------------------------------------
LOCAL FN FSpOpenDF(@specAddr&, permission, refNumAddr&)
  'Call as follows:
  '  OSErr = FN FSpOpenDF(spec, permission, @refNum)
  'where spec is a 70-byte fsSpec record
  DIM OSErr
  `     clr.w   -(sp)
  `     move.l  ^specAddr&,-(sp)
  `     move.w  ^permission,-(sp)
  `     move.l  ^refNumAddr&,-(sp)
  `     move.w  #$0002,d0
  `     dc.w    $AA52
  `     move.w  (sp)+,^OSErr
END FN = OSErr
'-------------------------------------------------------------
LOCAL FN FSClose(fRefNum%)
  'This appears to be one of those damned "high level"
  '(not in ROM) routines.
  DIM pb.50
  pb.ioCompletion& = _nil
  pb.ioRefNum% = fRefNum%
END FN = FN CLOSE(@pb)
'-------------------------------------------------------------
LOCAL FN SetFilePos(fRefNum%, posMode%, posOffset&)
  DIM pb.50
  pb.ioCompletion& = _nil
  pb.ioRefNum% = fRefNum%
  pb.ioPosMode% = posMode%
  pb.ioPosOffset& = posOffset&
END FN = FN SETFPOS(@pb)
'-------------------------------------------------------------
LOCAL FN SetFileEOF(fRefNum%, eofPos&)
  DIM pb.50
  pb.ioCompletion& = _nil
  pb.ioRefNum% = fRefNum%
  pb.ioMisc& = eofPos&
END FN = FN SETEOF(@pb)
'-------------------------------------------------------------
LOCAL FN ReportOSErr(errnum, msg$)
  DIM x
  WINDOW 1
  BEEP
  PRINT "Error #"; errnum
  PRINT msg$
  INPUT x
  IF gDevRefNum& THEN x = FN SPBCloseDevice(gDevRefNum&)
  IF gFRefNum% THEN x = FN FSClose(gFRefNum%)
  END
END FN
'--------------------------------------------------------
LOCAL FN BuildRecordingWindow
  DIM wWidth, wHeight, bTop, bBot
  wWidth = 400
  wHeight = 100
  bTop = 50
  bBot = 66
  WINDOW _recWindow,"",(0,0)-(wWidth,wHeight), _docNoGrow+_noGoAway
  BUTTON _recButton, _activeBtn, "Record",(10,bTop)-(100,bBot)
  BUTTON _pauseButton, _grayBtn, "Pause", (110,bTop)-(200,bBot)
  BUTTON _saveButton, _grayBtn, "Save", (210,bTop)-(290,bBot)
  BUTTON _canclButton, _activeBtn, "Cancel",(300,bTop)-(390,bBot)
END FN
'--------------------------------------------------------
LOCAL FN DoDialog
  DIM evnt, id, OSErr
  evnt = DIALOG(0)
  id = DIALOG(evnt)
  SELECT CASE evnt
    CASE _btnClick
      SELECT CASE id
        CASE _recButton
          LONG IF gRecordingStatus = _notStarted
            gSpb.inRefNum& = gDevRefNum&
            gSpb.count& = 500000000
            gSpb.milliseconds& = 0
            gSpb.completionRoutine& = _nil
            gSpb.unused1& = 0
            OSErr = FN SPBRecordToFile(gFRefNum%, @gSpb, _zTrue)
            IF OSErr THEN FN ReportOSErr(OSErr, "SPBRecordToFile")
            BUTTON _saveButton, _activeBtn
          XELSE
            'Recording restarted from pause:
            OSErr = FN SPBResumeRecording(gDevRefNum&)
            IF OSErr THEN FN ReportOSErr(OSErr, "SPBResumeRecording")
          END IF
          gRecordingStatus = _recording
          BUTTON _recButton, _grayBtn
          BUTTON _pauseButton, _activeBtn
        CASE _pauseButton
          OSErr = FN SPBPauseRecording(gDevRefNum&)
          IF OSErr THEN FN ReportOSErr(OSErr, "SPBPauseRecording")
          gRecordingStatus = _paused
          BUTTON _recButton, _activeBtn
          BUTTON _pauseButton, _grayBtn
        CASE _saveButton
          OSErr = FN SPBStopRecording(gDevRefNum&)
          IF OSErr THEN FN ReportOSErr(OSErr, "SPBStopRecording")
          gRecordingStatus = _stopped
          WINDOW CLOSE _recWindow
        CASE _canclButton
          LONG IF gRecordingStatus <> _notStarted
            OSErr = FN SPBStopRecording(gDevRefNum&)
            IF OSErr THEN FN ReportOSErr(OSErr, "SPBStopRecording")
          END IF
          gRecordingStatus = _cancelled
          WINDOW CLOSE _recWindow
      END SELECT
  END SELECT
END FN
'====================== MAIN ============================
WINDOW OFF
DIM outSpec.fsSpec, myPt.4
DIM f$, wd, OSErr, recordingErr, numBytes&
DIM numChannels, playThruVolume,sampleRate&,sampleSize%,compressionType&
ON DIALOG FN DoDialog

f$ = FILES$(_fSave,"Save sound file as:","untitled.AIFF",wd)
LONG IF LEN(f$) > 0
  OSErr = FN FSMakeFSSpec(wd, 0, f$, @outSpec)
  SELECT CASE OSErr
    CASE _noErr
      'File already exists
    CASE _fnfErr
      'File doesn't exist: create it:
      OSErr = FN FSpCreate(outSpec, _"Rick", _"AIFF", _smSystemScript)
      IF OSErr THEN FN ReportOSErr(OSErr,"FSpCreate")
    CASE ELSE
      FN ReportOSErr(OSErr,"FSMakeFSSpec")
  END SELECT

  numChannels = 2
  playThruVolume = 3
  sampleRate& = &AC440000                         '44.1 kHz
  sampleSize% = 16
  compressionType& = _"NONE"

  'Open the file for output:
  OSErr = FN FSpOpenDF(outSpec, _fsWrPerm, @gFRefNum%)
  IF OSErr FN ReportOSErr(OSErr, "FSpOpenDF")
  OSErr = FN SetFilePos(gFRefNum%, _fsFromStart, 0)
  IF OSErr THEN FN ReportOSErr(OSErr, "SetFPos")
  OSErr = FN SetFileEOF(gFRefNum%, 0)
  IF OSErr THEN FN ReportOSErr(OSErr, "SetFileEOF")

  'Write the AIFF header:
  OSErr = FN SetupAIFFHeader(gFRefNum%, numChannels, sampleRate&, sampleSize%,
compressionType&, 0, 0)
  IF OSErr THEN FN ReportOSErr(OSErr, "SetupAIFFHeader")

  'Open the sound input device, and set it for 44.1kHz, 16-bit, stereo:
  OSErr = FN SPBOpenDevice("", _siWritePermission, @gDevRefNum&)
  IF OSErr THEN FN ReportOSErr(OSErr, "SPBOpenDevice")
  OSErr = FN SPBSetDeviceInfo(gDevRefNum&, _"chan", @numChannels)
  IF OSErr THEN FN ReportOSErr(OSErr, "SPBSetDeviceInfo: chan")
  OSErr = FN SPBSetDeviceInfo(gDevRefNum&, _"plth", @playThruVolume)
  IF OSErr THEN FN ReportOSErr(OSErr, "SPBSetDeviceInfo: plth")
  OSErr = FN SPBSetDeviceInfo(gDevRefNum&, _"srat", @sampleRate&)
  IF OSErr THEN FN ReportOSErr(OSErr, "SPBSetDeviceInfo: srat")
  OSErr = FN SPBSetDeviceInfo(gDevRefNum&, _"ssiz", @sampleSize%)
  IF OSErr THEN FN ReportOSErr(OSErr, "SPBSetDeviceInfo: ssiz")
  OSErr = FN SPBSetDeviceInfo(gDevRefNum&, _"comp", @compressionType&)
  IF OSErr THEN FN ReportOSErr(OSErr, "SPBSetDeviceInfo: comp")

  'Display the recording dialog:
  FN BuildRecordingWindow
  'Loop until finished recording:
  gRecordingStatus = _notStarted
  DO
    HANDLEEVENTS
  UNTIL gRecordingStatus <> _notStarted AND gSpb.spbError% <> 1
  'Recording is now finished.

  recordingErr = gSpb.spbError%
  numBytes& = gSpb.count&

  'Close the sound input device:
  OSErr = FN SPBCloseDevice(gDevRefNum&)
  IF OSErr THEN FN ReportOSErr(OSErr, "SPBCloseDevice")

  LONG IF recordingErr = _noErr
    'Exceeded maximum allowable bytes:
    BEEP
    WINDOW CLOSE _recWindow
  END IF
  SELECT CASE recordingErr
    CASE _noErr, _abortErr
      LONG IF gRecordingStatus = _cancelled
        'Close the file, then delete it
        OSErr = FN FSClose(gFRefNum%)
        IF OSErr THEN FN ReportOSErr(OSErr, "FSClose")
        OSErr = FN FSpDelete(outSpec)
        IF OSErr THEN FN ReportOSErr(OSErr, "FSpDelete")
      XELSE
        'Set the byte count parameter properly in the file header:
        OSErr = FN SetFilePos(gFRefNum%, _fsFromStart, 0)
        IF OSErr THEN FN ReportOSErr(OSErr, "SetFPos")
        IF numBytes& AND 1 THEN INC(numBytes&)    'must be even
        OSErr = FN SetupAIFFHeader(gFRefNum%, numChannels, sampleRate&,
sampleSize%, compressionType&, numBytes&, 0)
        IF OSErr THEN FN ReportOSErr(OSErr, "SetupAIFFHeader")
        'Close the file:
        OSErr = FN FSClose(gFRefNum%)
        IF OSErr THEN FN ReportOSErr(OSErr, "FSClose")
      END IF
    CASE ELSE
      FN ReportOSErr(recordingErr, "SPBRecordToFile")
  END SELECT
END IF