MODULE AGMSPlaySound; (*************************************************************************** This program plays sound samples which are too big to fit into memory, using multiple buffered audio IO. Copyright (c) 1990 by Alexander G. M. Smith. July 1990 Original written by Alexander G. M. Smith September 6, 1992 Added NoWait option for James Atwill. June 13, 1993 Recompiled with faster buffered dos (seeks avoided), info message made AmigaDOS 2.0 ANSI compatible. July 17, 1993 Fixed lockup bug (do a CMD_FLUSH). ***************************************************************************) FROM ARexxStorage IMPORT RexxMsg; FROM ArpBase IMPORT ErrorBreak; FROM ArpConsole IMPORT CLIArg, GADS; FROM ArpDOS IMPORT ArpLock, ArpOpen, PathName; FROM ArpMemory IMPORT ArpAllocMem; FROM ArpPatMatch IMPORT AnchorPathPtr, APFlags, APFlagSet, FindFirst, FindNext, FreeAnchorChain; FROM ArpTracking IMPORT FreeTrackedItem, TrackedResourcePtr; FROM AudioDevice IMPORT ADCmdAllocate, ADIOErrChannelStolen, ADIOErrNoAllocation, ADIONoWait, ADIOPerVol, ADIOSyncCycle, ADIOWriteMessage, AudioChannelSet, AudioName, IOAudio, IOAudioPtr, Left0, Left1, Right0, Right1; FROM BufferedDOS IMPORT BufClose, BufHandle, BufOpen; FROM CStrings IMPORT strcpy, strlen; FROM Conversions IMPORT ConvStrToNum; IMPORT Debug; FROM Devices IMPORT CloseDevice, DevicePtr, OpenDevice, UnitPtr; FROM DOS IMPORT AccessRead, ErrorNoMoreEntries, Examine, FileHandle, FileInfoBlockPtr, FileLock, IoErr, Lock, ModeOldFile, OffsetBeginning, Read, Seek, SIGBreakC, SIGBreakE, SIGBreakF, UnLock; FROM EasyARexx IMPORT CloseARexxLib, CloseARexxPort, OpenARexxLib, OpenARexxPort, ProcessCmds, RexxCommand, RexxCommandPtr; FROM IFF IMPORT BadForm, BadIFF, ClientError, ClientFrame, ClientFramePtr, DOSError, EndMark, GroupContext, GroupContextPtr, ID, IFFDone, IFFOkay, IFFP, NoFile, NotIFF, NullChunk, ShortChunk; FROM IFFMsgs IMPORT MsgBad, MsgClientError, MsgDone, MsgDos, MsgEndMark, MsgForm, MsgNoFile, MsgNot, MsgOkay, MsgShort; FROM IFFR IMPORT CloseRGroup, GetF1ChunkHdr, GetPChunkHdr, IFFReadBytes, OpenRGroup, ReadIFF, ReadICat, ReadIList; FROM InOut IMPORT Write, WriteCard, WriteInt, WriteLn, WriteLongHex, WriteLongInt, WriteString; FROM IO IMPORT AbortIO, BeginIO, CmdFlush, CmdWrite, DoIO, IOAborted, IOFlagSet, IOQuick, WaitIO; FROM IOUtils IMPORT CreateExtIO, DeleteExtIO; FROM Lists IMPORT AddTail, List, NewList; FROM Memory IMPORT MemChip, MemClear, MemPublic, MemReqSet; FROM Nodes IMPORT Node, NodeType; FROM Ports IMPORT GetMsg, MessagePtr, MsgPortPtr, PutMsg; FROM PortUtils IMPORT CreatePort, DeletePort; FROM RunTime IMPORT CmdLinePtr, CmdLineLen, CurrentProcess; FROM Strings IMPORT AppendSubStr, LengthStr; FROM SVX8 IMPORT Compression, GetVHDR, ID8SVX, IDANNO, IDAUTH, IDBODY, IDCopyright, IDNAME, IDVHDR, Unity, Voice8Header; FROM SYSTEM IMPORT ADDRESS, ADR, BYTE, LONGWORD, SETREG, STRPTR; FROM Tasks IMPORT MaxSignal, SetSignal, Signal, SignalSet, Wait; CONST AUDIOCLOCKHZ = 3579545; (* The frequency of the audio chip's clock tick, in Hz. Each tick counts down the period counter by 1, until it hits zero when it loads in the next sample byte. Every pair of samples, it generates an interrupt and loads in a fresh word of data. *) COMMANDTEMPLATESTRING = "Files/...,Buffers/K,Size/K,Hz/K,IFFLikeRaw/S,Volume/K,Verbose/S,Priority/K,All/S,NoRaw/S,NoWait/S"; (* This is the command line template string used by the ARP command line parser. *) NUMBEROFTEMPLATEITEMS = 11; (* The number of template items on the command line and thus the amount of storage to allocate for the arguments. Note that some template items (the file name one for example) can have more than one argument so that the maximum number of arguments isn't related to this. *) MAXNUMBEROFBUFFERS = 30; (* Maximum number of sound sample buffers that we can create. Controls the size of a static array containing pointers to those buffers (too much work to make a linked list). *) MAXPATHNAMELENGTH = 1023; (* The length of the longest full path name we can handle while decoding file name arguments. *) TYPE (* Each sound sample has one of these records. Since there may be several sound samples in an IFF file, several of these records can refer to different parts of the same file. *) SampleFileInfoRecord = RECORD node : Node; (* This node links this record into a list of all the samples to be played. The string part points to the file name, allocated with ArpAlloc so you don't have to worry about deallocating it. Also, it may be shared with other records referencing the same file. *) file : FileHandle; (* The file handle returned by Open for this file. Actually, ArpOpen is used so you don't have to worry about closing it. Several of these records could refer to the same file if it contains several sound samples. This is an unbuffered file (speedier when reading large blocks of data). *) startPosition : LONGINT; (* Where in the file this sound sample starts. *) endPlusOnePosition : LONGINT; (* Identifies the end of the sound sample in the file. It is the position of the byte just after the last byte in the sample. *) volume : CARDINAL; (* The volume at which this sound sample should be played. 0 to 64. *) period : CARDINAL; (* The rate of playback expressed as a hardware period value. *) END; SampleFileInfoPointer = POINTER TO SampleFileInfoRecord; (* One of these records is created for each buffer / IO request used in playing the sounds. *) SoundSampleBufferRecord = RECORD AudioIORequest : IOAudio; (* The nested IO request which this buffer uses. The audio IO request also has a regular IO request in it and that has a message header in it. So, this huge record can be passed around as a message. Note that it must be allocated on a long word boundary. *) WaveFormData : ADDRESS; (* A pointer to a block of CHIP ram containing part of the waveform to be played. The block has a size of SampleBufferSize. *) BufferIDNumber : INTEGER; (* Just a sequence number used to identify the buffer for debugging purposes. *) RequestIsBeingExecuted : BOOLEAN; (* This field is true when the request has been sent away for execution and not yet received back. Used for keeping track of requests that need to be canceled when an abort or some other error occurs. *) SampleBeingExecuted : SampleFileInfoPointer; (* Identifies which file is being executed. Used for backtracking when a sound channel is stolen. *) PositionInSample : LONGINT; (* The position in the sample that is being played by this IO request. *) END; SoundSampleBufferPointer = POINTER TO SoundSampleBufferRecord; SVX8Frame = RECORD (* This contains the current state of one nesting level in the IFF file reader tree. The sound sample default paramters are copied from the level above and changed as parameter chunks are encountered. *) clientFrame : ClientFrame; (* System state information, mostly about file positioning. *) levels : CARDINAL; (* Keeps track of the indentation level for display purposes. Each time a new state copy is created for state nesting, a new level is started. Also increased when snooping around inside other chunks though they might not mean creating a new state (like for PROP chunk internals). Useful for debugging and printing out indented descriptions of things. *) voiceData : Voice8Header; (* Default voice parameters are stored in here and modified as parameter chunks are read IN. *) encounteredSVX8 : BOOLEAN; (* TRUE when we have encountered an SVX8 FORM, meaning that any BODY chunks contain sound sample information. FALSE when in other types of FORMS, meaning that the BODY contains other kinds of data. *) END; SVX8FramePtr = POINTER TO SVX8Frame; SignalNumber = [0..MaxSignal]; (* Global variables. *) VAR AllFilesRecursively : BOOLEAN; (* TRUE to play all files in directories. *) ARexxIsOpen : BOOLEAN; (* If this is TRUE then the ARexx library has been opened and is useable. It also means it needs to be closed when the program exits. *) ARexxKeywords : ARRAY [0..0] OF RexxCommand; (* A list of the ARexx commands this program understands. *) ARexxMessagePortPntr : MsgPortPtr; (* Points to the message port used for receiving ARexx messages. Set up by the EasyARexx module. *) ARexxMessagePortSignal : CARDINAL; (* The number of the signal bit used by the ARexx message port. *) ArgumentArray : ARRAY [1..NUMBEROFTEMPLATEITEMS] OF CLIArg; ARPFileInfoPtr : AnchorPathPtr; (* Info on wildcarded files. *) AudioAllocKey : INTEGER; AudioChannelUsed : AudioChannelSet; AudioCommandPort : MsgPortPtr; (* This message port only has the AudioCommandRequest sent to it. Not used for ordinary data transfer messages. *) AudioCommandRequest : IOAudioPtr; (* This is the IO request used for opening the audio.device, allocating audio channels and aborting IO if things go wrong. It is not used for anything else. It also is queued to a special message port separate from the data transfer IO requests. *) AudioDevice : DevicePtr; AudioPriority : INTEGER; (* Controls channel stealing priority. *) AudioWritePort : MsgPortPtr; (* Only data moving IO requests are queued up at this port. Indeed, they are queued up by the program as part of initialization. The main loop of the program removes received messages, fills their audio buffers and sends them for execution. *) CurrentPosition : LONGINT; (* Where in the current sample. *) CurrentSample : SampleFileInfoPointer; (* Sound being loaded. *) ExtraHelp : ARRAY [0..1399] OF CHAR; (* Help message for ARP to display. *) NewFileHandle : FileHandle; (* data during initialization. *) NewFilePathName : STRPTR; (* Path of file being searched for sound *) NewFileWasUsed : BOOLEAN; (* TRUE if someone found the file useful. *) NoRawFiles : BOOLEAN; (* TRUE to not play raw data files. *) NoWaitingForChannels : BOOLEAN; (* FALSE if should wait for channel allocation. *) NumberOfBuffers : INTEGER; (* From 2 to MAXNUMBEROFBUFFERS. *) PlaybackPeriod : CARDINAL; (* In hardware units, 279ns per unit. *) PlaybackVolume : CARDINAL; (* From 0 to 64. *) PlayIFFLikeRaw : BOOLEAN; (* TRUE to play IFF like raw samples. *) SampleBufferSize : LONGINT; (* Size of each buffer. *) SampleBufferArray : ARRAY [1..MAXNUMBEROFBUFFERS] OF SoundSampleBufferPointer; SampleFileList : List; (* A list of SampleFileInfoRecords. *) Verbose : BOOLEAN; (* TRUE to print out debugging messages. *) PROCEDURE WriteIFFErrorMessage (errorCode : IFFP); (* Writes the error message for the given IFF error. Doesn't do a WriteLn at the end. *) BEGIN (* Note that CASE statements only work for 16 bit values. *) CASE INTEGER (errorCode) OF IFFOkay : WriteString (MsgOkay); | EndMark : WriteString (MsgEndMark); | IFFDone : WriteString (MsgDone); | DOSError : WriteString (MsgDos); | NotIFF : WriteString (MsgNot); | NoFile : WriteString (MsgNoFile); | ClientError : WriteString (MsgClientError); | BadForm : WriteString (MsgForm); | ShortChunk : WriteString (MsgShort); | BadIFF : WriteString (MsgBad); ELSE WriteString("Unspecified error ("); WriteLongInt (errorCode, 1); WriteString (" occurred"); END; END WriteIFFErrorMessage; PROCEDURE DisplayIFFID ( VAR id : ARRAY OF BYTE ); (* Display the IFF identification code as a sequence of four characters on the standard output. *) VAR i : CARDINAL; BEGIN FOR i := 0 TO 3 DO Write (CHAR (id[i])); END; END DisplayIFFID; PROCEDURE DisplayContext ( context : GroupContextPtr ); (* Display a Human readable form of the context (a context is the same as a chunk). The surrounding state nesting level is shown using indentation. The chunk type, subtype and size are also shown. *) VAR CurrentStateFrame : SVX8FramePtr; i : CARDINAL; BEGIN CurrentStateFrame := ADDRESS (context ^ . clientFrame); (* Indent by printing a dot for each level of indentation. *) WriteString (" "); FOR i := 1 TO CurrentStateFrame ^ . levels DO Write ('.'); END; (* Print chunk ID then optional subtype (like FORM ILBM). *) DisplayIFFID (context ^ . ckHdr . ckID); Write (' '); IF context ^ . subtype # NullChunk THEN DisplayIFFID (context ^ . subtype); Write (' '); END; (* Print the chunk size, identifying what kind of data it is if it is a BODY chunk. *) WriteString (" Size: "); WriteLongInt (context ^ . ckHdr . ckSize, 1); IF context ^ . ckHdr . ckID = IDBODY THEN IF CurrentStateFrame ^ . encounteredSVX8 THEN WriteString (" bytes of sound data!"); ELSE WriteString (" bytes of useless data."); END; END; WriteLn; END DisplayContext; PROCEDURE ProcessLeafChunk ( CurrentContext : GroupContextPtr; (* The context containing the chunk to be processed. *) In8SVXFORM : BOOLEAN (* TRUE when the chunk is contained in a FORM or PROP that has a subtype of 8SVX. This means that the 8SVX specific chunk names are meaningful. Otherwise, the 8SVX names are undefined. Also controls whether BODY chunks are known to contain sound sample data. This will fail if someone sticks a BODY chunk into a PROP. I'll assume that it doesn't happen. *) ) : IFFP; (* Read the various possible properties from within a chunk. Update the current state with the read in properties only if this is within an 8SVX FORM or PROP. Recognizes VHDR, NAME, (c), AUTH, ANNO, BODY. *) VAR CurrentStateFramePtr : SVX8FramePtr; Hz : LONGINT; LongString : ARRAY [0..255] OF CHAR; NewSampleInfo : SampleFileInfoPointer; PropertyType : ID; ReturnCode : IFFP; SampleSize : LONGINT; StringLength : LONGINT; BEGIN IF Verbose THEN DisplayContext (CurrentContext); END; IF SIGBreakC IN SetSignal (SignalSet {}, SignalSet {}) THEN IF Verbose THEN WriteString ("Control-C detected while scanning an IFF file.\n"); END; RETURN DOSError; END; ReturnCode := IFFOkay; CurrentStateFramePtr := ADDRESS (CurrentContext ^ . clientFrame); PropertyType := CurrentContext ^ . ckHdr . ckID; IF (PropertyType = IDVHDR) AND In8SVXFORM THEN (* Voice attributes are meaningful, update current state. *) ReturnCode := GetVHDR (CurrentContext, ADR (CurrentStateFramePtr ^ . voiceData)); IF Verbose THEN WITH CurrentStateFramePtr ^ . voiceData DO WriteString ("\tOne shot hi samples: \t"); WriteLongInt (oneShotHiSamples, 1); WriteString ("\n\tRepeat hi samples: \t"); WriteLongInt (repeatHiSamples, 1); WriteString ("\n\tSamples per hi cycle: \t"); WriteLongInt (samplesPerHiCycle, 1); WriteString ("\n\tSamples per second:\t"); WriteLongInt (samplesPerSec, 1); WriteString ("\n\tNumber of Octaves:\t"); WriteInt (INTEGER (ctOctave), 1); WriteString ("\n\tSample compression:\t"); IF sCompression = sCmpNone THEN WriteString ("none"); ELSIF sCompression = sCmpFibDelta THEN WriteString ("fibonacci-delta"); ELSE WriteString ("unknown ("); WriteInt (INTEGER (sCompression), 1); WriteString (")\n"); END; WriteString ("\n\tVolume (0 to 65536):\t"); WriteLongInt (volume, 1); WriteLn; END; (* END WITH *) END; (* IF Verbose *) END; (* IF VHDR *) IF Verbose AND ((PropertyType = IDANNO) OR (PropertyType = IDAUTH) OR (PropertyType = IDCopyright) OR (PropertyType = IDNAME)) THEN (* This is a printable string. *) StringLength := CurrentContext ^ . ckHdr . ckSize; IF StringLength > 255 THEN StringLength := 255; END; ReturnCode := IFFReadBytes (CurrentContext, ADR (LongString), StringLength); LongString [INTEGER (StringLength)] := 0C; WriteString ("\t"); WriteString (LongString); WriteLn; END; (* IF printable string *) IF (PropertyType = IDBODY) AND In8SVXFORM THEN (* Remember where this sound data is so that it can be played. *) NewSampleInfo := ArpAllocMem (SIZE (NewSampleInfo ^), MemReqSet {MemClear, MemPublic}); IF NewSampleInfo = NIL THEN WriteString ("Can't allocate memory for sample information.\n"); ReturnCode := DOSError; ELSE WITH NewSampleInfo ^ DO node . lnName := NewFilePathName; file := NewFileHandle; NewFileWasUsed := TRUE; startPosition := CurrentContext ^ . position; IF PlayIFFLikeRaw THEN SampleSize := CurrentContext ^ . ckHdr . ckSize; ELSE SampleSize := CurrentStateFramePtr ^ . voiceData . oneShotHiSamples; IF (SampleSize <= 0) OR (SampleSize > CurrentContext ^ . ckHdr . ckSize) THEN (* Probably an old PerfectSound sample. *) IF Verbose THEN WriteString ("Sample size is weird! Using chunk size instead.\n"); END; SampleSize := CurrentContext ^ . ckHdr . ckSize; END; END; endPlusOnePosition := startPosition + SampleSize; IF PlayIFFLikeRaw THEN volume := PlaybackVolume; period := PlaybackPeriod; ELSE volume := CurrentStateFramePtr ^ . voiceData . volume * 64 DIV Unity; Hz := LONGINT (CurrentStateFramePtr ^ . voiceData . samplesPerSec); IF Hz > 50000D THEN Hz := 50000D; END; (* Don't allow big values. *) IF Hz < 110 THEN Hz := 110; END; (* Smaller makes period overflow. *) period := AUDIOCLOCKHZ DIV Hz; END; IF Verbose THEN WriteString ("\t\c1;32mParameters in effect for this IFF sample:\n"); WriteString ("\tVolume:\t"); WriteInt (volume,1); WriteString ("\n\tPeriod:\t"); WriteInt (period, 1); WriteString ("\n\tStart:\t"); WriteLongInt (startPosition, 1); WriteString ("\n\tEnd+1:\t"); WriteLongInt (endPlusOnePosition, 1); WriteString ("\cm\n"); END; END; (* WITH NewSampleInfo *) AddTail (ADR (SampleFileList), NewSampleInfo); END; END; RETURN ReturnCode; END ProcessLeafChunk; PROCEDURE SVX8GetList ( CurrentContext : GroupContextPtr (* The context containing the data part of the LIST chunk. *) ) : IFFP; (* Handle a LIST chunk. LIST chunks contain an arbitrary number of PROP chunks describing default properties and then a collection of FORMs which use the defaults specified at the start of the list. A new level of state nesting is opened to keep track of the LIST specific defaults. The defaults for the defaults are inherited from the parent state. *) VAR NewStateFrame : SVX8Frame; ParentStateFramePtr : SVX8FramePtr; BEGIN IF Verbose THEN DisplayContext (CurrentContext); END; ParentStateFramePtr := ADDRESS (CurrentContext ^ . clientFrame); NewStateFrame := ParentStateFramePtr ^; (* Copy default values. *) INC (NewStateFrame . levels); NewStateFrame . encounteredSVX8 := FALSE; (* No BODY until FORM in LIST *) RETURN ReadIList (CurrentContext, ADR (NewStateFrame)); END SVX8GetList; PROCEDURE SVX8GetForm ( CurrentContext : GroupContextPtr (* The context containing the data part of the FORM chunk. *) ) : IFFP; (* Handle a FORM chunk. The FORM can contain many other things, including other FORM, BODY, LIST etc. chunks. Since it has this grouping function, a new level of state nesting has to be opened to preserve default values. The subtype of the form defines the name space for attribute chunks. A VHDR in a FORM 8SVX describes sound sample parameters. A VHDR in a FORM ILBM is undefined though it could be defined to be something for use with ILBMs. *) VAR NewStateFrame : SVX8Frame; OldStateFramePtr : SVX8FramePtr; ReturnCode : IFFP; Subcontext : GroupContext; BEGIN IF Verbose THEN DisplayContext (CurrentContext); END; OldStateFramePtr := ADDRESS (CurrentContext ^ . clientFrame); NewStateFrame := OldStateFramePtr ^; (* Copy default values. *) INC (NewStateFrame . levels); NewStateFrame . encounteredSVX8 := CurrentContext ^ . subtype = ID8SVX; (* Open a new read on the contents of the FORM. *) ReturnCode := OpenRGroup (CurrentContext, ADR (Subcontext)); IF ReturnCode # IFFOkay THEN RETURN ReturnCode; END; Subcontext . clientFrame := ADR (NewStateFrame); (* Sift through the FORM contents. Subchunks of type LIST, FORM, PROP, CAT are already handled by GetF1ChunkHdr (calls appropriate routine and returns IFFOkay). We have to handle the BODY and attribute chunks. Note that the meaning of chunks depends on whether this is an 8SVX FORM or not. *) REPEAT ReturnCode := GetF1ChunkHdr (ADR (Subcontext)); IF ReturnCode > IFFOkay THEN (* Chunk not understood by GetF1... *) ReturnCode := ProcessLeafChunk (ADR (Subcontext), NewStateFrame . encounteredSVX8); END UNTIL ReturnCode < IFFOkay; (* Until error or end of chunk. *) ReturnCode := CloseRGroup (ADR (Subcontext)); IF ReturnCode = EndMark THEN (* Ok to hit end of chunk normally. *) RETURN IFFOkay; END; RETURN ReturnCode; END SVX8GetForm; PROCEDURE SVX8GetProp ( CurrentContext : GroupContextPtr (* The context for the data part of the LIST in which this PROP resides. *) ) : IFFP; (* Handle a PROP chunk. It contains a subtype (the same as the subtype for the FORM it is describing properties of) and then the attributes. The attribute type names are related to the surrounding FORM / PROP subtype. For example, a VHDR in an FORM 8SVX or PROP 8SVX means what we think it means (parameters for an 8 bit sound sample). The name VHDR in a FORM ILBM or PROP ILBM means something completely different. *) VAR CurrentStateFramePtr : SVX8FramePtr; ReturnCode : IFFP; Subcontext : GroupContext; ThisIsAn8SVXPROP : BOOLEAN; BEGIN IF Verbose THEN DisplayContext (CurrentContext); END; ThisIsAn8SVXPROP := CurrentContext ^ . subtype = ID8SVX; ReturnCode := OpenRGroup (CurrentContext, ADR (Subcontext)); IF ReturnCode # IFFOkay THEN RETURN ReturnCode; END; (* One more level of indentation for display purposes (state is still the same one, no new state nesting for PROP). *) CurrentStateFramePtr := ADDRESS (CurrentContext ^ . clientFrame); INC (CurrentStateFramePtr ^ . levels); REPEAT ReturnCode := GetPChunkHdr (ADR (Subcontext)); IF ReturnCode > IFFOkay THEN (* Not an invalid type for a PROP, we have to process chunk. *) ReturnCode := ProcessLeafChunk (ADR (Subcontext), ThisIsAn8SVXPROP); END UNTIL ReturnCode < IFFOkay; (* Finished snooping around inside the PROP, decrease indentation. *) DEC (CurrentStateFramePtr ^ . levels); ReturnCode := CloseRGroup (ADR (Subcontext)); IF ReturnCode = EndMark THEN RETURN IFFOkay; END; RETURN ReturnCode; END SVX8GetProp; PROCEDURE SVX8GetCat ( CurrentContext : GroupContextPtr (* The context for the CAT's data. *) ) : IFFP; (* Handle a CAT chunk. This kind of chunk is just a collection of assorted things (FORM, LIST or CAT only, no PROP's). It has a type hint which doesn't really mean anything. *) VAR CurrentStateFramePtr : SVX8FramePtr; ReturnCode : IFFP; BEGIN IF Verbose THEN DisplayContext (CurrentContext); END; CurrentStateFramePtr := ADDRESS (CurrentContext ^ . clientFrame); INC (CurrentStateFramePtr ^ . levels); ReturnCode := ReadICat (CurrentContext); DEC (CurrentStateFramePtr ^ . levels); RETURN ReturnCode; END SVX8GetCat; PROCEDURE LocateSVX8Samples () : IFFP; (* The NewFilePathName file will be opened and searched for SVX8 sound sample information. All data found will be added to SampleFileList, one entry for each BODY of sound. A return code of IFFOkay means that things were read successfully. A return code of NotIFF means just that. The global variables NewFilePathName, NewFileHandle, NewFileWasUsed and SampleFileList are used. *) VAR ReturnCode : IFFP; InputFile : BufHandle; CurrentStateFrame : SVX8Frame; aBoolean : BOOLEAN; BEGIN (* Initialize the default defaults. *) CurrentStateFrame . levels := 0; WITH CurrentStateFrame . voiceData DO oneShotHiSamples := 20000; repeatHiSamples := 0; samplesPerHiCycle := 0; samplesPerSec := 10000; ctOctave := BYTE (1); sCompression := sCmpNone; volume := Unity; END; CurrentStateFrame . encounteredSVX8 := FALSE; (* Specify the IFF routines we want to use. *) CurrentStateFrame . clientFrame . getList := SVX8GetList; CurrentStateFrame . clientFrame . getForm := SVX8GetForm; CurrentStateFrame . clientFrame . getProp := SVX8GetProp; CurrentStateFrame . clientFrame . getCat := SVX8GetCat; (* Do the work. Note small file size since we are only examining the headers and that doesn't take much (so read < 1 disk sector). *) IF NOT BufOpen (InputFile, NewFilePathName, 480, ModeOldFile) THEN ReturnCode := NoFile; ELSE ReturnCode := ReadIFF (InputFile, ADR (CurrentStateFrame)); aBoolean := BufClose (InputFile); END; RETURN ReturnCode; END LocateSVX8Samples; PROCEDURE ProcessARexxCommands ( VAR Message : RexxMsg; (* The message from ARexx with the command. *) CommandWord : RexxCommandPtr (* The command keyword that the message is about. *) ) : INTEGER; (* A return code for the result of the command processing. Halts command processing if it isn't zero. Not returned to the ARexx calling program. *) (* This procedure is called by the ARexx processing routines whenever a message comes in. Check things out and do the command requested. Returns an error code in the message's rmResult1 field with an optional result string (if rmResult1 is zero) optionally created by calling ProvideString. *) VAR I : CARDINAL; BEGIN IF Verbose THEN WriteString ("Got ARexx command keyword "); WriteString (CommandWord ^ . rcName ^); WriteString (" with arguments:\n"); FOR I := 0 TO 15 DO IF Message . rmArgs [I] <> NIL THEN WriteCard (I, 2); WriteString (": \""); WriteString (Message . rmArgs [I] ^); WriteString ("\"\n"); END; END; END; IF CommandWord ^ . rcUserData = 0 THEN (* The StopPlaying keyword. *) Signal (CurrentProcess, SignalSet {SIGBreakC}); END; RETURN 0; END ProcessARexxCommands; PROCEDURE Initialize ( ) : BOOLEAN; (* True for successful initialization, false for a failure. *) (* Returns TRUE if it successfully opened files, allocated memory and so on. Returns FALSE if something went wrong. Will leave partially allocated, opened things still open so that the termination procedure will have to close them. *) VAR ArgumentPosition : INTEGER; FileSize : LONGINT; FileArgumentPtr : STRPTR; FilePathNameLength : CARDINAL; Hz : LONGINT; I : INTEGER; LongWord : LONGWORD; NewFilePathNameTracker : TrackedResourcePtr; NewFileTracker : TrackedResourcePtr; NewSampleInfo : SampleFileInfoPointer; NumberOfArguments : LONGINT; ResultOfReadingIFFFile : IFFP; ReturnCode : CARDINAL; TemporaryFileLock : FileLock; TemporaryFileNamePtr : STRPTR; TemporaryPathName : ARRAY [0..MAXPATHNAMELENGTH] OF CHAR; UserWantsToStopExaminingFiles : BOOLEAN; PROCEDURE ABPS (String : ARRAY OF CHAR); (* Append Blank Padded String. Appends enough blanks to the string so that it extends out to column 77. CSI sequences and control characters are ignored. The ExtraHelp string is the destination of the padding. *) VAR ExtraIndex : CARDINAL; I, J : CARDINAL; InCSI : BOOLEAN; Letter : CHAR; LetterCount : CARDINAL; BEGIN ExtraIndex := LengthStr (ExtraHelp); InCSI := FALSE; LetterCount := 0; FOR I := 0 TO HIGH (String) DO Letter := String [I]; IF InCSI THEN IF Letter >= 'A' THEN InCSI := FALSE; END; ELSE IF Letter = '\c' THEN InCSI := TRUE; ELSIF Letter >= ' ' THEN (* Not a control character. *) INC (LetterCount); ELSIF Letter = '\n' THEN (* Add on padding blanks at end of line. *) FOR J := 77 - LetterCount TO 1 BY -1 DO ExtraHelp [ExtraIndex] := ' '; INC (ExtraIndex); END; LetterCount := 0; ELSIF Letter = '\t' THEN WHILE (LetterCount MOD 8) <> 7 DO ExtraHelp [ExtraIndex] := ' '; INC (ExtraIndex); INC (LetterCount); END; Letter := ' '; INC (LetterCount); END; END; ExtraHelp [ExtraIndex] := Letter; INC (ExtraIndex); END; END ABPS; BEGIN (* Set all the global variables to nice initial values which won't cause problems if deallocations have to be done before everything is allocated. Some are also defaults if the user doesn't specify a parameter value. *) ExtraHelp := "\n\c1;30;41m\c\x4a"; ABPS ("\n\tAGMSPlaySound\c0;32;41m (December 19, 1993).\n"); ABPS ("\tDirect from disk IFF and raw data sound sample player.\n\n"); ABPS ("\c33m\tDeveloped using M2Sprint for the Amiga\n"); ABPS ("\tM2S Inc., Dallas, Texas\c32m\n\n"); ABPS ("\tWritten by Alexander G. M. Smith, Ottawa, Canada.\n\n"); ABPS ("\tNow with ARP wildcards (the usual plus *,[a-z],~=not,'=unwild,.=cd).\n"); ABPS ("\tAnd with full IFF file decoding! (Try the Verbose option too)\n\n"); ABPS ("\tIf you have any comments, please write to me at:\n\n"); ABPS ("\t\tagmsmith@BIX.com\n\t\t71330.3173@CompuServe.com\n\n\cm\c\x4a"); (* Bleeble FOR debugging, TO avoid string overflows. * ) WriteString ("Help length: "); WriteInt (LengthStr (ExtraHelp), 1); WriteLn; ( * *) FOR I := 1 TO MAXNUMBEROFBUFFERS DO SampleBufferArray [I] := NIL; END; FOR I := 1 TO NUMBEROFTEMPLATEITEMS DO ArgumentArray [I] . Str := NIL; END; Verbose := FALSE; PlayIFFLikeRaw := FALSE; NoRawFiles := FALSE; NoWaitingForChannels := FALSE; AllFilesRecursively := FALSE; NumberOfBuffers := 5; SampleBufferSize := 10000; PlaybackPeriod := 358; (* 10 kHz *) PlaybackVolume := 64; (* Maximum volume. *) AudioPriority := -90; (* Background sound priority. *) ARPFileInfoPtr := NIL; (* An anchor chain used in wildcard expansion. *) NewList (ADR (SampleFileList)); AudioDevice := NIL; AudioAllocKey := 0; AudioChannelUsed := AudioChannelSet {}; AudioCommandRequest := NIL; AudioCommandPort := NIL; AudioWritePort := NIL; (* Parse the command line using ARP's template matching code. *) NumberOfArguments := GADS (CmdLinePtr, CmdLineLen, ADR (ExtraHelp), ADR (ArgumentArray), ADR (COMMANDTEMPLATESTRING)); IF NumberOfArguments < 0 THEN (* Command line error. *) (* Display error message from ARP. *) WriteString (ArgumentArray [1] . Str ^); WriteString (".\n"); RETURN FALSE; END; IF NumberOfArguments = 0 THEN WriteString ( "This is an ARP based program. Use ? for template and again for more info.\n"); RETURN FALSE; END; (* Get the verbosity argument first since we need to control the verbosity right away. *) ArgumentPosition := 7; Verbose := ArgumentArray [ArgumentPosition] . Bool; IF Verbose THEN WriteString ("Will display verbose status messages. Now initializing.\n"); END; IF Verbose THEN WriteString ("You specified "); WriteLongInt (NumberOfArguments, 1); WriteString (" arguments on the command line.\n"); END; (* Process the NumberOfBuffers command line argument. First convert it from string form and then make sure that it is within range. *) ArgumentPosition := 2; IF ArgumentArray [ArgumentPosition] . Str <> NIL THEN IF NOT ConvStrToNum (ArgumentArray [ArgumentPosition] . Str ^, LongWord, 10, FALSE) THEN WriteString ("Can't figure out what \""); WriteString (ArgumentArray [ArgumentPosition] . Str ^); WriteString ("\" means for the number of buffers.\n"); RETURN FALSE; END; NumberOfBuffers := INTEGER (LongWord); END; IF NumberOfBuffers < 1 THEN NumberOfBuffers := 1; END; IF NumberOfBuffers > MAXNUMBEROFBUFFERS THEN NumberOfBuffers := MAXNUMBEROFBUFFERS; END; IF Verbose THEN WriteString ("Using "); WriteInt (NumberOfBuffers, 1); WriteString (" buffers for sound samples.\n"); END; (* Now set the buffer size to the user specified value, if any. *) ArgumentPosition := 3; IF ArgumentArray [ArgumentPosition] . Str <> NIL THEN IF NOT ConvStrToNum (ArgumentArray [ArgumentPosition] . Str ^, LongWord, 10, FALSE) THEN WriteString ("Can't decode your buffer size of \""); WriteString (ArgumentArray [ArgumentPosition] . Str ^); WriteString ("\".\n"); RETURN FALSE; END; SampleBufferSize := LONGINT (LongWord); END; (* Adjust sound sample buffer size to the amount that the audio device hardware can handle. *) IF ODD (SampleBufferSize) THEN INC (SampleBufferSize); END; IF SampleBufferSize > 131072 THEN SampleBufferSize := 131072; END; IF SampleBufferSize < 2 THEN SampleBufferSize := 2; END; IF Verbose THEN WriteString ("Each buffer takes "); WriteLongInt (SampleBufferSize, 1); WriteString (" bytes of CHIP RAM and also some FAST RAM.\n"); END; (* Compute the audio playback period from the user's frequency, if any. *) ArgumentPosition := 4; IF ArgumentArray [ArgumentPosition] . Str <> NIL THEN IF NOT ConvStrToNum (ArgumentArray [ArgumentPosition] . Str ^, LongWord, 10, FALSE) THEN WriteString ("The sampling playback frequency of \""); WriteString (ArgumentArray [ArgumentPosition] . Str ^); WriteString ("\" doesn't make sense.\n"); RETURN FALSE; END; Hz := LONGINT (LongWord); IF Hz > 50000D THEN Hz := 50000D; END; (* Don't allow ridiculous values. *) IF Hz < 110 THEN Hz := 110; END; (* Any smaller causes DIV problems. *) PlaybackPeriod := AUDIOCLOCKHZ DIV Hz; END; (* Validate the playback period. *) IF PlaybackPeriod < 124 THEN PlaybackPeriod := 124; END; (* Min period. *) IF Verbose THEN WriteString ("Playback period is "); WriteInt (PlaybackPeriod, 1); WriteString (" which is equivalent to "); Hz := AUDIOCLOCKHZ DIV LONGINT (PlaybackPeriod); WriteLongInt (Hz, 1); WriteString (" samples per second.\n"); END; (* Get the flag for treating IFF files like raw data files. *) ArgumentPosition := 5; PlayIFFLikeRaw := ArgumentArray [ArgumentPosition] . Bool; IF Verbose THEN IF PlayIFFLikeRaw THEN WriteString ("IFF files will use the raw data file playback parameters and use the chunk\n"); WriteString ("size for their length.\n"); ELSE WriteString ("IFF samples will be played at their own volume and period settings and will\n"); WriteString ("use the one shot sample size for their length (if it is reasonable).\n"); END; END; (* Get the volume of playback. *) ArgumentPosition := 6; IF ArgumentArray [ArgumentPosition] . Str <> NIL THEN IF NOT ConvStrToNum (ArgumentArray [ArgumentPosition] . Str ^, LongWord, 10, FALSE) THEN WriteString ("Your volume selection of \""); WriteString (ArgumentArray [ArgumentPosition] . Str ^); WriteString ("\" doesn't parse.\n"); RETURN FALSE; END; PlaybackVolume := CARDINAL (LongWord); END; IF PlaybackVolume > 64 THEN PlaybackVolume := 64; END; IF Verbose THEN WriteString ("The playback volume setting is "); WriteInt (PlaybackVolume, 1); WriteString (" out of a range from 0 to 64.\n"); END; (* Get the audio priority. *) ArgumentPosition := 8; IF ArgumentArray [ArgumentPosition] . Str <> NIL THEN IF NOT ConvStrToNum (ArgumentArray [ArgumentPosition] . Str ^, LongWord, 10, TRUE) THEN WriteString ("What kind of priority is \""); WriteString (ArgumentArray [ArgumentPosition] . Str ^); WriteString ("\"? It doesn't make sense.\n"); RETURN FALSE; END; AudioPriority := INTEGER (LongWord); END; IF AudioPriority < -128 THEN AudioPriority := -128; END; IF AudioPriority > 127 THEN AudioPriority := 127; END; IF Verbose THEN WriteString ("Will use a priority of "); WriteInt (AudioPriority, 1); WriteString (" to arbitrate control of the audio channel.\n"); END; (* Check for the ALL keyword. *) ArgumentPosition := 9; AllFilesRecursively := ArgumentArray [ArgumentPosition] . Bool; IF Verbose THEN IF AllFilesRecursively THEN WriteString ("Will play all files found in ALL subdirectories.\n"); ELSE WriteString ("Not playing the contents of directories encountered.\n"); END; END; (* Check for the NoRaw keyword. *) ArgumentPosition := 10; NoRawFiles := ArgumentArray [ArgumentPosition] . Bool; IF Verbose THEN IF NoRawFiles THEN WriteString ("Will not play any raw data files, just IFF files.\n"); ELSE WriteString ("Will play both raw data files and IFF files.\n"); END; END; (* Check for the NoWait keyword. *) ArgumentPosition := 11; NoWaitingForChannels := ArgumentArray [ArgumentPosition] . Bool; IF Verbose THEN IF NoWaitingForChannels THEN WriteString ("Will not wait for audio channel allocation, if there are\n"); WriteString ("none, the program will exit right away.\n"); ELSE WriteString ( "Will wait for audio channels to become free if there aren't any.\n"); END; END; (* Load up on multiple file names. Open ones that are worth playing. Scan for wildcards. *) ArgumentPosition := 1; IF ArgumentArray [ArgumentPosition] . Array <> NIL THEN I := 0; (* Argument counter and index. *) (* Process each argument. It may be a wild card file name which could generate several file names to be looked at. *) UserWantsToStopExaminingFiles := FALSE; WHILE (ArgumentArray [ArgumentPosition] . Array ^ [I] <> NIL) AND NOT UserWantsToStopExaminingFiles DO FileArgumentPtr := ArgumentArray [ArgumentPosition] . Array ^ [I]; IF Verbose THEN WriteString ("Files/... argument number "); WriteInt (I, 1); WriteString (": \""); WriteString (FileArgumentPtr ^); WriteString ("\".\n"); END; IF ARPFileInfoPtr = NIL THEN (* Allocate only when needed so init by FindFirst is done. *) ARPFileInfoPtr := ArpAllocMem (SIZE (ARPFileInfoPtr ^) + MAXPATHNAMELENGTH + 1, MemReqSet {MemClear, MemPublic}); IF ARPFileInfoPtr = NIL THEN WriteString ("Couldn't allocate wildcard pattern anchor chain record.\n"); RETURN FALSE; END; END; WITH ARPFileInfoPtr ^ DO (* Reinitialize the FindFirst/Next parameters. *) apBreakBits := SignalSet {SIGBreakC, SIGBreakE}; apFoundBreak := SignalSet {}; apFlags := APFlagSet {apDoDot (* Allow "." for current directory *), apDoWild (* Allow wildcards. *)}; apLength := MAXPATHNAMELENGTH; END; (* WITH ARPFileInfoPtr *) (* Undocumented ARP parameter: set register A1 to point to the file info block being used before doing FindFirst. This bug found October 13, 1990 by disassembling the ARP "delete" command. Some other weirdness too: puts $000D in the word just before the allocated memory for the AnchorPath. But that doesn't seem to do anything. Update: it is setting the tracker node type. The missing A1 problem causes lost memory when using the ALL recursive directory traversal. *) SETREG (9, ADR (ARPFileInfoPtr ^ . apInfo)); ReturnCode := FindFirst (FileArgumentPtr, ARPFileInfoPtr); WHILE ReturnCode = 0 DO (* Process all files matching wildcards. *) TemporaryFileNamePtr := ADR (ARPFileInfoPtr ^ . apBuffer); IF Verbose THEN WriteString (" Now processing: "); WriteString (TemporaryFileNamePtr ^); WriteString (" (\c33m"); WriteString (ARPFileInfoPtr ^ . apInfo . fibFileName); WriteString ("\cm).\n"); END; IF ARPFileInfoPtr ^ . apInfo . fibDirEntryType < 0 THEN (* This is a file, not a directory. *) NewFileWasUsed := FALSE; (* Will close file if it isn't used. *) NewFileHandle := NIL; NewFileTracker := NIL; NewFilePathName := NIL; NewFilePathNameTracker := NIL; (* Find the file size and full path name. *) FileSize := ARPFileInfoPtr ^ . apInfo . fibSize; TemporaryFileLock := Lock (TemporaryFileNamePtr, AccessRead); IF TemporaryFileLock = NIL THEN WriteString ("Can't get a lock on \""); WriteString (TemporaryFileNamePtr ^); WriteString ("\".\n"); RETURN FALSE; END; FilePathNameLength := PathName (TemporaryFileLock, ADR (TemporaryPathName), MAXPATHNAMELENGTH DIV 32); UnLock (TemporaryFileLock); IF FilePathNameLength <= 0 THEN WriteString ("Problems trying to find the full path name for "); WriteString (TemporaryFileNamePtr ^); WriteLn; RETURN FALSE; END; IF FilePathNameLength >= MAXPATHNAMELENGTH THEN WriteString ("Full path name for "); WriteString (TemporaryFileNamePtr ^); WriteString (" overflowed allocated buffer space!\n"); RETURN FALSE; END; NewFilePathName := ArpAllocMem (FilePathNameLength + 1, MemReqSet {MemClear, MemPublic}); NewFilePathNameTracker := TrackedResourcePtr (IoErr ()); IF NewFilePathName = NIL THEN WriteString ( "Ran out of memory while trying to allocate path name buffer.\n"); RETURN FALSE; END; strcpy (ADDRESS (NewFilePathName), ADR (TemporaryPathName)); IF Verbose THEN WriteString (" Full path name: \""); WriteString (NewFilePathName ^); WriteString ("\".\n File size: "); WriteLongInt (FileSize, 1); WriteString (" bytes.\n"); END; IF FileSize > 0 THEN (* Something there to be played. *) NewFileHandle := ArpOpen (NewFilePathName, ModeOldFile); NewFileTracker := TrackedResourcePtr (IoErr ()); IF NewFileHandle = NIL THEN WriteString ("Can't open file \""); WriteString (NewFilePathName ^); WriteString ("\".\n"); RETURN FALSE; END; (* Read the file and see if it is IFF. Stash away sound sample data for any sample chunks if it is an IFF file. Sets the NewFileWasUsed flag to TRUE if it found sound data. *) ResultOfReadingIFFFile := LocateSVX8Samples (); IF Verbose THEN WriteString (" IFF read result is: "); WriteIFFErrorMessage (ResultOfReadingIFFFile); WriteLn; END; IF (ResultOfReadingIFFFile = NotIFF) AND NOT NoRawFiles THEN (* Treat it as a raw data file. *) NewSampleInfo := ArpAllocMem (SIZE (NewSampleInfo ^), MemReqSet {MemClear, MemPublic}); IF NewSampleInfo = NIL THEN WriteString ("Can't allocate memory for sample information.\n"); RETURN FALSE; END; WITH NewSampleInfo ^ DO node . lnName := NewFilePathName; file := NewFileHandle; NewFileWasUsed := TRUE; startPosition := 0; endPlusOnePosition := FileSize; volume := PlaybackVolume; period := PlaybackPeriod; IF Verbose THEN WriteString ("\t\c32mParameters in effect for this raw sample:\n"); WriteString ("\tStart:\t"); WriteLongInt (startPosition, 1); WriteString ("\n\tEnd+1:\t"); WriteLongInt (endPlusOnePosition, 1); WriteString ("\cm\n"); END; END; AddTail (ADR (SampleFileList), NewSampleInfo); END; (* IF treated as a raw file. *) END; (* If file size is larger than zero. *) (* If the file was not used and was opened (zero length files are not opened) then close it. Reduces the amount of memory taken up by files that were examined but not used. Also frees the string storage for the path name, which can be quite large. *) IF NOT NewFileWasUsed THEN IF Verbose THEN WriteString (" Closing this file, no sounds found in it.\n"); END; IF NewFilePathNameTracker <> NIL THEN FreeTrackedItem (NewFilePathNameTracker); END; IF NewFileTracker <> NIL THEN FreeTrackedItem (NewFileTracker); END; END; ELSE (* This is a directory. *) WITH ARPFileInfoPtr ^ DO EXCL (apFlags, apDoDir); IF AllFilesRecursively AND NOT (apDidDir IN apFlags) THEN (* Descend recursively into the directory. *) INCL (apFlags, apDoDir); END; EXCL (apFlags, apDidDir); (* Reset it for next sibling subdir. *) IF Verbose THEN IF apDoDir IN apFlags THEN WriteString (" Recursively examining this directory.\n"); ELSE WriteString (" Ignoring contents of this directory.\n"); END; END; END; (* WITH *) END; (* If it was a directory. *) ReturnCode := FindNext (ARPFileInfoPtr); END; (* WHILE ReturnCode = 0 *) FreeAnchorChain (ARPFileInfoPtr); (* Finished with the anchor chain. *) (* Analyse return code to see why we stopped. *) IF ReturnCode = ErrorBreak THEN (* Examine the break bits to see what broke. *) WITH ARPFileInfoPtr ^ DO IF SIGBreakC IN apFoundBreak THEN WriteString ( "Control-C break detected during file examination. Stopping completely.\n"); RETURN FALSE; ELSIF SIGBreakE IN apFoundBreak THEN WriteString ("Control-E break detected during file examination,\n"); WriteString ("skipping the rest of the files.\n"); UserWantsToStopExaminingFiles := TRUE; ELSE WriteString ("Unexpected break signal (unknown kind) received.\n"); RETURN FALSE; END; END; (* WITH ARPFileInfoPtr *) ELSIF ReturnCode <> ErrorNoMoreEntries THEN WriteString ("Error number "); WriteInt (ReturnCode, 1); WriteString (" occured while examining files.\n"); RETURN FALSE; END; INC (I); (* Index to next Files/... argument. *) END; (* WHILE file parameters to process. *) END; (* IF there are some Files/... arguments specified. *) CurrentSample := SampleFileInfoPointer (SampleFileList . lhHead); CurrentPosition := 0; IF CurrentSample ^ . node . lnSucc = NIL THEN WriteString ("No sound sample files to play.\n"); RETURN FALSE; END; CurrentPosition := CurrentSample ^ . startPosition; AudioCommandPort := CreatePort (NIL, 0); IF AudioCommandPort = NIL THEN WriteString ("Can't allocate audio IO message port for commands.\n"); RETURN FALSE; END; AudioCommandRequest := CreateExtIO (AudioCommandPort, SIZE (AudioCommandRequest ^)); IF AudioCommandRequest = NIL THEN WriteString ("Can't allocate audio IO command request.\n"); RETURN FALSE; END; AudioWritePort := CreatePort (NIL, 0); IF AudioWritePort = NIL THEN WriteString ("Couldn't create port for audio write requests.\n"); RETURN FALSE; END; FOR I := 1 TO NumberOfBuffers DO SampleBufferArray [I] := ArpAllocMem (SIZE (SampleBufferArray [I] ^), MemReqSet {MemClear, MemPublic}); IF SampleBufferArray [I] = NIL THEN WriteString ("Couldn't allocate a sound sample buffer IO request.\n"); RETURN FALSE; END; WITH SampleBufferArray [I] ^ DO BufferIDNumber := I; RequestIsBeingExecuted := FALSE; SampleBeingExecuted := NIL; PositionInSample := 0; WaveFormData := ArpAllocMem (SampleBufferSize, MemReqSet {MemPublic, MemChip}); IF WaveFormData = NIL THEN WriteString ("Couldn't allocate CHIP ram for a waveform buffer.\n"); RETURN FALSE; END; WITH AudioIORequest . ioaRequest . ioMessage DO mnNode . lnType := NTMessage; mnLength := SIZE (SampleBufferArray [I] ^); mnReplyPort := AudioWritePort; END; END; (* WITH SampleBufferArray [I] ^ *) (* Queue up the new request at the message port used for data requests. The main loop just takes completed requests from the port and reuses them. *) PutMsg (AudioWritePort, SampleBufferArray [I]); END; (* FOR I *) IF OpenDevice (ADR (AudioName), (* unit number *) 0, AudioCommandRequest, LONGBITSET {}) <> 0 THEN WriteString ("Failed to open the "); WriteString (AudioName); WriteString (" device.\n"); RETURN FALSE; END; AudioDevice := AudioCommandRequest ^ . ioaRequest . ioDevice; (* Try to open the ARexx library. No error possible since this program should work even if ARexx isn't available. *) IF Verbose THEN WriteString ("Attempting to open the ARexx library.\n"); END; ARexxIsOpen := OpenARexxLib (); IF Verbose THEN WriteString ("ARexx library "); IF ARexxIsOpen THEN WriteString ("is"); ELSE WriteString ("didn't"); END; WriteString (" open.\n"); END; IF ARexxIsOpen THEN IF Verbose THEN WriteString ("Opening a message port for ARexx messages.\n"); END; ARexxMessagePortPntr := OpenARexxPort ("AGMSPlaySound", "AGMSPS", ProcessARexxCommands, ARexxKeywords); IF ARexxMessagePortPntr = NIL THEN WriteString ("Failed to open the ARexx message port.\n"); RETURN FALSE; END; ARexxMessagePortSignal := CARDINAL (ARexxMessagePortPntr ^ . mpSigBit); END; RETURN TRUE; END Initialize; PROCEDURE AllocateSoundChannel () : BOOLEAN; (* Allocate an audio channel. If none are available, wait. Let the user use control-C or ARexx to abort. Returns TRUE if successfully allocated a channel, FALSE otherwise (even if allocated a channel but was aborted by the user). Sets AudioAllocKey and AudioChannelUsed to reflect the channel allocated. Gives preference to right side channels. Allocates with a low priority: the background music priority. Uses the AudioCommandRequest to do the IO to the already open audio.device. *) VAR GetChannelArray : ARRAY [0..3] OF AudioChannelSet; Junk : INTEGER; SignalsToWaitFor : SignalSet; WakeupSignals : SignalSet; BEGIN (* Set the order of allocation preference for any right hand channel first then any left hand channel. *) GetChannelArray [0] := AudioChannelSet {Right0}; GetChannelArray [1] := AudioChannelSet {Right1}; GetChannelArray [2] := AudioChannelSet {Left0}; GetChannelArray [3] := AudioChannelSet {Left1}; AudioAllocKey := 0; (* Zero for a new key. *) AudioChannelUsed := AudioChannelSet {}; (* No channels until allocated. *) WITH AudioCommandRequest ^ DO ioaAllocKey := AudioAllocKey; ioaData := ADR (GetChannelArray); ioaLength := 4; WITH ioaRequest DO ioCommand := ADCmdAllocate; ioMessage . mnNode . lnPri := BYTE (AudioPriority); IF NoWaitingForChannels THEN ioFlags := IOFlagSet {ADIONoWait}; ELSE ioFlags := IOFlagSet {}; END; ioUnit := UnitPtr (AudioChannelUsed); END; END; IF Verbose THEN WriteString ( "Now waiting for a free audio channel. Use control-C to abort.\n"); END; BeginIO (AudioCommandRequest); (* Wait for the sound channel allocation or for an abort from the user. *) SignalsToWaitFor := SignalSet {SIGBreakC, SignalNumber (AudioCommandPort ^ . mpSigBit)}; IF ARexxMessagePortPntr <> NIL THEN INCL (SignalsToWaitFor, ARexxMessagePortSignal); END; WakeupSignals := Wait (SignalsToWaitFor); (* Something woke us up. If the request completed, store away the results. If an abort occured, clean up request and return. If both occured, clean up and return. *) IF ARexxMessagePortPntr <> NIL THEN IF NOT ProcessCmds (ARexxMessagePortPntr) THEN WriteString ("Some kind of error detected by ARexx interface.\n"); END; (* See if the ARexx processing added a control-C signal. *) IF SIGBreakC IN SetSignal (SignalSet {}, SignalSet {SIGBreakC}) THEN INCL (WakeupSignals, SIGBreakC); END; END; IF SignalNumber (AudioCommandPort ^ . mpSigBit) IN WakeupSignals THEN IF GetMsg (AudioCommandPort) <> AudioCommandRequest THEN WriteString ("Bug: Didn't get command IO request back at message port.\n"); RETURN FALSE; END; IF AudioCommandRequest ^ . ioaRequest . ioError = BYTE (0) THEN AudioAllocKey := AudioCommandRequest ^ . ioaAllocKey; AudioChannelUsed := AudioChannelSet (AudioCommandRequest ^ . ioaRequest . ioUnit); IF Verbose THEN WriteString ("Got audio channel(s) "); IF Left0 IN AudioChannelUsed THEN WriteString ("Left0 "); END; IF Left1 IN AudioChannelUsed THEN WriteString ("Left1 "); END; IF Right0 IN AudioChannelUsed THEN WriteString ("Right0 "); END; IF Right1 IN AudioChannelUsed THEN WriteString ("Right1 "); END; WriteString ("with allocation key "); WriteInt (AudioAllocKey, 1); WriteString (".\n"); END; ELSE (* IO request error, -11 (no channel allocated) normal for NoWait. *) IF (AudioCommandRequest ^ . ioaRequest . ioError <> BYTE (-11)) OR Verbose THEN WriteString ("Error "); WriteInt (INTEGER (AudioCommandRequest ^ . ioaRequest . ioError) - 256, 1); WriteString (" occured while allocating the audio channel.\n"); END; RETURN FALSE; END; IF SIGBreakC IN WakeupSignals THEN (* Aborted AND finished request. *) WriteString ("Abort signal received AND allocation request completed.\n"); RETURN FALSE; END; END; IF SIGBreakC IN WakeupSignals THEN (* Just aborted, request pending. *) WriteString ("Abort signal received, aborting channel allocation.\n"); Junk := AbortIO (AudioCommandRequest); Junk := WaitIO (AudioCommandRequest); RETURN FALSE; END; RETURN TRUE; END AllocateSoundChannel; PROCEDURE AbortAllWriteRequests; (* When an error happens, all pending IO requests should be aborted and then requeued at the message port so that they can be reused. *) VAR AbortedRequest : SoundSampleBufferPointer; ErrorCode : LONGINT; I : INTEGER; Junk : INTEGER; BEGIN (* Hmmm, AbortIO locks up some times under AmigaDOS 2.0, try doing a CMD_FLUSH first. Unfortunately CMD_RESET resets the hardware but doesn't check to see if some other program is using the hardware, so it isn't all that safe. *) WITH AudioCommandRequest ^ DO ioaAllocKey := AudioAllocKey; ioaData := NIL; ioaLength := 0; WITH ioaRequest DO ioCommand := CmdFlush; ioFlags := IOFlagSet {}; (* Trashed by DoIO. *) ioUnit := UnitPtr (AudioChannelUsed); END; END; ErrorCode := DoIO (AudioCommandRequest); IF (ErrorCode <> 0) AND (ErrorCode <> ADIOErrNoAllocation) THEN WriteString ("Oops, error "); WriteLongInt (ErrorCode, 1); WriteString (" occured while flushing the audio channel.\n"); END; (* Abort all IO request that are in progress. Don't wait for the Abort to finish otherwise the next pending unaborted sound will start up. *) FOR I := 1 TO NumberOfBuffers DO WITH SampleBufferArray [I] ^ DO IF RequestIsBeingExecuted THEN Junk := AbortIO (SampleBufferArray [I]); END; END; (* WITH *) END; (* FOR *) (* Now that all aborts have been done, wait for them to complete. *) FOR I := 1 TO NumberOfBuffers DO WITH SampleBufferArray [I] ^ DO IF RequestIsBeingExecuted THEN IF Verbose THEN WriteString ("Waiting for abort of buffer "); WriteInt (BufferIDNumber, 1); WriteString (", result: "); END; Junk := WaitIO (SampleBufferArray [I]); IF Verbose THEN WriteInt (Junk, 1); WriteString (".\n"); END; END; END; (* WITH *) END; (* FOR *) (* Remove all waiting messages, if any, from the IO message port. That way we can start with a clean slate, so to speak. *) REPEAT AbortedRequest := GetMsg (AudioWritePort); UNTIL AbortedRequest = NIL; (* Queue up all IO requests at the message buffer so that they can be filled again. *) FOR I := 1 TO NumberOfBuffers DO SampleBufferArray [I] ^ . RequestIsBeingExecuted := FALSE; SampleBufferArray [I] ^ . AudioIORequest . ioaRequest . ioError := BYTE (0); PutMsg (AudioWritePort, SampleBufferArray [I]); END; END AbortAllWriteRequests; PROCEDURE FillSoundBufferLoop () : BOOLEAN; (* This procedure repeatedly takes available sound buffers from the message port, fills them and sends them off for playback. If it finds one with a stolen channel, it will return with a value of TRUE. If the user signals a control-C abort or ARexx stop command or a disk error occurs, it will return FALSE. Also, if it runs out of data it will wait for the existing samples to finish playing and will then return FALSE. Note that it doesn't abort the IO in progress when it returns. *) VAR AmountRead : LONGINT; AmountToRead : LONGINT; ErrorCode : INTEGER; I : INTEGER; PositionAtEndOfLastRead : LONGINT; (* Used for avoiding SEEK commands. *) NothingMoreToDo : BOOLEAN; RequestToFill : SoundSampleBufferPointer; SignalsToWaitFor : SignalSet; WakeupSignals : SignalSet; PROCEDURE SwitchToNextSample; (* This is an internal procedure which just moves the current sample pointer and position along to the start of the next sample, if it is available. Can set the position to be at the end of the list (pointing at the list tail dummy node), meaning that there are no more samples to be played. *) BEGIN IF CurrentSample ^ . node . lnSucc = NIL THEN (* If already at the very end of the list. *) IF Verbose THEN (* Message in red. *) WriteString ("\c33mCan't move to next sample; already at end of list.\cm\n"); END; ELSE (* Can move forward, but may hit the end. *) CurrentSample := SampleFileInfoPointer (CurrentSample ^ . node . lnSucc); IF CurrentSample ^ . node . lnSucc = NIL THEN (* Just moved to the end of the list. *) IF Verbose THEN (* Message in red. *) WriteString ("\c33mMoved to end of list of samples.\cm\n"); END; ELSE CurrentPosition := CurrentSample ^ . startPosition; PositionAtEndOfLastRead := -1; (* Force a SEEK. *) IF Verbose THEN (* Message with sample name in black. *) WriteString ("Moved forward to \"\c32m"); WriteString (CurrentSample ^ . node . lnName ^); WriteString ("\cm\"\n"); END; END; END; END SwitchToNextSample; PROCEDURE SwitchToPreviousSample; (* This is an internal procedure which just moves the current sample pointer and position along to the start of the previous sample, if it is available. Stops at the first sample (just sets the position back to the beginning). *) BEGIN IF CurrentSample ^ . node . lnPred ^ . lnPred <> NIL THEN (* If not at the first node in the list. *) CurrentSample := SampleFileInfoPointer (CurrentSample ^ . node . lnPred); ELSE (* Already at the first sample. *) IF Verbose THEN (* Message in red. *) WriteString ("\c33mCan't move backwards; will restart first sound sample.\cm\n"); END; END; CurrentPosition := CurrentSample ^ . startPosition; PositionAtEndOfLastRead := -1; (* Force a SEEK. *) IF Verbose THEN (* Message with sample name in black. *) WriteString ("Moved back to \"\c32m"); WriteString (CurrentSample ^ . node . lnName ^); WriteString ("\cm\"\n"); END; END SwitchToPreviousSample; BEGIN PositionAtEndOfLastRead := -1; LOOP RequestToFill := GetMsg (AudioWritePort); WHILE RequestToFill <> NIL DO WITH RequestToFill ^ DO RequestIsBeingExecuted := FALSE; ErrorCode := INTEGER (AudioIORequest . ioaRequest . ioError); IF ErrorCode > 127 THEN ErrorCode := ErrorCode - 256; END; IF ErrorCode <> 0 THEN IF Verbose THEN WriteString ("Got error "); WriteInt (ErrorCode, 1); WriteString (" for completed IO request for buffer "); WriteInt (BufferIDNumber, 1); WriteString (".\n"); END; (* Backtrack to the sample which had the error. *) CurrentSample := SampleBeingExecuted; CurrentPosition := PositionInSample; IF ErrorCode = IOAborted THEN IF Verbose THEN WriteString ( "Channel was just stolen. Will try to reallocate.\n"); END; RETURN TRUE; END; IF ErrorCode = ADIOErrNoAllocation THEN IF Verbose THEN WriteString ( "Allocation key error, channel got stolen a while ago. Try reallocating.\n"); END; RETURN TRUE; END; WriteString ("Got unknown audio device error number "); WriteInt (ErrorCode, 1); WriteString (".\n"); RETURN FALSE; END; (* Switch to next sample if at end of this one and not at end of the list of samples. *) IF (CurrentSample ^ . node . lnSucc <> NIL) AND (CurrentPosition >= CurrentSample ^ . endPlusOnePosition) THEN SwitchToNextSample; END; (* Check if we have to refill this sound request. If at end of list then we don't.*) IF CurrentSample ^ . node . lnSucc = NIL THEN (* No sound sample to play, don't requeue the sound request. *) NothingMoreToDo := TRUE; FOR I := 1 TO NumberOfBuffers DO IF SampleBufferArray [I] ^ . RequestIsBeingExecuted THEN NothingMoreToDo := FALSE; END; END; IF NothingMoreToDo THEN IF Verbose THEN WriteString ( "\nNo more samples, finished all IO, done!\n"); END; RETURN FALSE; END; ELSE (* There is a sound sample to be played. Read and do IO. *) (* Seek to the sample position in the sample file. *) IF Verbose THEN WriteString ("Filling buffer "); WriteInt (BufferIDNumber, 1); END; IF PositionAtEndOfLastRead <> CurrentPosition THEN IF Seek (CurrentSample ^ . file, CurrentPosition, OffsetBeginning) < 0 THEN (* Seek to current position has failed. *) IF Verbose THEN WriteLn; END; WriteString ("Seek to position "); WriteLongInt (CurrentPosition, 1); WriteString (" in file \""); WriteString (CurrentSample ^ . node . lnName ^); WriteString ("\" has failed.\n"); RETURN FALSE; END; IF Verbose THEN WriteString (", seek to position "); END; ELSE (* Don't have to do a seek, already there. *) IF Verbose THEN WriteString (", position "); END; END; (* SEEKing or not seeking. *) IF Verbose THEN WriteLongInt (CurrentPosition, 1); END; (* Read the data into the buffer. *) AmountToRead := SampleBufferSize; IF CurrentPosition + AmountToRead > CurrentSample ^ . endPlusOnePosition THEN AmountToRead := CurrentSample ^ . endPlusOnePosition - CurrentPosition; END; AmountRead := Read (CurrentSample ^ . file, WaveFormData, AmountToRead); IF Verbose THEN WriteString (", read "); WriteLongInt (AmountRead, 1); WriteString (" bytes.\n"); END; (* Check for errors from reading. *) IF AmountRead = AmountToRead THEN (* Queue up another write command. *) WITH AudioIORequest . ioaRequest DO ioDevice := AudioDevice; ioUnit := UnitPtr (AudioChannelUsed); ioCommand := CmdWrite; ioFlags := IOFlagSet {ADIOPerVol}; END; WITH AudioIORequest DO ioaAllocKey := AudioAllocKey; ioaData := WaveFormData; ioaLength := AmountRead; ioaPeriod := CurrentSample ^ . period; ioaVolume := CurrentSample ^ . volume; ioaCycles := 1; END; RequestIsBeingExecuted := TRUE; SampleBeingExecuted := CurrentSample; PositionInSample := CurrentPosition; BeginIO (RequestToFill); CurrentPosition := CurrentPosition + AmountRead; PositionAtEndOfLastRead := CurrentPosition; END; (* If read any data. *) IF (AmountRead > 0) AND (AmountRead <> AmountToRead) THEN WriteString ("Unexpected end of file when reading \""); WriteString (CurrentSample ^ . node . lnName ^); WriteString ("\".\n"); RETURN FALSE; END; IF AmountRead < 0 THEN WriteString ("Got error number "); WriteLongInt (IoErr (), 1); WriteString (" while reading from file \""); WriteString (CurrentSample ^ . node . lnName ^); WriteString ("\".\n"); RETURN FALSE; END; END; (* If there is a sample to be played. *) END; (* WITH RequestToFill ^ *) (* Check for abort before doing any other requests. Turn off any signals that have been used or are unimportant now. *) IF ARexxMessagePortPntr <> NIL THEN IF NOT ProcessCmds (ARexxMessagePortPntr) THEN WriteString ("Some kind of error detected by ARexx interface.\n"); RETURN FALSE; END; END; WakeupSignals := SetSignal (SignalSet {}, SignalSet {}); IF SIGBreakC IN WakeupSignals THEN WriteString ( "Abort signal detected. Hope you didn't have to wait too long!\n"); RETURN FALSE; END; IF SIGBreakF IN WakeupSignals THEN WriteString ( "Next sample signal detected. Hope you didn't have to wait too long!\n"); WakeupSignals := SetSignal (SignalSet {}, SignalSet {SIGBreakF}); SwitchToNextSample; END; IF SIGBreakE IN WakeupSignals THEN WriteString ( "Previous sample signal detected. Hope you didn't have to wait too long!\n"); WakeupSignals := SetSignal (SignalSet {}, SignalSet {SIGBreakE}); SwitchToPreviousSample; END; RequestToFill := GetMsg (AudioWritePort); END; (* While loop for processing a message. *) (* No more audio IO requests to do. Wait for completion or abort. *) IF Verbose THEN WriteString ("Sleep... "); END; SignalsToWaitFor := SignalSet {SIGBreakC, SIGBreakE, SIGBreakF, SignalNumber (AudioWritePort ^ . mpSigBit)}; IF ARexxMessagePortPntr <> NIL THEN INCL (SignalsToWaitFor, ARexxMessagePortSignal); END; WakeupSignals := Wait (SignalsToWaitFor); IF ARexxMessagePortPntr <> NIL THEN IF NOT ProcessCmds (ARexxMessagePortPntr) THEN WriteString ("Some kind of error detected by ARexx interface.\n"); RETURN FALSE; END; (* See if the ARexx processing added a control-C signal. *) IF SIGBreakC IN SetSignal (SignalSet {}, SignalSet {SIGBreakC}) THEN INCL (WakeupSignals, SIGBreakC); END; END; IF SIGBreakC IN WakeupSignals THEN WriteString ("Abort signal woke me up, stopping.\n"); RETURN FALSE; END; IF SIGBreakF IN WakeupSignals THEN WriteString ("Next sample signal woke me up.\n"); SwitchToNextSample; END; IF SIGBreakE IN WakeupSignals THEN WriteString ("Previous sample signal woke me up.\n"); SwitchToPreviousSample; END; END; (* Writing data LOOP. *) END FillSoundBufferLoop; PROCEDURE ReadAndPlaySound; (* Play the sounds. Allocate the sound channel then dump data to it. If the channel gets stolen, reallocate it. If an error or control-C occurs, return. In both cases, abort all sound IO in progress before reallocating / exiting. *) VAR ThingsAreOk : BOOLEAN; BEGIN LOOP IF NOT AllocateSoundChannel () THEN RETURN; END; ThingsAreOk := FillSoundBufferLoop (); AbortAllWriteRequests; IF NOT ThingsAreOk THEN RETURN; END; END; END ReadAndPlaySound; PROCEDURE Terminate; (* Deallocate things that were allocated or partially allocated. Most of the memory allocations are automatically deallocated when the ARP library is closed. *) VAR I, Junk : INTEGER; JunkSignals : SignalSet; BEGIN IF AudioDevice <> NIL THEN AudioCommandRequest ^ . ioaAllocKey := AudioAllocKey; AudioCommandRequest ^ . ioaRequest . ioUnit := UnitPtr (AudioChannelUsed); CloseDevice (AudioCommandRequest); END; IF AudioCommandRequest <> NIL THEN DeleteExtIO (AudioCommandRequest, SIZE (AudioCommandRequest ^)); END; IF AudioCommandPort <> NIL THEN DeletePort (AudioCommandPort); END; IF AudioWritePort <> NIL THEN DeletePort (AudioWritePort); END; IF ARPFileInfoPtr <> NIL THEN FreeAnchorChain (ARPFileInfoPtr); END; IF ARexxMessagePortPntr <> NIL THEN IF Verbose THEN WriteString ("Closing the ARexx message port.\n"); END; CloseARexxPort (ARexxMessagePortPntr); ARexxMessagePortPntr := NIL; END; IF ARexxIsOpen THEN IF Verbose THEN WriteString ("Closing the ARexx library.\n"); END; CloseARexxLib; ARexxIsOpen := FALSE; END; JunkSignals := SetSignal (SignalSet {}, SignalSet {SIGBreakC, SIGBreakE, SIGBreakF}); END Terminate; BEGIN (* Main Program *) ARexxIsOpen := FALSE; ARexxKeywords [0] . rcName := ADR ("StopPlaying"); ARexxKeywords [0] . rcUserData := 0; ARexxMessagePortPntr := NIL; ARexxMessagePortSignal := 0; IF Initialize () THEN ReadAndPlaySound; END; Terminate; IF Verbose THEN WriteString ("Program finished (got past termination).\n"); END; END AGMSPlaySound.