home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 125.lha / ListI.mod < prev    next >
Encoding:
Text File  |  1986-11-20  |  11.3 KB  |  399 lines
  1. MODULE ListI; (* ListSMUSInstruments *)
  2.  
  3. (*
  4. Author : Richard A. DeVenezia  (GEnie - R.DEVENEZIA)
  5.   Date : March 18, 1988.
  6.   Mod. : March 19, 1988. Add workbench startup.
  7.  
  8.     After getting a few Sonix downloads it appeared I needed help finding
  9.     what instruments scores needed.  Well this should help.
  10.  
  11.     If you redirect the output to a file and then edit that file so it
  12.     becomes a series of copy commands you have the perfect execute file
  13.     for getting instruments to where you want them.
  14.  
  15. *)
  16.  
  17. FROM SYSTEM        IMPORT ADDRESS, ADR, TSIZE;
  18.  
  19. FROM AmigaDOS        IMPORT ModeOldFile, ModeNewFile, OffsetCurrent,
  20.                 FileHandle, Open, Close, Read, Seek,
  21.                 WaitForChar, CurrentDir,
  22.                 Examine, FileInfoBlock, FileLock;
  23. FROM Strings        IMPORT CopyString, ConvStringToUpperCase, StringLength,
  24.                 LocateSubString, ConcatString;
  25. FROM System        IMPORT StdInput, StdOutput, argc, argv, WBenchMsg;
  26. FROM Terminal        IMPORT WriteString, Write, WriteLn;
  27. FROM Workbench        IMPORT WBStartupPtr, WBArgPtr;
  28.  
  29.  
  30. TYPE
  31.     ID = LONGINT;
  32.     StringPointer = POINTER TO ARRAY [0..255] OF CHAR;
  33. CONST
  34.   (* Constants used to shift chars *)
  35.   H = 16777216D; (* shift 24 bits *)
  36.   M = 65536D;    (* shift 16 bits *)
  37.   L = 256D;      (* shift  8 bits *)
  38.  
  39. (* Standard group IDs.  A chunk with one of these IDs contains a
  40.    SubTypeID followed by zero or more chunks.*)
  41.   FORM   = ID('F')*H + ID('O')*M + ID('R')*L + ID('M');
  42.   PROP   = ID('P')*H + ID('R')*M + ID('O')*L + ID('P');
  43.   LIST   = ID('L')*H + ID('I')*M + ID('S')*L + ID('T');
  44.   CAT    = ID('C')*H + ID('A')*M + ID('T')*L + ID(' ');
  45.  
  46.   SMUS   = ID('S')*H + ID('M')*M + ID('U')*L + ID('S');
  47.   SHDR   = ID('S')*H + ID('H')*M + ID('D')*L + ID('R');
  48.   SNX1   = ID('S')*H + ID('N')*M + ID('X')*L + ID('1');
  49.   NAME   = ID('N')*H + ID('A')*M + ID('M')*L + ID('E');
  50.   INS1   = ID('I')*H + ID('N')*M + ID('S')*L + ID('1');
  51.   TRAK   = ID('T')*H + ID('R')*M + ID('A')*L + ID('K');
  52.  
  53.   FTXT   = ID('F')*H + ID('T')*M + ID('X')*L + ID('T');
  54.   ILBM   = ID('I')*H + ID('L')*M + ID('B')*L + ID('M');
  55.   PICS   = ID('P')*H + ID('I')*M + ID('C')*L + ID('S');
  56.  
  57.  
  58. VAR
  59.     ClearScreenString,
  60.     progName : ARRAY [0..255] OF CHAR;
  61.     smusName : ARRAY [0..255] OF CHAR;
  62.      outName : ARRAY [0..255] OF CHAR;
  63.     smusFile : FileHandle;
  64.     holdStdInput,
  65.     holdStdOutput : ADDRESS;
  66.     Done, filesOK : BOOLEAN;
  67.     
  68.     ckID : ID;
  69.     ckSize : LONGINT;
  70.     buffer : ARRAY [0..32] OF CHAR;
  71.  
  72.     ch : CHAR;
  73.     start : WBStartupPtr;
  74.     arg : WBArgPtr;
  75.     nargs : INTEGER;
  76.     sptr : POINTER TO ARRAY [0..127] OF CHAR;
  77.  
  78.     lock : FileLock;
  79.     INFO : FileInfoBlock;
  80.  
  81.     (********************************************************************)
  82.     PROCEDURE ValidChunkID (id : ID) : BOOLEAN;
  83.     BEGIN
  84.         RETURN
  85.         (id = ILBM) OR (id = FTXT) OR (id = PICS) OR
  86.         (id = FORM) OR (id = PROP) OR
  87.         (id = LIST) OR (id = CAT ) OR
  88.         (id = NAME) OR (id = INS1) OR (id = TRAK);
  89.     END ValidChunkID;
  90.  
  91.     (********************************************************************)
  92.     PROCEDURE ReadChunkID (f : FileHandle; VAR id : ID);
  93.     BEGIN
  94.         Done := Read (f, ADR(id), 4D) = 4D;
  95.     END ReadChunkID;
  96.  
  97.     (********************************************************************)
  98.     PROCEDURE ReadChunkSize (f : FileHandle; VAR size : LONGINT);
  99.     BEGIN
  100.         Done := Read (f, ADR(size), 4D) = 4D;
  101.     END ReadChunkSize;
  102.  
  103.     (********************************************************************)
  104.     PROCEDURE SkipOver (f : FileHandle; offset : LONGINT);
  105.     BEGIN
  106.         IF ODD (offset) THEN  INC (offset);  END;
  107.         Done := Seek (f, offset, OffsetCurrent) <> -1D;
  108.     END SkipOver;
  109.  
  110.     (********************************************************************)
  111.     PROCEDURE SkipThenReadAndWrite (f : FileHandle;
  112.                     n : LONGINT; size : LONGINT);
  113.     (* assume only reading the writing small amounts of data *)
  114.     BEGIN
  115.         SkipOver (f, n);
  116.         size := size - n;
  117.         buffer[32] := 0C;
  118.         WHILE (size > LONGINT (HIGH (buffer))) AND Done DO
  119.             Done := Read (f, ADR(buffer), 32D) = 32D;
  120.             WriteString (buffer);
  121.             DEC (size, 32);
  122.         END;
  123.         Done := Read (f, ADR(buffer), size) = size;
  124.         buffer [INTEGER(size)] := 0C;
  125.         WriteString (buffer);
  126.     END SkipThenReadAndWrite;
  127.  
  128.     (********************************************************************)
  129.     PROCEDURE StripQuotes (VAR s : ARRAY OF CHAR);
  130.     VAR
  131.         i, n : INTEGER;
  132.     BEGIN
  133.         IF s[0] = '"' THEN
  134.             n := StringLength (s);
  135.  
  136.             IF s[n-1] = '"' THEN DEC (n) END; (* chop closing quote *)
  137.             DEC (n); (* lose the open quote *)
  138.  
  139.             FOR i := 0 TO n-1 DO
  140.                 s[i] := s[i+1];
  141.             END;
  142.             s[n] := 0C;
  143.         END;
  144.     END StripQuotes;
  145.  
  146.  
  147.     (********************************************************************)
  148.     PROCEDURE ListSMUSInstruments (inFile : FileHandle) : INTEGER;
  149.     VAR
  150.         result : INTEGER;
  151.     BEGIN
  152.         Done := TRUE; (* as in last file operation successfully completed *)
  153.         result := -1;
  154.  
  155.         WHILE Done DO
  156.         ReadChunkID (inFile, ckID);    (* 1st should be FORM *)
  157.         IF ckID = FORM THEN (* keep going *)
  158.             ReadChunkSize (inFile, ckSize);
  159.             ReadChunkID (inFile, ckID);        (* FormType *)
  160.             IF ckID = SMUS THEN            (* deal with it *)
  161.             WHILE Done DO
  162.                 ReadChunkID (inFile, ckID);
  163.                 ReadChunkSize (inFile, ckSize);
  164.  
  165.                 IF ODD (ckSize) THEN INC (ckSize); END;
  166.                 IF ckID = NAME THEN
  167.                 WriteString ('Score named "');
  168.                 SkipThenReadAndWrite (inFile, 0, ckSize);
  169.                 WriteString ('" requires:\n');
  170.                 ELSIF ckID = INS1 THEN
  171.                 WriteString ('  ');
  172.                 SkipThenReadAndWrite (inFile, 4, ckSize);
  173.                 WriteLn;
  174.                 ELSIF ckID = TRAK THEN
  175.                 result := 0;
  176.                 Done := FALSE;
  177.                 ELSE (* unknown (uncaring?) id type *)
  178.                 SkipOver (inFile, ckSize);
  179.                 END;
  180.             END; (* While *)
  181.             ELSE (* not SMUS form type, skip to next form *)
  182.             WriteString ('Nothing pertaining to SMUS found.\n');
  183.             (* -4 because we had to read past to form type before
  184.                figuring this wasn't SMUS
  185.             *)
  186.             SkipOver (inFile, ckSize-4D);
  187.             result := -1;
  188.             END;
  189.         ELSE (* chunk id <> FORM *)
  190.             IF Done THEN
  191.             WriteString (smusName);
  192.             WriteString (' is not an IFF file.\n');
  193.             Done := FALSE;
  194.             result := -1;
  195.             END;
  196.         END;
  197.         END; (* While *)
  198.         RETURN result;
  199.     END ListSMUSInstruments;
  200.  
  201.  
  202.     (********************************************************************)
  203.     PROCEDURE WaitForKeyPress (prompt : ARRAY OF CHAR; VAR ch : CHAR);
  204.     VAR
  205.         result : LONGINT;
  206.     BEGIN
  207.         IF prompt [0] = 0C  THEN WriteString ('--press any key to continue--');
  208.                 ELSE WriteString (prompt);
  209.         END;
  210.  
  211.         REPEAT
  212.         UNTIL WaitForChar (StdInput, 5000);   (* loop (time-out) every 5 seconds *)
  213.  
  214.          result := Read (StdInput, ADR(ch), 1);
  215.         WriteLn;
  216.     END WaitForKeyPress;
  217.  
  218.     (********************************************************************)
  219.     PROCEDURE NullString (s : ARRAY OF CHAR) : BOOLEAN;
  220.     BEGIN
  221.         RETURN s[0] = 0C;
  222.     END NullString;
  223.     (********************************************************************)
  224.  
  225. BEGIN (* Main *)
  226.  
  227. ClearScreenString := '\x9B1;1H\x9BJ'; 
  228.  
  229. IF argc > 0 THEN
  230.     IF (argc = 1) OR ((argc = 2) AND (argv^[1]^[0] = "?")) THEN
  231.     (* HELP ! *)
  232.     CopyString (progName, argv^[0]^);
  233.     WriteString ('Usage: ');
  234.     WriteString (progName);
  235.     WriteString (' score[.smus]  [output file]\n');
  236.     WriteString ('Lists all instruments required by a Sonix score,\n');
  237.     WriteString ('on the screen or to a file.\n');
  238.     ELSE
  239.     (* get filename from argument *)
  240.     CopyString (smusName, argv^[1]^);
  241.     ConvStringToUpperCase (smusName);
  242.     StripQuotes (smusName);
  243.  
  244.     (* get output filename *)
  245.     IF argc = 3 THEN
  246.         CopyString (outName, argv^[2]^);
  247.         StripQuotes (outName);
  248.     END;
  249.  
  250.     (* append .smus to input file if necessary *)
  251.     IF (LocateSubString (smusName, '.SMUS', 0, StringLength (smusName) - 1)
  252.     <> INTEGER (StringLength (smusName) - 5))
  253.     OR
  254.     (StringLength (smusName) < StringLength ('.SMUS'))
  255.     THEN
  256.         ConcatString (smusName, ".SMUS");
  257.     END;
  258.  
  259.     (* open the files *)
  260.     filesOK := FALSE;
  261.     smusFile := Open (ADR(smusName), ModeOldFile);
  262.     IF smusFile = NIL THEN
  263.         WriteString ("Couldn't open ");
  264.         WriteString (smusName);
  265.         WriteLn;
  266.         ELSIF argc = 3 THEN
  267.         holdStdOutput := StdOutput;
  268.         StdOutput := Open (ADR(outName), ModeNewFile);
  269.         IF StdOutput = NIL THEN
  270.         Close (smusFile);
  271.         StdOutput := holdStdOutput;     (* go to the screen anyway *)
  272.         WriteString ("Couldn't open ");
  273.         WriteString (outName);
  274.         WriteLn;
  275.         END;
  276.         filesOK := TRUE;
  277.     ELSE
  278.         filesOK := TRUE;
  279.     END;
  280.  
  281.     IF filesOK THEN
  282.         IF ListSMUSInstruments (smusFile) <> -1 THEN END;
  283.     END;
  284.  
  285.     Close (smusFile);
  286.     IF argc = 3 THEN
  287.         Close (StdOutput);
  288.         StdOutput := holdStdOutput;
  289.     END;
  290.  
  291.     END;
  292. ELSE (* argc = 0, implies workbench startup *)
  293.  
  294.     (* Re-assign standard i/o to a window we open *)
  295.     holdStdInput := StdInput;
  296.     holdStdOutput := StdOutput;
  297.     StdInput :=  Open (ADR("RAW:0/11/400/152/SMUS List"), ModeNewFile);
  298.     StdOutput := StdInput;
  299.  
  300.     IF StdInput <> NIL THEN
  301.  
  302.     (* start is a WBStartupPtr, WBenchMsg is an ADDRESS *)
  303.     start := WBenchMsg;
  304.  
  305.     (* get program name, arg points to an array of WBArg *)
  306.     arg := start^.smArgList;
  307.     sptr := arg^.waName;
  308.     CopyString (progName, sptr^);
  309.  
  310.     IF start^.smNumArgs = LONGINT (1) THEN
  311.         WriteString ("List Instruments Usage:\n");
  312.         WriteString ("  hold down shift,\n");
  313.         WriteString ("  click on ");
  314.         WriteString (progName);
  315.         WriteString (",\n  click on score icon(s),\n");
  316.         WriteString ("  double-click on a score icon.\n");
  317.         WriteLn;
  318.         WaitForKeyPress ('', ch);
  319.     ELSE (* process workbench arguments *)
  320.         (* right now arg points to the first WBArg, the program name
  321.            we want the second and succesive, they are the icons clicked.
  322.         *)
  323.         nargs := INTEGER (start^.smNumArgs);
  324.         WHILE nargs > 1 DO
  325.         (* the startup list, WBenchMsg^.smArgList is like a variable
  326.            array [1..nargs] of WBArg. We have to traverse this array.
  327.         *)
  328.         INC (ADDRESS(arg), SIZE(arg^));  (* by god, it works! *)
  329.  
  330.         (* waName is an ADDRESS, sptr is a POINTER to ARRAY OF CHAR *)
  331.         sptr := arg^.waName;
  332.         lock := arg^.waLock;
  333.         IF Examine (lock, INFO) THEN
  334.             IF NullString (sptr^) THEN (* a disk or drawer icon *)
  335.             WriteString (ClearScreenString);
  336.             IF NullString (INFO.fibFileName)
  337.                 THEN WriteString ('RAM Disk');
  338.                 ELSE WriteString (INFO.fibFileName);
  339.             END;
  340.             WriteString (' is not a file!\n');
  341.             WaitForKeyPress ('', ch);
  342.             ELSE (* a file *)
  343.             (* not necessary, but for clarity *)
  344.             CopyString (smusName, sptr^);
  345.  
  346.             WriteString (ClearScreenString);
  347.             WriteString ('Looking at file ');
  348.             WriteString (smusName);
  349.             WriteLn;
  350.  
  351.             (* move to the indicated file's directory and open it *)
  352.             lock := CurrentDir (lock);
  353.             IF lock <> NIL THEN
  354.             smusFile := Open (ADR(smusName), ModeOldFile);
  355.             IF smusFile = NIL THEN
  356.                 WriteString (ClearScreenString);
  357.                 WriteString ("Couldn't open ");
  358.                 WriteString (smusName);
  359.                 WriteLn;
  360.                 WaitForKeyPress ('', ch);
  361.             ELSE (* smusFile opened *)
  362.  
  363.     IF ListSMUSInstruments (smusFile) <> -1 THEN
  364.     WaitForKeyPress ("--press 'p' to print--\x0A--any other key to continue--", ch);
  365.     IF (ch = 'p') OR (ch = 'P') THEN
  366.         StdOutput := Open (ADR('PRT:'), ModeNewFile);
  367.         IF StdOutput # NIL THEN
  368.         IF ListSMUSInstruments (smusFile) = 0 THEN END;
  369.         Close (StdOutput);
  370.         StdOutput := StdInput;
  371.         ELSE (* problems opening *)
  372.         StdOutput := StdInput;
  373.         WriteString ("Couldn't open PRT:\n");
  374.         WaitForKeyPress ('', ch);
  375.         END;
  376.     END;
  377.     ELSE
  378.     WaitForKeyPress ('', ch);
  379.     END;
  380.             Close (smusFile);
  381.             END; (* smusFile opened *)
  382.             END; (* lock <> NIL *)
  383.             END;
  384.         END; (* Examine *)
  385.         DEC (nargs);
  386.         END; (* While *)
  387.     END; (* process workbench arguments *)
  388.     Close (StdInput);
  389.     END; (* i/o re-assigned successfully *)
  390.  
  391.     (* set standard i/o back *)
  392.     StdInput := holdStdInput;
  393.     StdOutput := holdStdOutput;
  394.  
  395. END;
  396.  
  397.  
  398. END ListI.
  399.