UNIT LoadMOD;

{ Unit for loading/unloading of MOD files from memory.
  Totally unsupported.  Contributed by Kurt Kennett.
}

INTERFACE

CONST
  MaxTracks = 4;

TYPE
  Note = RECORD
    InstNum  : BYTE;      { Instrument Number   }
    Period   : INTEGER;   { Note Period (Amiga) }
    Effect   : BYTE;      { Effect Number 0-15  }
    EffArg   : BYTE;      { Effect Argument     }
   END;
  Track = ARRAY[0..MaxTracks-1] OF Note;

  Pattern = ARRAY[0..63] OF Track;
  PPattern = ^Pattern;

  Sheet = RECORD
    Num  : BYTE;
    Patt : PPattern;
   END;
  Script = ARRAY[0..127] OF Sheet;

  Instrument = RECORD
    IName   : STRING[22];  { Instrument's name      }
    ILen    : LONGINT;     { Length in bytes        }
    ITune   : BYTE;        { FineTune options       }
    IAmpl   : WORD;        { aplitude (volume)      }
    IMode   : BYTE;        { GUS Mode BYTE          }
    IRepSt  : LONGINT;     { Repeat start position  }
    IRepNd  : LONGINT;     { Repeat END position    }
    IMemLoc : LONGINT;     { GUS Sample location    }
   END;

  MODFile = RECORD
    Name     : STRING[20];
    Instr    : ARRAY[1..31] OF Instrument;
    SongLen  : BYTE;    { # OF valid sheets in the score }
    Score    : Script;
    MChans   : BYTE;
    M31Inst  : BOOLEAN; { file has 31 instruments? }
    TagField : STRING[4];
    EndJump  : BYTE;
   END;
  PModFile = ^ModFile;


FUNCTION LoadModFile(VAR FHandle     : FILE;
                     VAR ModF        : MODFile;
                         FSize       : LONGINT) : BOOLEAN;

PROCEDURE DumpMODFile(VAR MODf : MODFile);


IMPLEMENTATION


USES
  UltraDrv;


VAR
  SampSizes : LONGINT;

FUNCTION LoadModFile(VAR FHandle     : FILE;
                     VAR ModF        : MODFile;
                         FSize       : LONGINT) : BOOLEAN;
  VAR
    HoldPos : LONGINT;

FUNCTION DetermineMODType : BOOLEAN;
  CONST
    NumTags = 8;
    TagStrs : ARRAY[1..NumTags] OF STRING[4] = ('M.K.','FLT4','4CHN','M!K!',
                                                'FLT8','8CHN','OCTA','6CHN');
  VAR
    Check   : BYTE;
    Hold    : LONGINT;
  BEGIN
    DetermineMODType := FALSE;
    WITH ModF DO BEGIN
      IF FSize < 1084 THEN
        EXIT; { File not long enough to be a MOD file }

      { Go find the tag field }
      Hold := FilePos(FHandle);
      Seek(FHandle,Hold+1080);
      BlockRead(FHandle, TagField[1], 4);
      { Put the file back the way we found it }
      Seek(FHandle,Hold);

      IF IOResult <> 0 THEN EXIT;
      TagField[0] := Chr(4);
      Check := 1;
      WHILE Check <= NumTags DO
        IF TagField=TagStrs[Check] THEN
          INC(Check,100)
        ELSE
          INC(Check);
      { Could put in more determination logic here }
      IF Check < 100 THEN
        BEGIN
          Check := 1;
          Exit;
        END
      ELSE
        DEC(Check,100);
      { Default to 4 chans IF no valid tag found }
      IF Check < 8 THEN
        BEGIN
          IF Check < 5 THEN
            MChans := 4
          ELSE
            MChans := 8;
        END
      ELSE
        MChans := 6;

      M31Inst := TRUE;
      { Default.  Could put more determination logic here }

    END;
    DetermineMODType := TRUE;
  END;


FUNCTION WFlip(W : WORD) : WORD;
  BEGIN
    WFlip := WORD(Lo(W)) SHL 8 + Hi(W);
  END;


FUNCTION LoadSampleInfo : BOOLEAN;
  VAR
    LCount,
    MaxRead : BYTE;
    AWLoad  : WORD;
  BEGIN
    LoadSampleInfo := FALSE;
    WITH ModF DO BEGIN
      IF M31Inst THEN MaxRead := 31 ELSE MaxRead := 15;
      FOR LCount := 1 TO MaxRead DO
        WITH Instr[LCount] DO
          BEGIN
            { Nuke the struct }
            FillChar(Instr[LCount], SizeOf(Instr[LCount]), 0);

            {Instrument Name }
            BlockRead(FHandle, IName[1], 22);
            IF IOResult <> 0 THEN EXIT;
            IName[0] := Chr(22);
            IF Pos(#0,IName) <> 0 THEN
              IName[0] := Chr(Pos(#0,IName)-1);

            { Instrument Length }
            BlockRead(FHandle, AWLoad, 2);   { Sample length stays the same }
            IF IOResult <> 0 THEN EXIT;
            ILen := WFlip(AWLoad)*2;
            INC(SampSizes,ILen);

            { Instrument FineTune }
            BlockRead(FHandle, ITune, 1);
            IF IOResult <> 0 THEN EXIT;

            { Instrument Max Volume 0-64 }
            BlockRead(FHandle, IAmpl, 1);
            IF IOResult <> 0 THEN EXIT;

            { Instrument Repeat Offset }
            BlockRead(FHandle, AWLoad, 2);
            IF IOResult <> 0 THEN EXIT;
            IRepSt := WFlip(AWLoad)*2;

            { Instrument Repeat Length }
            BlockRead(FHandle, AWLoad, 2);
            IF IOResult <> 0 THEN EXIT;
            IRepNd := WFlip(AWLoad)*2;
            IF IRepNd < 3 THEN
              BEGIN
                IRepSt := 0;
                IRepNd := 0;
                IMode  := 0;
              END
            ELSE
              BEGIN
                IF IRepSt > 1 THEN DEC(IRepSt,2);
                { Dec(IRepNd,2); }
                IMode := Loop_Voice;
              END;
            IMemLoc := -1;
          END;
    END;
    LoadSampleInfo := TRUE;
  END;


FUNCTION LoadSampleData : BOOLEAN;
  CONST
    SizeLBlock = 32 * 1024; { 32k load buffer }
  VAR
    LCount,
    MaxRead    : BYTE;
    HoldBite   : BYTE;
    LoadSize   : LONGINT;
    SizeDone   : LONGINT;
    BlockSize  : WORD;
    LBlock     : POINTER;
    HoldBWord  : WORD;
  BEGIN
    LoadSampleData := FALSE;
    GetMem(LBlock, SizeLBlock+2);
    WITH ModF DO BEGIN
      IF M31Inst THEN MaxRead := 31 ELSE MaxRead := 15;
      FOR LCount := 1 TO MaxRead DO
        WITH Instr[LCount] DO
          IF ILen > 0 THEN
            BEGIN
              IF NOT UltraMemAlloc(ILen,IMemLoc) THEN
                BEGIN
                  IMemLoc := -1;
                  FreeMem(LBlock, SizeLBlock+2);
                  EXIT; { Out OF GUS RAM }
                END;  
              LoadSize := ILen;
              SizeDone := 2;
              { Get Rid OF junk bytes }
              BlockRead(FHandle, LBlock^, 2);
              IF IOResult <> 0 THEN
                BEGIN
                  FreeMem(LBlock, SizeLBlock+2);
                  EXIT; { File Read Error }
                END;
              IF SizeDone=LoadSize THEN
                Continue;
              WHILE SizeDone < ILen DO
                BEGIN
                  IF ((LoadSize-SizeDone) > SizeLBlock) THEN
                    BlockSize := SizeLBlock
                  ELSE
                    BlockSize := LoadSize-SizeDone;
                  BlockRead(FHandle, LBlock^, BlockSize);
                  IF IOResult <> 0 THEN
                    BEGIN
                      FreeMem(LBlock, SizeLBlock+2);
                      EXIT; { File Read error }
                    END;
                  IF NOT UltraDownLoad(LBlock, 0, IMemLoc+SizeDone-1,{*-2*}
                                       BlockSize, TRUE) THEN
                    BEGIN
                      FreeMem(LBlock, SizeLBlock+2);
                      EXIT; { Error Downloading sample fragment }
                    END;
                  INC(SizeDone, BlockSize);
                END;
              { Set New Start Position }
              INC(IMemLoc);
              DEC(ILen,2);
              IF IMode <> 0 THEN
                BEGIN
                  INC(IRepSt,IMemLoc);
                  IRepNd := IRepSt + IRepNd;
                  IF IRepSt = IMemLoc THEN
                    BEGIN
                      { fill 0th byte with repeat end byte }
                      HoldBite := UltraPeekData(Ultra_Config.Base_Port,IRepNd);
                      UltraPokeData(Ultra_Config.Base_Port,IMemLoc-1,HoldBite);
                    END
                  ELSE
                    BEGIN
                      { fill 0th byte with 1st byte }
                      HoldBite := UltraPeekData(Ultra_Config.Base_Port,IMemLoc);
                      UltraPokeData(Ultra_Config.Base_Port,IMemLoc-1,HoldBite);
                    END;
                  IF IRepNd = IMemLoc+ILen-1 THEN
                    BEGIN
                      { fill last+1 byte with repeat start byte }
                      HoldBite := UltraPeekData(Ultra_Config.Base_Port,IRepSt);
                      UltraPokeData(Ultra_Config.Base_Port,IMemLoc+ILen,HoldBite);
                    END
                  ELSE
                    BEGIN
                      { fill last+1 byte with last byte }
                      HoldBite := UltraPeekData(Ultra_Config.Base_Port,IMemLoc+ILen-1);
                      UltraPokeData(Ultra_Config.Base_Port,IMemLoc+ILen,HoldBite);
                    END;
                END
              ELSE
                BEGIN
                  { fill 0th byte with 1st byte }
                  HoldBite := UltraPeekData(Ultra_Config.Base_Port,IMemLoc);
                  UltraPokeData(Ultra_Config.Base_Port,IMemLoc-1,HoldBite);
                  { fill last+1 byte with last byte }
                  HoldBite := UltraPeekData(Ultra_Config.Base_Port,IMemLoc+ILen-1);
                  UltraPokeData(Ultra_Config.Base_Port,IMemLoc+ILen,HoldBite);
                END;
            END;
    END;
    FreeMem(LBlock, SizeLBlock+2);
    LoadSampleData := TRUE;
  END;

{ loadmod main }
  TYPE
    TrackLoad = ARRAY[1..4] OF BYTE;
  VAR
    LineLoad  : ARRAY[0..7] OF TrackLoad;
    PatArray  : ARRAY[1..128] OF BYTE;
    PatSize   : WORD;
    Calc      : LONGINT;
    PCount    : WORD;
    TCount,
    LCount    : BYTE;
    NewPat    : PPattern;
    PatUsed   : BOOLEAN;
  BEGIN
    LoadMODFile := FALSE;
    FillChar(MODF, SizeOf(ModF), 0);
    IF NOT Ultra_Installed THEN
      EXIT; { Ultrasound not available }
    WITH MODF DO BEGIN
      IF NOT DetermineMODType THEN
        BEGIN
          EXIT; { TYPE determination error }
        END;

      HoldPos := FilePos(FHandle);

      { Song name }
      BlockRead(FHandle, Name[1], 20);
      IF IOResult <> 0 THEN
        BEGIN
          EXIT; { File read error }
        END;
      Name[0] := Chr(20);
      IF Pos(#0,Name) <> 0 THEN
        Name[0] := Chr(Pos(#0,Name)-1);

      { Sample Information }
      SampSizes := 0;
      IF NOT LoadSampleInfo THEN
        BEGIN
          EXIT; { File Read Error }
        END;

      { Number OF Patterns in song }
      BlockRead(FHandle, SongLen, 1);
      IF IOResult <> 0 THEN
        BEGIN
          EXIT; { File Read Error }
        END;

      { END Jump Position }
      BlockRead(FHandle, EndJump, 1);
      IF IOResult <> 0 THEN
        BEGIN
          EXIT; { File Read Error }
        END;

      { Pattern Table }
      BlockRead(FHandle, PatArray[1], 128);
      IF IOResult <> 0 THEN
        BEGIN
          EXIT; { File Read Error }
        END;
      FOR LCount := 1 TO 128 DO
        Score[LCount-1].Num := PatArray[LCount];

      { File Format Tag }
      BlockRead(FHandle, TagField[1], 4);
      IF IOResult <> 0 THEN
        BEGIN
          EXIT; { File Read Error }
        END;
      TagField[0] := Chr(4);

      { Patterns : compute # and load }
      PatSize := WORD(MChans) SHL 8;
      Calc := FilePos(FHandle)-HoldPos;
      Calc := ((FSize-(FilePos(FHandle)-HoldPos))-SampSizes) DIV PatSize;
      FOR PCount := 0 TO Calc-1 DO
        BEGIN
          New(NewPat);
          FillChar(NewPat^, SizeOf(NewPat^), 0);
          FOR LCount := 0 TO 63 DO
            BEGIN
              BlockRead(FHandle, LineLoad[0], MChans*4);
              IF IOResult <> 0 THEN
                BEGIN
                  EXIT;
                END;
              FOR TCount := 0 TO MChans-1 DO
                BEGIN
                  NewPat^[LCount][TCount].InstNum :=
                    (LineLoad[TCount][1] AND $F0) OR
                    (((LineLoad[TCount][3] SHR 4)) AND $0F);
                  NewPat^[LCount][TCount].Period :=
                    (WORD(LineLoad[TCount][1] AND $0F) SHL 8) OR
                    LineLoad[TCount][2];
                  NewPat^[LCount][TCount].Effect :=
                    (LineLoad[TCount][3] AND $0F);
                  NewPat^[LCount][TCount].EffArg := LineLoad[TCount][4];
                END;
            END;
          PatUsed := FALSE;
          FOR LCount := 0 TO 127 DO
            IF Score[LCount].Num=PCount THEN
              BEGIN
                Score[LCount].Patt := NewPat;
                PatUsed := TRUE;
              END;
          IF NOT PatUsed THEN
            Dispose(NewPat);
        END;

      { Sample Data }
      IF NOT LoadSampleData THEN
        BEGIN
          IF M31Inst THEN TCount := 31 ELSE TCount := 15;
          FOR LCount := 1 TO TCount DO
            IF Instr[LCount].IMemLoc <> -1 THEN
              UltraMemFree(Instr[LCount].IMemLoc-1, Instr[LCount].ILen+2);
          FOR LCount := 0 TO 127 DO
            IF Score[LCount].Patt <> NIL THEN
              BEGIN
                FOR TCount := LCount+1 TO 127 DO
                  IF Score[TCount].Num=Score[LCount].Num THEN
                    Score[TCount].Patt := NIL;
                Dispose(Score[LCount].Patt);
                Score[LCount].Patt := NIL;
              END;
          EXIT; { Error loading sample data }
        END;

    END;
    LoadMODFile := TRUE;
  END;

PROCEDURE DumpMODFile(VAR MODf : MODFile);
  VAR
    TCount,
    LCount  : WORD;
  BEGIN
    IF ModF.M31Inst THEN TCount := 31 ELSE TCount := 15;
    { Dump GUS RAM Held }
    FOR LCount := 1 TO TCount DO
      IF ModF.Instr[LCount].IMemLoc <> -1 THEN
        UltraMemFree(ModF.Instr[LCount].ILen+2, ModF.Instr[LCount].IMemLoc-1);
    { Dump head space used by patterns }
    FOR LCount := 0 TO 127 DO
      IF ModF.Score[LCount].Patt <> NIL THEN
        BEGIN
          FOR TCount := LCount+1 TO 127 DO
            IF ModF.Score[TCount].Num=ModF.Score[LCount].Num THEN
              ModF.Score[TCount].Patt := NIL;
          Dispose(ModF.Score[LCount].Patt);
          ModF.Score[LCount].Patt := NIL;
        END;
  END;

END.
