Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
8568 lines (8232 sloc) 266 KB
{
This is part of Vortex Tracker II project
(c)2000-2009 S.V.Bulba
Author Sergey Bulba
E-mail: vorobey@mail.khstu.ru
Support page: http://bulba.untergrund.net/
}
unit trfuncs;
interface
uses SysUtils, Controls, Dialogs;
type
TChansArray = array[0..2] of integer;
const
StdChns: TChansArray = (0, 1, 2); //ABC (for export to text/clipboard)
MaxPatLen = 256; //Pro Tracker 3.xx allows 64 max :(
DefPatLen = 64;
MaxPatNum = 84; //Alone Coder had made Pro Tracker 3.6x+ with 48 patterns
//and with player, which supports up to 85 patterns
MaxNumOfPats = MaxPatNum + 1;
MaxOrnLen = 255; //can be up to 255; 64 in ZX version of PT3-editor
MaxSamLen = 64; //not bigger than 64 (players limitation)
FeaturesLevel: integer = 1;
//0 for PT 3.5 and older
//1 for VT II and PT3.6 (Correct3xxxInterpretation - Allows Vortex Tracker II
//rightly do the situation like
// A-4 .... 11.1
// --- .... ....
// A-4 .... 31.1
//An ASC modules conversion also depends of this switch)
//2 for PT 3.7 (New1xxx2xxxInterpretation - PT 3.7 1.xx and 2.xx allows sinlge
//tone offset without glissando)
DetectFeaturesLevel: boolean = True;
VortexModuleHeader: boolean = True;
DetectModuleHeader: boolean = True;
MaxNumberOfSoundChips = 2;
type
BytePtr = ^byte;
WordPtr = ^word;
DWordPtr = ^longword;
Available_Types =
(Unknown, STCFile, ASCFile, ASC0File, STPFile, PSCFile, FLSFile, FTCFile,
PT1File, PT2File, PT3File, SQTFile, GTRFile, FXMFile, PSMFile);
TRegisters = packed record
case Boolean of
True: (Index: array[0..13] of byte);
False: (TonA, TonB, TonC: word;
Noise, Mixer: byte;
AmplitudeA, AmplitudeB, AmplitudeC: byte;
Envelope: word;
EnvType: byte);
end;
PPosition = ^TPosition;
TPosition = record
Value: array[0..255] of integer; {0..42 for compatability with Pro Tracker 3.4r,
i.e. max 43 patterns (85 in 3.6+}
Length, Loop: integer;
end;
POrnament = ^TOrnament;
TOrnament = record
Items: array[0..MaxOrnLen - 1] of shortint;
Length, Loop: integer;
end;
PSampleTick = ^TSampleTick;
TSampleTick = record
Add_to_Ton: smallint;
Ton_Accumulation: boolean;
Amplitude: byte;
Amplitude_Sliding: boolean;
Amplitude_Slide_Up: boolean;
Envelope_Enabled: boolean;
Envelope_or_Noise_Accumulation: boolean;
Add_to_Envelope_or_Noise: shortint;
Mixer_Ton, Mixer_Noise: boolean;
end;
PSample = ^TSample;
TSample = packed record
Length, Loop: byte;
Enabled: boolean;
Items: array[0..MaxSamLen - 1] of TSampleTick;
end;
TAdditionalCommand = packed record
Number: byte;
Delay: byte;
Parameter: byte;
end;
TChannelLine = packed record
Note: shortint; {0..95} {-2 - Sound off (R--)} {-1 - No note (---)}
Sample: byte; {0..31}
Ornament: byte; {0..15}
Volume: shortint; {1-15 - vol, 0 - prev vol}
Envelope: byte; {1-14 - R13, 15 - Envelope off, 0 - prev}
Additional_Command: TAdditionalCommand;
end;
PPattern = ^TPattern;
TPattern = record
Length: integer;
Items: array[0..MaxPatLen - 1] of record
Noise: byte;
Envelope: word;
Channel: array[0..2] of TChannelLine;
end;
end;
PModule = ^TModule;
TModule = packed record
Title, Author: string;
Ton_Table: byte;
Initial_Delay: byte;
Positions: TPosition;
Samples: array[1..31] of PSample;
Ornaments: array[0..15] of POrnament;
Patterns: array[-1..MaxPatNum] of PPattern;
FeaturesLevel: integer;
VortexModule_Header: boolean;
IsChans: array[0..2] of record
Global_Ton, Global_Noise, Global_Envelope, EnvelopeEnabled: boolean;
Ornament, Sample, Volume: byte;
end;
end;
PSpeccyModule = ^TSpeccyModule;
TSpeccyModule = packed record
case Integer of
0: (Index: array[0..65535] of byte);
1: (PT3_Name: array[0..$62] of char;
PT3_Table: byte;
PT3_Delay: byte;
PT3_NumberOfPositions: byte;
PT3_LoopPosition: byte;
PT3_PatternsPointer: word;
PT3_SamplePointers: array[0..31] of word;
PT3_OrnamentPointers: array[0..15] of word);
2: (PT2_Delay: byte;
PT2_NumberOfPositions: byte;
PT2_LoopPosition: byte;
PT2_SamplePointers: array[0..31] of word;
PT2_OrnamentPointers: array[0..15] of word;
PT2_PatternsPointer: word;
PT2_MusicName: array[0..29] of char;
PT2_PositionList: array[0..65535 - 131] of byte);
3: (ST_Delay: byte;
ST_PositionsPointer, ST_OrnamentsPointer, ST_PatternsPointer: word;
ST_Name: array[0..17] of char;
ST_Size: word);
4: (STP_Delay: byte;
STP_PositionsPointer, STP_PatternsPointer,
STP_OrnamentsPointer, STP_SamplesPointer: word;
STP_Init_Id: byte);
5: (SQT_Size, SQT_SamplesPointer, SQT_OrnamentsPointer, SQT_PatternsPointer,
SQT_PositionsPointer, SQT_LoopPointer: word);
6: (ASC1_Delay, ASC1_LoopingPosition: byte;
ASC1_PatternsPointers, ASC1_SamplesPointers, ASC1_OrnamentsPointers: word;
ASC1_Number_Of_Positions: byte;
ASC1_Positions: array[0..65535 - 9] of byte);
7: (ASC0_Delay: byte;
ASC0_PatternsPointers, ASC0_SamplesPointers, ASC0_OrnamentsPointers: word;
ASC0_Number_Of_Positions: byte;
ASC0_Positions: array[0..65535 - 8] of byte);
8: (PSC_MusicName: array[0..68] of char;
PSC_UnknownPointer: word;
PSC_PatternsPointer: word;
PSC_Delay: byte;
PSC_OrnamentsPointer: word;
PSC_SamplesPointers: array[0..31] of word);
9: (FLS_PositionsPointer: word;
FLS_OrnamentsPointer: word;
FLS_SamplesPointer: word;
FLS_PatternsPointers: array[1..(65536 - 6) div 6] of packed record
PatternA, PatternB, PatternC: word;
end);
10: (PT1_Delay: byte;
PT1_NumberOfPositions: byte;
PT1_LoopPosition: byte;
PT1_SamplesPointers: array[0..15] of word;
PT1_OrnamentsPointers: array[0..15] of word;
PT1_PatternsPointer: word;
PT1_MusicName: array[0..29] of char;
PT1_PositionList: array[0..65535 - 99] of byte);
11: (GTR_Delay: byte;
GTR_ID: array[0..3] of char;
GTR_Address: word;
GTR_Name: array[0..31] of char;
GTR_SamplesPointers: array[0..14] of word;
GTR_OrnamentsPointers: array[0..15] of word;
GTR_PatternsPointers: array[0..31] of packed record
PatternA, PatternB, PatternC: word;
end;
GTR_NumberOfPositions: byte;
GTR_LoopPosition: byte;
GTR_Positions: array[0..65536 - 295 - 1] of byte);
12: (FTC_MusicName: array[0..68] of char;
FTC_Delay: byte;
FTC_Loop_Position: byte;
FTC_Slack: integer;
FTC_PatternsPointer: word;
FTC_Slack2: array[0..4] of byte;
FTC_SamplesPointers: array[0..31] of word;
FTC_OrnamentsPointers: array[0..32] of word;
FTC_Positions: array[0..(65536 - $D4) div 2 - 1] of packed record
Pattern: byte;
Transposition: shortint;
end);
13: (PSM_PositionsPointer: word;
PSM_SamplesPointer: word;
PSM_OrnamentsPointer: word;
PSM_PatternsPointer: word;
PSM_Remark: array[0..65535 - 8] of byte);
end;
//AY-file header and structures
TAYFileHeader = packed record
FileID, TypeID: longword;
FileVersion, PlayerVersion: byte;
PSpecialPlayer, PAuthor, PMisc: smallint;
NumOfSongs, FirstSong: byte;
PSongsStructure: smallint;
end;
TSongStructure = packed record
PSongName, PSongData: smallint;
end;
TSongData = packed record
ChanA, ChanB, ChanC, Noise: byte;
SongLength: word;
FadeLength: word;
HiReg, LoReg: byte;
PPoints, PAddresses: smallint;
end;
TPoints = packed record
Stek, Init, Inter: word;
Adr1, Len1, Offs1, Adr2, Len2, Offs2, Zero: word;
end;
const
EmptySampleTick: TSampleTick =
(Add_to_Ton: 0; Ton_Accumulation: False; Amplitude: 0; Amplitude_Sliding: False;
Amplitude_Slide_Up: False; Envelope_Enabled: False;
Envelope_or_Noise_Accumulation: False; Add_to_Envelope_or_Noise: 0; Mixer_Ton: False;
Mixer_Noise: False);
EmptyChannelLine: TChannelLine =
(Note: - 1; Sample: 0; Ornament: 0; Volume: 0; Envelope: 0;
Additional_Command: (Number: 0; Delay: 0; Parameter: 0));
KsaId = 'KSA SOFTWARE COMPILATION OF ';
var
TxtFile: TextFile;
TxtLine: integer;
TxtString: string;
MidChan: integer = 1;
CurChip: integer;
PlVars: array[1..MaxNumberOfSoundChips] of record
CurrentPosition: integer;
CurrentPattern: integer;
CurrentLine: Integer;
Env_Base: smallint;
ParamsOfChan: array[0..2] of record
SamplePosition: byte;
OrnamentPosition: byte;
SoundEnabled: boolean;
Slide_To_Note, Note: Byte;
Ton_Slide_Delay: shortint;
Ton_Slide_Count: shortint;
Ton_Slide_Step, Ton_Slide_Delta: SmallInt;
Ton_Slide_Type: integer;
Current_Ton_Sliding: SmallInt;
OnOff_Delay, OffOn_Delay, Current_OnOff: shortint;
Ton, Ton_Accumulator: word;
Amplitude: byte;
Current_Amplitude_Sliding: shortint;
Current_Envelope_Sliding: shortint;
Current_Noise_Sliding: shortint;
end;
Delay, DelayCounter: shortint;
Cur_Env_Slide: smallint;
Cur_Env_Delay, Env_Delay: shortint;
Env_Slide_Add: smallint;
AddToEnv, AddToNoise: shortint;
PT3Noise: Byte;
IntCnt: integer;
end;
procedure Module_SetPointer(ModulePointer: PModule; Chip: integer);
{óñòàíàâëèâàåò óêàçàòåëü íà ñòðóêòóðó ìîäóëÿ}
{Âûçûâàåòñÿ õîòÿ áû ðàç ïåðåä èñïîëüçîâàíèåì äðóãèõ ïðîöåäóð}
procedure Module_SetDelay(Dl: shortint);
{Óñòàíàâëèâàåò òåêóùèé Delay
 ïðîöåññå ïðîèãðûâàíèÿ Delay ìîæåò ìåíÿòüñÿ ñïåö êîìàíäîé}
{Âûçûâàåòñÿ êàæäûé ðàç ïåðåä íà÷àëîì ïðîèãðûâàíèÿ ïðîöåäóðàìè
Pattern_PlayCurrentLine èëè Module_PlayCurrentLine, èíà÷å
áóäåò èñïîëüçîâàíî ïîñëåäíåå çíà÷åíèå Delay, êîòîðîå â îáùåì
ñëó÷àå ìîæåò áûòü ëþáûì. Äèàïàçîí çíà÷åíèé - 3..255
(3 - äëÿ ñîâìåñòèìîñòè ñ PT3)}
procedure Module_SetCurrentPosition(Position: Integer);
{óñòàíàâëèâàåò òåêóùóþ ïîçèöèþ}
{çíà÷åíèÿ Position: 0..255;
Ýòî çíà÷åíèå èñïîëüçóåòñÿ â êà÷åñòâå èíäåêñà ïðè âûáîðå íîìåðà ïàòòåðíà
èç VTM.Position_List)}
procedure Module_SetCurrentPattern(Pattern: Integer);
{óñòàíàâëèâàåò òåêóùóþ ïîçèöèþ}
{çíà÷åíèÿ Pattern: 0..MaxPatNum}
procedure Pattern_SetCurrentLine(Line: Integer);
{óñòàíàâëèâàåò òåêóùóþ ñòðîêó â ïàòòåðíå}
{Çíà÷åíèÿ: îò 0 äî PatternLength-1}
{Ñ ýòîé ñòðîêè íà÷íóò ïðîèãðûâàíèå ôóíêöèè
Module_PlayCurrentLine èëè Pattern_PlayCurrentLine)}
function Pattern_PlayCurrentLine: Integer;
{âîçâðàùàåò çíà÷åíèÿ ðåãèñòðîâ AY äëÿ òåêóùåé ñòðîêè ïàòòåðíà
è äåëàåò ñëåäóþùóþ ñòðîêó òåêóùåé.
Íà âûõîäå:
Åñëè '1' - ñòðîêà çàêîí÷èëàñü è AYRegisters óæå îò íîâîé ñòðîêè
Åñëè '2' - áîëüøå ñòðîê íåò è AYRegisters íå ìåíÿþòñÿ
针֌ - '0'}
function Module_PlayCurrentLine: Integer;
{âîçâðàùàåò çíà÷åíèÿ ðåãèñòðîâ AY äëÿ òåêóùåé ñòðîêè ïàòòåðíà
è äåëàåò ñëåäóþùóþ ñòðîêó òåêóùåé, ïî äîñòèæåíèþ ïîñëåäíåé
ñòðîêè àâòîìàòè÷åñêè ñòàíîâèòñÿ òåêóùèì ñëåäóþùèé ïî Position
List ïàòòåðí.
Íà âûõîäå:
Åñëè '1' - ñòðîêà çàêîí÷èëàñü è AYRegisters óæå îò íîâîé ñòðîêè
Åñëè '2' - Ïàòòåðí çàêîí÷èëñÿ è AYRegisters - îò ïåðâîé ñòðîêè
ñëåäóþùåãî ïî PositionList ïàòåðíà
Åñëè '3' - âñå ïàòòåðíû çàêîí÷èëèñü è AYRegisters - îò ïåðâîé ñòðîêè
ïåðâîãî ïî PositionList ïàòåðíà
针֌ - '0'}
procedure Pattern_PlayOnlyCurrentLine;
{âîçâðàùàåò çíà÷åíèÿ ðåãèñòðîâ AY äëÿ òåêóùåé ñòðîêè ïàòòåðíà, ïåðåõîä
íà ñëåäóþùóþ ñòðîêó íå ïðîèçâîäèòñÿ.}
function PT32VTM(PT3: PSpeccyModule; FSize: integer; VTM1: PModule; var VTM2: PModule): boolean;
{êîíâåðòåð èç PT3 â VTM.
PT3 - óêàçàòåëü íà ïðåäâàðèòåëüíî çàãðóæåííûé PT3}
procedure InitTrackerParameters(All: boolean);
{Âûçâàòü äëÿ èíèöèàëèçàöèè âíóòðåííèõ ïåðåìåííûõ}
{All = True => 1F.F => Sam=1,Env=15,Orn=0,Vol=15}
procedure ValidatePattern(pat: integer; VTM: PModule);
function LoadPatternDataTxt(OnePat: PPattern): integer;
function LoadSampleDataTxt(Sam: PSample): string;
procedure ValidateSample(sam: integer; VTM: PModule);
function RecognizeOrnamentString(const orst: string; Orn: POrnament): boolean;
function LoadModuleFromText(FN: string; VTM1: PModule; var VTM2: PModule): integer;
function PT22VTM(PT2: PSpeccyModule; VTM: PModule): boolean;
function PT12VTM(PT1: PSpeccyModule; VTM: PModule): boolean;
function STC2VTM(STC: PSpeccyModule; FSize: integer; VTM: PModule): boolean;
function STP2VTM(STP: PSpeccyModule; VTM: PModule): boolean;
function SQT2VTM(SQT: PSpeccyModule; VTM: PModule): boolean;
function ASC2VTM(ASC: PSpeccyModule; VTM: PModule): boolean;
function PSC2VTM(PSC: PSpeccyModule; VTM: PModule): boolean;
function FLS2VTM(FLS: PSpeccyModule; VTM: PModule): boolean;
function GTR2VTM(GTR: PSpeccyModule; VTM: PModule): boolean;
function FTC2VTM(FTC: PSpeccyModule; VTM: PModule): boolean;
function FXM2VTM(FXM: PSpeccyModule; ZXAddr, Tm, amad_andsix: integer;
SongN, AuthN: string; VTM: PModule): boolean;
function PSM2VTM(PSM: PSpeccyModule; VTM: PModule): boolean;
function IntsToTime(i: integer): string;
function Int2ToStr(i: integer): string;
function Int1DToStr(i: integer): string;
function SampToStr(i: integer): string;
function NoteToStr(i: integer): string;
function Int2DToStr(i: integer): string;
function Int4DToStr(i: integer): string;
function SGetNumber(s: string; max: integer; var res: integer): boolean;
function SGetNote(s: string; var res: integer): boolean;
function GetPatternLineString(PatPtr: PPattern; n: integer; Chn: TChansArray): string;
function GetSampleString(SL: TSampleTick; Vol, Ns: boolean): string;
procedure SavePattern(VTMP: PModule; n: integer);
procedure SaveSample(VTMP: PModule; n: integer);
procedure SaveOrnament(VTM: PModule; n: integer);
procedure VTM2TextFile(FN: string; VTM: PModule; Apnd: boolean);
function VTM2PT3(PT3: PSpeccyModule; VTM: PModule;
var Module_Size: Integer): boolean;
{êîíâåðòåð èç VTM â PT3.
PT3 - óêàçàòåëü, ãäå áóäåò ñôîðìèðîâàí PT3
â Module_Size âîçâðàùàåòñÿ ðàçìåð äàííîãî PT3}
procedure PrepareZXModule(ZXP: PSpeccyModule; var FType: Available_Types; Length: integer);
function LoadAndDetect(ZXP: PSpeccyModule; FileName: string; var Length: integer;
var FType2: Available_Types; var TSSize2: integer;
var ZXAddr: word; var Tm: integer; var Andsix: byte;
var AuthorName, SongName: string): Available_Types;
function GetModuleTime(VTM: PModule): integer;
function GetPositionTime(VTM: PModule; Pos: integer; var PosDelay: integer): integer;
function GetPositionTimeEx(VTM: PModule; Pos, PosDelay, Line: integer): integer;
function GetNoteFreq(t, j: integer): integer;
function GetNoteByEnvelope(e: integer): integer;
function GetNoteByEnvelope2(nt: integer; e: integer): integer;
procedure GetTimeParams(VTM: PModule; Time: integer; var Pos, Line: integer);
procedure FreeVTMP(var VTMP: PModule);
procedure NewVTMP(var VTMP: PModule);
type
PT3ToneTable = array[0..95] of word;
const
{Table #0 of Pro Tracker 3.4x - 3.5x}
PT3NoteTable_PT: PT3ToneTable = (
$0C22, $0B73, $0ACF, $0A33, $09A1, $0917, $0894, $0819, $07A4, $0737, $06CF, $066D,
$0611, $05BA, $0567, $051A, $04D0, $048B, $044A, $040C, $03D2, $039B, $0367, $0337,
$0308, $02DD, $02B4, $028D, $0268, $0246, $0225, $0206, $01E9, $01CE, $01B4, $019B,
$0184, $016E, $015A, $0146, $0134, $0123, $0112, $0103, $00F5, $00E7, $00DA, $00CE,
$00C2, $00B7, $00AD, $00A3, $009A, $0091, $0089, $0082, $007A, $0073, $006D, $0067,
$0061, $005C, $0056, $0052, $004D, $0049, $0045, $0041, $003D, $003A, $0036, $0033,
$0031, $002E, $002B, $0029, $0027, $0024, $0022, $0020, $001F, $001D, $001B, $001A,
$0018, $0017, $0016, $0014, $0013, $0012, $0011, $0010, $000F, $000E, $000D, $000C);
{Table #1 of Pro Tracker 3.3x - 3.5x)}
PT3NoteTable_ST: PT3ToneTable = (
$0EF8, $0E10, $0D60, $0C80, $0BD8, $0B28, $0A88, $09F0, $0960, $08E0, $0858, $07E0,
$077C, $0708, $06B0, $0640, $05EC, $0594, $0544, $04F8, $04B0, $0470, $042C, $03FD,
$03BE, $0384, $0358, $0320, $02F6, $02CA, $02A2, $027C, $0258, $0238, $0216, $01F8,
$01DF, $01C2, $01AC, $0190, $017B, $0165, $0151, $013E, $012C, $011C, $010A, $00FC,
$00EF, $00E1, $00D6, $00C8, $00BD, $00B2, $00A8, $009F, $0096, $008E, $0085, $007E,
$0077, $0070, $006B, $0064, $005E, $0059, $0054, $004F, $004B, $0047, $0042, $003F,
$003B, $0038, $0035, $0032, $002F, $002C, $002A, $0027, $0025, $0023, $0021, $001F,
$001D, $001C, $001A, $0019, $0017, $0016, $0015, $0013, $0012, $0011, $0010, $000F);
{Table #2 of Pro Tracker 3.4x - 3.5x}
PT3NoteTable_ASM: PT3ToneTable = (
$0D10, $0C55, $0BA4, $0AFC, $0A5F, $09CA, $093D, $08B8, $083B, $07C5, $0755, $06EC,
$0688, $062A, $05D2, $057E, $052F, $04E5, $049E, $045C, $041D, $03E2, $03AB, $0376,
$0344, $0315, $02E9, $02BF, $0298, $0272, $024F, $022E, $020F, $01F1, $01D5, $01BB,
$01A2, $018B, $0174, $0160, $014C, $0139, $0128, $0117, $0107, $00F9, $00EB, $00DD,
$00D1, $00C5, $00BA, $00B0, $00A6, $009D, $0094, $008C, $0084, $007C, $0075, $006F,
$0069, $0063, $005D, $0058, $0053, $004E, $004A, $0046, $0042, $003E, $003B, $0037,
$0034, $0031, $002F, $002C, $0029, $0027, $0025, $0023, $0021, $001F, $001D, $001C,
$001A, $0019, $0017, $0016, $0015, $0014, $0012, $0011, $0010, $000F, $000E, $000D);
{Table #3 of Pro Tracker 3.4x - 3.5x}
PT3NoteTable_REAL: PT3ToneTable = (
$0CDA, $0C22, $0B73, $0ACF, $0A33, $09A1, $0917, $0894, $0819, $07A4, $0737, $06CF,
$066D, $0611, $05BA, $0567, $051A, $04D0, $048B, $044A, $040C, $03D2, $039B, $0367,
$0337, $0308, $02DD, $02B4, $028D, $0268, $0246, $0225, $0206, $01E9, $01CE, $01B4,
$019B, $0184, $016E, $015A, $0146, $0134, $0123, $0112, $0103, $00F5, $00E7, $00DA,
$00CE, $00C2, $00B7, $00AD, $00A3, $009A, $0091, $0089, $0082, $007A, $0073, $006D,
$0067, $0061, $005C, $0056, $0052, $004D, $0049, $0045, $0041, $003D, $003A, $0036,
$0033, $0031, $002E, $002B, $0029, $0027, $0024, $0022, $0020, $001F, $001D, $001B,
$001A, $0018, $0017, $0016, $0014, $0013, $0012, $0011, $0010, $000F, $000E, $000D);
{Table #4 of IvanRochin NATURAL Cmaj/Am}
PT3NoteTable_NATURAL: PT3ToneTable = (
//5760, 5400, 5120, 4800, 4608, 4320, 4050, 3840, 3600, 3456, 3240, 3072, //3041280
//1520640 MHz
2880, 2700, 2560, 2400, 2304, 2160, 2025, 1920, 1800, 1728, 1620, 1536,
1440, 1350, 1280, 1200, 1152, 1080, 1013, 960, 900, 864, 810, 768,
720, 675, 640, 600, 576, 540, 506, 480, 450, 432, 405, 384,
360, 338, 320, 300, 288, 270, 253, 240, 225, 216, 203, 192,
180, 169, 160, 150, 144, 135, 127, 120, 113, 108, 101, 96,
90, 84, 80, 75, 72, 68, 63, 60, 56, 54, 51, 48,
45, 42, 40, 38, 36, 34, 32, 30, 28, 27, 25, 24,
23, 21, 20, 19, 18, 17, 16, 15, 14, 14, 13, 12);
{Volume table of Pro Tracker 3.5x}
PT3_Vol: array[0..15, 0..15] of byte = (
($00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00),
($00, $00, $00, $00, $00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01, $01),
($00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01, $01, $02, $02, $02, $02),
($00, $00, $00, $01, $01, $01, $01, $01, $02, $02, $02, $02, $02, $03, $03, $03),
($00, $00, $01, $01, $01, $01, $02, $02, $02, $02, $03, $03, $03, $03, $04, $04),
($00, $00, $01, $01, $01, $02, $02, $02, $03, $03, $03, $04, $04, $04, $05, $05),
($00, $00, $01, $01, $02, $02, $02, $03, $03, $04, $04, $04, $05, $05, $06, $06),
($00, $00, $01, $01, $02, $02, $03, $03, $04, $04, $05, $05, $06, $06, $07, $07),
($00, $01, $01, $02, $02, $03, $03, $04, $04, $05, $05, $06, $06, $07, $07, $08),
($00, $01, $01, $02, $02, $03, $04, $04, $05, $05, $06, $07, $07, $08, $08, $09),
($00, $01, $01, $02, $03, $03, $04, $05, $05, $06, $07, $07, $08, $09, $09, $0A),
($00, $01, $01, $02, $03, $04, $04, $05, $06, $07, $07, $08, $09, $0A, $0A, $0B),
($00, $01, $02, $02, $03, $04, $05, $06, $06, $07, $08, $09, $0A, $0A, $0B, $0C),
($00, $01, $02, $03, $03, $04, $05, $06, $07, $08, $09, $0A, $0A, $0B, $0C, $0D),
($00, $01, $02, $03, $04, $05, $06, $07, $07, $08, $09, $0A, $0B, $0C, $0D, $0E),
($00, $01, $02, $03, $04, $05, $06, $07, $08, $09, $0A, $0B, $0C, $0D, $0E, $0F));
implementation
uses AY, WaveOutAPI, FXMImport, Main;
var
VTM: PModule;
procedure Module_SetPointer(ModulePointer: PModule; Chip: integer);
begin
VTM := ModulePointer;
CurChip := Chip
end;
procedure Module_SetDelay(Dl: shortint);
begin
PlVars[CurChip].Delay := Dl
end;
procedure InitTrackerParameters;
var
k: integer;
begin
ResetAYChipEmulation(CurChip);
PlVars[CurChip].DelayCounter := 1;
PlVars[CurChip].PT3Noise := 0;
PlVars[CurChip].Env_Base := 0;
PlVars[CurChip].IntCnt := 0;
if All then
for k := 0 to 2 do
begin
VTM.IsChans[k].Sample := 1;
VTM.IsChans[k].EnvelopeEnabled := False;
VTM.IsChans[k].Ornament := 0;
VTM.IsChans[k].Volume := 15
end;
for k := 0 to 2 do
begin
PlVars[CurChip].ParamsOfChan[k].SamplePosition := 0;
PlVars[CurChip].ParamsOfChan[k].OrnamentPosition := 0;
PlVars[CurChip].ParamsOfChan[k].SoundEnabled := False;
PlVars[CurChip].ParamsOfChan[k].Note := 0;
PlVars[CurChip].ParamsOfChan[k].Ton_Slide_Count := 0;
PlVars[CurChip].ParamsOfChan[k].Current_Ton_Sliding := 0;
PlVars[CurChip].ParamsOfChan[k].Current_OnOff := 0;
PlVars[CurChip].ParamsOfChan[k].Ton_Accumulator := 0;
PlVars[CurChip].ParamsOfChan[k].Ton := 0;
PlVars[CurChip].ParamsOfChan[k].Current_Amplitude_Sliding := 0;
PlVars[CurChip].ParamsOfChan[k].Current_Envelope_Sliding := 0;
PlVars[CurChip].ParamsOfChan[k].Current_Noise_Sliding := 0
end;
PlVars[CurChip].CurrentLine := 0
end;
procedure Pattern_SetCurrentLine(Line: Integer);
begin
PlVars[CurChip].CurrentLine := Line
end;
procedure Module_SetCurrentPattern(Pattern: Integer);
begin
PlVars[CurChip].CurrentPattern := Pattern;
Pattern_SetCurrentLine(0)
end;
procedure Module_SetCurrentPosition(Position: Integer);
begin
if VTM.Positions.Length = 0 then exit;
PlVars[CurChip].CurrentPosition := Position;
Module_SetCurrentPattern(VTM.Positions.Value[Position])
end;
function GetNoteFreq(t, j: integer): integer;
begin
case t of
0: Result := PT3NoteTable_PT[j];
1: Result := PT3NoteTable_ST[j];
2: Result := PT3NoteTable_ASM[j];
3: Result := PT3NoteTable_REAL[j];
else
Result := PT3NoteTable_NATURAL[j]
end
end;
function GetNoteByEnvelope2(nt: Integer; e: integer): integer;
var
NoteTable: PT3ToneTable;
n, i: Integer;
f: Real;
begin
case nt of
0: NoteTable := PT3NoteTable_PT;
1: NoteTable := PT3NoteTable_ST;
2: NoteTable := PT3NoteTable_ASM;
3: NoteTable := PT3NoteTable_REAL;
else
NoteTable := PT3NoteTable_NATURAL;
end;
Result := 0;
for i := 1 to 96 do
begin
f := (NoteTable[i] / 16);
n := Round(f);
if n = e then
begin
Result := i;
Exit;
end
end;
end;
function GetNoteByEnvelope(e: integer): integer;
var nt: Integer;
begin
{ try
nt:= VTM.Ton_Table;
except
on EAccessViolation do nt:= -1;
else
nt:= -1;
end;}
if VTM = nil then nt := -1
else nt := VTM.Ton_Table;
if nt = -1 then
begin
Result := 0;
Exit;
end;
Result := GetNoteByEnvelope2(nt, e);
end;
procedure Pattern_PlayOnlyCurrentLine;
var
TempMixer: integer;
procedure GetRegisters(ChNum: integer);
var
j: byte;
w: word;
gt, gn, ge: boolean;
begin
with PlVars[CurChip].ParamsOfChan[ChNum], VTM.IsChans[ChNum] do
begin
if SoundEnabled then
begin
if (VTM.Samples[Sample] = nil) or
(SamplePosition >= VTM.Samples[Sample].Length) then
Ton := 0
else
begin
Ton := Ton_Accumulator + VTM.Samples[Sample].Items[SamplePosition].Add_to_Ton;
if VTM.Samples[Sample].Items[SamplePosition].Ton_Accumulation then
Ton_Accumulator := Ton
end;
if (VTM.Ornaments[Ornament] = nil) or
(OrnamentPosition >= VTM.Ornaments[Ornament].Length) then
j := Note
else
j := Note + VTM.Ornaments[Ornament].Items[OrnamentPosition];
if shortint(j) < 0 then
j := 0
else if j > 95 then
j := 95;
w := GetNoteFreq(VTM.Ton_Table, j);
Ton := (Ton + Current_Ton_Sliding + w) and $FFF;
if Ton_Slide_Count > 0 then
begin
Dec(Ton_Slide_Count);
if Ton_Slide_Count = 0 then
begin
Inc(Current_Ton_Sliding, Ton_Slide_Step);
Ton_Slide_Count := Ton_Slide_Delay;
if Ton_Slide_Type = 1 then
if ((Ton_Slide_Step < 0) and (Current_Ton_Sliding <= Ton_Slide_Delta)) or
((Ton_Slide_Step >= 0) and (Current_Ton_Sliding >= Ton_Slide_Delta)) then
begin
Note := Slide_To_Note;
Ton_Slide_Count := 0;
Current_Ton_Sliding := 0
end
end
end;
if (VTM.Samples[Sample] = nil) or
(SamplePosition >= VTM.Samples[Sample].Length) then
Amplitude := 0
else
begin
Amplitude := VTM.Samples[Sample].Items[SamplePosition].Amplitude;
if VTM.Samples[Sample].Items[SamplePosition].Amplitude_Sliding then
if VTM.Samples[Sample].Items[SamplePosition].Amplitude_Slide_Up then
begin
if Current_Amplitude_Sliding < 15 then inc(Current_Amplitude_Sliding)
end
else
if Current_Amplitude_Sliding > -15 then dec(Current_Amplitude_Sliding);
inc(Amplitude, Current_Amplitude_Sliding);
if shortint(Amplitude) < 0 then Amplitude := 0
else if Amplitude > 15 then Amplitude := 15;
Amplitude := PT3_Vol[Volume, Amplitude];
if VTM.Samples[Sample].Items[SamplePosition].Envelope_Enabled and
EnvelopeEnabled then Amplitude := Amplitude or 16;
if not VTM.Samples[Sample].Items[SamplePosition].Mixer_Noise then
begin
j := Current_Envelope_Sliding +
VTM.Samples[Sample].Items[SamplePosition].Add_to_Envelope_or_Noise;
if VTM.Samples[Sample].Items[SamplePosition].
Envelope_or_Noise_Accumulation then
Current_Envelope_Sliding := j;
inc(PlVars[CurChip].AddToEnv, j)
end
else
begin
PlVars[CurChip].PT3Noise := Current_Noise_Sliding +
VTM.Samples[Sample].Items[SamplePosition].Add_to_Envelope_or_Noise;
if VTM.Samples[Sample].Items[SamplePosition].
Envelope_or_Noise_Accumulation then
Current_Noise_Sliding := PlVars[CurChip].PT3Noise
end;
if not VTM.Samples[Sample].Items[SamplePosition].Mixer_Ton then
TempMixer := TempMixer or 8;
if not VTM.Samples[Sample].Items[SamplePosition].Mixer_Noise then
TempMixer := TempMixer or $40;
end;
if VTM.Samples[Sample] <> nil then
begin
Inc(SamplePosition);
if SamplePosition >= VTM.Samples[Sample].Length then
SamplePosition := VTM.Samples[Sample].Loop
end;
if VTM.Ornaments[Ornament] <> nil then
begin
inc(OrnamentPosition);
if OrnamentPosition >= VTM.Ornaments[Ornament].Length then
OrnamentPosition := VTM.Ornaments[Ornament].Loop
end
end
else
Amplitude := 0;
TempMixer := TempMixer shr 1;
if Current_OnOff > 0 then
begin
Dec(Current_OnOff);
if Current_OnOff = 0 then
begin
SoundEnabled := not SoundEnabled;
if SoundEnabled then
Current_OnOff := OnOff_Delay
else
Current_OnOff := OffOn_Delay
end
end;
if PlVars[CurChip].CurrentPattern = -1 then exit;
gt := VTM.IsChans[ChNum].Global_Ton;
gn := VTM.IsChans[ChNum].Global_Noise;
ge := VTM.IsChans[ChNum].Global_Envelope;
if (VTM.Samples[Sample] <> nil) and not VTM.Samples[Sample].Enabled then
begin
gt := False;
gn := False;
ge := False;
end;
if not gt then TempMixer := TempMixer or 4;
if not gn then TempMixer := TempMixer or 32;
if not ge then Amplitude := Amplitude and 15;
if (not gt or not gn) and (Amplitude and 16 = 0) and (TempMixer and 36 = 36) then
Amplitude := 0;
end;
end;
var
k: integer;
begin
Inc(PlVars[CurChip].IntCnt);
PlVars[CurChip].AddToEnv := 0;
TempMixer := 0;
for k := 0 to 2 do
GetRegisters(k);
with SoundChip[CurChip] do
begin
SetMixerRegister(TempMixer);
AYRegisters.TonA := PlVars[CurChip].ParamsOfChan[0].Ton;
AYRegisters.TonB := PlVars[CurChip].ParamsOfChan[1].Ton;
AYRegisters.TonC := PlVars[CurChip].ParamsOfChan[2].Ton;
SetAmplA(PlVars[CurChip].ParamsOfChan[0].Amplitude);
SetAmplB(PlVars[CurChip].ParamsOfChan[1].Amplitude);
SetAmplC(PlVars[CurChip].ParamsOfChan[2].Amplitude);
AYRegisters.Noise := (PlVars[CurChip].PT3Noise + PlVars[CurChip].AddToNoise) and 31;
AYRegisters.Envelope := PlVars[CurChip].AddToEnv + PlVars[CurChip].Cur_Env_Slide + PlVars[CurChip].Env_Base;
end;
if PlVars[CurChip].Cur_Env_Delay > 0 then
begin
Dec(PlVars[CurChip].Cur_Env_Delay);
if PlVars[CurChip].Cur_Env_Delay = 0 then
begin
PlVars[CurChip].Cur_Env_Delay := PlVars[CurChip].Env_Delay;
Inc(PlVars[CurChip].Cur_Env_Slide, PlVars[CurChip].Env_Slide_Add)
end
end
end;
function Pattern_PlayCurrentLine: integer;
procedure PatternInterpreter(ChNum: integer);
var
TS, PrNote, Ch, Gls: integer;
begin
Ch := ChNum;
if PlVars[CurChip].CurrentPattern = -1 then Ch := MidChan;
with VTM.Patterns[PlVars[CurChip].CurrentPattern].Items[PlVars[CurChip].CurrentLine].Channel[ChNum] do
begin
TS := PlVars[CurChip].ParamsOfChan[Ch].Current_Ton_Sliding;
PrNote := PlVars[CurChip].ParamsOfChan[Ch].Note;
if Note = -2 then
begin
PlVars[CurChip].ParamsOfChan[Ch].SoundEnabled := False;
PlVars[CurChip].ParamsOfChan[Ch].Current_Envelope_Sliding := 0;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Count := 0;
PlVars[CurChip].ParamsOfChan[Ch].SamplePosition := 0;
PlVars[CurChip].ParamsOfChan[Ch].OrnamentPosition := 0;
PlVars[CurChip].ParamsOfChan[Ch].Current_Noise_Sliding := 0;
PlVars[CurChip].ParamsOfChan[Ch].Current_Amplitude_Sliding := 0;
PlVars[CurChip].ParamsOfChan[Ch].Current_OnOff := 0;
PlVars[CurChip].ParamsOfChan[Ch].Current_Ton_Sliding := 0;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Accumulator := 0
end
else if Note <> -1 then
begin
PlVars[CurChip].ParamsOfChan[Ch].SoundEnabled := True;
PlVars[CurChip].ParamsOfChan[Ch].Note := Note;
PlVars[CurChip].ParamsOfChan[Ch].Current_Envelope_Sliding := 0;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Count := 0;
PlVars[CurChip].ParamsOfChan[Ch].SamplePosition := 0;
PlVars[CurChip].ParamsOfChan[Ch].OrnamentPosition := 0;
PlVars[CurChip].ParamsOfChan[Ch].Current_Noise_Sliding := 0;
PlVars[CurChip].ParamsOfChan[Ch].Current_Amplitude_Sliding := 0;
PlVars[CurChip].ParamsOfChan[Ch].Current_OnOff := 0;
PlVars[CurChip].ParamsOfChan[Ch].Current_Ton_Sliding := 0;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Accumulator := 0
end;
if (Note <> -1) and (Sample <> 0) then
VTM.IsChans[Ch].Sample := Sample;
if not (Envelope in [0, 15]) then
begin
VTM.IsChans[Ch].EnvelopeEnabled := True;
PlVars[CurChip].Env_Base := VTM.Patterns[PlVars[CurChip].CurrentPattern].Items[PlVars[CurChip].CurrentLine].Envelope;
SoundChip[CurChip].SetEnvelopeRegister(Envelope);
VTM.IsChans[Ch].Ornament := Ornament;
PlVars[CurChip].ParamsOfChan[Ch].OrnamentPosition := 0;
PlVars[CurChip].Cur_Env_Slide := 0;
PlVars[CurChip].Cur_Env_Delay := 0
end
else if Envelope = 15 then
begin
VTM.IsChans[Ch].EnvelopeEnabled := False;
VTM.IsChans[Ch].Ornament := Ornament;
PlVars[CurChip].ParamsOfChan[Ch].OrnamentPosition := 0
end
else if Ornament <> 0 then
begin
VTM.IsChans[Ch].Ornament := Ornament;
PlVars[CurChip].ParamsOfChan[Ch].OrnamentPosition := 0
end;
if Volume > 0 then VTM.IsChans[Ch].Volume := Volume;
case Additional_Command.Number of
1:
begin
Gls := Additional_Command.Delay;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Delay := Gls;
if (Gls = 0) and (VTM.FeaturesLevel >= 2) then Inc(Gls);
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Count := Gls;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Step := Additional_Command.Parameter;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Type := 0;
PlVars[CurChip].ParamsOfChan[Ch].Current_OnOff := 0;
end;
2:
begin
Gls := Additional_Command.Delay;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Delay := Gls;
if (Gls = 0) and (VTM.FeaturesLevel >= 2) then Inc(Gls);
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Count := Gls;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Step := -Additional_Command.Parameter;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Type := 0;
PlVars[CurChip].ParamsOfChan[Ch].Current_OnOff := 0;
end;
3:
if (Note >= 0) or ((Note <> -2) and (VTM.FeaturesLevel >= 1)) then
begin
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Delay := Additional_Command.Delay;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Count := PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Delay;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Step := Additional_Command.Parameter;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Delta :=
GetNoteFreq(VTM.Ton_Table, PlVars[CurChip].ParamsOfChan[Ch].Note) -
GetNoteFreq(VTM.Ton_Table, PrNote);
PlVars[CurChip].ParamsOfChan[Ch].Slide_To_Note := PlVars[CurChip].ParamsOfChan[Ch].Note;
PlVars[CurChip].ParamsOfChan[Ch].Note := PrNote;
if VTM.FeaturesLevel >= 1 then
PlVars[CurChip].ParamsOfChan[Ch].Current_Ton_Sliding := TS;
if PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Delta -
PlVars[CurChip].ParamsOfChan[Ch].Current_Ton_Sliding < 0 then
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Step :=
-PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Step;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Type := 1;
PlVars[CurChip].ParamsOfChan[Ch].Current_OnOff := 0
end;
4: PlVars[CurChip].ParamsOfChan[Ch].SamplePosition := Additional_Command.Parameter;
5: PlVars[CurChip].ParamsOfChan[Ch].OrnamentPosition := Additional_Command.Parameter;
6:
begin
PlVars[CurChip].ParamsOfChan[Ch].OffOn_Delay := Additional_Command.Parameter and 15;
PlVars[CurChip].ParamsOfChan[Ch].OnOff_Delay := Additional_Command.Parameter shr 4;
PlVars[CurChip].ParamsOfChan[Ch].Current_OnOff := PlVars[CurChip].ParamsOfChan[Ch].OnOff_Delay;
PlVars[CurChip].ParamsOfChan[Ch].Ton_Slide_Count := 0;
PlVars[CurChip].ParamsOfChan[Ch].Current_Ton_Sliding := 0
end;
9:
begin
PlVars[CurChip].Env_Delay := Additional_Command.Delay;
PlVars[CurChip].Cur_Env_Delay := PlVars[CurChip].Env_Delay;
PlVars[CurChip].Env_Slide_Add := Additional_Command.Parameter
end;
10:
begin
PlVars[CurChip].Env_Delay := Additional_Command.Delay;
PlVars[CurChip].Cur_Env_Delay := PlVars[CurChip].Env_Delay;
PlVars[CurChip].Env_Slide_Add := -Additional_Command.Parameter
end;
11: if Additional_Command.Parameter <> 0 then
PlVars[CurChip].Delay := Additional_Command.Parameter
end
end
end;
var
k: integer;
begin
Result := 0;
if PlVars[CurChip].CurrentPattern = -1 then
begin
PlVars[CurChip].AddToNoise := VTM.Patterns[-1].Items[PlVars[CurChip].CurrentLine].Noise;
PatternInterpreter(0)
end
else
begin
Dec(PlVars[CurChip].DelayCounter);
if PlVars[CurChip].DelayCounter = 0 then
begin
Inc(Result);
if VTM.Patterns[PlVars[CurChip].CurrentPattern].Length <= PlVars[CurChip].CurrentLine then
begin
Inc(PlVars[CurChip].DelayCounter);
Inc(Result);
exit
end;
PlVars[CurChip].AddToNoise := VTM.Patterns[PlVars[CurChip].CurrentPattern].Items[PlVars[CurChip].CurrentLine].Noise;
for k := 0 to 2 do
PatternInterpreter(k);
Inc(PlVars[CurChip].CurrentLine);
PlVars[CurChip].DelayCounter := PlVars[CurChip].Delay
end
end;
Pattern_PlayOnlyCurrentLine
end;
function Module_PlayCurrentLine: Integer;
begin
if VTM.Positions.Length = 0 then
begin
Result := 3;
exit;
end;
Result := Pattern_PlayCurrentLine;
if Result = 2 then
begin
inc(PlVars[CurChip].CurrentPosition);
if PlVars[CurChip].CurrentPosition >= VTM.Positions.Length then
begin
PlVars[CurChip].CurrentPosition := VTM.Positions.Loop;
inc(Result)
end;
PlVars[CurChip].CurrentPattern := VTM.Positions.Value[PlVars[CurChip].CurrentPosition];
PlVars[CurChip].CurrentLine := 0;
Pattern_PlayCurrentLine
end
end;
function GetString(var st: string): boolean;
begin
st := '';
repeat
Result := not eof(TxtFile);
if Result then
begin
Readln(TxtFile, st);
inc(TxtLine)
end;
st := Trim(st);
until (not Result) or (st <> '')
end;
function RecognizeOrnamentString;
var
lp, l, i, j, sl: integer;
begin
Result := False;
lp := 0;
l := 0;
i := 1;
sl := Length(orst);
repeat
while (i <= sl) and not (orst[i] in ['0'..'9', '-', '+', 'L']) do Inc(i);
if i <= sl then
if orst[i] = 'L' then
begin
lp := l;
Inc(i)
end
else
begin
j := i;
repeat
Inc(i)
until (i > sl) or not (orst[i] in ['0'..'9']);
try
Orn.Items[l] := StrToInt(Copy(orst, j, i - j))
except
exit
end;
Inc(l)
end
until (i > sl) or (l >= MaxOrnLen);
Result := l <> 0;
if Result then
begin
Orn.Length := l;
Orn.Loop := lp;
for i := l to MaxOrnLen - 1 do
Orn.Items[i] := 0;
end;
end;
procedure ValidateSample;
var
i: integer;
begin
if VTM.Samples[sam] = nil then
begin
New(VTM.Samples[sam]);
VTM.Samples[sam].Loop := 0;
VTM.Samples[sam].Length := 1;
VTM.Samples[sam].Enabled := True;
VTM.Samples[sam].Items[0].Add_to_Ton := 0;
VTM.Samples[sam].Items[0].Ton_Accumulation := False;
VTM.Samples[sam].Items[0].Amplitude := 0;
VTM.Samples[sam].Items[0].Amplitude_Sliding := False;
VTM.Samples[sam].Items[0].Amplitude_Slide_Up := False;
VTM.Samples[sam].Items[0].Envelope_Enabled := False;
VTM.Samples[sam].Items[0].Envelope_or_Noise_Accumulation := False;
VTM.Samples[sam].Items[0].Add_to_Envelope_or_Noise := 0;
VTM.Samples[sam].Items[0].Mixer_Ton := False;
VTM.Samples[sam].Items[0].Mixer_Noise := False;
for i := 1 to MaxSamLen - 1 do
VTM.Samples[sam].Items[i] := MainForm.SampleLineTemplates[MainForm.CurrentSampleLineTemplate];
end;
end;
function LoadSampleDataTxt;
var
s: string;
i, sg, nm, lp, len: integer;
function GetNum: boolean;
begin
Result := False;
while (i <= Length(s)) and not (s[i] in ['+', '-', '0'..'9', 'A'..'F', 'a'..'f']) do Inc(i);
if i > Length(s) then exit;
sg := 1;
if s[i] in ['+', '-'] then
begin
if s[i] = '-' then sg := -1;
Inc(i)
end;
nm := 0;
while (i <= Length(s)) and (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) do
begin
if s[i] in ['0'..'9'] then
nm := nm * 16 + Ord(s[i]) - Ord('0')
else
nm := nm * 16 + (Ord(s[i]) or $20) - Ord('a') + 10;
Inc(i);
end;
nm := nm * sg;
Result := True
end;
function RecognizeSampleString: boolean;
begin
Result := False;
s := Trim(s);
if s = '' then exit;
Result := True;
i := 1;
Sam.Items[len] := EmptySampleTick;
while (i <= Length(s)) and not (s[i] in ['t', 'T']) do Inc(i);
if i > Length(s) then exit;
Sam.Items[len].Mixer_Ton := s[i] = 'T';
Inc(i);
while (i <= Length(s)) and not (s[i] in ['n', 'N']) do Inc(i);
if i > Length(s) then exit;
Sam.Items[len].Mixer_Noise := s[i] = 'N';
Inc(i);
while (i <= Length(s)) and not (s[i] in ['e', 'E']) do Inc(i);
if i > Length(s) then exit;
Sam.Items[len].Envelope_Enabled := s[i] = 'E';
Inc(i);
if not GetNum then exit;
Sam.Items[len].Add_to_Ton := nm;
while (i <= Length(s)) and not (s[i] in ['_', '^']) do Inc(i);
if i > Length(s) then exit;
Sam.Items[len].Ton_Accumulation := s[i] = '^';
Inc(i);
if not GetNum then exit;
Sam.Items[len].Add_to_Envelope_or_Noise := nm and $1F;
if Sam.Items[len].Add_to_Envelope_or_Noise and $10 <> 0 then
Sam.Items[len].Add_to_Envelope_or_Noise :=
Sam.Items[len].Add_to_Envelope_or_Noise or shortint($F0);
while (i <= Length(s)) and not (s[i] in ['_', '^']) do Inc(i);
if i > Length(s) then exit;
Sam.Items[len].Envelope_or_Noise_Accumulation := s[i] = '^';
Inc(i);
if not GetNum then exit;
Sam.Items[len].Amplitude := nm and 15;
while (i <= Length(s)) and not (s[i] in ['_', '+', '-']) do Inc(i);
if i > Length(s) then exit;
if s[i] in ['+', '-'] then
begin
Sam.Items[len].Amplitude_Sliding := True;
Sam.Items[len].Amplitude_Slide_Up := s[i] = '+'
end;
Inc(i);
while (i <= Length(s)) and not (s[i] in ['l', 'L']) do Inc(i);
if i > Length(s) then exit;
lp := len
end;
begin
Result := '';
len := 0;
lp := 0;
while GetString(s) do
begin
if s[1] = '[' then break;
if not RecognizeSampleString then
begin
Result := 'Bad file structure';
exit
end;
Inc(len);
if len = MaxSamLen then break;
end;
if len = 0 then
begin
Result := 'Error: empty sample';
exit;
end
else
begin
TxtString := s;
Sam.Loop := lp;
Sam.Length := len;
Sam.Enabled := True;
for len := len to MaxSamLen - 1 do
Sam.Items[len] := EmptySampleTick;
end;
end;
procedure NewPattern(var Pat: PPattern);
var
i: integer;
begin
New(Pat);
for i := 0 to MaxPatLen - 1 do
with Pat.Items[i] do
begin
Envelope := 0;
Noise := 0;
Channel[0] := EmptyChannelLine;
Channel[1] := EmptyChannelLine;
Channel[2] := EmptyChannelLine;
end;
Pat.Length := DefPatLen;
end;
procedure ValidatePattern;
begin
if VTM.Patterns[pat] = nil then
NewPattern(VTM.Patterns[pat]);
end;
function SGetNumber(s: string; max: integer; var res: integer): boolean;
var
i: integer;
begin
Result := False;
res := 0;
for i := 1 to Length(s) do
begin
if s[i] = '.' then s[i] := '0';
s := UpperCase(s);
case s[i] of
'0'..'9': res := res * 16 + Ord(s[i]) - Ord('0');
'A'..'V': res := res * 16 + Ord(s[i]) - Ord('A') + 10
else exit
end
end;
if res > max then exit;
Result := True
end;
function SGetNote(s: string; var res: integer): boolean;
var
d, o, n: integer;
begin
s := UpperCase(s);
Result := True;
res := -2;
if s = 'R--' then exit;
inc(res);
if s = '---' then exit;
Result := False;
d := 0;
if s[2] = '#' then d := 1
else if s[2] <> '-' then exit;
o := Ord(s[3]) - Ord('1');
if not (o in [0..7]) then exit;
case s[1] of
'C': n := 0;
'D': n := 2;
'E': n := 4;
'F': n := 5;
'G': n := 7;
'A': n := 9;
'B': n := 11
else exit
end;
res := n + d + o * 12;
if res > 95 then exit;
Result := True
end;
function LoadPatternDataTxt;
var
s: string;
len: integer;
function RecognizePatternString: boolean;
var
i, j: integer;
sti: string;
begin
Result := False;
if (Length(s) <> 49) and (Length(s) <> 48) then exit;
if SGetNumber(Copy(s, 1, 4), 65535, i) then
begin
OnePat.Items[len].Envelope := i;
end
else if SGetNote(Copy(s, 1, 3), i) then
begin
OnePat.Items[len].Envelope := round(GetNoteFreq(MainForm.Tone_Table_On_Load, i) / 16);
s := ' ' + s;
end
else Exit;
if not SGetNumber(Copy(s, 6, 2), 31, i) then exit;
OnePat.Items[len].Noise := i;
for i := 0 to 2 do
begin
if not SGetNote(Copy(s, 9 + i * 14, 3), j) then exit;
OnePat.Items[len].Channel[i].Note := j;
if not SGetNumber(Copy(s, 13 + i * 14, 1), 31, j) then exit;
OnePat.Items[len].Channel[i].Sample := j;
if not SGetNumber(Copy(s, 14 + i * 14, 1), 15, j) then exit;
OnePat.Items[len].Channel[i].Envelope := j;
if not SGetNumber(Copy(s, 15 + i * 14, 1), 15, j) then exit;
OnePat.Items[len].Channel[i].Ornament := j;
if not SGetNumber(Copy(s, 16 + i * 14, 1), 15, j) then exit;
OnePat.Items[len].Channel[i].Volume := j;
if not SGetNumber(Copy(s, 18 + i * 14, 1), 15, j) then exit;
OnePat.Items[len].Channel[i].Additional_Command.Number := j;
if not SGetNumber(Copy(s, 19 + i * 14, 1), 15, j) then exit;
OnePat.Items[len].Channel[i].Additional_Command.Delay := j;
if not SGetNumber(Copy(s, 20 + i * 14, 2), 255, j) then exit;
OnePat.Items[len].Channel[i].Additional_Command.Parameter := j
end;
Result := True
end;
begin
Result := 0;
len := 0;
while GetString(s) do
begin
if s[1] = '[' then break;
if not RecognizePatternString then
begin
Result := 6;
exit
end;
Inc(len);
if Len = MaxPatLen then break
end;
if len = 0 then
begin
Result := 6;
exit
end
else
begin
TxtString := s;
OnePat.Length := len;
for len := len to MaxPatLen - 1 do
begin
OnePat.Items[len].Noise := 0;
OnePat.Items[len].Envelope := 0;
OnePat.Items[len].Channel[0] := EmptyChannelLine;
OnePat.Items[len].Channel[1] := EmptyChannelLine;
OnePat.Items[len].Channel[2] := EmptyChannelLine;
end;
end
end;
function LoadModuleFromText;
var
s, s1: string;
i, j, er, lp: integer;
Pat: PPattern;
Orn: POrnament;
Sam: PSample;
procedure LoadTxtMod(VTM: PModule);
begin
while GetString(s) do
begin
if s[1] = '[' then break;
i := Pos('=', s);
if i < 2 then
begin
Result := 2;
exit
end;
s1 := UpperCase(TrimRight(Copy(s, 1, i - 1)));
if s1 = 'VORTEXTRACKERII' then
begin
if i = Length(s) then
s1 := ''
else
s1 := TrimLeft(Copy(s, i + 1, Length(s) - i));
if s1 = '' then
begin
Result := 2;
exit
end;
VTM.VortexModule_Header := s1 <> '0'
end
else if s1 = 'VERSION' then
begin
if i = Length(s) then
s1 := ''
else
s1 := TrimLeft(Copy(s, i + 1, Length(s) - i));
if s1 = '' then
begin
Result := 2;
exit
end;
if s1 = '3.5' then
VTM.FeaturesLevel := 0
else if s1 = '3.7' then
VTM.FeaturesLevel := 2
else
VTM.FeaturesLevel := 1;
end
else if s1 = 'TITLE' then
begin
if i = Length(s) then
s1 := ''
else
s1 := TrimLeft(Copy(s, i + 1, Length(s) - i));
if Length(s1) > 32 then SetLength(s, 32);
VTM.Title := s1
end
else if s1 = 'AUTHOR' then
begin
if i = Length(s) then
s1 := ''
else
s1 := TrimLeft(Copy(s, i + 1, Length(s) - i));
if Length(s1) > 32 then SetLength(s, 32);
VTM.Author := s1
end
else if s1 = 'NOTETABLE' then
begin
if i = Length(s) then
s1 := ''
else
s1 := TrimLeft(Copy(s, i + 1, Length(s) - i));
Val(s1, i, er);
if er <> 0 then
begin
Result := 2;
exit
end;
if not (i in [0..4]) then
begin
Result := 3;
exit
end;
VTM.Ton_Table := i;
MainForm.Tone_Table_On_Load := VTM.Ton_Table;
end
else if s1 = 'CHIPFREQ' then
begin
if i = Length(s) then
s1 := ''
else
s1 := TrimLeft(Copy(s, i + 1, Length(s) - i));
if Length(s1) > 10 then SetLength(s, 10);
SetAYFreq(StrToInt(s1));
end
else if s1 = 'SPEED' then
begin
if i = Length(s) then
s1 := ''
else
s1 := TrimLeft(Copy(s, i + 1, Length(s) - i));
Val(s1, i, er);
if er <> 0 then
begin
Result := 2;
exit
end;
if not (i in [1..255]) then
begin
Result := 3;
exit
end;
VTM.Initial_Delay := i
end
else if s1 = 'PLAYORDER' then
begin
if i = Length(s) then
s1 := ''
else
s1 := TrimLeft(Copy(s, i + 1, Length(s) - i));
if s1 <> '' then
begin
VTM.Positions.Loop := 0;
s1 := s1 + ',';
repeat
i := Pos(',', s1);
if i < 2 then
begin
Result := 2;
exit
end;
s := TrimRight(Copy(s1, 1, i - 1));
Val(s, j, er);
lp := 0;
if er <> 0 then
if (s <> '') and (UpperCase(s[1]) = 'L') then
begin
lp := 1;
s[1] := ' ';
Val(TrimLeft(s), j, er);
end;
if er <> 0 then
begin
Result := 2;
exit
end;
if (not (j in [0..MaxPatNum])) or (VTM.Positions.Length > 255) then
begin
Result := 3;
exit
end;
if lp <> 0 then VTM.Positions.Loop := VTM.Positions.Length;
VTM.Positions.Value[VTM.Positions.Length] := j;
inc(VTM.Positions.Length);
if i = Length(s1) then break;
s1 := TrimLeft(Copy(s1, i + 1, Length(s1) - i));
until False;
end;
end
end;
TxtString := s;
repeat
if (Length(TxtString) > Length('[ORNAMENT')) and
(UpperCase(Copy(TxtString, 1, Length('[ORNAMENT'))) = '[ORNAMENT') then
begin
s := Copy(TxtString, Length('[ORNAMENT') + 1, Length(TxtString) - Length('[ORNAMENT'));
if s[Length(s)] <> ']' then
begin
Result := 2;
exit
end;
s[Length(s)] := ' ';
s := Trim(s);
Val(s, i, er);
if er <> 0 then
begin
Result := 2;
exit
end;
if not (i in [1..15]) then
begin
Result := 3;
exit
end;
if not GetString(s1) then
begin
Result := 4;
exit
end;
New(Orn);
if not RecognizeOrnamentString(s1, Orn) then
begin
Result := 2;
Dispose(Orn);
exit
end;
VTM.Ornaments[i] := Orn;
if not GetString(TxtString) then exit
end
else if (Length(TxtString) > Length('[SAMPLE')) and
(UpperCase(Copy(TxtString, 1, Length('[SAMPLE'))) = '[SAMPLE') then
begin
s := Copy(TxtString, Length('[SAMPLE') + 1, Length(TxtString) - Length('[SAMPLE'));
if s[Length(s)] <> ']' then
begin
Result := 2;
exit
end;
s[Length(s)] := ' ';
s := Trim(s);
Val(s, i, er);
if er <> 0 then
begin
Result := 2;
exit
end;
if not (i in [1..31]) then
begin
Result := 3;
exit
end;
New(Sam);
s := LoadSampleDataTxt(Sam);
if s <> '' then
begin
Dispose(Sam);
Result := 5;
exit;
end;
VTM.Samples[i] := Sam;
end
else if (Length(TxtString) > Length('[PATTERN')) and
(UpperCase(Copy(TxtString, 1, Length('[PATTERN'))) = '[PATTERN') then
begin
s := Copy(TxtString, Length('[PATTERN') + 1, Length(TxtString) - Length('[PATTERN'));
if s[Length(s)] <> ']' then
begin
Result := 2;
exit
end;
s[Length(s)] := ' ';
s := Trim(s);
Val(s, i, er);
if er <> 0 then
begin
Result := 2;
exit
end;
if not (i in [0..MaxPatNum]) then
begin
Result := 3;
exit
end;
New(Pat);
Result := LoadPatternDataTxt(Pat);
if Result <> 0 then
begin
Dispose(Pat);
exit;
end;
VTM.Patterns[i] := Pat;
end
else if not GetString(TxtString) then break
until (TxtString = '') or (UpperCase(TxtString) = '[MODULE]');
end;
begin
Result := 0;
AssignFile(TxtFile, FN);
Reset(TxtFile);
TxtLine := 0;
VTM2 := nil;
try
if not GetString(s) or (UpperCase(s) <> '[MODULE]') then
begin
Result := 1;
exit
end;
LoadTxtMod(VTM1);
if (TxtString = '') or (Result <> 0) then exit;
NewVTMP(VTM2);
LoadTxtMod(VTM2);
if Result <> 0 then FreeVTMP(VTM2);
finally
CloseFile(TxtFile);
end;
end;
function PT32VTM;
var
ChPtr: packed array[0..2] of word;
Skip: array[0..2] of byte;
SkipCounter: array[0..2] of byte;
PrevOrn: array[0..2] of byte;
NsBase: integer;
TS: integer;
procedure PatternInterpreter(VTM: PModule; PatNum, LnNum, ChNum: integer);
var
quit: boolean;
tmp: smallint;
begin
quit := False;
repeat
case PT3.Index[ChPtr[ChNum]] of
$F0..$FF: begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15;
PrevOrn[ChNum] := PT3.Index[ChPtr[ChNum]] - $F0;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament :=
PrevOrn[ChNum];
Inc(ChPtr[ChNum]);
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Sample :=
PT3.Index[ChPtr[ChNum]] div 2
end;
$D1..$EF:
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Sample :=
PT3.Index[ChPtr[ChNum]] - $D0;
$D0: begin
quit := true;
end;
$C1..$CF: VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Volume := PT3.Index[ChPtr[ChNum]] - $C0;
$C0: begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Note := -2;
quit := true;
end;
$B2..$BF: begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := PT3.Index[ChPtr[ChNum]] - $B1;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := PrevOrn[ChNum];
Inc(ChPtr[ChNum]);
VTM.Patterns[PatNum].Items[LnNum].Envelope := word(PT3.Index[ChPtr[ChNum]]) shl 8;
Inc(ChPtr[ChNum]);
Inc(VTM.Patterns[PatNum].Items[LnNum].Envelope, PT3.Index[ChPtr[ChNum]])
end;
$B1: begin
inc(ChPtr[ChNum]);
Skip[ChNum] := PT3.Index[ChPtr[ChNum]];
end;
$B0: begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := PrevOrn[ChNum]
end;
$50..$AF: begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Note :=
PT3.Index[ChPtr[ChNum]] - $50;
quit := True;
end;
$40..$4F:
begin
if PT3.Index[ChPtr[ChNum]] = $40 then // only for Orn #0 rom pt3.69
if VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope = 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15;
PrevOrn[ChNum] := PT3.Index[ChPtr[ChNum]] - $40;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := PrevOrn[ChNum]
end;
$20..$3F: NsBase := PT3.Index[ChPtr[ChNum]] - $20;
$10..$1F: begin
if PT3.Index[ChPtr[ChNum]] = $10 then
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15
else
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := PT3.Index[ChPtr[ChNum]] - $10;
inc(ChPtr[ChNum]);
VTM.Patterns[PatNum].Items[LnNum].Envelope := word(PT3.Index[ChPtr[ChNum]]) shl 8;
inc(ChPtr[ChNum]);
inc(VTM.Patterns[PatNum].Items[LnNum].Envelope, PT3.Index[ChPtr[ChNum]]);
end;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := PrevOrn[ChNum];
Inc(ChPtr[ChNum]);
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Sample :=
PT3.Index[ChPtr[ChNum]] div 2;
end;
$8..$9: VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Number := PT3.Index[ChPtr[ChNum]];
$1..$5: VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Number := PT3.Index[ChPtr[ChNum]];
end;
inc(ChPtr[ChNum]);
until quit;
case VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Number of
1: begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Delay := PT3.Index[ChPtr[ChNum]];
inc(ChPtr[ChNum]);
move(PT3.Index[ChPtr[ChNum]], Tmp, 2);
if Tmp < 0 then
begin
inc(VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Number);
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Parameter := -Tmp;
end
else
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Parameter := Tmp;
inc(ChPtr[ChNum], 2);
end;
2: begin
inc(VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Number);
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Delay := PT3.Index[ChPtr[ChNum]];
inc(ChPtr[ChNum], 3);
move(PT3.Index[ChPtr[ChNum]], Tmp, 2);
if Tmp < 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Parameter := -Tmp
else
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Parameter := Tmp;
inc(ChPtr[ChNum], 2);
end;
3, 4: begin
inc(VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Number);
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Parameter := PT3.Index[ChPtr[ChNum]];
inc(ChPtr[ChNum]);
end;
5: begin
inc(VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Number);
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Parameter :=
PT3.Index[ChPtr[ChNum]] shl 4;
inc(ChPtr[ChNum]);
inc(VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Parameter,
PT3.Index[ChPtr[ChNum]]);
inc(ChPtr[ChNum]);
end;
8: begin
inc(VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Number);
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Delay := PT3.Index[ChPtr[ChNum]];
inc(ChPtr[ChNum]);
move(PT3.Index[ChPtr[ChNum]], Tmp, 2);
if Tmp < 0 then
begin
inc(VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Number);
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Parameter := -Tmp;
end
else
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Parameter := Tmp;
inc(ChPtr[ChNum], 2);
end;
9: begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Number := $B;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Additional_Command.Parameter := PT3.Index[ChPtr[ChNum]];
inc(ChPtr[ChNum]);
end;
end;
SkipCounter[ChNum] := Skip[ChNum]
end;
procedure DecodePattern(VTM: PModule; j, jj: integer);
var
i, k: integer;
quit: boolean;
begin
if VTM.Patterns[j] = nil then
begin
NewPattern(VTM.Patterns[j]);
for k := 0 to 2 do
begin
PrevOrn[k] := 0;
SkipCounter[k] := 1;
Skip[k] := 1
end;
move(PT3.Index[PT3.PT3_PatternsPointer + jj * 6], ChPtr, 6);
NsBase := 0; i := 0; quit := False;
while (i < MaxPatLen) and not quit do
begin
for k := 0 to 2 do
begin
dec(SkipCounter[k]);
if SkipCounter[k] = 0 then
begin
if (k = 0) and (PT3.Index[ChPtr[0]] = 0) then
begin
Dec(i);
quit := True;
break
end;
PatternInterpreter(VTM, j, i, k)
end
end;
VTM.Patterns[j].Items[i].Noise := NsBase;
inc(i);
end;
VTM.Patterns[j].Length := i;
end;
end;
function FoundPT36TS: boolean;
var
j1, j2, k, Pos: Integer;
begin
Result := False;
if PT3.PT3_Name[13] <> '6' then exit;
Pos := 0;
while (Pos < 256) and (PT3.Index[Pos + $C9] <> 255) do
begin
j1 := PT3.Index[Pos + $C9] div 3;
if j1 < $30 / 2 then exit;
j2 := $30 - j1 - 1;
move(PT3.Index[PT3.PT3_PatternsPointer + j2 * 6], ChPtr, 6);
for k := 0 to 2 do
if (ChPtr[k] < 100) or (ChPtr[k] >= FSize - 4) then exit;
Inc(Pos);
end;
if MessageDlg('This PT 3.6 module can contain Turbo Sound data. Try to import?',
mtConfirmation, [mbYes, mbNo], 0) <> mrYes then exit;
TS := $30;
Result := True;
end;
var
i, j, k, kk, Pos: Integer;
tset: boolean;
begin
Result := True;
if DetectFeaturesLevel then
begin
if StrLComp(@PT3.PT3_Name, 'ProTracker 3.', 13) = 0 then
case Ord(PT3.PT3_Name[13]) of
$30..$35: VTM1.FeaturesLevel := 0;
$37..$39: VTM1.FeaturesLevel := 2;
else VTM1.FeaturesLevel := 1;
end
else if StrLComp(@PT3.PT3_Name, 'Vortex Tracker II', 17) = 0 then
VTM1.FeaturesLevel := 1
else
VTM1.FeaturesLevel := 0;
end;
if DetectModuleHeader then
VTM1.VortexModule_Header := StrLComp(@PT3.PT3_Name, 'ProTracker 3.', 13) <> 0;
SetLength(VTM1.Title, 32);
Move(PT3.PT3_Name[$1E], VTM1.Title[1], 32);
VTM1.Title := TrimRight(VTM1.Title);
SetLength(VTM1.Author, 32);
Move(PT3.PT3_Name[$42], VTM1.Author[1], 32);
VTM1.Author := TrimRight(VTM1.Author);
VTM1.Ton_Table := PT3.PT3_Table;
VTM1.Initial_Delay := PT3.PT3_Delay;
VTM1.Positions.Loop := PT3.PT3_LoopPosition;
for i := 0 to 255 do
VTM1.Positions.Value[i] := 0;
VTM1.Ornaments[0] := nil;
for i := 1 to 15 do
begin
if PT3.PT3_OrnamentPointers[i] = 0 then
VTM1.Ornaments[i] := nil
else
begin
New(VTM1.Ornaments[i]);
VTM1.Ornaments[i].Loop := PT3.Index[PT3.PT3_OrnamentPointers[i]];
VTM1.Ornaments[i].Length := PT3.Index[PT3.PT3_OrnamentPointers[i] + 1];
for j := 0 to VTM1.Ornaments[i].Length - 1 do
VTM1.Ornaments[i].Items[j] := PT3.Index[PT3.PT3_OrnamentPointers[i] + 2 + j];
end;
end;
for i := 1 to 31 do
begin
if PT3.PT3_SamplePointers[i] = 0 then
VTM1.Samples[i] := nil
else
begin
New(VTM1.Samples[i]);
VTM1.Samples[i].Loop := PT3.Index[PT3.PT3_SamplePointers[i]];
VTM1.Samples[i].Length := PT3.Index[PT3.PT3_SamplePointers[i] + 1];
for j := 0 to VTM1.Samples[i].Length - 1 do
begin
VTM1.Samples[i].Items[j].Add_to_Ton :=
WordPtr(@PT3.Index[PT3.PT3_SamplePointers[i] + j * 4 + 4])^;
VTM1.Samples[i].Items[j].Ton_Accumulation :=
PT3.Index[PT3.PT3_SamplePointers[i] + j * 4 + 3] and $40 <> 0;
VTM1.Samples[i].Items[j].Amplitude :=
PT3.Index[PT3.PT3_SamplePointers[i] + j * 4 + 3] and $F;
VTM1.Samples[i].Items[j].Amplitude_Sliding :=
PT3.Index[PT3.PT3_SamplePointers[i] + j * 4 + 2] and $80 <> 0;
VTM1.Samples[i].Items[j].Amplitude_Slide_Up :=
PT3.Index[PT3.PT3_SamplePointers[i] + j * 4 + 2] and $40 <> 0;
VTM1.Samples[i].Items[j].Envelope_Enabled :=
PT3.Index[PT3.PT3_SamplePointers[i] + j * 4 + 2] and 1 = 0;
VTM1.Samples[i].Items[j].Envelope_or_Noise_Accumulation :=
PT3.Index[PT3.PT3_SamplePointers[i] + j * 4 + 3] and $20 <> 0;
VTM1.Samples[i].Items[j].Add_to_Envelope_or_Noise :=
PT3.Index[PT3.PT3_SamplePointers[i] + j * 4 + 2] shr 1;
if VTM1.Samples[i].Items[j].Add_to_Envelope_or_Noise and $10 <> 0 then
VTM1.Samples[i].Items[j].Add_to_Envelope_or_Noise :=
VTM1.Samples[i].Items[j].Add_to_Envelope_or_Noise or shortint($F0)
else
VTM1.Samples[i].Items[j].Add_to_Envelope_or_Noise :=
VTM1.Samples[i].Items[j].Add_to_Envelope_or_Noise and 15;
VTM1.Samples[i].Items[j].Mixer_Ton :=
PT3.Index[PT3.PT3_SamplePointers[i] + j * 4 + 3] and $10 = 0;
VTM1.Samples[i].Items[j].Mixer_Noise :=
PT3.Index[PT3.PT3_SamplePointers[i] + j * 4 + 3] and $80 = 0
end
end
end;
for i := 0 to MaxPatNum do
VTM1.Patterns[i] := nil;
VTM2 := nil; TS := Byte(PT3.PT3_Name[98]);
if ((TS <> $20) and (PT3.PT3_Name[13] in ['7'..'9'])) or FoundPT36TS then
begin
New(VTM2);
VTM2^ := VTM1^;
New(VTM2.Patterns[-1]);
VTM2.Patterns[-1]^ := VTM1.Patterns[-1]^;
for i := 1 to 15 do
if VTM1.Ornaments[i] <> nil then
begin
New(VTM2.Ornaments[i]);
VTM2.Ornaments[i]^ := VTM1.Ornaments[i]^;
end;
for i := 1 to 31 do
if VTM1.Samples[i] <> nil then
begin
New(VTM2.Samples[i]);
VTM2.Samples[i]^ := VTM1.Samples[i]^;
end;
end;
Pos := 0;
while (Pos < 256) and (PT3.Index[Pos + $C9] <> 255) do
begin
j := PT3.Index[Pos + $C9] div 3;
if VTM2 <> nil then
begin
j := TS - j - 1;
VTM2.Positions.Value[Pos] := j;
end;
VTM1.Positions.Value[Pos] := j;
Inc(Pos);
if VTM2 <> nil then
begin
DecodePattern(VTM2, j, j);
DecodePattern(VTM1, j, TS - j - 1);
for i := 0 to MaxPatLen - 1 do
begin
tset := False;
for k := 2 downto 0 do
if VTM2.Patterns[j].Items[i].Channel[k].Additional_Command.Number = 11 then
begin
for kk := 2 downto 0 do
if VTM1.Patterns[j].Items[i].Channel[kk].Additional_Command.Number in [0, 11] then
begin
VTM1.Patterns[j].Items[i].Channel[kk].Additional_Command :=
VTM2.Patterns[j].Items[i].Channel[k].Additional_Command;
break;
end;
tset := True;
break;
end;
if not tset then
for k := 2 downto 0 do
if VTM1.Patterns[j].Items[i].Channel[k].Additional_Command.Number = 11 then
begin
for kk := 2 downto 0 do
if VTM2.Patterns[j].Items[i].Channel[kk].Additional_Command.Number = 0 then
begin
VTM2.Patterns[j].Items[i].Channel[kk].Additional_Command :=
VTM1.Patterns[j].Items[i].Channel[k].Additional_Command;
break;
end;
break;
end;
end;
end
else
DecodePattern(VTM1, j, j);
end;
VTM1.Positions.Length := Pos;
if VTM2 <> nil then
VTM2.Positions.Length := Pos;
end;
function GetSampleString;
var
j: integer;
begin
Result := Char(Ord('T') or (Ord(not SL.Mixer_Ton) shl 5));
Result := Result + Char(Ord('N') or (Ord(not SL.Mixer_Noise) shl 5));
Result := Result + Char(Ord('E') or (Ord(not SL.Envelope_Enabled) shl 5)) + ' ';
if SL.Add_to_Ton >= 0 then
Result := Result + '+' + IntToHex(SL.Add_to_Ton, 3)
else
Result := Result + '-' + IntToHex(-SL.Add_to_Ton, 3);
if SL.Ton_Accumulation then
Result := Result + '^ '
else
Result := Result + '_ ';
if SL.Add_to_Envelope_or_Noise >= 0 then
Result := Result + '+' + IntToHex(SL.Add_to_Envelope_or_Noise, 2)
else
Result := Result + '-' + IntToHex(-SL.Add_to_Envelope_or_Noise, 2);
if Ns then
Result := Result + '(' +
IntToHex(SL.Add_to_Envelope_or_Noise and 31, 2) + ')';
if SL.Envelope_or_Noise_Accumulation then
Result := Result + '^ '
else
Result := Result + '_ ';
Result := Result + IntToHex(SL.Amplitude, 1);
if not SL.Amplitude_Sliding then
Result := Result + '_'
else if SL.Amplitude_Slide_Up then
Result := Result + '+'
else
Result := Result + '-';
if Vol then
begin
Result := Result + ' ';
for j := 1 to 15 do
if j <= SL.Amplitude then
Result := Result + '*'
else
Result := Result + ' '
end
end;
procedure SaveSample;
var
lp, l, i: integer;
begin
if VTMP.Samples[n] = nil then
Writeln(TxtFile, 'tne +000_ +00_ 0_ L')
else
with VTMP.Samples[n]^ do
begin
lp := Loop;
l := Length - 1;
for i := 0 to l do
begin
Write(TxtFile, GetSampleString(Items[i], False, False));
if i = lp then Write(TxtFile, ' L');
Writeln(TxtFile)
end
end
end;
procedure SaveOrnament;
var
lp, l, i: integer;
begin
if VTM.Ornaments[n] = nil then
Writeln(TxtFile, 'L0')
else
with VTM.Ornaments[n]^ do
begin
lp := Loop;
l := Length - 1;
for i := 0 to l do
begin
if i = lp then Write(TxtFile, 'L');
Write(TxtFile, IntToStr(Items[i]));
if i < l then Write(TxtFile, ',')
end;
Writeln(TxtFile)
end
end;
function Int2ToStr(i: integer): string;
begin
if i < 10 then
Result := '0' + IntToStr(i)
else
Result := IntToStr(i)
end;
function Int4DToStr(i: integer): string;
begin
if i = 0 then
Result := '....'
else if i < 16 then
Result := '...' + IntToHex(i, 1)
else if i < 256 then
Result := '..' + IntToHex(i, 2)
else if i < $1000 then
Result := '.' + IntToHex(i, 3)
else
Result := IntToHex(i, 4)
end;
function Int2DToStr(i: integer): string;
begin
if i = 0 then
Result := '..'
else if i < 16 then
Result := '.' + IntToHex(i, 1)
else
Result := IntToHex(i, 2)
end;
function Int1DToStr(i: integer): string;
begin
if i = 0 then
Result := '.'
else
Result := IntToHex(i, 1)
end;
function NoteToStr(i: integer): string;
const
Notes: array[0..11] of string =
('C-', 'C#', 'D-', 'D#', 'E-', 'F-', 'F#', 'G-', 'G#', 'A-', 'A#', 'B-');
begin
if i = -1 then
Result := '---'
else if i = -2 then
Result := 'R--'
else
Result := Notes[i mod 12] + IntToStr(i div 12 + 1)
end;
function SampToStr(i: integer): string;
begin
if i = 0 then
Result := '.'
else if i < 16 then
Result := IntToHex(i, 1)
else
Result := Char(i + Ord('A') - 10)
end;
function IntsToTime(i: integer): string;
var
sec, min: integer;
begin
sec := round(i * 1000 / Interrupt_Freq);
min := sec div 60;
sec := sec mod 60;
Result := IntToStr(min) + ':' + Int2ToStr(sec)
end;
function GetPatternLineString;
function Envelope2NoteText(e: Integer): string;
var
note: Integer;
ntxt: string;
begin
Result := Int4DToStr(e);
if MainForm.Saved_EnvelopeAsNote = False then Exit;
note := GetNoteByEnvelope(e);
if (note <> 0) and (note <= 60) then
Result := ' ' + NoteToStr(note);
end;
var
j1, j: integer;
begin
if MainForm.Saved_DecBase then
begin
Result := Format('%.2d', [n mod 100]) + '|';
if n = 100 then Result := '@1|';
if n = 200 then Result := '@2|';
end
else
begin
Result := IntToHex(n, 2) + '|';
end;
if PatPtr = nil then
Result := Result + '....|..|--- .... ....|--- .... ....|--- .... ....'
else
begin
//Result := Result + Int4DToStr(PatPtr.Items[n].Envelope) + '|';
Result := Result + Envelope2NoteText(PatPtr.Items[n].Envelope) + '|';
Result := Result + Int2DToStr(PatPtr.Items[n].Noise);
for j1 := 0 to 2 do
begin
j := Chn[j1];
Result := Result + '|' + NoteToStr(PatPtr.Items[n].Channel[j].Note) + ' ';
Result := Result + SampToStr(PatPtr.Items[n].Channel[j].Sample);
Result := Result + Int1DToStr(PatPtr.Items[n].Channel[j].Envelope);
Result := Result + Int1DToStr(PatPtr.Items[n].Channel[j].Ornament);
Result := Result + Int1DToStr(PatPtr.Items[n].Channel[j].Volume) + ' ';
Result := Result + Int1DToStr(PatPtr.Items[n].Channel[j].Additional_Command.Number);
Result := Result + Int1DToStr(PatPtr.Items[n].Channel[j].Additional_Command.Delay);
Result := Result + Int2DToStr(PatPtr.Items[n].Channel[j].Additional_Command.Parameter)
end
end;
end;
procedure SavePattern;
var
s: string;
i, l: integer;
begin
l := DefPatLen;
if VTMP.Patterns[n] <> nil then
l := VTMP.Patterns[n].Length;
for i := 0 to l - 1 do
begin
s := GetPatternLineString(VTMP.Patterns[n], i, StdChns);
Writeln(TxtFile, Copy(s, 4, Length(s) - 3))
end
end;
procedure VTM2TextFile;
var
i: integer;
begin
AssignFile(TxtFile, FN);
if not Apnd then
Rewrite(TxtFile)
else
Append(TxtFile);
try
Writeln(TxtFile, '[Module]');
if VTM.VortexModule_Header then
Writeln(TxtFile, 'VortexTrackerII=1')
else
Writeln(TxtFile, 'VortexTrackerII=0');
Writeln(TxtFile, 'Version=3.' + IntToStr(5 + VTM.FeaturesLevel));
Writeln(TxtFile, 'Title=' + VTM.Title);
Writeln(TxtFile, 'Author=' + VTM.Author);
Writeln(TxtFile, 'NoteTable=' + IntToStr(VTM.Ton_Table));
Writeln(TxtFile, 'ChipFreq=' + IntToStr(AY_Freq));
Writeln(TxtFile, 'Speed=' + IntToStr(VTM.Initial_Delay));
Write(TxtFile, 'PlayOrder=');
with VTM.Positions do
for i := 0 to Length - 1 do
begin
if i = Loop then Write(TxtFile, 'L');
Write(TxtFile, Value[i]);
if i <> Length - 1 then Write(TxtFile, ',');
end;
Writeln(TxtFile);
Writeln(TxtFile);
for i := 1 to 15 do
begin
Writeln(TxtFile, '[Ornament' + IntToStr(i) + ']');
SaveOrnament(VTM, i);
Writeln(TxtFile);
end;
for i := 1 to 31 do
begin
Writeln(TxtFile, '[Sample' + IntToStr(i) + ']');
SaveSample(VTM, i);
Writeln(TxtFile);
end;
for i := 0 to MaxPatNum do
if VTM.Patterns[i] <> nil then
begin
Writeln(TxtFile, '[Pattern' + IntToStr(i) + ']');
SavePattern(VTM, i);
Writeln(TxtFile);
end;
finally
CloseFile(TxtFile);
end;
end;
function VTM2PT3(PT3: PSpeccyModule; VTM: PModule;
var Module_Size: Integer): boolean;
const
Pt3Id: array[Boolean, 0..29] of char =
('ProTracker 3.6 compilation of ',
'Vortex Tracker II 1.0 module: ');
ById: array[0..3] of char = ' by ';
EmptyPatternString = #$B1#64#$D0#0;
var
i, i1, j, k, d: integer;
Patterns: array[0..MaxPatNum] of boolean;
CompiledPatterns: array[0..MaxPatNum] of boolean;
VTMPat2PT3Pat: array[0..MaxPatNum] of integer;
PatOfs: array[0..MaxNumOfPats * 3 - 1] of integer;
MaxPattern: integer;
PatStrs: array[0..MaxNumOfPats * 3 - 1] of string;
PatsIndexes: array[0..MaxPatNum, 0..2] of integer;
PatNum, StrNum: integer;
DeltT, TnStp, TnDl, TnCurDl, //<--- vars to avoid bug in Alone Coder's PT3 player
Note,
Sample,
Ornament,
Volume,
SkipPrev,
Skip,
Envelope: array[0..2] of integer;
Orn, Sam, Orn1, Sam1: boolean;
PrevNoise, Dl: integer;
IsOrnament: array[0..15] of boolean;
IsSample: array[1..31] of boolean;
begin
Result := False;
Move(Pt3Id[VTM.VortexModule_Header and (VTM.FeaturesLevel = 1), 0], PT3.PT3_Name, 30);
if VTM.FeaturesLevel <> 1 then PT3.PT3_Name[13] := Char($35 + VTM.FeaturesLevel);
i := 32; if i > Length(VTM.Title) then i := Length(VTM.Title);
Move(VTM.Title[1], PT3.PT3_Name[30], i);
j := 32 - i; if j <> 0 then FillChar(PT3.PT3_Name[30 + i], j, 32);
Move(ById, PT3.PT3_Name[62], 4);
i := 32; if i > Length(VTM.Author) then i := Length(VTM.Author);
Move(VTM.Author[1], PT3.PT3_Name[66], i);
FillChar(PT3.PT3_Name[66 + i], 32 - i + 1, 32);
PT3.PT3_Table := VTM.Ton_Table;
PT3.PT3_Delay := VTM.Initial_Delay;
PT3.PT3_NumberOfPositions := VTM.Positions.Length;
PT3.PT3_LoopPosition := VTM.Positions.Loop;
PT3.PT3_PatternsPointer := $C9 + PT3.PT3_NumberOfPositions + 1;
FillChar(PT3.PT3_SamplePointers, 96, 0);
PT3.Index[$C9 + PT3.PT3_NumberOfPositions] := 255;
for i := 0 to MaxPatNum do
begin
Patterns[i] := False;
CompiledPatterns[i] := False
end;
MaxPattern := 0;
for i := 0 to PT3.PT3_NumberOfPositions - 1 do
begin
if MaxPattern < VTM.Positions.Value[i] then
MaxPattern := VTM.Positions.Value[i];
Patterns[VTM.Positions.Value[i]] := True;
VTMPat2PT3Pat[VTM.Positions.Value[i]] := VTM.Positions.Value[i]
end;
for i := 0 to MaxPattern do
if not Patterns[i] then
for j := i + 1 to MaxPattern do Dec(VTMPat2PT3Pat[j]);
for i := 0 to PT3.PT3_NumberOfPositions - 1 do
PT3.Index[$C9 + i] := VTMPat2PT3Pat[VTM.Positions.Value[i]] * 3;
for i := 0 to 15 do IsOrnament[i] := False;
for i := 1 to 31 do IsSample[i] := False;
StrNum := 0;
Note[0] := 0;
Note[1] := 0;
Note[2] := 0;
//BUG in AlCo's pt3 player
DeltT[0] := 0; //
DeltT[1] := 0; //
DeltT[2] := 0; // this all for more compatability with old ZX players
TnDl[0] := 0; //
TnDl[1] := 0; //
TnDl[2] := 0; //
//BUG in AlCo's pt3 player
for i1 := 0 to PT3.PT3_NumberOfPositions - 1 do
begin
i := VTM.Positions.Value[i1];
PatNum := VTMPat2PT3Pat[i];
if not CompiledPatterns[i] then
begin
CompiledPatterns[i] := True;
if VTM.Patterns[i] <> nil then
begin
PrevNoise := 0;
for k := 0 to 2 do
begin
Dl := DeltT[k];
Sample[k] := -1;
Ornament[k] := -1;
Envelope[k] := -1;
Volume[k] := -1;
SkipPrev[k] := 255;
PatStrs[StrNum] := '';
j := 0;
while j < VTM.Patterns[i].Length do
begin
Orn := ((VTM.Patterns[i].Items[j].Channel[k].Envelope <> 0) or
(VTM.Patterns[i].Items[j].Channel[k].Ornament <> 0) {new standard in pt3.69}) and
((VTM.Patterns[i].Items[j].Channel[k].Ornament <> Ornament[k]) or
((Ornament[k] <> 0) and (VTM.Patterns[i].Items[j].Channel[k].Note = -1)));
if Orn then
IsOrnament[VTM.Patterns[i].Items[j].Channel[k].Ornament] := True;
Sam := (VTM.Patterns[i].Items[j].Channel[k].Note <> -1) and
(VTM.Patterns[i].Items[j].Channel[k].Sample <> 0) and
(VTM.Patterns[i].Items[j].Channel[k].Sample <> Sample[k]);
if Sam then
begin
IsSample[VTM.Patterns[i].Items[j].Channel[k].Sample] := True;
Sample[k] := VTM.Patterns[i].Items[j].Channel[k].Sample
end;
Orn1 := Orn;
Sam1 := Sam;
if Sam and Orn and (VTM.Patterns[i].Items[j].Channel[k].Envelope <> 0) then //new standard in pt3.69then
begin
if VTM.Patterns[i].Items[j].Channel[k].Envelope = 15 then
begin
if Envelope[k] <> 0 then
begin
Sam1 := False;
Orn1 := False;
PatStrs[StrNum] := PatStrs[StrNum] +
char($F0 + VTM.Patterns[i].Items[j].Channel[k].Ornament) +
char(VTM.Patterns[i].Items[j].Channel[k].Sample * 2)
end
end
else
begin
Sam1 := False;
Orn1 := False;
PatStrs[StrNum] := PatStrs[StrNum] + char($10 +
VTM.Patterns[i].Items[j].Channel[k].Envelope) +
char(Hi(VTM.Patterns[i].Items[j].Envelope)) +
char(VTM.Patterns[i].Items[j].Envelope) +
char(VTM.Patterns[i].Items[j].Channel[k].Sample * 2);
PatStrs[StrNum] := PatStrs[StrNum] +
char($40 + VTM.Patterns[i].Items[j].Channel[k].Ornament)
end
end;
if Sam1 then
PatStrs[StrNum] := PatStrs[StrNum] +
char($D0 + VTM.Patterns[i].Items[j].Channel[k].Sample);
if Orn1 then
begin
PatStrs[StrNum] := PatStrs[StrNum] +
char($40 + VTM.Patterns[i].Items[j].Channel[k].Ornament);
if VTM.Patterns[i].Items[j].Channel[k].Envelope in [1..14] then
PatStrs[StrNum] := PatStrs[StrNum] + char($B1 +
VTM.Patterns[i].Items[j].Channel[k].Envelope) +
char(Hi(VTM.Patterns[i].Items[j].Envelope)) +
char(VTM.Patterns[i].Items[j].Envelope)
else if (VTM.Patterns[i].Items[j].Channel[k].Envelope = 15) and (Envelope[k] <> 0) then
PatStrs[StrNum] := PatStrs[StrNum] + #$B0
end;
if not Orn and (VTM.Patterns[i].Items[j].Channel[k].Envelope > 0) then
begin
if VTM.Patterns[i].Items[j].Channel[k].Envelope <> 15 then
PatStrs[StrNum] := PatStrs[StrNum] + char($B1 +
VTM.Patterns[i].Items[j].Channel[k].Envelope) +
char(Hi(VTM.Patterns[i].Items[j].Envelope)) +
char(VTM.Patterns[i].Items[j].Envelope)
else if Envelope[k] <> 0 then
PatStrs[StrNum] := PatStrs[StrNum] + #$B0
end;
if Orn then
Ornament[k] := VTM.Patterns[i].Items[j].Channel[k].Ornament;
if VTM.Patterns[i].Items[j].Channel[k].Envelope <> 0 then
Envelope[k] := Ord(VTM.Patterns[i].Items[j].Channel[k].Envelope < 15);
if VTM.Patterns[i].Items[j].Channel[k].Volume <> 0 then
if VTM.Patterns[i].Items[j].Channel[k].Volume <> Volume[k] then
begin
PatStrs[StrNum] := PatStrs[StrNum] + char($C0 +
VTM.Patterns[i].Items[j].Channel[k].Volume);
Volume[k] := VTM.Patterns[i].Items[j].Channel[k].Volume
end;
if (k = 1) and (VTM.Patterns[i].Items[j].Noise <> PrevNoise) then
begin
PrevNoise := VTM.Patterns[i].Items[j].Noise;
PatStrs[StrNum] := PatStrs[StrNum] + char($20 +
VTM.Patterns[i].Items[j].Noise)
end;
case VTM.Patterns[i].Items[j].Channel[k].Additional_Command.Number of
1, 2:
begin
PatStrs[StrNum] := PatStrs[StrNum] + #1;
TnDl[k] := VTM.Patterns[i].Items[j].Channel[k].Additional_Command.Delay;
TnCurDl[k] := TnDl[k];
if VTM.Patterns[i].Items[j].Channel[k].Additional_Command.Number = 1 then
TnStp[k] := VTM.Patterns[i].Items[j].Channel[k].Additional_Command.Parameter
else
TnStp[k] := -VTM.Patterns[i].Items[j].Channel[k].Additional_Command.Parameter
end;
3:
if (VTM.Patterns[i].Items[j].Channel[k].Note >= 0) or
((VTM.Patterns[i].Items[j].Channel[k].Note <> -2) and
(VTM.FeaturesLevel >= 1)) then
begin
PatStrs[StrNum] := PatStrs[StrNum] + #2;
TnDl[k] := -VTM.Patterns[i].Items[j].Channel[k].Additional_Command.Delay;
TnCurDl[k] := -TnDl[k];
Dl := DeltT[k];
if VTM.Patterns[i].Items[j].Channel[k].Note >= 0 then
inc(Dl, GetNoteFreq(VTM.Ton_Table,
VTM.Patterns[i].Items[j].Channel[k].Note) -
GetNoteFreq(VTM.Ton_Table, Note[k]));
if Dl >= 0 then
TnStp[k] := VTM.Patterns[i].Items[j].Channel[k].Additional_Command.Parameter
else
TnStp[k] := -VTM.Patterns[i].Items[j].Channel[k].Additional_Command.Parameter;
DeltT[k] := Dl
end;
4..6:
PatStrs[StrNum] := PatStrs[StrNum] + char(
VTM.Patterns[i].Items[j].Channel[k].Additional_Command.Number - 1);
9, 10:
PatStrs[StrNum] := PatStrs[StrNum] + #8;
11:
if VTM.Patterns[i].Items[j].Channel[k].Additional_Command.
Parameter <> 0 then
PatStrs[StrNum] := PatStrs[StrNum] + #9
end;
if (VTM.Patterns[i].Items[j].Channel[k].Note = -2) or
((VTM.Patterns[i].Items[j].Channel[k].Note >= 0) and
not (VTM.Patterns[i].Items[j].Channel[k].Additional_Command.Number in [1..3])) then
begin
Dl := 0;
TnDl[k] := 0;
DeltT[k] := 0
end;
Skip[k] := 0;
d := j;
repeat
if TnDl[k] <> 0 then
begin
dec(TnCurDl[k]);
if TnCurDl[k] = 0 then
begin
TnCurDl[k] := Abs(TnDl[k]);
dec(DeltT[k], TnStp[k]);
if TnDl[k] < 0 then
if ((DeltT[k] >= 0) and (TnStp[k] < 0)) or
((DeltT[k] <= 0) and (TnStp[k] >= 0)) then
begin
TnDl[k] := 0;
DeltT[k] := 0
end
end
end;
inc(Skip[k]);
inc(j)
until (j >= VTM.Patterns[i].Length) or
(VTM.Patterns[i].Items[j].Channel[k].Note <> -1) or
((VTM.Patterns[i].Items[j].Channel[k].
Additional_Command.Number = 11) and
(VTM.Patterns[i].Items[j].Channel[k].
Additional_Command.Parameter <> 0)) or
not (VTM.Patterns[i].Items[j].Channel[k].
Additional_Command.Number in [0, 11]) or
(VTM.Patterns[i].Items[j].Channel[k].Volume <> 0) or
(VTM.Patterns[i].Items[j].Channel[k].Envelope in [1..14]) or
((VTM.Patterns[i].Items[j].Channel[k].Envelope = 15) and
((Envelope[k] <> 0) or
((VTM.Patterns[i].Items[j].Channel[k].Ornament = 0) and
(Ornament[k] <> 0)))) or
(VTM.Patterns[i].Items[j].Channel[k].Ornament <> 0) or //new standard in pt3.69
((k = 1) and (VTM.Patterns[i].Items[d].Noise <>
VTM.Patterns[i].Items[j].Noise));
if Skip[k] <> SkipPrev[k] then
begin
PatStrs[StrNum] := PatStrs[StrNum] + #$B1 + char(Skip[k]);
SkipPrev[k] := Skip[k]
end;
if VTM.Patterns[i].Items[d].Channel[k].Note = -2 then
PatStrs[StrNum] := PatStrs[StrNum] + #$C0
else if VTM.Patterns[i].Items[d].Channel[k].Note = -1 then
PatStrs[StrNum] := PatStrs[StrNum] + #$D0
else
begin
Note[k] := VTM.Patterns[i].Items[d].Channel[k].Note;
PatStrs[StrNum] := PatStrs[StrNum] + char($50 + Note[k])
end;
case VTM.Patterns[i].Items[d].Channel[k].Additional_Command.Number of
1:
begin
PatStrs[StrNum] := PatStrs[StrNum] + char(
VTM.Patterns[i].Items[d].Channel[k].Additional_Command.Delay) +
char(VTM.Patterns[i].Items[d].Channel[k].Additional_Command.
Parameter) + #0
end;
2:
begin
PatStrs[StrNum] := PatStrs[StrNum] + char(
VTM.Patterns[i].Items[d].Channel[k].Additional_Command.Delay) +
char(-VTM.Patterns[i].Items[d].Channel[k].Additional_Command.
Parameter) + #$FF
end;
3:
if (VTM.Patterns[i].Items[d].Channel[k].Note >= 0) or
((VTM.Patterns[i].Items[d].Channel[k].Note <> -2) and
(VTM.FeaturesLevel >= 1)) then
begin
if Dl >= 0 then
PatStrs[StrNum] := PatStrs[StrNum] + char(
VTM.Patterns[i].Items[d].Channel[k].Additional_Command.Delay) +
char(Dl) + char(Hi(Dl)) + char(VTM.Patterns[i].Items[d].
Channel[k].Additional_Command.Parameter) + #0
else
PatStrs[StrNum] := PatStrs[StrNum] + char(
VTM.Patterns[i].Items[d].Channel[k].Additional_Command.Delay) +
char(-Dl) + char(Hi(-Dl)) + char(-VTM.Patterns[i].Items[d].
Channel[k].Additional_Command.Parameter) + #$FF
end;
4, 5:
PatStrs[StrNum] := PatStrs[StrNum] + char(
VTM.Patterns[i].Items[d].Channel[k].Additional_Command.Parameter);
6:
PatStrs[StrNum] := PatStrs[StrNum] + char(
VTM.Patterns[i].Items[d].Channel[k].Additional_Command.Parameter
shr 4) + char(
VTM.Patterns[i].Items[d].Channel[k].Additional_Command.Parameter
and 15);
9:
PatStrs[StrNum] := PatStrs[StrNum] + char(
VTM.Patterns[i].Items[d].Channel[k].Additional_Command.Delay) +
char(VTM.Patterns[i].Items[d].Channel[k].
Additional_Command.Parameter) + #0;
10:
PatStrs[StrNum] := PatStrs[StrNum] + char(
VTM.Patterns[i].Items[d].Channel[k].Additional_Command.Delay) +
char(-VTM.Patterns[i].Items[d].Channel[k].
Additional_Command.Parameter) + #$FF;
11:
if VTM.Patterns[i].Items[d].Channel[k].
Additional_Command.Parameter <> 0 then
PatStrs[StrNum] := PatStrs[StrNum] + char(
VTM.Patterns[i].Items[d].Channel[k].Additional_Command.Parameter)
end;
Dl := DeltT[k]
end;
PatStrs[StrNum] := PatStrs[StrNum] + #0;
PatsIndexes[PatNum, k] := StrNum;
for d := 0 to StrNum - 1 do
if PatStrs[d] = PatStrs[StrNum] then
begin
PatsIndexes[PatNum, k] := d;
Dec(StrNum);
break
end;
Inc(StrNum)
end
end
else
begin
PatStrs[StrNum] := EmptyPatternString;
PatsIndexes[PatNum, 0] := StrNum;
PatsIndexes[PatNum, 1] := StrNum;
PatsIndexes[PatNum, 2] := StrNum;
for d := 0 to StrNum - 1 do
if PatStrs[d] = EmptyPatternString then
begin
PatsIndexes[PatNum, 0] := d;
PatsIndexes[PatNum, 1] := d;
PatsIndexes[PatNum, 2] := d;
Dec(StrNum);
break
end;
Inc(StrNum)
end
end
end;
PatNum := PT3.PT3_PatternsPointer + 6 * (VTMPat2PT3Pat[MaxPattern] + 1);
for i := 0 to StrNum - 1 do
begin
if PatNum > 65536 - 3 - Length(PatStrs[i]) then exit;
PatOfs[i] := PatNum;
Move(PatStrs[i][1], PT3.Index[PatNum], Length(PatStrs[i]));
Inc(PatNum, Length(PatStrs[i]))
end;
j := PT3.PT3_PatternsPointer;
for i := 0 to MaxPattern do
if Patterns[i] then
begin
for k := 0 to 2 do
begin
WordPtr(@PT3.Index[j])^ := PatOfs[PatsIndexes[VTMPat2PT3Pat[i], k]];
Inc(j, 2)
end
end;
for i := 1 to 31 do
if IsSample[i] then
begin
if PatNum >= 65536 - 2 - 3 then exit;
PT3.PT3_SamplePointers[i] := PatNum;
if VTM.Samples[i] <> nil then
PT3.Index[PatNum] := VTM.Samples[i].Loop
else
PT3.Index[PatNum] := 0;
Inc(PatNum);
if VTM.Samples[i] <> nil then
PT3.Index[PatNum] := VTM.Samples[i].Length
else
PT3.Index[PatNum] := 1;
Inc(PatNum);
if PatNum > 65536 - PT3.Index[PatNum - 1] * 4 - 3 then exit;
if VTM.Samples[i] <> nil then
for j := 0 to VTM.Samples[i].Length - 1 do
begin
d := 0;
if not VTM.Samples[i].Items[j].Envelope_Enabled then d := 1;
d := d + (VTM.Samples[i].Items[j].Add_to_Envelope_or_Noise) and 31 shl 1;
if VTM.Samples[i].Items[j].Amplitude_Sliding then
begin
d := d or $80;
if VTM.Samples[i].Items[j].Amplitude_Slide_Up then d := d or $40
end;
PT3.Index[PatNum] := d;
Inc(PatNum);
d := VTM.Samples[i].Items[j].Amplitude;
if not VTM.Samples[i].Items[j].Mixer_Ton then d := d or $10;
if not VTM.Samples[i].Items[j].Mixer_Noise then d := d or $80;
if VTM.Samples[i].Items[j].Envelope_or_Noise_Accumulation then
d := d or $20;
if VTM.Samples[i].Items[j].Ton_Accumulation then d := d or $40;
PT3.Index[PatNum] := d;
Inc(PatNum);
WordPtr(@PT3.Index[PatNum])^ := VTM.Samples[i].Items[j].Add_to_Ton;
Inc(PatNum, 2)
end
else
begin
DWordPtr(@PT3.Index[PatNum])^ := $9001;
Inc(PatNum, 4)
end
end;
if PatNum > 65536 - 3 then exit;
PT3.PT3_OrnamentPointers[0] := PatNum;
PT3.Index[PatNum] := 0;
Inc(PatNum);
PT3.Index[PatNum] := 1;
Inc(PatNum);
PT3.Index[PatNum] := 0;
Inc(PatNum);
for i := 1 to 15 do
if IsOrnament[i] then
begin
if PatNum >= 65536 - 2 then exit;
PT3.PT3_OrnamentPointers[i] := PatNum;
if VTM.Ornaments[i] <> nil then
PT3.Index[PatNum] := VTM.Ornaments[i].Loop
else
PT3.Index[PatNum] := 0;
Inc(PatNum);
if VTM.Ornaments[i] <> nil then
PT3.Index[PatNum] := VTM.Ornaments[i].Length
else
PT3.Index[PatNum] := 1;
Inc(PatNum);
if PatNum > 65536 - PT3.Index[PatNum - 1] then exit;
if VTM.Ornaments[i] <> nil then
for j := 0 to VTM.Ornaments[i].Length - 1 do
begin
PT3.Index[PatNum] := VTM.Ornaments[i].Items[j];
Inc(PatNum)
end
else
begin
PT3.Index[PatNum] := 0;
Inc(PatNum)
end
end;
Module_Size := PatNum;
Result := True
end;
function PT22VTM(PT2: PSpeccyModule; VTM: PModule): boolean;
var
ChPtr: packed array[0..2] of word;
Skip: array[0..2] of shortint;
SkipCounter: array[0..2] of shortint;
PrevOrn: array[0..2] of byte;
NsBase: integer;
procedure PatternInterpreter(PatNum, LnNum, ChNum: integer);
var
quit: boolean;
begin
quit := false;
repeat
case PT2.Index[ChPtr[ChNum]] of
$E1..$FF:
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Sample :=
PT2.Index[ChPtr[ChNum]] - $E0;
$E0:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Note := -2;
quit := True
end;
$80..$DF:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Note :=
PT2.Index[ChPtr[ChNum]] - $80;
quit := True
end;
$7F:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := PrevOrn[ChNum]
end;
$71..$7E:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := PrevOrn[ChNum];
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope :=
PT2.Index[ChPtr[ChNum]] - $70;
Inc(ChPtr[ChNum]);
VTM.Patterns[PatNum].Items[LnNum].Envelope :=
WordPtr(@PT2.Index[ChPtr[ChNum]])^;
Inc(ChPtr[ChNum])
end;
$70:
quit := True;
$60..$6F:
begin
PrevOrn[ChNum] := PT2.Index[ChPtr[ChNum]] - $60;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := PrevOrn[ChNum];
if VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope = 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15
end;
$20..$5F:
Skip[ChNum] := PT2.Index[ChPtr[ChNum]] - $20;
$10..$1F:
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Volume :=
PT2.Index[ChPtr[ChNum]] - $10;
$F:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 11;
Inc(ChPtr[ChNum]);
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := PT2.Index[ChPtr[ChNum]]
end;
$E:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Delay := 1;
Inc(ChPtr[ChNum]);
if shortint(PT2.Index[ChPtr[ChNum]]) >= 0 then
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 1;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := PT2.Index[ChPtr[ChNum]]
end
else
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 2;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := -PT2.Index[ChPtr[ChNum]]
end
end;
$D:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Delay := 1;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 3;
Inc(ChPtr[ChNum]);
if shortint(PT2.Index[ChPtr[ChNum]]) >= 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := PT2.Index[ChPtr[ChNum]]
else
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := -PT2.Index[ChPtr[ChNum]];
Inc(ChPtr[ChNum], 2)
end;
$C:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Delay := 0;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 1;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := 0
end
else
begin
Inc(ChPtr[ChNum]);
NsBase := PT2.Index[ChPtr[ChNum]]
end
end;
Inc(ChPtr[ChNum])
until quit;
SkipCounter[ChNum] := Skip[ChNum]
end;
var
i, j, k, Pos: Integer;
quit: boolean;
begin
Result := True;
if DetectFeaturesLevel then
VTM.FeaturesLevel := 0;
if DetectModuleHeader then
VTM.VortexModule_Header := False;
SetLength(VTM.Title, 30);
Move(PT2.PT2_MusicName, VTM.Title[1], 30);
VTM.Title := TrimRight(VTM.Title);
VTM.Author := '';
VTM.Ton_Table := 1;
VTM.Initial_Delay := PT2.PT2_Delay;
VTM.Positions.Loop := PT2.PT2_LoopPosition;
for i := 0 to 255 do
VTM.Positions.Value[i] := 0;
VTM.Ornaments[0] := nil;
for i := 1 to 15 do
begin
if PT2.PT2_OrnamentPointers[i] = 0 then
VTM.Ornaments[i] := nil
else
begin
New(VTM.Ornaments[i]);
VTM.Ornaments[i].Loop := PT2.Index[PT2.PT2_OrnamentPointers[i] + 1];
VTM.Ornaments[i].Length := PT2.Index[PT2.PT2_OrnamentPointers[i]];
if (VTM.Ornaments[i].Length = 0) or (VTM.Ornaments[i].Length > MaxOrnLen) then
VTM.Ornaments[i].Length := MaxOrnLen;
if VTM.Ornaments[i].Loop >= VTM.Ornaments[i].Length then
VTM.Ornaments[i].Loop := VTM.Ornaments[i].Length - 1;
for j := 0 to VTM.Ornaments[i].Length - 1 do
VTM.Ornaments[i].Items[j] := PT2.Index[PT2.PT2_OrnamentPointers[i] + 2 + j]
end
end;
for i := 1 to 31 do
begin
if PT2.PT2_SamplePointers[i] = 0 then
VTM.Samples[i] := nil
else
begin
New(VTM.Samples[i]);
VTM.Samples[i].Loop := PT2.Index[PT2.PT2_SamplePointers[i] + 1];
VTM.Samples[i].Length := PT2.Index[PT2.PT2_SamplePointers[i]];
if (VTM.Samples[i].Length = 0) or (VTM.Samples[i].Length > MaxSamLen) then
VTM.Samples[i].Length := MaxSamLen;
if VTM.Samples[i].Loop >= VTM.Samples[i].Length then
VTM.Samples[i].Loop := VTM.Samples[i].Length - 1;
for j := 0 to VTM.Samples[i].Length - 1 do
begin
VTM.Samples[i].Items[j] := EmptySampleTick;
VTM.Samples[i].Items[j].Envelope_Enabled := True;
VTM.Samples[i].Items[j].Add_to_Ton :=
PT2.Index[PT2.PT2_SamplePointers[i] + j * 3 + 4] +
word(PT2.Index[PT2.PT2_SamplePointers[i] + j * 3 + 3] and 15) shl 8;
if PT2.Index[PT2.PT2_SamplePointers[i] + j * 3 + 2] and 4 = 0 then
VTM.Samples[i].Items[j].Add_to_Ton := -VTM.Samples[i].Items[j].Add_to_Ton;
VTM.Samples[i].Items[j].Amplitude :=
PT2.Index[PT2.PT2_SamplePointers[i] + j * 3 + 3] shr 4;
VTM.Samples[i].Items[j].Mixer_Noise :=
PT2.Index[PT2.PT2_SamplePointers[i] + j * 3 + 2] and 1 = 0;
if VTM.Samples[i].Items[j].Mixer_Noise then
VTM.Samples[i].Items[j].Add_to_Envelope_or_Noise :=
(PT2.Index[PT2.PT2_SamplePointers[i] + j * 3 + 2] shr 3) and 31;
if VTM.Samples[i].Items[j].Add_to_Envelope_or_Noise and $10 <> 0 then
VTM.Samples[i].Items[j].Add_to_Envelope_or_Noise :=
VTM.Samples[i].Items[j].Add_to_Envelope_or_Noise or shortint($F0);
VTM.Samples[i].Items[j].Mixer_Ton :=
PT2.Index[PT2.PT2_SamplePointers[i] + j * 3 + 2] and 2 = 0
end
end
end;
for i := 0 to MaxPatNum do
VTM.Patterns[i] := nil;
Pos := 0;
while (Pos < 256) and (PT2.PT2_PositionList[Pos] < 128) do
begin
j := PT2.PT2_PositionList[Pos];
VTM.Positions.Value[Pos] := j;
Inc(Pos);
if VTM.Patterns[j] = nil then
begin
NewPattern(VTM.Patterns[j]);
for k := 0 to 2 do
begin
PrevOrn[k] := 0;
SkipCounter[k] := 0;
Skip[k] := 0
end;
Move(PT2.Index[PT2.PT2_PatternsPointer + j * 6], ChPtr, 6);
NsBase := 0; i := 0; quit := False;
while (i < MaxPatLen) and not quit do
begin
for k := 0 to 2 do
begin
Dec(SkipCounter[k]);
if SkipCounter[k] < 0 then
begin
if (k = 0) and (PT2.Index[ChPtr[0]] = 0) then
begin
Dec(i);
quit := True;
break
end;
PatternInterpreter(j, i, k)
end
end;
VTM.Patterns[j].Items[i].Noise := NsBase;
Inc(i)
end;
VTM.Patterns[j].Length := i
end
end;
VTM.Positions.Length := Pos
end;
function STC2VTM(STC: PSpeccyModule; FSize: integer; VTM: PModule): boolean;
type
TSTCPat = record
Numb, Trans: integer;
end;
var
ChPtr: packed array[0..2] of word;
Skip: array[0..2] of shortint;
SkipCounter: array[0..2] of shortint;
IsOrnament: array[0..15] of boolean;
IsSample: array[1..16] of boolean;
CPat: TSTCPat;
Orn2Sam: array[1..15] of byte;
CSam, COrn: array[0..2] of byte;
procedure PatternInterpreter(PatNum, LnNum, ChNum: integer);
var
nt: byte;
begin
repeat
case STC.Index[ChPtr[ChNum]] of
$0..$5F:
begin
nt := STC.Index[ChPtr[ChNum]] + CPat.Trans;
if nt > $5F then nt := $5F;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Note := nt;
Inc(ChPtr[ChNum]);
break
end;
$60..$6F:
begin
CSam[ChNum] := STC.Index[ChPtr[ChNum]] - $5F;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Sample := CSam[ChNum];
IsSample[CSam[ChNum]] := True
end;
$70..$7F:
begin
COrn[ChNum] := STC.Index[ChPtr[ChNum]] - $70;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := COrn[ChNum];
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15;
IsOrnament[COrn[ChNum]] := True
end;
$80:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Note := -2;
Inc(ChPtr[ChNum]);
break
end;
$81:
begin
Inc(ChPtr[ChNum]);
break
end;
$82:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := 0;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15
end;
$83..$8E:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope :=
STC.Index[ChPtr[ChNum]] - $80;
Inc(ChPtr[ChNum]);
VTM.Patterns[PatNum].Items[LnNum].Envelope := STC.Index[ChPtr[ChNum]];
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := 0
end
else
Skip[ChNum] := STC.Index[ChPtr[ChNum]] - $A1
end;
Inc(ChPtr[ChNum])
until False;
if (COrn[ChNum] > 0) and (Orn2Sam[COrn[ChNum]] = 0) then
Orn2Sam[COrn[ChNum]] := CSam[ChNum];
SkipCounter[ChNum] := Skip[ChNum]
end;
var
i, j, k, n, l, Pos, PatMax: Integer;
quit: boolean;
Pats: array[0..MaxPatNum] of TSTCPat;
begin
Result := True;
SetLength(VTM.Title, 18);
Move(STC.ST_Name, VTM.Title[1], 18);
if (VTM.Title = 'SONG BY ST COMPILE') or
(VTM.Title = 'SONG BY MB COMPILE') or
(VTM.Title = 'SONG BY ST-COMPILE') or
(VTM.Title = 'SOUND TRACKER v1.1') or
(VTM.Title = 'S.T.FULL EDITION ') or
(VTM.Title = 'S.T.FULL EDITION '#127) or
(VTM.Title = 'SOUND TRACKER v1.3') then
VTM.Title := ''
else
begin
if STC.ST_Size <> FSize then
if (STC.ST_Size and 255) in [32..127] then
begin
VTM.Title := VTM.Title + Char(STC.ST_Size and 255);
if (STC.ST_Size shr 8) in [32..127] then
VTM.Title := VTM.Title + Char(STC.ST_Size shr 8)
end;
VTM.Title := TrimRight(VTM.Title)
end;
VTM.Author := '';
VTM.Ton_Table := 1;
VTM.Initial_Delay := STC.ST_Delay;
VTM.Positions.Loop := 0;
for i := 0 to 15 do
VTM.Ornaments[i] := nil;
for i := 1 to 15 do
begin
IsOrnament[i] := False;
Orn2Sam[i] := 0
end;
for i := 1 to 31 do
VTM.Samples[i] := nil;
for i := 1 to 16 do
IsSample[i] := False;
for i := 0 to MaxPatNum do
VTM.Patterns[i] := nil;
for k := 0 to 2 do
begin
CSam[k] := 0;
COrn[k] := 0
end;
PatMax := 0;
Pos := 0;
while Pos <= STC.Index[STC.ST_PositionsPointer] do
begin
CPat.Numb := STC.Index[STC.ST_PositionsPointer + 1 + Pos * 2];
CPat.Trans := STC.Index[STC.ST_PositionsPointer + 2 + Pos * 2];
j := PatMax;
for i := 0 to PatMax - 1 do
if (Pats[i].Numb = CPat.Numb) and
(Pats[i].Trans = CPat.Trans) then
begin
j := i;
break
end;
if j = PatMax then
begin
Inc(PatMax);
Pats[j] := CPat
end;
VTM.Positions.Value[Pos] := j;
Inc(Pos);
if VTM.Patterns[j] = nil then
begin
NewPattern(VTM.Patterns[j]);
for k := 0 to 2 do
begin
SkipCounter[k] := 0;
Skip[k] := 0
end;
k := 0;
n := Pats[j].Numb;
while STC.Index[STC.ST_PatternsPointer + k * 7] <> n do inc(k);
Move(STC.Index[STC.ST_PatternsPointer + k * 7 + 1], ChPtr, 6);
i := 0; quit := False;
while (i < MaxPatLen) and not quit do
begin
for k := 0 to 2 do
begin
Dec(SkipCounter[k]);
if SkipCounter[k] < 0 then
begin
if (k = 0) and (STC.Index[ChPtr[0]] = 255) then
begin
Dec(i);
quit := True;
break
end;
PatternInterpreter(j, i, k)
end
end;
Inc(i)
end;
VTM.Patterns[j].Length := i
end
end;
VTM.Positions.Length := Pos;
for i := 0 to 15 do
begin
j := STC.Index[STC.ST_OrnamentsPointer + $21 * i];
if (j > 0) and (j <= 15) and IsOrnament[j] then
begin
IsOrnament[j] := False;
New(VTM.Ornaments[j]);
k := Orn2Sam[j] - 1;
l := 0;
n := 0;
if k >= 0 then
begin
while STC.Index[$1B + $63 * n] <> k do Inc(n);
l := STC.Index[$1B + $63 * n + $61]
end;
if l = 0 then
begin
VTM.Ornaments[j].Loop := 0;
VTM.Ornaments[j].Length := 32
end
else
begin
VTM.Ornaments[j].Loop := l - 1;
if VTM.Ornaments[j].Loop > 31 then VTM.Ornaments[j].Loop := 31;
VTM.Ornaments[j].Length := l + STC.Index[$1B + $63 * n + $62];
if VTM.Ornaments[j].Length > 32 then VTM.Ornaments[j].Length := 32;
if VTM.Ornaments[j].Length = 0 then Inc(VTM.Ornaments[j].Length);
if VTM.Ornaments[j].Loop >= VTM.Ornaments[j].Length then
VTM.Ornaments[j].Loop := VTM.Ornaments[j].Length - 1;
l := VTM.Ornaments[j].Loop + 1;
if VTM.Ornaments[j].Length < 32 then
begin
Inc(VTM.Ornaments[j].Length, 33 - l);
VTM.Ornaments[j].Loop := 32
end
end;
for k := 0 to 31 do
VTM.Ornaments[j].Items[k] :=
STC.Index[STC.ST_OrnamentsPointer + $21 * i + 1 + k];
for k := 32 to VTM.Ornaments[j].Length - 1 do
VTM.Ornaments[j].Items[k] := VTM.Ornaments[j].Items[k + l - 33]
end
end;
for i := 0 to 15 do
begin
j := STC.Index[$1B + $63 * i] + 1;
if (j > 0) and (j <= 16) and IsSample[j] then
begin
IsSample[j] := False;
New(VTM.Samples[j]);
l := STC.Index[$1B + $63 * i + $61];
if l = 0 then
begin
VTM.Samples[j].Length := 33;
VTM.Samples[j].Loop := 32
end
else
begin
VTM.Samples[j].Loop := l - 1;
if VTM.Samples[j].Loop > 31 then VTM.Samples[j].Loop := 31;
VTM.Samples[j].Length := l + STC.Index[$1B + $63 * i + $62];
if VTM.Samples[j].Length > 32 then VTM.Samples[j].Length := 32;
if VTM.Samples[j].Length = 0 then Inc(VTM.Samples[j].Length);
if VTM.Samples[j].Loop >= VTM.Samples[j].Length then
VTM.Samples[j].Loop := VTM.Samples[j].Length - 1;
l := VTM.Samples[j].Loop + 1;
if VTM.Samples[j].Length < 32 then
begin
Inc(VTM.Samples[j].Length, 33 - l);
VTM.Samples[j].Loop := 32
end
end;
for k := 0 to 31 do
begin
VTM.Samples[j].Items[k] := EmptySampleTick;
VTM.Samples[j].Items[k].Mixer_Noise :=
STC.Index[$1B + $63 * i + 1 + k * 3 + 1] and 128 = 0;
if VTM.Samples[j].Items[k].Mixer_Noise then
VTM.Samples[j].Items[k].Add_to_Envelope_or_Noise :=
STC.Index[$1B + $63 * i + 1 + k * 3 + 1] and $1F;
if VTM.Samples[j].Items[k].Add_to_Envelope_or_Noise and $10 <> 0 then
VTM.Samples[j].Items[k].Add_to_Envelope_or_Noise :=
VTM.Samples[j].Items[k].Add_to_Envelope_or_Noise or shortint($F0);
VTM.Samples[j].Items[k].Mixer_Ton :=
STC.Index[$1B + $63 * i + 1 + k * 3 + 1] and 64 = 0;
VTM.Samples[j].Items[k].Amplitude :=
STC.Index[$1B + $63 * i + 1 + k * 3] and 15;
VTM.Samples[j].Items[k].Add_to_Ton :=
STC.Index[$1B + $63 * i + 1 + k * 3 + 2] +
word(STC.Index[$1B + $63 * i + 1 + k * 3] and $F0) shl 4;
if STC.Index[$1B + $63 * i + 1 + k * 3 + 1] and $20 = 0 then
VTM.Samples[j].Items[k].Add_to_Ton :=
-VTM.Samples[j].Items[k].Add_to_Ton;
VTM.Samples[j].Items[k].Envelope_Enabled := True
end;
if l = 0 then
VTM.Samples[j].Items[32] := EmptySampleTick
else for k := 32 to VTM.Samples[j].Length - 1 do
VTM.Samples[j].Items[k] := VTM.Samples[j].Items[k + l - 33]
end
end
end;
function STP2VTM(STP: PSpeccyModule; VTM: PModule): boolean;
type
TSTPPat = record
Numb, Trans: integer;
end;
var
ChPtr: packed array[0..2] of word;
Gliss, Skip, SkipCounter: array[0..2] of shortint;
IsOrnament: array[0..15] of boolean;
IsSample: array[1..15] of boolean;
CPat: TSTPPat;
procedure PatternInterpreter(PatNum, LnNum, ChNum: integer);
var
quit, StopGliss: boolean;
nt: byte;
i: integer;
begin
quit := False;
StopGliss := False;
repeat
case STP.Index[ChPtr[ChNum]] of
$1..$60:
begin
nt := STP.Index[ChPtr[ChNum]] - 1 + CPat.Trans;
if nt > $5F then nt := $5F;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Note := nt;
if not StopGliss then
begin
i := Gliss[ChNum];
if (i <> 0) and
(VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number = 0) then
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Delay := 1;
if i > 0 then
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 1;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := i
end
else
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 2;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := -i
end
end
end
else
begin
StopGliss := False;
Gliss[ChNum] := 0
end;
quit := True
end;
$61..$6F:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Sample :=
STP.Index[ChPtr[ChNum]] - $60;
IsSample[VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Sample] := True
end;
$70..$7F:
begin
StopGliss := True;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament :=
STP.Index[ChPtr[ChNum]] - $70;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15;
IsOrnament[VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Ornament] := True
end;
$80..$BF:
Skip[ChNum] := STP.Index[ChPtr[ChNum]] - $80;
$C0..$CF:
begin
StopGliss := True;
if STP.Index[ChPtr[ChNum]] <> $C0 then
begin
if STP.Index[ChPtr[ChNum]] <> $CF then
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope :=
STP.Index[ChPtr[ChNum]] - $C0
else
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 7;
Inc(ChPtr[ChNum]);
VTM.Patterns[PatNum].Items[LnNum].Envelope := STP.Index[ChPtr[ChNum]]
end
else
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := 0
end;
$D0..$DF:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Note := -2;
quit := True
end;
$E0..$EF:
quit := True;
$F0:
begin
Inc(ChPtr[ChNum]);
i := shortint(STP.Index[ChPtr[ChNum]]);
if i = 0 then
StopGliss := True
else
begin
Gliss[ChNum] := i;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Delay := 1;
if i >= 0 then
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 1;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := i
end
else
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 2;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := -i
end
end
end;
$F1..$FF:
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Volume :=
256 - STP.Index[ChPtr[ChNum]]
end;
Inc(ChPtr[ChNum])
until quit;
if StopGliss and (Gliss[ChNum] <> 0) then
begin
Gliss[ChNum] := 0;
if VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number = 0 then
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 1;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Delay := 0;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := 0
end
end;
SkipCounter[ChNum] := Skip[ChNum]
end;
var
i, j, k, Pos, PatMax: Integer;
quit: boolean;
KsaId2: string;
Pats: array[0..MaxPatNum] of TSTPPat;
begin
Result := True;
SetLength(KsaId2, 28);
Move(STP.Index[10], KsaId2[1], 28);
if KsaId2 = KsaId then
begin
SetLength(VTM.Title, 25);
Move(STP.Index[38], VTM.Title[1], 25);
VTM.Title := TrimRight(VTM.Title)
end
else
VTM.Title := '';
VTM.Author := '';
VTM.Ton_Table := 1;
VTM.Initial_Delay := STP.STP_Delay;
VTM.Positions.Loop := STP.Index[STP.STP_PositionsPointer + 1];
for i := 0 to 15 do
VTM.Ornaments[i] := nil;
for i := 1 to 15 do
IsOrnament[i] := False;
for i := 1 to 31 do
VTM.Samples[i] := nil;
for i := 1 to 15 do
IsSample[i] := False;
for i := 0 to MaxPatNum do
VTM.Patterns[i] := nil;
for k := 0 to 2 do
Gliss[k] := 0;
PatMax := 0;
Pos := 0;
while Pos < STP.Index[STP.STP_PositionsPointer] do
begin
CPat.Numb := STP.Index[STP.ST_PositionsPointer + 2 + Pos * 2] div 6;
CPat.Trans := STP.Index[STP.ST_PositionsPointer + 3 + Pos * 2];
j := PatMax;
for i := 0 to PatMax - 1 do
if (Pats[i].Numb = CPat.Numb) and
(Pats[i].Trans = CPat.Trans) then
begin
j := i;
break
end;
if j = PatMax then
begin
Inc(PatMax);
Pats[j] := CPat
end;
VTM.Positions.Value[Pos] := j;
Inc(Pos);
if VTM.Patterns[j] = nil then
begin
NewPattern(VTM.Patterns[j]);
for k := 0 to 2 do
begin
SkipCounter[k] := 0;
Skip[k] := 0
end;
Move(STP.Index[STP.STP_PatternsPointer + CPat.Numb * 6], ChPtr, 6);
i := 0; quit := False;
while (i < MaxPatLen) and not quit do
begin
for k := 0 to 2 do
begin
Dec(SkipCounter[k]);
if SkipCounter[k] < 0 then
begin
if (k = 0) and (STP.Index[ChPtr[0]] = 0) then
begin
Dec(i);
quit := True;
break
end;
PatternInterpreter(j, i, k)
end
end;
Inc(i)
end;
VTM.Patterns[j].Length := i
end
else
for k := 0 to 2 do
Gliss[k] := 0
end;
VTM.Positions.Length := Pos;
if VTM.Positions.Loop >= Pos then
VTM.Positions.Loop := Pos - 1;
for i := 1 to 15 do
begin
if IsOrnament[i] then
begin
New(VTM.Ornaments[i]);
j := WordPtr(@STP.Index[STP.STP_OrnamentsPointer + i * 2])^;
VTM.Ornaments[i].Loop := STP.Index[j]; Inc(j);
VTM.Ornaments[i].Length := STP.Index[j];
for k := 0 to VTM.Ornaments[i].Length - 1 do
begin
Inc(j);
VTM.Ornaments[i].Items[k] := STP.Index[j]
end
end
end;
for i := 1 to 15 do
begin
if IsSample[i] then
begin
New(VTM.Samples[i]);
j := WordPtr(@STP.Index[STP.STP_SamplesPointer + (i - 1) * 2])^;
VTM.Samples[i].Loop := STP.Index[j]; Inc(j);
VTM.Samples[i].Length := STP.Index[j]; Inc(j);
for k := 0 to VTM.Samples[i].Length - 1 do
begin
VTM.Samples[i].Items[k] := EmptySampleTick;
VTM.Samples[i].Items[k].Add_to_Ton := WordPtr(@STP.Index[j + k * 4 + 2])^;
VTM.Samples[i].Items[k].Amplitude := STP.Index[j + k * 4] and 15;
VTM.Samples[i].Items[k].Envelope_Enabled :=
STP.Index[j + k * 4 + 1] and 1 <> 0;
VTM.Samples[i].Items[k].Mixer_Ton := STP.Index[j + k * 4] and $10 = 0;
VTM.Samples[i].Items[k].Mixer_Noise := STP.Index[j + k * 4] and $80 = 0;
if VTM.Samples[i].Items[k].Envelope_Enabled or
VTM.Samples[i].Items[k].Mixer_Noise then
begin
VTM.Samples[i].Items[k].Add_to_Envelope_or_Noise :=
(STP.Index[j + k * 4 + 1] shr 1) and 31;
if VTM.Samples[i].Items[k].Add_to_Envelope_or_Noise and $10 <> 0 then
VTM.Samples[i].Items[k].Add_to_Envelope_or_Noise :=
VTM.Samples[i].Items[k].Add_to_Envelope_or_Noise or shortint($F0)
end
end;
if shortint(VTM.Samples[i].Loop) < 0 then
begin
VTM.Samples[i].Loop := VTM.Samples[i].Length;
Inc(VTM.Samples[i].Length);
VTM.Samples[i].Items[VTM.Samples[i].Loop] := EmptySampleTick
end
end
end
end;
function SQT2VTM(SQT: PSpeccyModule; VTM: PModule): boolean;
type
TSQTPat = record
Del: integer;
Chn: array[0..2] of record
EnableEffects: boolean;
PatChanNumber, Vol, Trans: integer;
end
end;
var
ChPtr: packed array[0..2] of word;
PrevNote, PrevOrn, PrevSamp: array[0..2] of byte;
ix21: array[0..2] of byte;
ix27: array[0..2] of word;
b6ix0, b7ix0, EnvEn: array[0..2] of boolean;
orns: array[1..31] of integer;
IsSample: array[1..31] of boolean;
CDelay, EnvP, EnvT: byte;
CPat: TSQTPat;
CVol: array[0..2] of byte;
NOrns: integer;
Orn2Sam: array[1..15] of byte;
procedure PatternInterpreter(PatNum, LnNum, ChNum: integer);
var
Ptr: word;
Temp, PrOrn: integer;
SampleSet: boolean;
procedure Call_LC1D1(a: byte);
begin
Inc(Ptr);
if b6ix0[ChNum] then
begin
ChPtr[ChNum] := Ptr + 1;
b6ix0[ChNum] := False
end;
case a - 1 of
0:
if CPat.Chn[ChNum].EnableEffects then
begin
CVol[ChNum] := SQT.Index[Ptr] and 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Volume := 15 -
CVol[ChNum];
if VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Volume = 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Volume := 1
end;
1:
if CPat.Chn[ChNum].EnableEffects then
begin
CVol[ChNum] := (CVol[ChNum] + SQT.Index[Ptr]) and 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Volume := 15 -
CVol[ChNum];
if VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Volume = 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Volume := 1
end;
2:
if CPat.Chn[ChNum].EnableEffects then
begin
CVol[0] := SQT.Index[Ptr] and 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[0].Volume := 15 - CVol[0];
if VTM.Patterns[PatNum].Items[LnNum].Channel[0].Volume = 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[0].Volume := 1;
CVol[1] := SQT.Index[Ptr] and 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[1].Volume := 15 - CVol[1];
if VTM.Patterns[PatNum].Items[LnNum].Channel[1].Volume = 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[1].Volume := 1;
CVol[2] := SQT.Index[Ptr] and 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[2].Volume := 15 - CVol[2];
if VTM.Patterns[PatNum].Items[LnNum].Channel[2].Volume = 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[2].Volume := 1
end;
3:
if CPat.Chn[ChNum].EnableEffects then
begin
CVol[0] := (CVol[0] + SQT.Index[Ptr]) and 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[0].Volume := 15 - CVol[0];
if VTM.Patterns[PatNum].Items[LnNum].Channel[0].Volume = 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[0].Volume := 1;
CVol[1] := (CVol[1] + SQT.Index[Ptr]) and 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[1].Volume := 15 - CVol[1];
if VTM.Patterns[PatNum].Items[LnNum].Channel[1].Volume = 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[1].Volume := 1;
CVol[2] := (CVol[2] + SQT.Index[Ptr]) and 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[2].Volume := 15 - CVol[2];
if VTM.Patterns[PatNum].Items[LnNum].Channel[2].Volume = 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[2].Volume := 1
end;
4:
if CPat.Chn[ChNum].EnableEffects then
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 11;
CDelay := SQT.Index[Ptr] and 31;
if CDelay = 0 then CDelay := 32;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := CDelay
end;
5:
if CPat.Chn[ChNum].EnableEffects then
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 11;
CDelay := (CDelay + SQT.Index[Ptr]) and 31;
if CDelay = 0 then CDelay := 32;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := CDelay
end;
6:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Delay := 1;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 2;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := SQT.Index[Ptr]
end;
7:
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Delay := 1;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Number := 1;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].
Additional_Command.Parameter := SQT.Index[Ptr]
end;
else
begin
EnvEn[ChNum] := True;
EnvT := (a - 1) and 15;
if EnvT = 15 then EnvT := 7;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := EnvT;
if PrevOrn[ChNum] <> 255 then
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament :=
PrevOrn[ChNum];
EnvP := SQT.Index[Ptr];
VTM.Patterns[PatNum].Items[LnNum].Envelope := EnvP
end
end
end;
procedure Call_LC2A8(a: byte);
begin
if EnvEn[ChNum] or (PrevOrn[ChNum] <> 0) then
begin
SampleSet := True;
PrOrn := PrevOrn[ChNum];
PrevOrn[ChNum] := 0;
EnvEn[ChNum] := False;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := 0
end;
if (a > 0) and (a <= 31) then IsSample[a] := True;
if PrevSamp[ChNum] <> a then
begin
PrevSamp[ChNum] := a;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Sample := a
end;
if a <> 0 then
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Note := PrevNote[ChNum]
end;
procedure Call_LC2D9(a: byte);
var
orn: integer;
begin
if a = 0 then exit;
orn := orns[a];
if orn < 0 then
begin
if NOrns >= 15 then exit;
Inc(NOrns);
orn := NOrns;
orns[a] := orn
end;
if SampleSet then
begin
PrevOrn[ChNum] := PrOrn;
if not EnvEn[ChNum] then
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 0
end;
if EnvEn[ChNum] or (PrevOrn[ChNum] <> orn) then
begin
PrevOrn[ChNum] := orn;
if EnvEn[ChNum] then
begin
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := EnvT;
VTM.Patterns[PatNum].Items[LnNum].Envelope := EnvP
end
else
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Envelope := 15;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Ornament := orn
end
end;
procedure Call_LC283;
begin
case SQT.Index[Ptr] of
0..$7F:
Call_LC1D1(SQT.Index[Ptr]);
$80..$FF:
begin
if SQT.Index[Ptr] shr 1 and 31 <> 0 then
Call_LC2A8(SQT.Index[Ptr] shr 1 and 31);
if SQT.Index[Ptr] and 64 <> 0 then
begin
Temp := SQT.Index[Ptr + 1] shr 4;
if SQT.Index[Ptr] and 1 <> 0 then Temp := Temp or 16;
if Temp <> 0 then Call_LC2D9(Temp);
Inc(Ptr);
if SQT.Index[Ptr] and 15 <> 0 then
Call_LC1D1(SQT.Index[Ptr] and 15)
end
end
end;
Inc(Ptr)
end;
procedure Call_LC191;
begin
Ptr := ix27[ChNum];
b6ix0[ChNum] := False;
case SQT.Index[Ptr] of
0..$7F:
begin
Inc(Ptr);
Call_LC283
end;
$80..$FF:
Call_LC2A8(SQT.Index[Ptr] and 31)
end
end;
var
nt: byte;
begin
SampleSet := False;
if ix21[ChNum] <> 0 then
begin
Dec(ix21[ChNum]);
if b7ix0[ChNum] then
Call_LC191;
if (PrevOrn[ChNum] > 0) and (Orn2Sam[PrevOrn[ChNum]] = 0) then
Orn2Sam[PrevOrn[ChNum]] := PrevSamp[ChNum];
exit
end;
Ptr := ChPtr[ChNum];
b7ix0[ChNum] := False;
b6ix0[ChNum] := True;
repeat
case SQT.Index[Ptr] of
$0..$5F:
begin
nt := SQT.Index[Ptr] + CPat.Chn[ChNum].Trans + 2;
if nt > $5F then nt := $5F;
VTM.Patterns[PatNum].Items[LnNum].Channel[ChNum].Note := nt;
PrevNote[ChNum] := nt;
ix27[ChNum] := Ptr;
Inc(Ptr);
Call_LC283;
if b6ix0[ChNum] then ChPtr[ChNum] := Ptr;
break
end;
$60..$6E:
begin
Call_LC1D1(SQT.Index[Ptr] - $60);
break
end;