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.
