home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / Opus8 / source.lzh / Opus8.i next >
Encoding:
Text File  |  1991-10-25  |  3.0 KB  |  126 lines
  1. {
  2.     Opus8.i - This is the Include file for the Opus8 program by jOhn Safranek.
  3.                                                (C)1991 Underground Softworks
  4.               This Include has all the External references, various funtions,
  5.               and procedures. Keep this with the source code or face an 
  6.               eternity of flogging. Thank you.
  7. }
  8.  
  9. PROCEDURE Usage();
  10. BEGIN {Usage}
  11.   WRITELN('    Usage : Opus8 <MacFile> <8SVXFile> <Hz>');
  12.   WRITELN;
  13.   WRITELN('    Program by : jOhn Safranek');
  14.   WRITELN;
  15.   WRITELN('    (C)1991 Underground Softworks');
  16.   EXIT(5);
  17. END;  {Usage}
  18.  
  19. FUNCTION AllocString(l : INTEGER) : STRING;
  20.   External;
  21.  
  22. PROCEDURE FreeString(sq : STRING);
  23.   External;
  24.  
  25. PROCEDURE GetParam(    n : SHORT;
  26.                    VAR s : STRING);
  27.   External;
  28.  
  29. FUNCTION GetHz(B : SHORT) : INTEGER;
  30. VAR
  31.   Noombah    : STRING;
  32.   Multiplier : INTEGER;
  33.   Numb       : INTEGER;
  34.   Counter    : SHORT;
  35. BEGIN {GetHz}
  36.   Multiplier := 1;
  37.   Numb := 0;
  38.   Counter := 4;
  39.   Noombah := AllocString(6);
  40.   GetParam(B, Noombah);
  41.   IF Noombah[0] = CHR(0)
  42.     THEN Usage;
  43.   FOR Counter := 4 DOWNTO 0 DO
  44.   BEGIN {FOR..DO}
  45.     IF Noombah[Counter] > CHR(0)
  46.       THEN
  47.       BEGIN {IF..THEN}
  48.         Numb := Numb + ((ORD(Noombah[Counter]) - 48) * Multiplier);
  49.         Multiplier := Multiplier * 10;
  50.       END;  {IF..THEN}
  51.   END;  {FOR..DO}
  52.   FreeString(Noombah);
  53.   GetHz := Numb;
  54. END;  {GetHz}
  55.  
  56. PROCEDURE NoFile();
  57. BEGIN {NoFile}
  58.   WRITELN('I cannot find your Mac file.');
  59.   WRITELN('Program  ABORTED.');
  60.   EXIT(5);
  61. END;  {NoFile}
  62.  
  63. PROCEDURE CannotOpen();
  64. BEGIN {CannotOpen}
  65.   WRITELN('I cannot open the IFF file.');
  66.   WRITELN('Program  ABORTED.');
  67.   EXIT(5);
  68. END;  {CannotOpen}
  69.  
  70. FUNCTION FileSize(FileName : STRING) : INTEGER;
  71. VAR
  72.   FInfo  : FileInfoBlockPtr;
  73.   FLock  : FileLock;
  74.   Result : INTEGER;
  75. BEGIN {FileSize}
  76.   FLock := Lock(FileName, SHARED_LOCK);
  77.   IF FLock = NIL
  78.     THEN FileSize := 0;
  79.   NEW(FInfo);
  80.   IF Examine(FLock, FInfo)
  81.     THEN Result := FInfo^.fib_Size
  82.     ELSE Result := 0;
  83.   DISPOSE(FInfo);
  84.   UnLock(FLock);
  85.   FileSize := Result;
  86. END;  {FileSize}
  87.  
  88. PROCEDURE MakeChar(    Benign : INTEGER;
  89.                    VAR Fin    : SArray);
  90. VAR
  91.   Result : ARRAY [1..8] OF SHORT;
  92.   index,
  93.   Count  : SHORT;
  94. BEGIN {MakeChar}
  95.   FOR Count := 1 TO 4 DO
  96.     Fin[Count] := CHR($00);
  97.   FOR index := 8 DOWNTO 1 DO
  98.   BEGIN {FOR..DO}
  99.     Result[index] := Benign AND 15;
  100.     Benign := Benign DIV 16;
  101.   END;  {FOR..DO}
  102.   Count := 1;
  103.   FOR index := 1 TO 4 DO
  104.   BEGIN {FOR..DO}
  105.     Fin[index] := (CHR((Result[Count] * 16) + Result[Count+1]));
  106.     Count := Count + 2;
  107.   END;  {FOR..DO}
  108. END;  {MakeChar}
  109.  
  110. PROCEDURE WriteTheHeader(    Hur  : SHORT;
  111.                              Lan  : INTEGER); 
  112. VAR
  113.   Cnt  : SHORT; 
  114.   Hrts,
  115.   Len,
  116.   Lun  : SArray;
  117. BEGIN {WriteTheHeader}
  118.   MakeChar(Hur, Hrts);
  119.   MakeChar(Lan+40, Len);
  120.   MakeChar(Lan, Lun);  
  121.   WRITE(OutFile, 'FORM', Len, '8SVXVHDR', CHR($00), CHR($00), CHR($00), 
  122.   CHR($14), Lun, CHR($00), CHR($00), CHR($00), CHR($00), CHR($00), CHR($00), 
  123.   CHR($00), CHR($00), Hrts[3], Hrts[4], CHR($01), CHR($00), CHR($00), CHR($01),
  124.   CHR($00), CHR($00), 'BODY', Lun);
  125. END;  {WriteTheHeader}
  126.