home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.mactech.com 2010
/
ftp.mactech.com.tar
/
ftp.mactech.com
/
macintosh-pascal
/
macintoshp-1.2-demos.sit.hqx
/
chap21pascal_demo
/
SoundPascal.p
< prev
next >
Wrap
Text File
|
1999-04-05
|
21KB
|
813 lines
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
// SoundPascal.p
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
//
// This program opens a modal dialog containing eight button controls arranged in two
// groups, namely, a synchronous sound group and an asynchronous sound group. Clicking
// on the buttons causes sound to be played back or recorded as follows:
//
// • Synchronous group:
//
// • Play sound resource.
//
// • Play sound file.
//
// • Record sound resource.
//
// • Record sound file.
//
// • Speak text string.
//
// • Asynchronous group:
//
// • Start and stop looped sound playback.
//
// • Play unlooped sound.
//
// • Speak text string.
//
// At startup, the program checks for play-from-disk, sound recording capability, speech
// capability, and multi-channel capability. If these are not available, the relevant
// buttons are disabled.
//
// The asynchronous sound sections of the program utilise a special library called
// AsyncSoundLib, which must be included in the CodeWarrior project.
//
// The program utilises the following resources:
//
// • A 'DLOG' resource and associated 'DITL' and 'dctb' resources (all purgeable).
//
// • Three 'snd ' resources, one for synchronous playback (purgeable), one for looped
// asynchronous playback (unpurgeable), and one for unlooped asynchronous playback
// (purgeable).
//
// • Two 'cicn' resources (purgeable) used to provide an animated display which halts
// during synchronous playback and continues during asynchronous playback.
//
// • Three 'STR#' resources containing error message strings and "speak text" strings
// (all purgeable).
//
// • Two 'ALRT' resources (purgeable) for displaying error messages.
//
// In addition, the function doPlayFile utilises the file "soundfile.aiff".
//
// Each time is is invoked, the function doRecordResource creates a new 'snd' resource
// with a unique ID in the application's resource fork.
//
// When first invoked, the function doRecordFile creates the file "test.aiff" in the
// chap21cw_demo folder. All subsequent record-to-file is to this file.
//
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }
program SoundPascal(input, output);
{ …………………………………………………………………………………………………………………… include the following Universal Interfaces }
uses
Windows, Fonts, Menus, TextEdit, Quickdraw, Dialogs, QuickdrawText, Processes, Types,
Memory, Events, TextUtils, ToolUtils, OSUtils, Devices, SegLoad, Resources,
Sound, SoundInput, Speech, GestaltEqu, Icons;
{ …………………………………………………………………………………………………………………………………………………… define the following constants }
const
rDialog = 128;
iQuit = 1;
iPlayResource = 2;
iPlayFile = 3;
iRecordResource = 4;
iRecordFile = 5;
iSpeakTextSync = 6;
iLoopedSound = 7;
iUnloopedSound = 8;
iSpeakTextAsync = 9;
iSynchSoundRect = 10;
iAsynchSoundRect = 11;
rPlaySoundResource = 8192;
rLoopedSound = 8193;
rUnloopedSound = 8194;
rSpeechStrings = 130;
rErrorAlert = 129;
rErrorStrings = 128;
eOpenDialogFail = 1;
eLoopedSoundSetUp = 2;
eCannotInitialise = 3;
eGetResource = 4;
eNoChannelsAvailable = 5;
ePlaySound = 6;
eMemory = 7;
rErrorAlertWithCode = 130;
rErrorStringsWithCode = 129;
eSndPlay = 1;
ePlayFile = 2;
eSndRecord = 3;
eWriteResource = 4;
eRecordFile = 5;
eSpeakString = 6;
eSndDoImmediate = 7;
rColourIcon1 = 128;
rColourIcon2 = 129;
kMaxChannels = 8;
kOutOfChannels = 1;
{ ………………………………………………………………………………………………………………………………………………………………………………………… global variables }
var
gDone : boolean;
gDialogPtr : DialogPtr;
gAppResFileRefNum : integer;
gColorQuickDrawPresent : boolean;
gHasSoundPlayDoubBuff : boolean;
gHasSoundInputDevice : boolean;
gHasSpeechmanager : boolean;
gHasMultiChannel : boolean;
gLoopedSoundOn : boolean;
gLoopedSoundRefNum : longint;
gLoopedSoundChannel : SndChannelPtr;
gColourIconHdl1 : CIconHandle;
gColourIconHdl2 : CIconHandle;
theErr : OSErr;
response : longint;
{ ………………………………………………………………………………………………………………………………………………………… AsyncSoundLib attention flag }
gCallASLcloseChannel : boolean;
{ …………………………………………………………………………………………………………………………………………… procedure and function interfaces }
procedure DoInitManagers; forward;
procedure DoCheckSoundEnv; forward;
procedure DoInitialiseASL; forward;
function DoLoopedSoundSetUp : boolean; forward;
procedure EventLoop; forward;
procedure DoDialogHit(item : integer); forward;
procedure DoPlayResource; forward;
procedure DoPlayFile; forward;
procedure DoRecordResource; forward;
procedure DoRecordFile; forward;
procedure DoSpeakStringSync; forward;
procedure DoLoopedSoundAsync; forward;
procedure DoUnloopedSoundAsync; forward;
procedure DoSpeakStringAsync; forward;
procedure DoSetUpDialog; forward;
procedure DrawDialog(theDialogPtr : DialogPtr; theItem : integer); forward;
procedure DoAdjustItems; forward;
procedure DoErrorAlert(stringIndex : integer); forward;
procedure DoErrorAlertWithCode(stringIndex, resultCode : integer); forward;
{ ………………………………………………………………………………………………………………………………………… AsyncSoundLib procedure interfaces }
function ASLinitialise(var attnFlag : boolean; numChannels : integer) : OSErr; C; external;
function ASLgetChannel(refNum : longint; var channel : SndChannelPtr) : OSErr; C; external;
function ASLplayID(resID: integer; refNum : UNIV Ptr) : OSErr; C; external;
function ASLplayHandle(sound : Handle; refNum : UNIV Ptr) : OSErr; C; external;
procedure ASLcloseChannel; C; external;
procedure ASLcloseDown; C; external;
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInitManagers }
procedure DoInitManagers;
begin
MaxApplZone;
MoreMasters;
InitGraf(@qd.thePort);
InitFonts;
InitWindows;
InitMenus;
TEInit;
InitDialogs(nil);
InitCursor;
FlushEvents(everyEvent, 0);
end;
{of procedure DoInitManagers}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoCheckSoundEnv }
procedure DoCheckSoundEnv;
var
theErr : OSErr;
response : longint;
begin
theErr := Gestalt(gestaltSoundAttr,response);
if (theErr = noErr) then
gHasSoundPlayDoubBuff := BitTst(@response,31 - gestaltSndPlayDoubleBuffer)
else
gHasSoundPlayDoubBuff := false;
if (theErr = noErr) then
gHasSoundInputDevice := BitTst(@response,31 - gestaltHasSoundInputDevice)
else
gHasSoundInputDevice := false;
if (theErr = noErr) then
gHasSpeechmanager := BitTst(@response,31 - gestaltSpeechMgrPresent)
else
gHasSpeechmanager := false;
if (theErr = noErr) then
gHasMultiChannel := BitTst(@response,31 - gestaltMultiChannels)
else
gHasMultiChannel := false;
end;
{of procedure DoCheckSoundEnv}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInitialiseASL }
procedure DoInitialiseASL;
begin
if (ASLinitialise(gCallASLcloseChannel, kMaxChannels) <> noErr) then
begin
DoErrorAlert(eCannotInitialise);
ExitToShell;
end;
end;
{of procedure DoInitialiseASL}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoLoopedSoundSetUp }
function DoLoopedSoundSetUp : boolean;
var
error : integer;
theErr : OSErr;
soundHdl : Handle;
begin
error := ASLplayHandle(nil, @gLoopedSoundRefNum);
if (error <> 0) then
begin
DoLoopedSoundSetUp := false;
Exit(DoLoopedSoundSetUp);
end
else begin
error := ASLgetChannel(gLoopedSoundRefNum, gLoopedSoundChannel);
if (error <> 0) then
begin
DoLoopedSoundSetUp := false;
Exit(DoLoopedSoundSetUp);
end;
soundHdl := GetResource('snd ', rLoopedSound);
if (soundHdl <> nil) then
begin
HLockHi(soundHdl);
theErr := SndPlay(gLoopedSoundChannel, SndListHandle(soundHdl), true);
if (theErr <> noErr) then
begin
DoLoopedSoundSetUp := false;
Exit(DoLoopedSoundSetUp);
end;
end
else begin
DoLoopedSoundSetUp := false;
Exit(DoLoopedSoundSetUp);
end;
end;
DoLoopedSoundSetUp := true;
end;
{of procedure DoLoopedSoundSetUp}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ EventLoop }
procedure EventLoop;
var
theRect, eraseRect : Rect;
gotEvent : boolean;
eventRec : EventRecord;
theDialogPtr : DialogPtr;
itemHit : integer;
finalTicks : UInt32;
begin
gDone := false;
SetRect(theRect, 10, 273, 35, 299);
SetRect(eraseRect, 45, 273, 125, 299);
while not (gDone) do
begin
if (gCallASLcloseChannel) then
begin
ASLcloseChannel;
TextFont(kFontIDGeneva);
TextSize(9);
MoveTo(45, 285);
DrawString('ASLcloseChannel');
MoveTo(45, 295);
DrawString('called');
end;
gotEvent := WaitNextEvent(everyEvent, eventRec, 10, nil);
if (gotEvent) then
begin
if (IsDialogEvent(eventRec)) then
if (DialogSelect(eventRec, theDialogPtr, itemHit)) then
DoDialogHit(itemHit);
end
else begin
if (gColorQuickDrawPresent) then
begin
PlotCIcon(theRect, gColourIconHdl1);
Delay(15, finalTicks);
PlotCIcon(theRect, gColourIconHdl2);
Delay(15, finalTicks);
EraseRect(eraseRect);
end;
end;
end;
DisposeDialog(gDialogPtr);
ASLcloseDown;
end;
{of procedure EventLoop}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDialogHit }
procedure DoDialogHit(item : integer);
begin
case (item) of
iQuit: begin
gDone := true;
end;
iPlayResource: begin
DoPlayResource;
end;
iPlayFile: begin
DoPlayFile;
end;
iRecordResource: begin
DoRecordResource;
end;
iRecordFile: begin
DoRecordFile;
end;
iSpeakTextSync: begin
DoSpeakStringSync;
end;
iLoopedSound: begin
DoLoopedSoundAsync;
end;
iUnloopedSound: begin
DoUnloopedSoundAsync;
end;
iSpeakTextAsync: begin
DoSpeakStringAsync;
end;
end;
{of case statement}
end;
{of procedure DoDialogHit}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoPlayResource }
procedure DoPlayResource;
var
sndListHdl : SndListHandle;
resErr : integer;
theErr : OSErr;
begin
sndListHdl := SndListHandle(GetResource('snd ', rPlaySoundResource));
resErr := ResError;
if (resErr <> noErr) then
DoErrorAlert(eGetResource);
if (sndListHdl <> nil) then
begin
HLock(Handle(sndListHdl));
theErr := SndPlay(nil, sndListHdl, false);
if (theErr <> noErr) then
DoErrorAlertWithCode(eSndPlay, theErr);
HUnlock(Handle(sndListHdl));
ReleaseResource(Handle(sndListHdl));
end;
end;
{of procedure DoPlayResource}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoPlayFile }
procedure DoPlayFile;
var
theErr : OSErr;
fileSysSpec : FSSpec;
fileRefNum : integer;
ignoredErr : OSErr;
begin
theErr := FSMakeFSSpec(0, 0, ':soundfile.aiff', fileSysSpec);
if (theErr = noErr) then
theErr := FSpOpenDF(fileSysSpec, fsRdPerm, fileRefNum);
if (theErr = noErr) then
ignoredErr := SetFPos(fileRefNum, fsFromStart, 0);
if (theErr = noErr) then
theErr := SndStartFilePlay(nil, fileRefNum, 0, 20480, nil, nil, nil, false);
if (theErr <> noErr) then
DoErrorAlertWithCode(ePlayFile, theErr);
ignoredErr := FSClose(fileRefNum);
end;
{of procedure DoPlayFile}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoRecordResource }
procedure DoRecordResource;
var
oldResFileRefNum : integer;
topLeft : Point;
soundHdl : Handle;
theErr, memErr : OSErr;
theResourceID, resErr : integer;
begin
oldResFileRefNum := CurResFile;
UseResFile(gAppResFileRefNum);
topLeft.v := 40;
topLeft.h := 250;
soundHdl := NewHandle(25000);
memErr := MemError;
if (memErr <> noErr) then
begin
DoErrorAlert(eMemory);
Exit(DoRecordResource);
end;
theErr := SndRecord(nil, topLeft, siBetterQuality, SndListHandle(soundHdl));
if ((theErr <> noErr) and (theErr <> userCanceledErr)) then
DoErrorAlertWithCode(eSndRecord, theErr)
else begin
repeat
theResourceID := UniqueID('snd ');
until (theResourceID >= 8191);
AddResource(Handle(soundHdl), 'snd ', theResourceID, 'Test');
resErr := ResError;
if (resErr = noErr) then
UpdateResFile(gAppResFileRefNum);
resErr := ResError;
if (resErr <> noErr) then
DoErrorAlertWithCode(eWriteResource, resErr);
end;
UseResFile(oldResFileRefNum);
end;
{of procedure DoRecordResource}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoRecordFile }
procedure DoRecordFile;
var
topLeft : Point;
theErr : OSErr;
fileSysSpec : FSSpec;
fileRefNum : integer;
ignoredErr : OSErr;
begin
topLeft.v := 40;
topLeft.h := 250;
theErr := FSMakeFSSpec(0, 0, ':test.aiff', fileSysSpec);
if (theErr = fnfErr) then
theErr := FSpCreate(fileSysSpec, '????', 'AIFF', smSystemScript);
if (theErr = noErr) then
theErr := FSpOpenDF(fileSysSpec, fsWrPerm, fileRefNum);
if (theErr = noErr) then
ignoredErr := SetFPos(fileRefNum, fsFromStart, 0);
if (theErr = noErr) then
theErr := SndRecordToFile(nil, topLeft, siBetterQuality, fileRefNum);
if ((theErr <> noErr) and (theErr <> userCanceledErr)) then
DoErrorAlertWithCode(eRecordFile, theErr);
ignoredErr := FSClose(fileRefNum);
end;
{of procedure DoRecordFile}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoSpeakStringSync }
procedure DoSpeakStringSync;
var
activeChannels : integer;
theString : Str255;
resErr, theErr : OSErr;
begin
activeChannels := SpeechBusy;
GetIndString(theString, rSpeechStrings, 1);
resErr := ResError;
if (resErr <> noErr) then
begin
DoErrorAlert(eGetResource);
Exit(DoSpeakStringSync);
end;
theErr := SpeakString(theString);
if (theErr <> noErr) then
DoErrorAlertWithCode(eSpeakString, theErr);
while (SpeechBusy <> activeChannels) do ;
end;
{of procedure DoSpeakStringSync}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoLoopedSoundAsync }
procedure DoLoopedSoundAsync;
var
soundCommand : SndCommand;
theErr : OSErr;
begin
gLoopedSoundOn := not (gLoopedSoundOn);
DoAdjustItems;
soundCommand.param1 := 0;
if (gLoopedSoundOn) then
begin
soundCommand.cmd := freqCmd;
soundCommand.param2 := $3C;
end
else begin
soundCommand.cmd := quietCmd;
soundCommand.param2 := 0;
end;
theErr := SndDoImmediate(gLoopedSoundChannel, soundCommand);
if (theErr <> noErr) then
DoErrorAlertWithCode(eSndDoImmediate, theErr);
end;
{of procedure DoLoopedSoundAsync}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoUnloopedSoundAsync }
procedure DoUnloopedSoundAsync;
var
error : integer;
begin
error := ASLplayID(rUnloopedSound, nil);
if (error = kOutOfChannels) then
DoErrorAlert(eNoChannelsAvailable)
else if (error <> noErr) then
DoErrorAlert(ePlaySound);
end;
{of procedure DoUnloopedSoundAsync}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoSpeakStringAsync }
procedure DoSpeakStringAsync;
var
theString : Str255;
resErr, theErr : OSErr;
begin
GetIndString(theString, rSpeechStrings, 2);
resErr := ResError;
if (resErr <> noErr) then
begin
DoErrorAlert(eGetResource);
Exit(DoSpeakStringAsync);
end;
theErr := SpeakString(theString);
if (theErr <> noErr) then
DoErrorAlertWithCode(eSpeakString, theErr);
end;
{of procedure DoSpeakStringAsync}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoSetUpDialog }
procedure DoSetUpDialog;
var
itemType : integer;
itemHdl : Handle;
itemRect : Rect;
begin
GetDialogItem(gDialogPtr, iSynchSoundRect, itemType, itemHdl, itemRect);
SetDialogItem(gDialogPtr, iSynchSoundRect, itemType, Handle(@DrawDialog), itemRect);
if not (gHasSoundPlayDoubBuff) then
begin
GetDialogItem(gDialogPtr, iPlayFile, itemType, itemHdl, itemRect);
HiliteControl(ControlHandle(itemHdl), 255);
end;
if not (gHasSoundInputDevice) then
begin
GetDialogItem(gDialogPtr, iRecordResource, itemType, itemHdl, itemRect);
HiliteControl(ControlHandle(itemHdl), 255);
GetDialogItem(gDialogPtr, iRecordFile, itemType, itemHdl, itemRect);
HiliteControl(ControlHandle(itemHdl), 255);
end;
if not (gHasSpeechmanager) then
begin
GetDialogItem(gDialogPtr, iSpeakTextSync, itemType, itemHdl, itemRect);
HiliteControl(ControlHandle(itemHdl), 255);
GetDialogItem(gDialogPtr, iSpeakTextAsync, itemType, itemHdl, itemRect);
HiliteControl(ControlHandle(itemHdl), 255);
end;
if not (gHasMultiChannel) then
begin
GetDialogItem(gDialogPtr, iLoopedSound, itemType, itemHdl, itemRect);
HiliteControl(ControlHandle(itemHdl), 255);
end;
end;
{of procedure DoSetUpDialog}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DrawDialog }
procedure DrawDialog(theDialogPtr : DialogPtr; theItem : integer);
var
itemType : integer;
itemHdl : Handle;
itemRect : Rect;
buttonOval : integer;
begin
GetDialogItem(theDialogPtr, iSynchSoundRect, itemType, itemHdl, itemRect);
FrameRect(itemRect);
GetDialogItem(theDialogPtr, iAsynchSoundRect, itemType, itemHdl, itemRect);
FrameRect(itemRect);
GetDialogItem(theDialogPtr, iQuit, itemType, itemHdl, itemRect);
InsetRect(itemRect, -4, -4);
PenSize(3, 3);
buttonOval := (itemRect.bottom - itemRect.top) div 2 + 2;
FrameRoundRect(itemRect, buttonOval, buttonOval);
end;
{of procedure DrawDialog}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoAdjustItems }
procedure DoAdjustItems;
var
itemType, a : integer;
itemHdl : Handle;
itemRect : Rect;
begin
GetDialogItem(gDialogPtr, iLoopedSound, itemType, itemHdl, itemRect);
if (gLoopedSoundOn) then
SetControlTitle(ControlHandle(itemHdl), 'Switch Looped Sound Off')
else
SetControlTitle(ControlHandle(itemHdl), 'Switch Looped Sound On');
for a := iRecordResource to iRecordFile do
begin
GetDialogItem(gDialogPtr, a, itemType, itemHdl, itemRect);
if (gLoopedSoundOn) then
HiliteControl(ControlHandle(itemHdl), 255)
else
HiliteControl(ControlHandle(itemHdl), 0);
end;
end;
{of procedure DoAdjustItems}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoErrorAlert }
procedure DoErrorAlert(stringIndex : integer);
var
errorString : string;
ignoredErr : OSErr;
begin
GetIndString(errorString, rErrorStrings, stringIndex);
ParamText(errorString, '', '', '');
ignoredErr := StopAlert(rErrorAlert, nil);
end;
{of procedure DoErrorAlert}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoErrorAlertWithCode }
procedure DoErrorAlertWithCode(stringIndex, resultCode : integer);
var
errorString, resultCodeString : string;
ignoredErr : OSErr;
begin
GetIndString(errorString, rErrorStringsWithCode, stringIndex);
NumToString(longint(resultCode), resultCodeString);
ParamText(errorString, resultCodeString, '', '');
ignoredErr := StopAlert(rErrorAlertWithCode, nil);
end;
{of procedure DoErrorAlertWithCode}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ start of main program }
begin
gColorQuickDrawPresent := false;
gLoopedSoundOn := false;
gCallASLcloseChannel := false;
{ ……………………………………………………………………………………………………………………………………………………… check for Color QuickDraw }
theErr := Gestalt(gestaltQuickdrawVersion, response);
if (response >= gestalt8BitQD) then
gColorQuickDrawPresent := true;
{ ……………………………………………………………………………………………………………………………………………………………………… initialise managers }
DoInitManagers;
{ ……………………………………………………………………………… save reference number of application's resource file }
gAppResFileRefNum := CurResFile;
{ …………………………………………………………… check for sound recording equipment and speech capabilities }
DoCheckSoundEnv;
{ ……………………………………………………………………………………………… open and set up modal dialog, get colour icons }
gDialogPtr := GetNewDialog(rDialog, nil, WindowPtr(-1));
if (gDialogPtr = nil) then
begin
DoErrorAlert(eOpenDialogFail);
ExitToShell;
end;
SetPort(gDialogPtr);
DoSetUpDialog;
if (gColorQuickDrawPresent) then
begin
gColourIconHdl1 := GetCIcon(rColourIcon1);
gColourIconHdl2 := GetCIcon(rColourIcon2);
end;
{ ………………………………………………………………………………………………………………………………………………………… initialize AsychSoundLib }
DoInitialiseASL;
{ ……………………………………………………………………………………………………………………………………………………………………… set up looped sound }
if (gHasMultiChannel) then
if not (DoLoopedSoundSetUp) then
begin
DoErrorAlert(eLoopedSoundSetUp);
ASLcloseDown;
ExitToShell;
end;
{ ……………………………………………………………………………………………………………………………………………………………………………… enter event loop }
EventLoop;
end.
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }