home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / DOS / SS_PLAY / VTSRC12B.ZIP / LIB / S3MLOADE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-26  |  18.1 KB  |  608 lines
  1. UNIT S3mLoader;
  2.  
  3. INTERFACE
  4.  
  5. USES Objects, SongUnit;
  6.  
  7.  
  8.  
  9.  
  10. PROCEDURE LoadS2mFileFormat  (VAR Song: TSong; VAR St: TStream; VAR Header: TSongHeader);
  11. PROCEDURE LoadS3mFileFormat  (VAR Song: TSong; VAR St: TStream; VAR Header: TSongHeader);
  12.  
  13.  
  14.  
  15.  
  16. IMPLEMENTATION
  17.  
  18. USES SongElements, SongUtils, Heaps, AsciiZ;
  19.  
  20.  
  21.  
  22.  
  23. {----------------------------------------------------------------------------}
  24. { Internal definitions. Format of the files.                                 }
  25. {____________________________________________________________________________}
  26.  
  27. TYPE
  28.   TS3mFileMagic1 = WORD;
  29.   TS3mFileMagic2 = ARRAY[0..3] OF CHAR;
  30.   TS2mFileMagic  = ARRAY[0..3] OF CHAR;
  31.  
  32. CONST
  33.   S3mMagic1 = $101A;
  34.   S3mMagic2 : TS3mFileMagic2 = ( 'S', 'C', 'R', 'M' );
  35.   S3mInstr2 : TS3mFileMagic2 = ( 'S', 'C', 'R', 'S' );
  36.   S2mMagic  : TS3mFileMagic2 = ( 'S', 'C', 'R', 'M' );
  37.  
  38. TYPE
  39.  
  40.   TS3mHeader =
  41.     RECORD
  42.       Name        : ARRAY[1..28] OF CHAR;
  43.       Magic1      : TS3mFileMagic1;
  44.       NPI1        : WORD;
  45.       SeqLen      : WORD;
  46.       NInstruments: WORD;
  47.       NPatts      : WORD;
  48.       Word4       : WORD;
  49.       Long1       : LONGINT;
  50.       Magic2      : TS3mFileMagic2;
  51.       Volume      : BYTE;
  52.       Tempo       : BYTE;
  53.       BPM         : BYTE;
  54.       fill1       : ARRAY[1..13] OF BYTE;
  55.       ChannelMaps : ARRAY[1..32] OF BYTE;
  56.     END;
  57.  
  58.   TS2mHeader =
  59.     RECORD
  60.       Name        : ARRAY[1..20] OF CHAR;
  61.       Scream      : ARRAY[1.. 8] OF CHAR;
  62.       Version     : BYTE;
  63.       fill1       : ARRAY[1.. 3] OF BYTE;
  64.       PattOfs     : WORD;
  65.       InstrOfs    : WORD;
  66.       SeqOfs      : WORD;
  67.       fill2       : ARRAY[1.. 4] OF BYTE;
  68.       Volume      : BYTE;
  69.       Tempo       : BYTE;
  70.       fill3       : ARRAY[1.. 4] OF BYTE;
  71.       NPatts      : WORD;
  72.       NInstruments: WORD;
  73.       SeqLen      : WORD;
  74.       Word4       : WORD;
  75.       Long1       : LONGINT;
  76.       Magic       : TS2mFileMagic;
  77.     END;
  78.  
  79.   TS3mInstrument =
  80.     RECORD
  81.       Flag      : BYTE;
  82.       Name      : ARRAY[1..13] OF CHAR;
  83.       Position  : WORD;
  84.       Size      : LONGINT;
  85.       RepStart  : LONGINT;
  86.       RepLen    : LONGINT;
  87.       Volume    : WORD;
  88.       Byte1     : BYTE;
  89.       Looped    : BOOLEAN;
  90.       PeriodFine: WORD;
  91.       fill3     : ARRAY[1..10] OF BYTE;
  92.       Word3     : WORD;
  93.       Word4     : WORD;
  94.       Comment   : ARRAY[1..28] OF CHAR;
  95.       Id        : TS3mFileMagic2;
  96.     END;
  97.  
  98.   TOffsets    = ARRAY[1..256] OF WORD;
  99.   TInstrFlags = ARRAY[1..256] OF BOOLEAN;
  100.  
  101. VAR
  102.   MaxChans   : WORD;
  103.   InitialPos : LONGINT;
  104.  
  105.  
  106.  
  107.  
  108. PROCEDURE SeekToOfs(VAR St: TStream; Ofs: WORD);
  109.   BEGIN
  110.     St.Seek(InitialPos + 16*LONGINT(Ofs));
  111.   END;
  112.  
  113.  
  114.  
  115. PROCEDURE ProcessPatterns(VAR Song: TSong; VAR St: TStream; VAR InstrFlags : TInstrFlags;
  116.                           VAR PattOfs: TOffsets; Num: WORD; S3m: BOOLEAN; Vers: BYTE);
  117.   VAR
  118.     Patt      : ARRAY[1..5000] OF BYTE;
  119.     FullTrack : TFullTrack;
  120.     Pattern   : PPattern;
  121.     Track     : PTrack;
  122.     Note      : TFullNote;
  123.     c         : BYTE;
  124.     i, j      : WORD;
  125.     n, t      : WORD;
  126.     Row       : WORD;
  127.     Size      : WORD;
  128.     NAdj      : WORD;
  129.     l         : LONGINT;
  130.     LastChan  : WORD;
  131.   LABEL
  132.     Ya, No;
  133.   BEGIN
  134.     t := 1;
  135.     FOR n := 1 TO Num DO
  136.       BEGIN
  137.         FOR i := 1 TO Song.SequenceLength DO
  138.           IF Song.PatternSequence^[i] = n THEN GOTO Ya;
  139.  
  140.         GOTO No;
  141. Ya:
  142. {WriteLn('Patt ', n : 3, FullHeap.HMaxAvail : 10, FullHeap.HMemAvail : 10);}
  143.         Pattern := Song.GetPattern(n);
  144.         IF Pattern = NIL THEN
  145.           BEGIN
  146.             Song.Status := msOutOfMemory;
  147.             EXIT;
  148.           END;
  149.  
  150.         WITH Pattern^.Patt^ DO
  151.           BEGIN
  152.             NNotes   := 64;
  153.             NChans   := Song.NumChannels;
  154.             Tempo    := 0;
  155.             BPM      := 0;
  156.           END;
  157.  
  158.         SeekToOfs(St, PattOfs[n]);
  159.  
  160.  
  161.         IF S3m OR (Vers > $0E) THEN
  162.           St.Read(Size, 2)
  163.         ELSE
  164.           Size := SizeOf(Patt) + 2;
  165.  
  166.         DEC(Size, 2);
  167.  
  168.         IF Size > SizeOf(Patt) THEN
  169.           Size := SizeOf(Patt);
  170.  
  171.         St.Read(Patt, Size);
  172.         IF St.Status <> stOk THEN
  173.           BEGIN
  174.             Song.Status := msFileTooShort;
  175.             EXIT;
  176.           END;
  177.  
  178.         LastChan := 1;
  179.         FOR j := 1 TO Song.NumChannels DO
  180.           BEGIN
  181.             FillChar(FullTrack, SizeOf(FullTrack), 0);
  182.  
  183.             i    := 1;
  184.             Row  := 0;
  185.             WHILE (i <= Size)         AND
  186.                   (S3m OR (Row < 64)) DO
  187.               BEGIN
  188.  
  189.                 c := Patt[i];
  190.                 INC(i);
  191.  
  192.                 IF c = 0 THEN
  193.                   Inc(Row)
  194.                 ELSE IF (c AND $1F) = (j - 1) THEN
  195.                   BEGIN
  196.  
  197.                     FillChar(Note, SizeOf(Note), 0);
  198.  
  199.                     IF c AND $20 <> 0 THEN
  200.                       BEGIN
  201.                         Note.Period     := Patt[i];
  202.                         IF NOT S3m THEN
  203.                           INC(Note.Period, $20);
  204.                         IF ((Note.Period AND $F0) > $90) OR
  205.                            ((Note.Period AND $F0) < $20) OR
  206.                            ((Note.Period AND $0F) > $0B) THEN
  207.                           Note.Period := 0;
  208.  
  209.                         IF Note.Period <> 0 THEN
  210.                           BEGIN
  211.                             Note.Period := PeriodSet[
  212.                               (Note.Period SHR 4) - 2, Note.Period AND 15];
  213.                             IF MaxChans <= (c AND $1F) THEN
  214.                               MaxChans := (c AND $1F) + 1;
  215.                           END;
  216.  
  217.                         Note.Instrument := Patt[i+1];
  218.  
  219.                         IF Note.Instrument <> 0 THEN
  220.                           InstrFlags[Note.Instrument] := TRUE;
  221.  
  222.                         INC(i, 2);
  223.                       END;
  224.  
  225.                     IF c AND $40 <> 0 THEN
  226.                       BEGIN
  227.                         Note.Volume := Patt[i] + 1;
  228.                         IF Note.Volume > 64 THEN
  229.                           Note.Volume := 64;
  230.                         INC(i, 1);
  231.                       END;
  232.  
  233.                     IF c AND $80 <> 0 THEN
  234.                       BEGIN
  235.                         Note.Parameter := Patt[i+1];
  236.                         CASE Patt[i] OF
  237.                            1 : BEGIN
  238.                                  Note.Command := mcSetTempo;
  239.                                  IF NOT S3m THEN
  240.                                    Note.Parameter := Note.Parameter SHR 4;
  241.                                END;
  242.                            2 : BEGIN
  243.                                  Note.Command := mcJumpPattern;
  244.                                  INC(Note.Parameter);
  245.                                END;
  246.                            3 : Note.Command := mcEndPattern;
  247.                            4 : BEGIN
  248.                                  IF Note.Parameter > $F0 THEN
  249.                                    BEGIN
  250.                                      Note.Command   := mcVolFineDown;
  251.                                      Note.Parameter := Note.Parameter AND $F;
  252.                                    END
  253.                                  ELSE IF ((Note.Parameter AND $F) = $F) AND
  254.                                          (Note.Parameter > $F)          THEN
  255.                                    BEGIN
  256.                                      Note.Command   := mcVolFineUp;
  257.                                      Note.Parameter := Note.Parameter SHR 4;
  258.                                    END
  259.                                  ELSE
  260.                                    Note.Command := mcVolSlide;
  261.                                END;
  262.                            5 : BEGIN
  263.                                  IF Note.Parameter > $F0 THEN
  264.                                    BEGIN
  265.                                      Note.Command   := mcFinePortaDn;
  266.                                      Note.Parameter := Note.Parameter AND $F;
  267.                                    END
  268.                                  ELSE
  269.                                    Note.Command := mcTPortDown;
  270.                                END;
  271.                            6 : BEGIN
  272.                                  IF Note.Parameter > $F0 THEN
  273.                                    BEGIN
  274.                                      Note.Command   := mcFinePortaUp;
  275.                                      Note.Parameter := Note.Parameter AND $F;
  276.                                    END
  277.                                  ELSE
  278.                                    Note.Command := mcTPortUp;
  279.                                END;
  280.                            7 : Note.Command := mcNPortamento;
  281.                            8 : Note.Command := mcVibrato;
  282.                           10 : Note.Command := mcArpeggio;
  283.                         ELSE
  284.                           Note.Command := TModCommand(ORD(mcLast) + Patt[i]);
  285.                         END;
  286.  
  287.                         IF ((Note.Command = mcEndPattern) OR (Note.Command = mcJumpPattern)) AND
  288.                            (Pattern^.Patt^.NNotes > Row + 1) THEN
  289.                           Pattern^.Patt^.NNotes := Row + 1;
  290.  
  291.                         INC(i, 2);
  292.                       END;
  293.  
  294.                     FullTrack[Row] := Note;
  295.                   END
  296.                 ELSE
  297.                   BEGIN
  298.                     IF (j = 1) AND (LastChan < (c AND $1F) + 1) THEN
  299.                       LastChan := (c AND $1F) + 1;
  300.                     IF c AND $20 <> 0 THEN INC(i, 2);
  301.                     IF c AND $40 <> 0 THEN INC(i, 1);
  302.                     IF c AND $80 <> 0 THEN INC(i, 2);
  303.                   END;
  304.               END;
  305.  
  306.             Track := Song.GetTrack(t);
  307.             IF Track = NIL THEN
  308.               BEGIN
  309.                 Song.Status := msOutOfMemory;
  310.                 EXIT;
  311.               END;
  312.  
  313.             Track^.SetFullTrack(FullTrack);
  314.  
  315.             Pattern^.Patt^.Channels[j] := t;
  316.  
  317.             INC(t);
  318.  
  319.             IF j > LastChan THEN GOTO No;
  320.           END;
  321. No:
  322.       END;
  323.   END;
  324.  
  325.  
  326. PROCEDURE ProcessInstruments(VAR Song: TSong; VAR St: TStream; VAR InstrFlags : TInstrFlags;
  327.                              VAR InstrOfs: TOffsets; Num: WORD; S3m: BOOLEAN; Vers: BYTE);
  328.   VAR
  329.     Instrument : TInstrumentRec;
  330.     Instr      : PInstrument;
  331.     S3mInstr   : TS3mInstrument;
  332.     i, w       : WORD;
  333.     Signo      : LONGINT;
  334.     NoSigno    : LONGINT;
  335.   BEGIN
  336.     FOR i := 1 TO Num DO
  337.       WITH Instrument DO
  338.         BEGIN
  339. {WriteLn('Instr ', i : 3, FullHeap.HMaxAvail : 10, FullHeap.HMemAvail : 10);}
  340.           FillChar(Instrument, SizeOf(Instrument), 0);
  341.  
  342.           Instr := Song.GetInstrument(i);
  343.           IF Instr = NIL THEN
  344.             BEGIN
  345.               Song.Status := msOutOfMemory;
  346.               EXIT;
  347.             END;
  348.  
  349.           SeekToOfs(St, InstrOfs[i]);
  350.           St.Read(S3mInstr, SizeOf(S3mInstr));
  351.  
  352.           IF S3mInstr.Flag = 1 THEN
  353.             BEGIN
  354.               Instr^.SetName(StrASCIIZ(S3mInstr.Comment, 22));
  355.  
  356.               IF InstrFlags[i] THEN
  357.                 Len := S3mInstr.Size;
  358.  
  359.               IF Len > 0 THEN
  360.                 BEGIN
  361.  
  362.                   IF S3mInstr.Looped THEN
  363.                     BEGIN
  364.                       Reps := S3mInstr.RepStart;
  365.                       Repl := S3mInstr.RepLen;
  366.                     END
  367.                   ELSE
  368.                     BEGIN
  369.                       Reps := 0;
  370.                       Repl := 0;
  371.                     END;
  372.  
  373.                   Vol  := S3mInstr.Volume;
  374.                   DAdj := S3mInstr.PeriodFine;
  375.                   IF S3m THEN
  376.                     NAdj := $20AB
  377.                   ELSE
  378.                     NAdj := $2100;
  379.  
  380.                   IF Repl        > Len THEN Repl := Len;
  381.                   IF Reps + Repl > Len THEN Repl := Len - Reps;
  382.  
  383.                   IF Vol > $40 THEN
  384.                     Vol := $40;
  385.  
  386.                   SeekToOfs(St, S3mInstr.Position);
  387.  
  388.                   IF Len <= MaxSample THEN
  389.                     BEGIN
  390.                       FullHeap.HGetMem(POINTER(Data), Len);
  391.                       IF Data = NIL THEN BEGIN
  392.                         Song.Status := msOutOfMemory;
  393.                         EXIT;
  394.                       END;
  395.  
  396.                       St.Read(Data^, Len);
  397.  
  398.                       IF St.Status <> stOk THEN BEGIN
  399.                         Song.Status := msFileDamaged;
  400.                         EXIT;
  401.                       END;
  402.  
  403.                       Signo   := 0;
  404.                       NoSigno := 0;
  405.                       FOR w := 1 TO Len - 1 DO
  406.                         BEGIN
  407.                           IF (Data^[w-1] XOR Data^[w]) AND $80 <> 0 THEN
  408.                             BEGIN
  409.                               IF (SHORTINT(Data^[w]   - 64) < 0) AND
  410.                                  (SHORTINT(Data^[w-1] - 64) < 0) THEN
  411.                                 INC(Signo)
  412.                               ELSE IF (SHORTINT(Data^[w]   - 64) >= 0) AND
  413.                                       (SHORTINT(Data^[w-1] - 64) >= 0) THEN
  414.                                 INC(NoSigno)
  415.                             END;
  416.                         END;
  417.  
  418.                       IF NoSigno > Signo THEN
  419.                         FOR w := 0 TO Len - 1 DO
  420.                           INC(Data^[w], 128);
  421.  
  422.                     END
  423.                   ELSE
  424.                     BEGIN
  425.                       FullHeap.HGetMem(POINTER(Data), MaxSample);
  426.                       FullHeap.HGetMem(POINTER(Xtra), Len-MaxSample);
  427.  
  428.                       IF (Data = NIL) OR (Xtra = NIL) THEN BEGIN
  429.                         Song.Status := msOutOfMemory;
  430.                         EXIT;
  431.                       END;
  432.  
  433.                       St.Read(Data^, MaxSample);
  434.                       St.Read(Xtra^, Len-MaxSample);
  435.  
  436.                       IF St.Status <> 0 THEN BEGIN
  437.                         Song.Status := msFileDamaged;
  438.                         EXIT;
  439.                       END;
  440.                     END;
  441.  
  442.                   Instr^.Change(@Instrument);
  443.                 END
  444.               ELSE
  445.                 Instr^.Change(NIL);
  446.             END;
  447.         END;
  448.   END;
  449.  
  450.  
  451. PROCEDURE LoadS3mFileFormat(VAR Song: TSong; VAR St: TStream; VAR Header: TSongHeader);
  452.   VAR
  453.     Hdr        : TS3mHeader ABSOLUTE Header;
  454.     InstrOfs   : TOffsets;
  455.     PattOfs    : TOffsets;
  456.     i          : WORD;
  457.     InstrFlags : TInstrFlags;
  458.   BEGIN
  459.     Song.FileFormat := mffS3m;
  460.  
  461.     InitialPos := St.GetPos;
  462.  
  463.     St.Seek(InitialPos + SizeOf(TS3mHeader));
  464.  
  465.     IF {(Hdr.Magic1 <> S3mMagic1) OR }(Hdr.Magic2 <> S3mMagic2) THEN
  466.       BEGIN
  467.         Song.Status := msNotLoaded;
  468.         EXIT;
  469.       END;
  470.  
  471.     Song.Status := msOK;
  472.  
  473.     FillChar(InstrFlags, SizeOf(InstrFlags), 0);
  474.  
  475.     Song.Name := FullHeap.HNewStr(StrASCIIZ(Hdr.Name, 28));
  476.  
  477.     IF Hdr.Volume = 64 THEN Hdr.Volume := 63;
  478.     Song.FirstTick    := TRUE;
  479.     Song.InitialTempo := Hdr.Tempo;
  480.     Song.InitialBPM   := Hdr.BPM;
  481.     Song.Volume       := Hdr.Volume * 4 + 3;
  482.     Song.NumChannels  := MaxChannels;
  483.     MaxChans := 1;
  484.  
  485.     Song.SequenceRepStart := 0;{Hdr.NPI1 + 1;}
  486.     St.Read(Song.PatternSequence^, Hdr.SeqLen);
  487.  
  488.     IF Hdr.SeqLen > Song.SongLen THEN
  489.       Hdr.SeqLen := Song.SongLen;
  490.     Song.SequenceLength   := Hdr.SeqLen;
  491.  
  492.     FOR i := 1 TO Hdr.SeqLen DO
  493.       INC(Song.PatternSequence^[i]);
  494.  
  495.     St.Read(InstrOfs, Hdr.NInstruments*2);
  496.     St.Read(PattOfs,  Hdr.NPatts*2);
  497.  
  498.     WHILE (Song.SequenceLength                        > 1) AND
  499.           (Song.PatternSequence^[Song.SequenceLength] = 0) DO
  500.       DEC(Song.SequenceLength);
  501.  
  502.     FOR i := 1 TO Song.SongStart - 1 DO
  503.       Song.PatternSequence^[i] := 0;
  504.  
  505.  
  506.     { Processing of the patterns (the partiture) }
  507.  
  508.     ProcessPatterns(Song, St, InstrFlags, PattOfs, Hdr.NPatts, TRUE, $FF);
  509.     IF Song.Status > msOk THEN EXIT;
  510.  
  511.  
  512.     { Processing of the instruments }
  513.  
  514.     ProcessInstruments(Song, St, InstrFlags, InstrOfs, Hdr.NInstruments, TRUE, $FF);
  515.     IF Song.Status > msFileTooShort THEN EXIT;
  516.  
  517.     IF Song.NumChannels > MaxChans THEN
  518.       Song.NumChannels := MaxChans;
  519.   END;
  520.  
  521.  
  522.  
  523.  
  524. PROCEDURE LoadS2mFileFormat(VAR Song: TSong; VAR St: TStream; VAR Header: TSongHeader);
  525.   VAR
  526.     Hdr        : TS2mHeader ABSOLUTE Header;
  527.     InstrOfs   : TOffsets;
  528.     PattOfs    : TOffsets;
  529.     i          : WORD;
  530.     InstrFlags : TInstrFlags;
  531.   BEGIN
  532.     Song.FileFormat := mffS2m;
  533.  
  534.     InitialPos := St.GetPos;
  535.  
  536.     St.Seek(InitialPos + SizeOf(TS2mHeader));
  537.  
  538.     IF Hdr.Magic <> S2mMagic THEN
  539.       BEGIN
  540.         Song.Status := msNotLoaded;
  541.         EXIT;
  542.       END;
  543.  
  544.     Song.Status := msOK;
  545.  
  546.     FillChar(InstrFlags, SizeOf(InstrFlags), 0);
  547.  
  548.     Song.Name := FullHeap.HNewStr(StrASCIIZ(Hdr.Name, 20));
  549.  
  550.     IF Hdr.Volume = 64 THEN Hdr.Volume := 63;
  551.     Song.FirstTick    := TRUE;
  552.     Song.InitialTempo := Hdr.Tempo SHR 4;
  553.     Song.InitialBPM   := 125;
  554.     Song.Volume       := Hdr.Volume * 4 + 3;
  555.     Song.NumChannels  := MaxChannels;
  556.     MaxChans := 1;
  557.  
  558.     Song.SequenceRepStart := 0;
  559.  
  560.     SeekToOfs(St, Hdr.InstrOfs);
  561.     St.Read(InstrOfs, (Hdr.NInstruments*2 + 15) AND $FFF0);
  562.  
  563.     SeekToOfs(St, Hdr.PattOfs);
  564.     St.Read(PattOfs,  (Hdr.NPatts*2 + 15) AND $FFF0);
  565.  
  566.     SeekToOfs(St, Hdr.SeqOfs);
  567.     St.Read(Song.PatternSequence^, 16);
  568.     St.Read(Song.PatternSequence^, 16);
  569.  
  570.     DEC(Hdr.SeqLen);
  571.     FOR i := 1 TO Hdr.SeqLen DO
  572.       BEGIN
  573.         St.Read(Song.PatternSequence^[i], 5);
  574.         INC(Song.PatternSequence^[i]);
  575.       END;
  576.  
  577.     IF Hdr.SeqLen > Song.SongLen THEN
  578.       Hdr.SeqLen := Song.SongLen;
  579.     Song.SequenceLength   := Hdr.SeqLen;
  580.  
  581.     WHILE (Song.SequenceLength                        > 1) AND
  582.           (Song.PatternSequence^[Song.SequenceLength] = 0) DO
  583.       DEC(Song.SequenceLength);
  584.  
  585.     FOR i := 1 TO Song.SongStart - 1 DO
  586.       Song.PatternSequence^[i] := 0;
  587.  
  588.  
  589.     { Processing of the patterns (the partiture) }
  590.  
  591.     ProcessPatterns(Song, St, InstrFlags, PattOfs, Hdr.NPatts, FALSE, Hdr.Version);
  592.     IF Song.Status > msOk THEN EXIT;
  593.  
  594.  
  595.     { Processing of the instruments }
  596.  
  597.     ProcessInstruments(Song, St, InstrFlags, InstrOfs, Hdr.NInstruments, FALSE, Hdr.Version);
  598.     IF Song.Status > msFileTooShort THEN EXIT;
  599.  
  600.     IF Song.NumChannels > MaxChans THEN
  601.       Song.NumChannels := MaxChans;
  602.   END;
  603.  
  604.  
  605.  
  606.  
  607. END.
  608.