home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
125.lha
/
ListI.mod
< prev
next >
Wrap
Text File
|
1986-11-20
|
12KB
|
399 lines
MODULE ListI; (* ListSMUSInstruments *)
(*
Author : Richard A. DeVenezia (GEnie - R.DEVENEZIA)
Date : March 18, 1988.
Mod. : March 19, 1988. Add workbench startup.
After getting a few Sonix downloads it appeared I needed help finding
what instruments scores needed. Well this should help.
If you redirect the output to a file and then edit that file so it
becomes a series of copy commands you have the perfect execute file
for getting instruments to where you want them.
*)
FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE;
FROM AmigaDOS IMPORT ModeOldFile, ModeNewFile, OffsetCurrent,
FileHandle, Open, Close, Read, Seek,
WaitForChar, CurrentDir,
Examine, FileInfoBlock, FileLock;
FROM Strings IMPORT CopyString, ConvStringToUpperCase, StringLength,
LocateSubString, ConcatString;
FROM System IMPORT StdInput, StdOutput, argc, argv, WBenchMsg;
FROM Terminal IMPORT WriteString, Write, WriteLn;
FROM Workbench IMPORT WBStartupPtr, WBArgPtr;
TYPE
ID = LONGINT;
StringPointer = POINTER TO ARRAY [0..255] OF CHAR;
CONST
(* Constants used to shift chars *)
H = 16777216D; (* shift 24 bits *)
M = 65536D; (* shift 16 bits *)
L = 256D; (* shift 8 bits *)
(* Standard group IDs. A chunk with one of these IDs contains a
SubTypeID followed by zero or more chunks.*)
FORM = ID('F')*H + ID('O')*M + ID('R')*L + ID('M');
PROP = ID('P')*H + ID('R')*M + ID('O')*L + ID('P');
LIST = ID('L')*H + ID('I')*M + ID('S')*L + ID('T');
CAT = ID('C')*H + ID('A')*M + ID('T')*L + ID(' ');
SMUS = ID('S')*H + ID('M')*M + ID('U')*L + ID('S');
SHDR = ID('S')*H + ID('H')*M + ID('D')*L + ID('R');
SNX1 = ID('S')*H + ID('N')*M + ID('X')*L + ID('1');
NAME = ID('N')*H + ID('A')*M + ID('M')*L + ID('E');
INS1 = ID('I')*H + ID('N')*M + ID('S')*L + ID('1');
TRAK = ID('T')*H + ID('R')*M + ID('A')*L + ID('K');
FTXT = ID('F')*H + ID('T')*M + ID('X')*L + ID('T');
ILBM = ID('I')*H + ID('L')*M + ID('B')*L + ID('M');
PICS = ID('P')*H + ID('I')*M + ID('C')*L + ID('S');
VAR
ClearScreenString,
progName : ARRAY [0..255] OF CHAR;
smusName : ARRAY [0..255] OF CHAR;
outName : ARRAY [0..255] OF CHAR;
smusFile : FileHandle;
holdStdInput,
holdStdOutput : ADDRESS;
Done, filesOK : BOOLEAN;
ckID : ID;
ckSize : LONGINT;
buffer : ARRAY [0..32] OF CHAR;
ch : CHAR;
start : WBStartupPtr;
arg : WBArgPtr;
nargs : INTEGER;
sptr : POINTER TO ARRAY [0..127] OF CHAR;
lock : FileLock;
INFO : FileInfoBlock;
(********************************************************************)
PROCEDURE ValidChunkID (id : ID) : BOOLEAN;
BEGIN
RETURN
(id = ILBM) OR (id = FTXT) OR (id = PICS) OR
(id = FORM) OR (id = PROP) OR
(id = LIST) OR (id = CAT ) OR
(id = NAME) OR (id = INS1) OR (id = TRAK);
END ValidChunkID;
(********************************************************************)
PROCEDURE ReadChunkID (f : FileHandle; VAR id : ID);
BEGIN
Done := Read (f, ADR(id), 4D) = 4D;
END ReadChunkID;
(********************************************************************)
PROCEDURE ReadChunkSize (f : FileHandle; VAR size : LONGINT);
BEGIN
Done := Read (f, ADR(size), 4D) = 4D;
END ReadChunkSize;
(********************************************************************)
PROCEDURE SkipOver (f : FileHandle; offset : LONGINT);
BEGIN
IF ODD (offset) THEN INC (offset); END;
Done := Seek (f, offset, OffsetCurrent) <> -1D;
END SkipOver;
(********************************************************************)
PROCEDURE SkipThenReadAndWrite (f : FileHandle;
n : LONGINT; size : LONGINT);
(* assume only reading the writing small amounts of data *)
BEGIN
SkipOver (f, n);
size := size - n;
buffer[32] := 0C;
WHILE (size > LONGINT (HIGH (buffer))) AND Done DO
Done := Read (f, ADR(buffer), 32D) = 32D;
WriteString (buffer);
DEC (size, 32);
END;
Done := Read (f, ADR(buffer), size) = size;
buffer [INTEGER(size)] := 0C;
WriteString (buffer);
END SkipThenReadAndWrite;
(********************************************************************)
PROCEDURE StripQuotes (VAR s : ARRAY OF CHAR);
VAR
i, n : INTEGER;
BEGIN
IF s[0] = '"' THEN
n := StringLength (s);
IF s[n-1] = '"' THEN DEC (n) END; (* chop closing quote *)
DEC (n); (* lose the open quote *)
FOR i := 0 TO n-1 DO
s[i] := s[i+1];
END;
s[n] := 0C;
END;
END StripQuotes;
(********************************************************************)
PROCEDURE ListSMUSInstruments (inFile : FileHandle) : INTEGER;
VAR
result : INTEGER;
BEGIN
Done := TRUE; (* as in last file operation successfully completed *)
result := -1;
WHILE Done DO
ReadChunkID (inFile, ckID); (* 1st should be FORM *)
IF ckID = FORM THEN (* keep going *)
ReadChunkSize (inFile, ckSize);
ReadChunkID (inFile, ckID); (* FormType *)
IF ckID = SMUS THEN (* deal with it *)
WHILE Done DO
ReadChunkID (inFile, ckID);
ReadChunkSize (inFile, ckSize);
IF ODD (ckSize) THEN INC (ckSize); END;
IF ckID = NAME THEN
WriteString ('Score named "');
SkipThenReadAndWrite (inFile, 0, ckSize);
WriteString ('" requires:\n');
ELSIF ckID = INS1 THEN
WriteString (' ');
SkipThenReadAndWrite (inFile, 4, ckSize);
WriteLn;
ELSIF ckID = TRAK THEN
result := 0;
Done := FALSE;
ELSE (* unknown (uncaring?) id type *)
SkipOver (inFile, ckSize);
END;
END; (* While *)
ELSE (* not SMUS form type, skip to next form *)
WriteString ('Nothing pertaining to SMUS found.\n');
(* -4 because we had to read past to form type before
figuring this wasn't SMUS
*)
SkipOver (inFile, ckSize-4D);
result := -1;
END;
ELSE (* chunk id <> FORM *)
IF Done THEN
WriteString (smusName);
WriteString (' is not an IFF file.\n');
Done := FALSE;
result := -1;
END;
END;
END; (* While *)
RETURN result;
END ListSMUSInstruments;
(********************************************************************)
PROCEDURE WaitForKeyPress (prompt : ARRAY OF CHAR; VAR ch : CHAR);
VAR
result : LONGINT;
BEGIN
IF prompt [0] = 0C THEN WriteString ('--press any key to continue--');
ELSE WriteString (prompt);
END;
REPEAT
UNTIL WaitForChar (StdInput, 5000); (* loop (time-out) every 5 seconds *)
result := Read (StdInput, ADR(ch), 1);
WriteLn;
END WaitForKeyPress;
(********************************************************************)
PROCEDURE NullString (s : ARRAY OF CHAR) : BOOLEAN;
BEGIN
RETURN s[0] = 0C;
END NullString;
(********************************************************************)
BEGIN (* Main *)
ClearScreenString := '\x9B1;1H\x9BJ';
IF argc > 0 THEN
IF (argc = 1) OR ((argc = 2) AND (argv^[1]^[0] = "?")) THEN
(* HELP ! *)
CopyString (progName, argv^[0]^);
WriteString ('Usage: ');
WriteString (progName);
WriteString (' score[.smus] [output file]\n');
WriteString ('Lists all instruments required by a Sonix score,\n');
WriteString ('on the screen or to a file.\n');
ELSE
(* get filename from argument *)
CopyString (smusName, argv^[1]^);
ConvStringToUpperCase (smusName);
StripQuotes (smusName);
(* get output filename *)
IF argc = 3 THEN
CopyString (outName, argv^[2]^);
StripQuotes (outName);
END;
(* append .smus to input file if necessary *)
IF (LocateSubString (smusName, '.SMUS', 0, StringLength (smusName) - 1)
<> INTEGER (StringLength (smusName) - 5))
OR
(StringLength (smusName) < StringLength ('.SMUS'))
THEN
ConcatString (smusName, ".SMUS");
END;
(* open the files *)
filesOK := FALSE;
smusFile := Open (ADR(smusName), ModeOldFile);
IF smusFile = NIL THEN
WriteString ("Couldn't open ");
WriteString (smusName);
WriteLn;
ELSIF argc = 3 THEN
holdStdOutput := StdOutput;
StdOutput := Open (ADR(outName), ModeNewFile);
IF StdOutput = NIL THEN
Close (smusFile);
StdOutput := holdStdOutput; (* go to the screen anyway *)
WriteString ("Couldn't open ");
WriteString (outName);
WriteLn;
END;
filesOK := TRUE;
ELSE
filesOK := TRUE;
END;
IF filesOK THEN
IF ListSMUSInstruments (smusFile) <> -1 THEN END;
END;
Close (smusFile);
IF argc = 3 THEN
Close (StdOutput);
StdOutput := holdStdOutput;
END;
END;
ELSE (* argc = 0, implies workbench startup *)
(* Re-assign standard i/o to a window we open *)
holdStdInput := StdInput;
holdStdOutput := StdOutput;
StdInput := Open (ADR("RAW:0/11/400/152/SMUS List"), ModeNewFile);
StdOutput := StdInput;
IF StdInput <> NIL THEN
(* start is a WBStartupPtr, WBenchMsg is an ADDRESS *)
start := WBenchMsg;
(* get program name, arg points to an array of WBArg *)
arg := start^.smArgList;
sptr := arg^.waName;
CopyString (progName, sptr^);
IF start^.smNumArgs = LONGINT (1) THEN
WriteString ("List Instruments Usage:\n");
WriteString (" hold down shift,\n");
WriteString (" click on ");
WriteString (progName);
WriteString (",\n click on score icon(s),\n");
WriteString (" double-click on a score icon.\n");
WriteLn;
WaitForKeyPress ('', ch);
ELSE (* process workbench arguments *)
(* right now arg points to the first WBArg, the program name
we want the second and succesive, they are the icons clicked.
*)
nargs := INTEGER (start^.smNumArgs);
WHILE nargs > 1 DO
(* the startup list, WBenchMsg^.smArgList is like a variable
array [1..nargs] of WBArg. We have to traverse this array.
*)
INC (ADDRESS(arg), SIZE(arg^)); (* by god, it works! *)
(* waName is an ADDRESS, sptr is a POINTER to ARRAY OF CHAR *)
sptr := arg^.waName;
lock := arg^.waLock;
IF Examine (lock, INFO) THEN
IF NullString (sptr^) THEN (* a disk or drawer icon *)
WriteString (ClearScreenString);
IF NullString (INFO.fibFileName)
THEN WriteString ('RAM Disk');
ELSE WriteString (INFO.fibFileName);
END;
WriteString (' is not a file!\n');
WaitForKeyPress ('', ch);
ELSE (* a file *)
(* not necessary, but for clarity *)
CopyString (smusName, sptr^);
WriteString (ClearScreenString);
WriteString ('Looking at file ');
WriteString (smusName);
WriteLn;
(* move to the indicated file's directory and open it *)
lock := CurrentDir (lock);
IF lock <> NIL THEN
smusFile := Open (ADR(smusName), ModeOldFile);
IF smusFile = NIL THEN
WriteString (ClearScreenString);
WriteString ("Couldn't open ");
WriteString (smusName);
WriteLn;
WaitForKeyPress ('', ch);
ELSE (* smusFile opened *)
IF ListSMUSInstruments (smusFile) <> -1 THEN
WaitForKeyPress ("--press 'p' to print--\x0A--any other key to continue--", ch);
IF (ch = 'p') OR (ch = 'P') THEN
StdOutput := Open (ADR('PRT:'), ModeNewFile);
IF StdOutput # NIL THEN
IF ListSMUSInstruments (smusFile) = 0 THEN END;
Close (StdOutput);
StdOutput := StdInput;
ELSE (* problems opening *)
StdOutput := StdInput;
WriteString ("Couldn't open PRT:\n");
WaitForKeyPress ('', ch);
END;
END;
ELSE
WaitForKeyPress ('', ch);
END;
Close (smusFile);
END; (* smusFile opened *)
END; (* lock <> NIL *)
END;
END; (* Examine *)
DEC (nargs);
END; (* While *)
END; (* process workbench arguments *)
Close (StdInput);
END; (* i/o re-assigned successfully *)
(* set standard i/o back *)
StdInput := holdStdInput;
StdOutput := holdStdOutput;
END;
END ListI.