FB II Compiler

PG PRO

Debugging

Memory

System

Mathematics

Resources

Disk I/O

Windows

Controls

Menus

Mouse

Keyboard

Text

Fonts

Drawing

Sound

Clipboard

Printing

Communication

ASM

Made with FB

SOUND

Record sounds from tape


"So having solved that problem, I quickly got my program to record CD-compatible AIFF sounds, and am now the proud father of my first audio CD made from snippets of sounds originally recorded on cassette tape."

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
Rick