UNIT SoundEnginePlayer;
{$IFDEF FPC}
 {$MODE DELPHI}
 {$WARNINGS OFF}
 {$HINTS OFF}
 {$OVERFLOWCHECKS OFF}
 {$RANGECHECKS OFF}
 {$IFDEF CPUI386}
  {$ASMMODE INTEL}
 {$ENDIF}
{$ENDIF}

INTERFACE

USES Windows,Messages,CommDlg,MMSystem,synth;

CONST BufferSize=2048;

      ChipOPL2=0;
      ChipOPL3=1;

TYPE PBufferSample=^TBufferSample;
     TBufferSample=PACKED RECORD
      Left,Right:SINGLE;
     END;

     TEvent=RECORD
      Tick:INTEGER;
      Note:BYTE;
      Volume:BYTE;
     END;
     TEvents=ARRAY OF TEvent;

     PBuffer=^TBuffer;
     TBuffer=ARRAY[0..BufferSize-1] OF TBufferSample;

     TSignature=ARRAY[1..8] OF CHAR;

     PPatternNoteEffect=^TPatternNoteEffect;
     TPatternNoteEffect=PACKED RECORD
      Effect:BYTE;
      Parameter:BYTE;
     END;

     PPatternNote=^TPatternNote;
     TPatternNote=PACKED RECORD
      Note:BYTE;
      Volume:BYTE;
      EffectA:TPatternNoteEffect;
      EffectB:TPatternNoteEffect;
     END;

     PPattern=^TPattern;
     TPattern=ARRAY[0..63,0..15] OF TPatternNote;

     TPatterns=ARRAY[0..255] OF TPattern;

     TChannel=PACKED RECORD
      Mode:BYTE;
      Mute:BYTE;
      Active:BYTE;
     END;
     TChannels=ARRAY[0..15] OF TChannel;

     TEffectData=RECORD
      Effect:BYTE;
      EffectParameter:BYTE;
      Pattern:BYTE;
      PatternNr:BYTE;
      Row:BYTE;
      TempVolume:BYTE;
      ArpeggioPosition:LONGWORD;
      Arpeggio:ARRAY[0..2] OF LONGWORD;
      TremoloParameterHi:LONGWORD;
      TremoloParameterLo:LONGINT;
      TremoloTyp:LONGWORD;
      TremoloPosition:LONGWORD;
      RetrigCounter:INTEGER;
      PatternLoop:BOOLEAN;
      PatternLoopStart:BYTE;
      PatternLoopCount:BYTE;
     END;

     TChannelData=RECORD
      Note:BYTE;
      Volume:BYTE;
      EffectA,EffectB:TEffectData;
     END;
     TChannelsData=ARRAY[0..15] OF TChannelData;

     TChannelFrequencys=ARRAY[0..15] OF BYTE;

     TInstrumentName=STRING[24];

     PInstrument=^TInstrument;
     TInstrument=PACKED RECORD
      Name:TInstrumentName;
     END;
     TInstruments=ARRAY[0..15] OF TInstrument;

     TPatternOrder=ARRAY[0..255] OF BYTE;

     TWaveStatusReport=PROCEDURE(Percent:LONGWORD) OF OBJECT;

     TPlayed=ARRAY[0..255] OF BYTE;

     TThreadMethod=PROCEDURE OF OBJECT;
     TThreadPriority=(tpIdle,tpLowest,tpLower,tpNormal,tpHigher,tpHighest,tpTimeCritical);

     TThread=CLASS
      PRIVATE
       FHandle,FThreadID:THandle;
       FFinished,FSuspended,FTerminated,FFreeOnTerminate,FEntered:BOOLEAN;
       FReturnValue:DWORD;
       FCriticalSection:TRTLCriticalSection;
       FUNCTION GetPriority:TThreadPriority;
       PROCEDURE SetPriority(Value:TThreadPriority);
       PROCEDURE SetSuspended(Value:Boolean);
      PROTECTED
       PROCEDURE Execute; VIRTUAL; ABSTRACT;
       PROPERTY ReturnValue:DWORD READ FReturnValue WRITE FReturnValue;
       PROPERTY Terminated:BOOLEAN READ FTerminated;
      PUBLIC
       CONSTRUCTOR Create(CreateSuspended:BOOLEAN);
       DESTRUCTOR Destroy; OVERRIDE;
       PROCEDURE Resume;
       PROCEDURE Suspend;
       PROCEDURE Terminate;
       PROCEDURE HardTerminate;
       PROCEDURE TerminateAndWait;
       PROCEDURE ThreadEnter;
       PROCEDURE ThreadLeave;
       PROCEDURE Enter;
       PROCEDURE Leave;
       PROPERTY FreeOnTerminate:BOOLEAN READ FFreeOnTerminate WRITE FFreeOnTerminate;
       PROPERTY Entered:BOOLEAN READ FEntered WRITE FEntered;
       PROPERTY Handle:THandle READ FHandle;
       PROPERTY Priority:TThreadPriority READ GetPriority WRITE SetPriority;
       PROPERTY Suspended:BOOLEAN READ FSuspended WRITE SetSuspended;
       PROPERTY ThreadID:THandle READ FThreadID;
     END;

     TTrack=CLASS(TThread)
      PRIVATE
       OutputBufferSize:LONGWORD;
       WaveFormat:TWaveFormatEx;
       WaveHandle:LONGWORD;
       WaveOutHandle:LONGWORD;
       WaveHandler:ARRAY[0..3] OF PWAVEHDR;
       BufferCounter:LONGWORD;
       Start:BOOLEAN;
       BPMSamples:LONGWORD;
       BPMSamplesCount:LONGWORD;
       Frequencys:TChannelFrequencys;
       IsTrackActive:BOOLEAN;
       Speed,BPM,Tick:BYTE;
       BD:BYTE;
       PatternBreak:BOOLEAN;
       PatternJump:BOOLEAN;
       PatternBreakTo:BYTE;
       PatternJumpTo:BYTE;
       PatternLoopRow:INTEGER;
       FrameDelay:BYTE;
       PatternDelay:BYTE;
       Buffer:PBuffer;
       TickCounter:INTEGER;
       RecordEvents:BOOLEAN;
       PROCEDURE SetTickVariables;
       PROCEDURE DoTick;
       FUNCTION DoMix(StartPosition,LengthCounter:LONGWORD;VAR DoContinue:LONGBOOL):LONGWORD;
       PROCEDURE MixBuffer(DestBuffer:POINTER);
      PROTECTED
       PROCEDURE Execute; OVERRIDE;
      PUBLIC
       Frequency:LONGWORD;
       Channels:TChannels;
       ChannelsData:TChannelsData;
       Patterns:TPatterns;
       PatternOrder:TPatternOrder;
       Instruments:TInstruments;
       SynthData:TSynthData;

       CurrentPatternOrder:BYTE;
       CurrentRow:BYTE;

       NextPatternOrder:BYTE;
       NextRow:BYTE;

       CountOfChannels:BYTE;
       Playing:BOOLEAN;
       FollowSong:BOOLEAN;

       RowHilightMinor:BYTE;
       RowHilightMajor:BYTE;

       RestartPosition:BYTE;

       DrumMode:BYTE;
       ChipMode:BYTE;

       Changed:BOOLEAN;
       FixedPattern:BOOLEAN;

       SongName:STRING;
       SongAuthor:STRING;
       SongMessage:STRING;

       Played:TPlayed;
       ShouldExit:BOOLEAN;

       ConvertOldEffects:BOOLEAN;

       WaveStatusReport:TWaveStatusReport;

       Events:ARRAY[0..15] OF TEvents;

       CONSTRUCTOR Create(CreateSuspended:BOOLEAN;AFrequency:LONGWORD);
       DESTRUCTOR Destroy; OVERRIDE;

       PROCEDURE Clear;
       PROCEDURE AddEvent(Channel,Tick:INTEGER;VAR Event:TEvent);
       PROCEDURE AddNewEvent(Channel,Note,Volume:BYTE);
       
       FUNCTION Load(DataPointer:POINTER;DataSize:LONGWORD):BOOLEAN;
       FUNCTION LoadFile(FileName:STRING):BOOLEAN;
       FUNCTION SaveFile(FileName:STRING):BOOLEAN;

       FUNCTION LoadInstrumentFile(Nr:BYTE;FileName:STRING):BOOLEAN;
       FUNCTION SaveInstrumentFile(Nr:BYTE;FileName:STRING):BOOLEAN;

       FUNCTION Play:BOOLEAN;
       PROCEDURE Poll;

       PROCEDURE RetrigNote(Channel,Parameter:INTEGER;VAR Effect:TEffectData);
       PROCEDURE PlayNote(Pattern,Row,Channel:BYTE);
       PROCEDURE PlayNoteTick(Pattern,Row,Channel:BYTE);
       PROCEDURE Stop;

       PROCEDURE DataUpdate;

       FUNCTION ExportToWaveFile(FileName:STRING;LoopExport:BOOLEAN):BOOLEAN;
       FUNCTION ExportToB4MFile(FileName:STRING;LoopExport:BOOLEAN):BOOLEAN;

       PROPERTY TrackActive:BOOLEAN READ IsTrackActive WRITE IsTrackActive;
     END;

IMPLEMENTATION

{$HINTS OFF}

CONST T0ASTSignature:TSignature='T0AST0OK';
      T0ASTSignature2:TSignature='T0AST'#1#0#1;
      T0ASTInstrumentSignature:TSignature='T0ASTINS';

      RetrigTabelle1:ARRAY[0..16-1] OF SHORTINT=(0,0,0,0,0,0,10,8,0,0,0,0,0,0,24,32);

      RetrigTabelle2:ARRAY[0..16-1] OF SHORTINT=(0,-1,-2,-4,-8,-16,0,0,0,1,2,4,8,16,0,0);


FUNCTION ThreadProc(Thread:TThread):DWORD;
VAR ThreadBeendet:BOOLEAN;
BEGIN
 Thread.Execute;
 ThreadBeendet:=Thread.FFreeOnTerminate;
 RESULT:=Thread.FReturnValue;
 Thread.FFinished:=TRUE;
 IF ThreadBeendet THEN BEGIN
  Thread.Free;
  Thread:=NIL;
 END;
 EndThread(RESULT);
END;
{$HINTS ON}

CONSTRUCTOR TThread.Create(CreateSuspended:BOOLEAN);
VAR Flags:DWORD;
BEGIN
 INHERITED Create;
 InitializeCriticalSection(FCriticalSection);
 FEntered:=FALSE;
 FSuspended:=CreateSuspended;
 Flags:=0;
 IF CreateSuspended THEN Flags:=CREATE_SUSPENDED;
 FHandle:=BeginThread(NIL,0,@ThreadProc,POINTER(SELF),Flags,FThreadID);
END;

DESTRUCTOR TThread.Destroy;
BEGIN
 IF FHandle<>0 THEN CloseHandle(FHandle);
 DeleteCriticalSection(FCriticalSection);
 INHERITED Destroy;
END;

CONST Priorities:ARRAY[TThreadPriority] OF INTEGER=
      (THREAD_PRIORITY_IDLE,THREAD_PRIORITY_LOWEST,THREAD_PRIORITY_BELOW_NORMAL,
       THREAD_PRIORITY_NORMAL,THREAD_PRIORITY_ABOVE_NORMAL,THREAD_PRIORITY_HIGHEST,
       THREAD_PRIORITY_TIME_CRITICAL);

FUNCTION TThread.GetPriority:TThreadPriority;
VAR P:INTEGER;
    I:TThreadPriority;
BEGIN
 P:=GetThreadPriority(FHandle);
 RESULT:=tpNormal;
 FOR I:=LOW(TThreadPriority) TO HIGH(TThreadPriority) DO IF Priorities[I]=P THEN RESULT:=I;
END;

PROCEDURE TThread.SetPriority(Value:TThreadPriority);
BEGIN
 SetThreadPriority(FHandle,Priorities[Value]);
END;

PROCEDURE TThread.SetSuspended(Value:BOOLEAN);
BEGIN
 IF Value<>FSuspended THEN BEGIN
  IF Value THEN BEGIN
   Suspend;
  END ELSE Resume;
 END;
END;

PROCEDURE TThread.Suspend;
BEGIN
 FSuspended:=TRUE;
 SuspendThread(FHandle);
END;

PROCEDURE TThread.Resume;
BEGIN
 IF ResumeThread(FHandle)=1 THEN FSuspended:=FALSE;
END;

PROCEDURE TThread.Terminate;
BEGIN
 FTerminated:=TRUE;
END;

PROCEDURE TThread.HardTerminate;
BEGIN
 FTerminated:=TRUE;
 WaitForSingleObject(FHandle,125);
 TerminateThread(FHandle,0);
 WaitForSingleObject(FHandle,5000);
END;

PROCEDURE TThread.TerminateAndWait;
BEGIN
 FTerminated:=TRUE;
 WaitForSingleObject(FHandle,LONGWORD(-1));
END;

PROCEDURE TThread.ThreadEnter;
BEGIN
 EnterCriticalSection(FCriticalSection);
END;

PROCEDURE TThread.ThreadLeave;
BEGIN
 LeaveCriticalSection(FCriticalSection);
END;

PROCEDURE TThread.Enter;
BEGIN
 EnterCriticalSection(FCriticalSection);
 FEntered:=TRUE;
END;

PROCEDURE TThread.Leave;
BEGIN
 FEntered:=FALSE;
 LeaveCriticalSection(FCriticalSection);
END;

CONSTRUCTOR TTrack.Create(CreateSuspended:BOOLEAN;AFrequency:LONGWORD);
VAR I:INTEGER;
BEGIN
 INHERITED Create(CreateSuspended);

 CountOfChannels:=16;
 Playing:=FALSE;
 FollowSong:=TRUE;

 RowHilightMinor:=4;
 RowHilightMajor:=16;

 Changed:=FALSE;
 
 Priority:=tpTimeCritical;

 Start:=FALSE;
 IsTrackActive:=FALSE;

 Frequency:=AFrequency;

 WaveStatusReport:=NIL;

 Clear;

 OutputBufferSize:=SIZEOF(TBuffer);

 ConvertOldEffects:=FALSE;
 
 WaveFormat.wFormatTag:=3;
 WaveFormat.nChannels:=2;
 WaveFormat.wBitsPerSample:=32;
 WaveFormat.nBlockAlign:=WaveFormat.nChannels*WaveFormat.wBitsPerSample DIV 8;
 WaveFormat.nSamplesPerSec:=Frequency;
 WaveFormat.nAvgBytesPerSec:=WaveFormat.nSamplesPerSec*WaveFormat.nBlockAlign;
 WaveFormat.cbSize:=0;
 WaveHandle:=waveOutOpen(@WaveOutHandle,WAVE_MAPPER,@WaveFormat,0,0,0);

 FOR I:=0 TO 3 DO BEGIN
  GETMEM(WaveHandler[I],SIZEOF(TWAVEHDR));
  WaveHandler[I].dwFlags:=WHDR_DONE;
  GETMEM(WaveHandler[I].lpData,OutputBufferSize);
  FILLCHAR(WaveHandler[I].lpData^,OutputBufferSize,#0);
  WaveHandler[I].dwBufferLength:=OutputBufferSize;
  WaveHandler[I].dwBytesRecorded:=0;
  WaveHandler[I].dwUser:=0;
  WaveHandler[I].dwLoops:=0;
 END;
 FOR I:=0 TO 15 DO Events[I]:=NIL;
END;

DESTRUCTOR TTrack.Destroy;
VAR I:INTEGER;
BEGIN
 Clear;
 FOR I:=0 TO 15 DO SETLENGTH(Events[I],0);
 waveOutReset(WaveOutHandle);
 FOR I:=0 TO 3 DO BEGIN
  WHILE waveOutUnprepareHeader(WaveOutHandle,WaveHandler[I],SIZEOF(TWAVEHDR))=WAVERR_STILLPLAYING DO BEGIN
   SLEEP(25);
  END;
 END;
 waveOutReset(WaveOutHandle);
 waveOutClose(WaveOutHandle);
 FOR I:=0 TO 3 DO BEGIN
  FREEMEM(WaveHandler[I].lpData);
  FREEMEM(WaveHandler[I]);
 END;
 INHERITED Destroy;
END;

PROCEDURE TTrack.Clear;
VAR I,J,ChannelCounter:INTEGER;
BEGIN
 FOR I:=0 TO 15 DO SETLENGTH(Events[I],0);
 SongName:='';
 SongAuthor:='';
 SongMessage:='';
 IsTrackActive:=FALSE;
 FILLCHAR(Channels,SIZEOF(TChannels),#0);
 FILLCHAR(ChannelsData,SIZEOF(TChannelsData),#0);
 FILLCHAR(Frequencys,SIZEOF(TChannelFrequencys),#0);
 FILLCHAR(Patterns,SIZEOF(TPatterns),#0);
 FILLCHAR(PatternOrder,SIZEOF(TPatternOrder),#255);
 FILLCHAR(Instruments,SIZEOF(TInstruments),#0);
 FILLCHAR(SynthData,SIZEOF(TSynthData),#0);
 FOR ChannelCounter:=0 TO 15 DO BEGIN
  Instruments[ChannelCounter].Name:='';
  FOR I:=0 TO 255 DO BEGIN
   FOR J:=0 TO 63 DO BEGIN
    Patterns[I,J,ChannelCounter].Note:=0;
    Patterns[I,J,ChannelCounter].Volume:=$FF;
    Patterns[I,J,ChannelCounter].EffectA.Effect:=0;
    Patterns[I,J,ChannelCounter].EffectA.Parameter:=0;
    Patterns[I,J,ChannelCounter].EffectB.Effect:=0;
    Patterns[I,J,ChannelCounter].EffectB.Parameter:=0;
   END;
  END;
  Channels[ChannelCounter].Active:=1;
  SynthData.FileData.WaveForm[ChannelCounter]:=0;
  SynthData.FileData.Link[ChannelCounter]:=$FF;
  SynthData.FileData.LinkFactor[ChannelCounter]:=0;
  SynthData.FileData.OutFactor[ChannelCounter]:=1;
  SynthData.FileData.StartVolume[ChannelCounter]:=1;
  SynthData.FileData.StartVolumeFactor[ChannelCounter]:=1;
  SynthData.FileData.StartPhaseFactor[ChannelCounter]:=1;
  SynthData.FileData.Panning[ChannelCounter]:=$80;
  SynthData.ADSRData.AttackStep[ChannelCounter]:=0.01;
  SynthData.ADSRData.DecayStep[ChannelCounter]:=0;
  SynthData.ADSRData.DestDecay[ChannelCounter]:=1;
  SynthData.ADSRData.Sustain[ChannelCounter]:=TRUE;
  SynthData.ADSRData.ReleaseStep[ChannelCounter]:=-0.01;
 END;
 SynthInit;
 SynthInitData(SynthData);
 PatternOrder[0]:=0;
 RestartPosition:=0;
 ChipMode:=ChipOPL2;
 DrumMode:=0;
 DataUpdate;
END;

PROCEDURE TTrack.AddEvent(Channel,Tick:INTEGER;VAR Event:TEvent);
VAR Index:INTEGER;
BEGIN
 IF RecordEvents AND NOT (ShouldExit AND (Tick=0)) THEN BEGIN
  Index:=LENGTH(Events[Channel]);
  SETLENGTH(Events[Channel],Index+1);
  Events[Channel,Index]:=Event;
  Events[Channel,Index].Tick:=Tick;
 END;
END;

PROCEDURE TTrack.AddNewEvent(Channel,Note,Volume:BYTE);
VAR Event:TEvent;
    Index,LastTick:INTEGER;
BEGIN
 IF RecordEvents AND NOT (ShouldExit AND (Tick=0)) THEN BEGIN
  Index:=LENGTH(Events[Channel]);
  IF Index>0 THEN BEGIN
   Event:=Events[Channel,Index-1];
   LastTick:=Event.Tick;
  END ELSE BEGIN
   LastTick:=0;
  END;
  WHILE (TickCounter-LastTick)>255 DO BEGIN
   FILLCHAR(Event,SIZEOF(TEvent),#0);
   Event.Note:=$FF;
   Event.Volume:=0;
   INC(LastTick,255);
   AddEvent(Channel,LastTick,Event);
  END;
  FILLCHAR(Event,SIZEOF(TEvent),#0);
  Event.Note:=Note;
  Event.Volume:=Volume;
  AddEvent(Channel,TickCounter,Event);
 END;
END;

FUNCTION TTrack.Load(DataPointer:POINTER;DataSize:LONGWORD):BOOLEAN;
VAR DataPosition,LW:LONGWORD;
    I:INTEGER;
 FUNCTION Read(VAR Buffer;LengthCounter:LONGWORD):LONGWORD;
 VAR SourcePointer,DestPointer:POINTER;
 BEGIN
  RESULT:=0;
  SourcePointer:=POINTER(LONGWORD(LONGWORD(DataPointer)+DataPosition));
  DestPointer:=@Buffer;
  WHILE (DataPosition<DataSize) AND (RESULT<LengthCounter) DO BEGIN
   BYTE(DestPointer^):=BYTE(SourcePointer^);
   INC(LONGWORD(SourcePointer));
   INC(LONGWORD(DestPointer));
   INC(DataPosition);
   INC(RESULT);
  END;
  IF RESULT<>LengthCounter THEN BEGIN
   WHILE RESULT<LengthCounter DO BEGIN
    BYTE(DestPointer^):=0;
    INC(LONGWORD(DestPointer));
    INC(RESULT);
   END;
  END;
 END;
 FUNCTION ReadByte:BYTE;
 BEGIN
  Read(RESULT,SIZEOF(BYTE));
 END;
 PROCEDURE ReadPattern(Nr:INTEGER);
 VAR Used:BYTE;
     B,BP,BPC,C:BYTE;
     I,J:INTEGER;
     EmptyNote,ANote:TPatternNote;
 BEGIN
  Used:=ReadByte;
  IF Used<>0 THEN BEGIN
   FOR I:=0 TO CountOfChannels-1 DO BEGIN
    EmptyNote.Note:=0;
    EmptyNote.Volume:=$FF;
    EmptyNote.EffectA.Effect:=0;
    EmptyNote.EffectA.Parameter:=0;
    EmptyNote.EffectB.Effect:=0;
    EmptyNote.EffectB.Parameter:=0;
    ANote:=EmptyNote;
    J:=0;
    WHILE J<64 DO BEGIN
     B:=ReadByte;
     IF (B AND 128)<>0 THEN BEGIN
      C:=B AND $7F;
      IF C>0 THEN BEGIN
       BP:=ReadByte;
       BPC:=J-BP;
       WHILE (C>0) AND (J<64) DO BEGIN
        ANote:=Patterns[Nr,BPC,I];
        Patterns[Nr,J,I]:=ANote;
        INC(BPC);
        INC(J);
        DEC(C);
       END;
      END ELSE BEGIN
       ANote:=EmptyNote;
       Patterns[Nr,J,I]:=ANote;
       INC(J);
      END;
     END ELSE BEGIN
      IF (B AND 1)<>0 THEN ANote.Note:=ReadByte;
      IF (B AND 2)<>0 THEN ANote.Volume:=ReadByte;
      IF (B AND 4)<>0 THEN ANote.EffectA.Effect:=ReadByte;
      IF (B AND 8)<>0 THEN ANote.EffectA.Parameter:=ReadByte;
      IF (B AND 16)<>0 THEN ANote.EffectB.Effect:=ReadByte;
      IF (B AND 32)<>0 THEN ANote.EffectB.Parameter:=ReadByte;
      IF ConvertOldEffects THEN BEGIN
       IF ANote.EffectA.Effect=14 THEN ANote.EffectA.Effect:=19;
       IF ANote.EffectB.Effect=14 THEN ANote.EffectB.Effect:=19;
      END;
      IF (B AND 64)<>0 THEN BEGIN
       C:=ReadByte;
       WHILE (C>0) AND (J<64) DO BEGIN
        Patterns[Nr,J,I]:=ANote;
        INC(J);
        DEC(C);
       END;
      END ELSE BEGIN
       Patterns[Nr,J,I]:=ANote;
       INC(J);
      END;
     END;
    END;
   END;
  END;
 END;
VAR Used:BYTE;
    LengthOfPatternOrder:WORD;
    Signature:TSignature;
BEGIN
 RESULT:=FALSE;
 Clear;
 DataPosition:=0;
 Read(Signature,SIZEOF(TSignature));
 IF (Signature=T0ASTSignature) OR (Signature=T0ASTSignature2) THEN BEGIN
  Read(SynthData.FileData,SIZEOF(TSynthFileData));
  IF Signature=T0ASTSignature2 THEN BEGIN
   Read(SynthData.ADSRData,SIZEOF(TSynthADSRData));
  END;
  Read(RowHilightMinor,SIZEOF(BYTE));
  Read(RowHilightMajor,SIZEOF(BYTE));
  Read(DrumMode,SIZEOF(BYTE));
  Read(ChipMode,SIZEOF(BYTE));
  Read(CountOfChannels,SIZEOF(BYTE));
  FOR I:=0 TO CountOfChannels-1 DO BEGIN
   Read(Used,SIZEOF(BYTE));
   IF Used<>0 THEN Read(Channels[I],SIZEOF(TChannel));
  END;
  FOR I:=0 TO CountOfChannels-1 DO BEGIN
   Read(Used,SIZEOF(BYTE));
   IF Used<>0 THEN Read(Instruments[I],SIZEOF(TInstrument));
  END;
  Read(LengthOfPatternOrder,SIZEOF(WORD));
  IF LengthOfPatternOrder>0 THEN Read(PatternOrder,LengthOfPatternOrder);
  FOR I:=0 TO 255 DO ReadPattern(I);
  Read(RestartPosition,SIZEOF(BYTE));
  Read(LW,SIZEOF(LONGWORD));
  SETLENGTH(SongName,LW);
  IF LW>0 THEN BEGIN
   Read(SongName[1],LW);
  END;
  Read(LW,SIZEOF(LONGWORD));
  SETLENGTH(SongAuthor,LW);
  IF LW>0 THEN BEGIN
   Read(SongAuthor[1],LW);
  END;
  Read(LW,SIZEOF(LONGWORD));
  SETLENGTH(SongMessage,LW);
  IF LW>0 THEN BEGIN
   Read(SongMessage[1],LW);
  END;
  RESULT:=TRUE;
 END;
 DataUpdate;
 IsTrackActive:=RESULT;
END;

FUNCTION TTrack.LoadFile(FileName:STRING):BOOLEAN;
VAR TheFile:FILE;
    Data:POINTER;
    Size:LONGWORD;
BEGIN
 RESULT:=FALSE;
 ASSIGNFILE(TheFile,FileName);
 {$I-}RESET(TheFile,1);{$I+}
 IF IOResult<>0 THEN EXIT;
 Size:=FILESIZE(TheFile);
 GETMEM(Data,Size);
 BLOCKREAD(TheFile,Data^,Size);
 CLOSEFILE(TheFile);
 RESULT:=Load(Data,Size);
 FREEMEM(Data);
END;

FUNCTION TTrack.SaveFile(FileName:STRING):BOOLEAN;
CONST PatternCompressionLevel=2;
VAR TheFile:FILE;
 FUNCTION SavePattern(PNr:INTEGER):BOOLEAN;
 VAR CurrentChannel,CurrentRow:INTEGER;
     RLEPosition,RLELength:INTEGER;
     BestLZPosition,BestLZLength:INTEGER;
     SearchPositionCounter,SearchPosition,FoundLength:INTEGER;
     Flags:BYTE;
     EmptyNote,LastNote,BestLastNote,FoundLastNote:TPatternNote;
     CurrentNote,NoteToCompare,AnotherNoteToCompare:TPatternNote;
  PROCEDURE WriteBufferByte(B:BYTE);
  BEGIN
   BLOCKWRITE(TheFile,B,SIZEOF(BYTE));
  END;
 BEGIN
  CurrentChannel:=0;
  WHILE CurrentChannel<CountOfChannels DO BEGIN
   EmptyNote.Note:=0;
   EmptyNote.Volume:=$FF;
   EmptyNote.EffectA.Effect:=0;
   EmptyNote.EffectA.Parameter:=0;
   EmptyNote.EffectB.Effect:=0;
   EmptyNote.EffectB.Parameter:=0;
   LastNote:=EmptyNote;
   CurrentRow:=0;
   WHILE CurrentRow<64 DO BEGIN
    CurrentNote:=Patterns[PNr,CurrentRow,CurrentChannel];
    Flags:=0;
    IF CurrentNote.Note<>LastNote.Note THEN BEGIN
     Flags:=Flags OR 1;
    END;
    IF CurrentNote.Volume<>LastNote.Volume THEN BEGIN
     Flags:=Flags OR 2;
    END;
    IF CurrentNote.EffectA.Effect<>LastNote.EffectA.Effect THEN BEGIN
     Flags:=Flags OR 4;
    END;
    IF CurrentNote.EffectA.Parameter<>LastNote.EffectA.Parameter THEN BEGIN
     Flags:=Flags OR 8;
    END;
    IF CurrentNote.EffectB.Effect<>LastNote.EffectB.Effect THEN BEGIN
     Flags:=Flags OR 16;
    END;
    IF CurrentNote.EffectB.Parameter<>LastNote.EffectB.Parameter THEN BEGIN
     Flags:=Flags OR 32;
    END;
    RLELength:=0;
    IF PatternCompressionLevel>0 THEN BEGIN
     RLEPosition:=CurrentRow+1;
     WHILE RLEPosition<64 DO BEGIN
      NoteToCompare:=Patterns[PNr,RLEPosition,CurrentChannel];
      IF (CurrentNote.Note<>NoteToCompare.Note) OR (CurrentNote.Volume<>NoteToCompare.Volume) OR
         (CurrentNote.EffectA.Effect<>NoteToCompare.EffectA.Effect) OR (CurrentNote.EffectA.Parameter<>NoteToCompare.EffectA.Parameter) OR
         (CurrentNote.EffectB.Effect<>NoteToCompare.EffectB.Effect) OR (CurrentNote.EffectB.Parameter<>NoteToCompare.EffectB.Parameter) THEN BEGIN
       BREAK;
      END;
      INC(RLELength);
      INC(RLEPosition);
     END;
    END;
    BestLZLength:=0;
    BestLZPosition:=0;
    IF PatternCompressionLevel>1 THEN BEGIN
     BestLastNote:=EmptyNote;
     SearchPositionCounter:=CurrentRow-1;
     WHILE (SearchPositionCounter>=0) AND (SearchPositionCounter<64) DO BEGIN
      NoteToCompare:=Patterns[PNr,SearchPositionCounter,CurrentChannel];
      IF (CurrentNote.Note=NoteToCompare.Note) AND (CurrentNote.Volume=NoteToCompare.Volume) AND
         (CurrentNote.EffectA.Effect=NoteToCompare.EffectA.Effect) AND (CurrentNote.EffectA.Parameter=NoteToCompare.EffectA.Parameter) AND
         (CurrentNote.EffectB.Effect=NoteToCompare.EffectB.Effect) AND (CurrentNote.EffectB.Parameter=NoteToCompare.EffectB.Parameter) THEN BEGIN
       FoundLastNote:=EmptyNote;
       FoundLength:=0;
       SearchPosition:=SearchPositionCounter;
       WHILE SearchPosition<CurrentRow DO BEGIN
        IF FoundLength>$7F THEN BEGIN
         FoundLength:=$7F;
         BREAK;
        END;
        AnotherNoteToCompare:=Patterns[PNr,CurrentRow+FoundLength,CurrentChannel];
        NoteToCompare:=Patterns[PNr,SearchPosition,CurrentChannel];
        IF (AnotherNoteToCompare.Note<>NoteToCompare.Note) OR (AnotherNoteToCompare.Volume<>NoteToCompare.Volume) OR
           (AnotherNoteToCompare.EffectA.Effect<>NoteToCompare.EffectA.Effect) OR (AnotherNoteToCompare.EffectA.Parameter<>NoteToCompare.EffectA.Parameter) OR
           (AnotherNoteToCompare.EffectB.Effect<>NoteToCompare.EffectB.Effect) OR (AnotherNoteToCompare.EffectB.Parameter<>NoteToCompare.EffectB.Parameter) THEN BEGIN
         BREAK;
        END;
        FoundLastNote:=NoteToCompare;
        INC(FoundLength);
        INC(SearchPosition);
       END;
       IF BestLZLength<FoundLength THEN BEGIN
        BestLastNote:=FoundLastNote;
        BestLZLength:=FoundLength;
        BestLZPosition:=SearchPositionCounter;
       END;
      END;
      DEC(SearchPositionCounter);
     END;
     IF (BestLZLength>1) AND ((CurrentRow-BestLZPosition)>0) THEN BEGIN
      IF BestLZLength>$7F THEN BEGIN
       BestLZLength:=$7F;
      END;
      IF ((RLELength>2) AND (Flags<>0)) OR ((RLELength>1) AND (Flags=0)) THEN BEGIN
       IF BestLZLength>RLELength THEN BEGIN
        Flags:=(Flags AND NOT (1 OR 2 OR 4 OR 8 OR 16 OR 32 OR 64)) OR 128;
       END ELSE BEGIN
        Flags:=Flags OR 64;
       END;
      END ELSE BEGIN
       Flags:=(Flags AND NOT (1 OR 2 OR 4 OR 8 OR 16 OR 32)) OR 128;
      END;
     END ELSE IF ((RLELength>2) AND (Flags<>0)) OR ((RLELength>1) AND (Flags=0)) THEN BEGIN
      Flags:=Flags OR 64;
     END;
    END ELSE IF ((RLELength>2) AND (Flags<>0)) OR ((RLELength>1) AND (Flags=0)) THEN BEGIN
     Flags:=Flags OR 64;
    END;
    IF (Flags AND 128)<>0 THEN BEGIN
     WriteBufferByte((BestLZLength AND $7F) OR 128);
     WriteBufferByte(CurrentRow-BestLZPosition);
     INC(CurrentRow,BestLZLength);
     LastNote:=BestLastNote;
    END ELSE IF ((CurrentNote.Note=EmptyNote.Note) AND (CurrentNote.Volume=EmptyNote.Volume) AND
                 (CurrentNote.EffectA.Effect=EmptyNote.EffectA.Effect) AND (CurrentNote.EffectA.Parameter=EmptyNote.EffectA.Parameter) AND
                 (CurrentNote.EffectB.Effect=EmptyNote.EffectB.Effect) AND (CurrentNote.EffectB.Parameter=EmptyNote.EffectB.Parameter)) AND
                 (((Flags AND 64)=0) AND (Flags<>0)) THEN BEGIN
     WriteBufferByte(128);
     LastNote:=EmptyNote;
     INC(CurrentRow);
    END ELSE BEGIN
     WriteBufferByte(Flags);
     IF (Flags AND 1)<>0 THEN WriteBufferByte(CurrentNote.Note);
     IF (Flags AND 2)<>0 THEN WriteBufferByte(CurrentNote.Volume);
     IF (Flags AND 4)<>0 THEN WriteBufferByte(CurrentNote.EffectA.Effect);
     IF (Flags AND 8)<>0 THEN WriteBufferByte(CurrentNote.EffectA.Parameter);
     IF (Flags AND 16)<>0 THEN WriteBufferByte(CurrentNote.EffectB.Effect);
     IF (Flags AND 32)<>0 THEN WriteBufferByte(CurrentNote.EffectB.Parameter);
     IF (Flags AND 64)<>0 THEN BEGIN
      WriteBufferByte(RLELength);
      INC(CurrentRow,RLELength);
     END ELSE BEGIN
      INC(CurrentRow);
     END;
     LastNote:=CurrentNote;
    END;
   END;
   INC(CurrentChannel);
  END;
  RESULT:=TRUE;
 END;
 FUNCTION IsUsed(Block:POINTER;Size:LONGWORD):BOOLEAN;
 TYPE PBYTE=^BYTE;
 VAR B:PBYTE;
     Counter:LONGWORD;
 BEGIN
  RESULT:=FALSE;
  B:=Block;
  FOR Counter:=1 TO Size DO BEGIN
   IF B^<>0 THEN BEGIN
    RESULT:=TRUE;
    BREAK;
   END;
   INC(B);
  END;
 END;
VAR I,R,C:INTEGER;
    B:BYTE;
    W:WORD;
    LW:LONGWORD;
BEGIN
 RESULT:=FALSE;
 ASSIGNFILE(TheFile,FileName);
 {$I-}REWRITE(TheFile,1);{$I+}
 IF IOResult<>0 THEN EXIT;
 BLOCKWRITE(TheFile,T0ASTSignature2,SIZEOF(TSignature));
 BLOCKWRITE(TheFile,SynthData.FileData,SIZEOF(TSynthFileData));
 BLOCKWRITE(TheFile,SynthData.ADSRData,SIZEOF(TSynthADSRData));
 BLOCKWRITE(TheFile,RowHilightMinor,SIZEOF(BYTE));
 BLOCKWRITE(TheFile,RowHilightMajor,SIZEOF(BYTE));
 BLOCKWRITE(TheFile,DrumMode,SIZEOF(BYTE));
 BLOCKWRITE(TheFile,ChipMode,SIZEOF(BYTE));
 BLOCKWRITE(TheFile,CountOfChannels,SIZEOF(BYTE));
 FOR I:=0 TO CountOfChannels-1 DO BEGIN
  IF IsUsed(@Channels[I],SIZEOF(TChannel)) THEN BEGIN
   B:=1;
   BLOCKWRITE(TheFile,B,SIZEOF(BYTE));
   BLOCKWRITE(TheFile,Channels[I],SIZEOF(TChannel));
  END ELSE BEGIN
   B:=0;
   BLOCKWRITE(TheFile,B,SIZEOF(BYTE));
  END;
 END;
 FOR I:=0 TO CountOfChannels-1 DO BEGIN
  IF IsUsed(@Instruments[I],SIZEOF(TInstrument)) THEN BEGIN
   B:=1;
   BLOCKWRITE(TheFile,B,SIZEOF(BYTE));
   BLOCKWRITE(TheFile,Instruments[I],SIZEOF(TInstrument));
  END ELSE BEGIN
   B:=0;
   BLOCKWRITE(TheFile,B,SIZEOF(BYTE));
  END;
 END;
 W:=0;
 FOR I:=255 DOWNTO 0 DO IF PatternOrder[I]<>$FF THEN BEGIN
  W:=I+1;
  BREAK;
 END;
 BLOCKWRITE(TheFile,W,SIZEOF(WORD));
 IF W>0 THEN BLOCKWRITE(TheFile,PatternOrder,W);
 FOR I:=0 TO 255 DO BEGIN
  B:=0;
  FOR R:=0 TO 63 DO BEGIN
   FOR C:=0 TO CountOfChannels-1 DO BEGIN
    IF Patterns[I,R,C].Note<>0 THEN B:=1;
    IF Patterns[I,R,C].Volume<>$FF THEN B:=1;
    IF Patterns[I,R,C].EffectA.Effect<>0 THEN B:=1;
    IF Patterns[I,R,C].EffectA.Parameter<>0 THEN B:=1;
    IF Patterns[I,R,C].EffectB.Effect<>0 THEN B:=1;
    IF Patterns[I,R,C].EffectB.Parameter<>0 THEN B:=1;
    IF B<>0 THEN BREAK;
   END;
   IF B<>0 THEN BREAK;
  END;
  IF B=0 THEN BEGIN
   FOR R:=0 TO 255 DO BEGIN
    IF I=PatternOrder[R] THEN BEGIN
     B:=1;
     BREAK;
    END;
   END;
  END;
  BLOCKWRITE(TheFile,B,SIZEOF(BYTE));
  IF B<>0 THEN SavePattern(I);
 END;
 BLOCKWRITE(TheFile,RestartPosition,SIZEOF(BYTE));
 LW:=LENGTH(SongName);
 BLOCKWRITE(TheFile,LW,SIZEOF(LONGWORD));
 IF LW>0 THEN BLOCKWRITE(TheFile,SongName[1],LW);
 LW:=LENGTH(SongAuthor);
 BLOCKWRITE(TheFile,LW,SIZEOF(LONGWORD));
 IF LW>0 THEN BLOCKWRITE(TheFile,SongAuthor[1],LW);
 LW:=LENGTH(SongMessage);
 BLOCKWRITE(TheFile,LW,SIZEOF(LONGWORD));
 IF LW>0 THEN BLOCKWRITE(TheFile,SongMessage[1],LW);
 CLOSEFILE(TheFile);
 RESULT:=TRUE;
END;

FUNCTION TTrack.LoadInstrumentFile(Nr:BYTE;FileName:STRING):BOOLEAN;
VAR TheFile:FILE;
    Signature:TSignature;
BEGIN
 RESULT:=FALSE;
 ASSIGNFILE(TheFile,FileName);
 {$I-}RESET(TheFile,1);{$I+}
 IF IOResult<>0 THEN EXIT;
 BLOCKREAD(TheFile,Signature,SIZEOF(TSignature));
 IF Signature=T0ASTInstrumentSignature THEN BEGIN
  BLOCKREAD(TheFile,Instruments[Nr],SIZEOF(TInstrument));
  RESULT:=TRUE;
 END;
 CLOSEFILE(TheFile);
END;

FUNCTION TTrack.SaveInstrumentFile(Nr:BYTE;FileName:STRING):BOOLEAN;
VAR TheFile:FILE;
BEGIN
 RESULT:=FALSE;
 ASSIGNFILE(TheFile,FileName);
 {$I-}REWRITE(TheFile,1);{$I+}
 IF IOResult<>0 THEN EXIT;
 BLOCKWRITE(TheFile,T0ASTInstrumentSignature,SIZEOF(TSignature));
 BLOCKWRITE(TheFile,Instruments[Nr],SIZEOF(TInstrument));
 CLOSEFILE(TheFile);
 RESULT:=TRUE;
END;

FUNCTION TTrack.Play:BOOLEAN;
//VAR ChannelCounter:BYTE;
BEGIN
 DataUpdate;
 Stop;

 Speed:=6;
 BPM:=125;
 Tick:=Speed;
 SetTickVariables;
 BPMSamplesCount:=0;
 TickCounter:=0;
 RecordEvents:=FALSE;

 FrameDelay:=0;
 PatternDelay:=0;

 BD:=0;
 PatternBreak:=FALSE;
 PatternJump:=FALSE;
 PatternBreakTo:=0;
 PatternJumpTo:=0;

 CurrentPatternOrder:=0;
 CurrentRow:=0;
 NextPatternOrder:=0;
 NextRow:=0;

 FixedPattern:=FALSE;

 FILLCHAR(Played,SIZEOF(TPlayed),#0);
 ShouldExit:=FALSE;

 SynthInitData(SynthData);

 BufferCounter:=0;
 Playing:=TRUE;
 Start:=TRUE;
 RESULT:=TRUE;
END;

PROCEDURE TTrack.RetrigNote(Channel,Parameter:INTEGER;VAR Effect:TEffectData);
VAR RetrigSpeed,RetrigCounter,Depth,Volume:INTEGER;
    DoRetrig:BOOLEAN;
BEGIN
 RetrigSpeed:=Parameter AND $F;
 RetrigCounter:=Effect.RetrigCounter;
 DoRetrig:=FALSE;
 IF RetrigSpeed=0 THEN RetrigSpeed:=1;
 DoRetrig:=DoRetrig OR ((RetrigCounter<>0) AND ((RetrigCounter MOD RetrigSpeed)=0));
 INC(RetrigCounter);
 IF DoRetrig THEN BEGIN
  Depth:=(Parameter DIV (1 SHL 4)) AND $0F;
  IF Depth<>0 THEN BEGIN
   Volume:=ChannelsData[Channel].Volume;
   IF RetrigTabelle1[Depth AND $F]<>0 THEN BEGIN
    Volume:=(Volume*RetrigTabelle1[Depth AND $F]) DIV (1 SHL 4);
   END ELSE BEGIN
    INC(Volume,RetrigTabelle2[Depth AND $F] SHL 2);
   END;
   IF Volume<0 THEN Volume:=0;
   IF Volume>$3F THEN Volume:=$3F;
   ChannelsData[Channel].Volume:=Volume;
   SynthSetNote(SynthData,Channel,ChannelsData[Channel].Note-1,SampleRate);
   SynthSetVolume(SynthData,Channel,ChannelsData[Channel].Volume);
   AddNewEvent(Channel,ChannelsData[Channel].Note-1,ChannelsData[Channel].Volume);
  END ELSE BEGIN
   SynthSetNote(SynthData,Channel,ChannelsData[Channel].Note-1,SampleRate);
   AddNewEvent(Channel,$92,ChannelsData[Channel].Note-1);
  END;
 END;
 Effect.RetrigCounter:=RetrigCounter AND $F;
END;

PROCEDURE TTrack.PlayNote(Pattern,Row,Channel:BYTE);
VAR Note:BYTE;
    PatternNote:PPatternNote;
 PROCEDURE ProcessEffect(Effect,EffectParameter:BYTE;VAR EffectData:TEffectData);
 VAR TheNote:BYTE;
 BEGIN
  CASE Effect OF
   1:Speed:=EffectParameter+1;
   2:BEGIN
    IF NOT FixedPattern THEN BEGIN
     PatternJump:=TRUE;
     PatternJumpTo:=EffectParameter;
    END ELSE BEGIN
     PatternBreak:=TRUE;
     PatternBreakTo:=0;
    END;
   END;
   3:BEGIN
    IF NOT FixedPattern THEN BEGIN
     PatternBreak:=TRUE;
     PatternBreakTo:=EffectParameter;
    END ELSE BEGIN
     PatternBreak:=TRUE;
     PatternBreakTo:=0;
    END;
   END;
   8:BEGIN
    SynthSetHarmony(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$96,EffectParameter);
   END;
   9:BEGIN
    EffectData.TempVolume:=ChannelsData[Channel].Volume;
    IF (EffectParameter SHR 4)<>0 THEN EffectData.TremoloParameterHi:=EffectParameter SHR 4;
    IF (EffectParameter AND $F)<>0 THEN EffectData.TremoloParameterLo:=EffectParameter AND $F;
    IF (EffectData.TremoloTyp AND 4)=0 THEN EffectData.TremoloPosition:=0;
   END;
   10:BEGIN
    TheNote:=ChannelsData[Channel].Note;
    EffectData.ArpeggioPosition:=0;
    EffectData.Arpeggio[0]:=TheNote;
    IF (TheNote+(EffectParameter SHR 4))<$80 THEN BEGIN
     EffectData.Arpeggio[1]:=TheNote+(EffectParameter SHR 4);
    END ELSE BEGIN
     EffectData.Arpeggio[1]:=$7F;
    END;
    IF (TheNote+(EffectParameter AND $F))<$80 THEN BEGIN
     EffectData.Arpeggio[2]:=TheNote+(EffectParameter AND $F);
    END ELSE BEGIN
     EffectData.Arpeggio[2]:=$7F;
    END;
   END;
   11:BEGIN
    SynthSetFeedBackFactor(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$94,EffectParameter);
   END;
   12:BEGIN
    SynthSetFineTune(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$95,EffectParameter);
   END;
   13:BEGIN
    IF EffectParameter>$3F THEN EffectParameter:=$3F;
    SynthSetVolume(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$81,EffectParameter);
   END;
   14:BEGIN
    SynthSetDistortion(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$A3,EffectParameter);
   END;
   15:BEGIN
   END;
   16:BEGIN
    SynthData.RealTimeData.Phase[Channel]:=(EffectParameter*Div256)*2*PI;
    AddNewEvent(Channel,$91,EffectParameter);
   END;
   17:RetrigNote(Channel,EffectParameter,EffectData);
   18:BEGIN
    SynthSetHz(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$AB,EffectParameter);
   END;
   19:BEGIN
    CASE EffectParameter SHR 4 OF
     $0:BEGIN
      SynthSetVowelFilter(SynthData,Channel,EffectParameter AND $F);
      AddNewEvent(Channel,$97,EffectParameter AND $F);
     END;
     $1:BEGIN
      SynthSetClipping(SynthData,Channel,EffectParameter AND $F);
      AddNewEvent(Channel,$A4,EffectParameter AND $F);
     END;
     $2:BEGIN
      SynthSetDelayActive(SynthData,Channel,EffectParameter AND $F);
      AddNewEvent(Channel,$A5,EffectParameter AND $F);
     END;
     $4:EffectData.TremoloTyp:=EffectParameter AND 4;
     $6:BEGIN
      FrameDelay:=EffectParameter AND $F;
     END;
     $A:BEGIN
      SynthSetWaveForm(SynthData,Channel,EffectParameter AND $F);
      AddNewEvent(Channel,$98,EffectParameter AND $F);
     END;
     $B:BEGIN
      IF PatternLoopRow<0 THEN BEGIN
       IF (EffectParameter AND $F)=0 THEN BEGIN
        IF NOT EffectData.PatternLoop THEN BEGIN
         EffectData.PatternLoopStart:=CurrentRow;
        END;
       END ELSE BEGIN
        IF EffectData.PatternLoop THEN BEGIN
         IF EffectData.PatternLoopCount=0 THEN BEGIN
          EffectData.PatternLoop:=FALSE;
         END ELSE BEGIN
          DEC(EffectData.PatternLoopCount);
          PatternJumpTo:=CurrentPatternOrder;
          PatternBreakTo:=EffectData.PatternLoopStart;
          PatternBreak:=TRUE;
          PatternJump:=TRUE;
          PatternLoopRow:=PatternBreakTo;
         END;
        END ELSE BEGIN
         EffectData.PatternLoopCount:=EffectParameter AND $F;
         DEC(EffectData.PatternLoopCount);
         EffectData.PatternLoop:=TRUE;
         PatternJumpTo:=CurrentPatternOrder;
         PatternBreakTo:=EffectData.PatternLoopStart;
         PatternBreak:=TRUE;
         PatternJump:=TRUE;
         PatternLoopRow:=PatternBreakTo;
        END;
       END;
      END;
     END;
     $D:BEGIN
      IF Tick<>(EffectParameter AND $F) THEN BEGIN
       SynthSetNote(SynthData,Channel,$80,SampleRate);
       AddNewEvent(Channel,$80,$FF);
      END;
     END;
     $E:BEGIN
      PatternDelay:=EffectParameter AND $F;
     END;
     $F:BEGIN
      SynthCopyInstrument(SynthData,Channel,EffectParameter AND $F);
      AddNewEvent(Channel,$99,EffectParameter AND $F);
     END;
    END;
   END;
   20:BEGIN
    BPM:=EffectParameter AND $FF;
    IF BPM=0 THEN BPM:=1;
    AddNewEvent(Channel,$82,EffectParameter);
   END;
   21:BEGIN
    SynthData.RealtimeData.ChorusDelayFactor[Channel]:=EffectParameter;
    AddNewEvent(Channel,$AA,EffectParameter);
   END;
   22:BEGIN
    SynthData.RealTimeData.Filter[Channel].RLP:=EffectParameter*Div256;
    SynthRecalcFilter(SynthData.RealtimeData.Filter[Channel]);
    AddNewEvent(Channel,$89,EffectParameter);
   END;
   23:BEGIN
    SynthData.RealTimeData.Filter[Channel].RHP:=EffectParameter*Div256;
    SynthRecalcFilter(SynthData.RealtimeData.Filter[Channel]);
    AddNewEvent(Channel,$90,EffectParameter);
   END;
   24:BEGIN
    SynthData.FileData.Panning[Channel]:=EffectParameter;
    AddNewEvent(Channel,$86,EffectParameter);
   END;
   25:BEGIN
    SynthData.RealTimeData.Filter[Channel].CLP:=EffectParameter*Div256;
    SynthRecalcFilter(SynthData.RealtimeData.Filter[Channel]);
    AddNewEvent(Channel,$87,EffectParameter);
   END;
   26:BEGIN
    SynthData.RealTimeData.Filter[Channel].CHP:=EffectParameter*Div256;
    SynthRecalcFilter(SynthData.RealtimeData.Filter[Channel]);
    AddNewEvent(Channel,$88,EffectParameter);
   END;
   27:BEGIN
    AddNewEvent(Channel,$AC,EffectParameter);
   END;
   28:BEGIN
    CASE EffectParameter SHR 4 OF
     $0:BEGIN
      SynthSetTB303WaveForm(SynthData,Channel,EffectParameter AND $F);
      AddNewEvent(Channel,$9A,EffectParameter AND $F);
     END;
     $1:BEGIN
      SynthSetTB303Acc(SynthData,Channel,EffectParameter AND $F);
      AddNewEvent(Channel,$A0,EffectParameter AND $F);
     END;
     $2:BEGIN
      SynthSetTB303Glide(SynthData,Channel,EffectParameter AND $F);
      AddNewEvent(Channel,$A1,EffectParameter AND $F);
     END;
     $3:BEGIN
      SynthSetTB303NoteOff(SynthData,Channel,EffectParameter AND $F);
      AddNewEvent(Channel,$A9,EffectParameter AND $F);
     END;
    END;
   END;
   29:BEGIN
    SynthSetTB303CutOff(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$9B,EffectParameter);
   END;
   30:BEGIN
    SynthSetTB303Resonance(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$9C,EffectParameter);
   END;
   31:BEGIN
    SynthSetTB303EnvMod(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$9D,EffectParameter);
   END;
   32:BEGIN
    SynthSetTB303EnvDecay(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$9E,EffectParameter);
   END;
   33:BEGIN
    SynthSetTB303GlideSpeed(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$9F,EffectParameter);
   END;
   34:BEGIN
    SynthSetTB303AccAmt(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$A2,EffectParameter);
   END;
   35:BEGIN
    SynthSetDelayFeedBack(SynthData,Channel,EffectParameter);
    AddNewEvent(Channel,$A6,EffectParameter);
   END;
   36:BEGIN
    CASE EffectParameter OF
     $00..$EF:BEGIN
      SynthSetDelayTime(SynthData,Channel,EffectParameter);
      AddNewEvent(Channel,$A7,EffectParameter);
     END;
     $F0..$FF:BEGIN
      SynthSetDelayTimeDiv(SynthData,Channel,EffectParameter-$80);
      AddNewEvent(Channel,$A8,EffectParameter-$80);
     END;
    END;
   END;
  END;
 END;
BEGIN
 PatternNote:=@Patterns[Pattern,Row AND $3F,Channel];
 Note:=PatternNote^.Note;
 IF (Channels[Channel].Active<>0) AND (Channels[Channel].Mute=0) THEN BEGIN
  IF Note<>0 THEN BEGIN
   IF Note>=$FE THEN BEGIN
    ChannelsData[Channel].Note:=Note;
    SynthSetNote(SynthData,Channel,$80,SampleRate);
    AddNewEvent(Channel,$80,$FF);
   END ELSE BEGIN
    ChannelsData[Channel].Note:=Note;
    SynthSetNote(SynthData,Channel,Note-1,SampleRate);
    IF PatternNote^.Volume>64 THEN BEGIN
     SynthSetVolume(SynthData,Channel,64);
     ChannelsData[Channel].Volume:=64;
    END ELSE  IF PatternNote^.Volume<=64 THEN BEGIN
     SynthSetVolume(SynthData,Channel,PatternNote^.Volume);
     ChannelsData[Channel].Volume:=PatternNote^.Volume;
    END;
    AddNewEvent(Channel,Note-1,ChannelsData[Channel].Volume);
   END;
  END ELSE IF PatternNote^.Volume<=64 THEN BEGIN
   SynthSetVolume(SynthData,Channel,PatternNote^.Volume);
   ChannelsData[Channel].Volume:=PatternNote^.Volume;
   AddNewEvent(Channel,$81,ChannelsData[Channel].Volume);
  END;
 END ELSE IF Channels[Channel].Mute<>0 THEN BEGIN
  SynthSetNote(SynthData,Channel,$80,SampleRate);
  SynthData.RealtimeData.Volume[Channel]:=0;
  ChannelsData[Channel].Volume:=0;
 END;
 ProcessEffect(PatternNote^.EffectA.Effect,PatternNote^.EffectA.Parameter,ChannelsData[Channel].EffectA);
 ProcessEffect(PatternNote^.EffectB.Effect,PatternNote^.EffectB.Parameter,ChannelsData[Channel].EffectB);
END;

PROCEDURE TTrack.PlayNoteTick(Pattern,Row,Channel:BYTE);
 PROCEDURE ProcessEffect(VAR EffectData:TEffectData);
 CONST Div64=1/64;
 VAR OscValue,Value:SINGLE;
 BEGIN
  CASE EffectData.Effect OF
   4:BEGIN
    IF (EffectData.EffectParameter AND $F)<>0 THEN BEGIN
     IF ChannelsData[Channel].Volume>(EffectData.EffectParameter AND $F) THEN BEGIN
      DEC(ChannelsData[Channel].Volume,(EffectData.EffectParameter AND $F));
     END ELSE BEGIN
      ChannelsData[Channel].Volume:=0;
     END;
    END;
    IF (EffectData.EffectParameter SHR 4)<>0 THEN BEGIN
     IF (ChannelsData[Channel].Volume+(EffectData.EffectParameter SHR 4))<64 THEN BEGIN
      INC(ChannelsData[Channel].Volume,(EffectData.EffectParameter SHR 4));
     END ELSE BEGIN
      ChannelsData[Channel].Volume:=64;
     END;
    END;
    SynthSetVolume(SynthData,Channel,ChannelsData[Channel].Volume);
    AddNewEvent(Channel,$81,ChannelsData[Channel].Volume);
   END;
   5:BEGIN
    OscValue:=EffectData.EffectParameter*PortamentoFactor;
    SynthData.RealtimeData.PhaseIncrement[Channel]:=SynthData.RealtimeData.PhaseIncrement[Channel]*(1-OscValue);
    AddNewEvent(Channel,$84,EffectData.EffectParameter);
   END;
   6:BEGIN
    OscValue:=EffectData.EffectParameter*PortamentoFactor;
    SynthData.RealtimeData.PhaseIncrement[Channel]:=SynthData.RealtimeData.PhaseIncrement[Channel]*(1+OscValue);
    AddNewEvent(Channel,$85,EffectData.EffectParameter);
   END;
   9:BEGIN
    CASE EffectData.TremoloTyp AND 3 OF
     0:Value:=(EffectData.TremoloPosition AND $3F)*Div64;
     1:BEGIN
      IF (EffectData.TremoloPosition AND $3F)<$20 THEN BEGIN
       Value:=0;
      END ELSE BEGIN
       Value:=1;
      END;
     END;
     2:Value:=RANDOM;
     ELSE Value:=SIN(((EffectData.TremoloPosition AND $3F)*Div64)*2*PI);
    END;
    Value:=LONGINT(EffectData.TempVolume)+TRUNCINT((Value-0.5)*4*EffectData.TremoloParameterLo);
    IF Value<0 THEN Value:=0;
    IF Value>64 THEN Value:=64;
    SynthSetVolume(SynthData,Channel,TRUNCINT(Value));
    AddNewEvent(Channel,$81,TRUNCINT(Value));
    EffectData.TremoloPosition:=(EffectData.TremoloPosition+EffectData.TremoloParameterHi) AND $3F;
   END;
   10:BEGIN
    SynthSetNoteEx(SynthData,Channel,EffectData.Arpeggio[EffectData.ArpeggioPosition MOD 3]-1,SampleRate);
    AddNewEvent(Channel,$92,EffectData.Arpeggio[EffectData.ArpeggioPosition MOD 3]-1);
    EffectData.ArpeggioPosition:=(EffectData.ArpeggioPosition+1) MOD 3;
   END;
   17:RetrigNote(Channel,EffectData.EffectParameter,EffectData);
   19:BEGIN
    CASE EffectData.EffectParameter SHR 4 OF
     $0:BEGIN
     END;
     $C:BEGIN
      IF (Tick<>0) AND (Tick=(EffectData.EffectParameter AND $F)) THEN BEGIN
       ChannelsData[Channel].Note:=$FE;
       SynthSetNote(SynthData,Channel,$80,SampleRate);
       AddNewEvent(Channel,$80,$FF);
      END;
     END;
     $D:BEGIN
      IF (Tick<>0) AND (Tick=(EffectData.EffectParameter AND $F)) THEN BEGIN
       PlayNote(EffectData.PatternNr,EffectData.Row,Channel);
      END;
     END;
    END;
   END;
  END;
 END;
BEGIN
 ProcessEffect(ChannelsData[Channel].EffectA);
 ProcessEffect(ChannelsData[Channel].EffectB);
END;

PROCEDURE TTrack.DoTick;
VAR ChannelCounter:BYTE;
    PatternNr:BYTE;
 PROCEDURE SearchPattern;
 BEGIN
  PatternNr:=PatternOrder[CurrentPatternOrder];
  WHILE (PatternNr=$FE) AND (CurrentPatternOrder<$FF) DO BEGIN
   INC(CurrentPatternOrder);
   PatternNr:=PatternOrder[CurrentPatternOrder];
  END;
  IF PatternNr=$FF THEN BEGIN
   CurrentPatternOrder:=RestartPosition;
   PatternNr:=PatternOrder[CurrentPatternOrder];
   IF PatternNr=$FF THEN BEGIN
    CurrentPatternOrder:=0;
    PatternNr:=PatternOrder[CurrentPatternOrder];
   END;
   ShouldExit:=TRUE;
  END;
 END;
BEGIN
 SynthData.RealtimeData.BPMSamples:=BPMSamples;
 INC(Tick);
 IF (Tick>=((Speed*(PatternDelay+1))+FrameDelay)) AND Playing THEN BEGIN
  Tick:=0;
  FrameDelay:=0;
  PatternDelay:=0;
  PatternLoopRow:=-1;
  IF CurrentPatternOrder<>NextPatternOrder THEN BEGIN
   CurrentPatternOrder:=NextPatternOrder;
   ShouldExit:=ShouldExit OR (Played[CurrentPatternOrder]<>0);
   INC(Played[CurrentPatternOrder]);
  END;
  CurrentRow:=NextRow;
  SearchPattern;
  IF RestartPosition<>0 THEN BEGIN
   IF (CurrentPatternOrder=RestartPosition) AND (CurrentRow=0) THEN BEGIN
    FOR ChannelCounter:=0 TO 15 DO BEGIN
     AddNewEvent(ChannelCounter,$93,0);
    END;
   END;
  END;
  FOR ChannelCounter:=0 TO 15 DO BEGIN
   ChannelsData[ChannelCounter].EffectA.Effect:=Patterns[PatternNr,CurrentRow AND $3F,ChannelCounter].EffectA.Effect;
   ChannelsData[ChannelCounter].EffectA.EffectParameter:=Patterns[PatternNr,CurrentRow AND $3F,ChannelCounter].EffectA.Parameter;
   ChannelsData[ChannelCounter].EffectA.Pattern:=CurrentPatternOrder;
   ChannelsData[ChannelCounter].EffectA.PatternNr:=PatternNr;
   ChannelsData[ChannelCounter].EffectA.Row:=CurrentRow AND $3F;
   ChannelsData[ChannelCounter].EffectB.Effect:=Patterns[PatternNr,CurrentRow AND $3F,ChannelCounter].EffectB.Effect;
   ChannelsData[ChannelCounter].EffectB.EffectParameter:=Patterns[PatternNr,CurrentRow AND $3F,ChannelCounter].EffectB.Parameter;
   ChannelsData[ChannelCounter].EffectB.Pattern:=CurrentPatternOrder;
   ChannelsData[ChannelCounter].EffectB.PatternNr:=PatternNr;
   ChannelsData[ChannelCounter].EffectB.Row:=CurrentRow AND $3F;
   PlayNote(PatternNr,CurrentRow AND $3F,ChannelCounter);
  END;
  IF PatternBreak OR PatternJump THEN BEGIN
   IF PatternBreak THEN BEGIN
    NextRow:=PatternBreakTo AND $3F;
    PatternBreak:=FALSE;
    IF NOT FixedPattern THEN BEGIN
     NextPatternOrder:=(CurrentPatternOrder+1) AND $FF;
    END;
   END ELSE BEGIN
    NextRow:=0;
   END;
   IF PatternJump THEN BEGIN
    NextPatternOrder:=PatternJumpTo AND $FF;
    PatternJump:=FALSE;
   END;
  END ELSE BEGIN
   NextRow:=(CurrentRow+1) AND $3F;
   IF (NextRow=0) AND NOT FixedPattern THEN BEGIN
    NextPatternOrder:=(CurrentPatternOrder+1) AND $FF;
   END;
  END;
 END;
 FOR ChannelCounter:=0 TO 15 DO BEGIN
  PlayNoteTick(PatternNr,CurrentRow AND $3F,ChannelCounter);
 END;
 INC(TickCounter);
 SetTickVariables;
END;

PROCEDURE TTrack.SetTickVariables;
BEGIN
 BPMSamples:=(Frequency*5*128) DIV (BPM SHL 8);
 BPMSamplesCount:=BPMSamples;
END;

PROCEDURE TTrack.Stop;
VAR ChannelCounter:BYTE;
BEGIN
 Playing:=FALSE;
 FOR ChannelCounter:=0 TO 15 DO BEGIN
  SynthData.RealtimeData.PhaseIncrement[ChannelCounter]:=0;
  SynthData.RealtimeData.PhaseFactor[ChannelCounter]:=1;
  SynthData.RealtimeData.Phase[ChannelCounter]:=0;
  SynthData.RealtimeData.Volume[ChannelCounter]:=0;
  ChannelsData[ChannelCounter].EffectA.Effect:=$FF;
  ChannelsData[ChannelCounter].EffectB.Effect:=$FF;
 END;
END;

FUNCTION TTrack.DoMix(StartPosition,LengthCounter:LONGWORD;VAR DoContinue:LONGBOOL):LONGWORD;
VAR TheLength:LONGWORD;
    BufferSample:PBufferSample;
BEGIN
 IF (StartPosition+LengthCounter)<=BufferSize THEN BEGIN
  TheLength:=LengthCounter;
 END ELSE IF StartPosition<=BufferSize THEN BEGIN
  TheLength:=BufferSize-StartPosition;
 END ELSE BEGIN
  TheLength:=0;
 END;
 IF TheLength>0 THEN BEGIN
  DEC(BPMSamplesCount,TheLength);
  BufferSample:=@Buffer^[StartPosition];
  SynthFillBuffer(SynthData,PSINGLE(BufferSample),StartPosition,TheLength);
 END ELSE BEGIN
  DoContinue:=FALSE;
 END;
 RESULT:=TheLength;
END;

PROCEDURE TTrack.MixBuffer(DestBuffer:POINTER);
VAR Counter:LONGWORD;
    DoContinue:LONGBOOL;
BEGIN
 Buffer:=DestBuffer;
 Counter:=0;
 DoContinue:=TRUE;
 WHILE Counter<BufferSize DO BEGIN
  IF BPMSamplesCount=0 THEN DoTick;
  INC(Counter,DoMix(Counter,BPMSamplesCount,DoContinue));
 END;
END;

PROCEDURE TTrack.Poll;
BEGIN
 IF (WaveHandler[BufferCounter].dwFlags AND WHDR_DONE)<>0 THEN BEGIN
  WaveHandler[BufferCounter].dwFlags:=WaveHandler[BufferCounter].dwFlags AND NOT WHDR_DONE;
  IF waveOutUnprepareHeader(WaveOutHandle,WaveHandler[BufferCounter],SIZEOF(TWAVEHDR))<>WAVERR_STILLPLAYING THEN BEGIN
   MixBuffer(WaveHandler[BufferCounter].lpData);
   waveOutPrepareHeader(WaveOutHandle,WaveHandler[BufferCounter],SIZEOF(TWAVEHDR));
   waveOutWrite(WaveOutHandle,WaveHandler[BufferCounter],SIZEOF(TWAVEHDR));
   BufferCounter:=(BufferCounter+1) MOD 4;
  END;
 END;
END;

PROCEDURE TTrack.Execute;
BEGIN
 Set8087CW($F7B);
 Priority:=tpTimeCritical;
 WHILE NOT Terminated DO BEGIN
  Enter;
  Poll;
  Leave;
  SLEEP(25);
 END;
END;

PROCEDURE TTrack.DataUpdate;
VAR ChannelCounter:INTEGER;
BEGIN
 FOR ChannelCounter:=0 TO 15 DO SynthData.FileData.Panning[ChannelCounter]:=$80;
END;

FUNCTION TTrack.ExportToWaveFile(FileName:STRING;LoopExport:BOOLEAN):BOOLEAN;
VAR TheFile:FILE;
    Buffer:POINTER;
    MaxOrder:LONGWORD;
    Size:LONGWORD;
 PROCEDURE FileHandler(VAR WaveFile:FILE;Bytes,Freq:LONGWORD);
 VAR Dummy:LONGWORD;
     W:WORD;
 BEGIN
  SEEK(WaveFile,0);
  BLOCKWRITE(WaveFile,'RIFF',4);
  Dummy:=Bytes+36;
  BLOCKWRITE(WaveFile,Dummy,4);
  BLOCKWRITE(WaveFile,'WAVE',4);
  BLOCKWRITE(WaveFile,'fmt ',4);
  Dummy:=16;
  BLOCKWRITE(WaveFile,Dummy,4);

  W:=3;
  BLOCKWRITE(WaveFile,W,2);

  W:=2;
  BLOCKWRITE(WaveFile,W,2);

  Dummy:=Freq;
  BLOCKWRITE(WaveFile,Dummy,4);

  Dummy:=Freq*8;
  BLOCKWRITE(WaveFile,Dummy,4);

  W:=8;
  BLOCKWRITE(WaveFile,W,2);

  W:=32;
  BLOCKWRITE(WaveFile,W,2);

  BLOCKWRITE(WaveFile,'data',4);
  BLOCKWRITE(WaveFile,Bytes,4);
 END;
 PROCEDURE DoReportStatus(ToAdd:LONGWORD);
 VAR Percent:LONGWORD;
 BEGIN
  IF LoopExport THEN BEGIN
   Percent:=((((CurrentPatternOrder*64)+CurrentRow)*50) DIV (MaxOrder*64));
   INC(Percent,ToAdd);
  END ELSE BEGIN
   Percent:=(((CurrentPatternOrder*64)+CurrentRow)*100) DIV (MaxOrder*64);
  END;
  IF ASSIGNED(WaveStatusReport) THEN WaveStatusReport(Percent);
 END;
BEGIN
 RESULT:=FALSE;
 ASSIGNFILE(TheFile,FileName);
 {$I-}REWRITE(TheFile,1);{$I+}
 IF IOResult<>0 THEN EXIT;
 Enter;
 MaxOrder:=0;
 WHILE (MaxOrder<$FF) AND (PatternOrder[MaxOrder]<$FE) DO INC(MaxOrder);
 GETMEM(Buffer,OutputBufferSize);
 Play;
 IF LoopExport THEN BEGIN
  WHILE NOT (ShouldExit AND (Tick=0)) DO BEGIN
   MixBuffer(Buffer);
   DoReportStatus(0);
  END;
  FILLCHAR(Played,SIZEOF(TPlayed),#0);
  ShouldExit:=FALSE;
  CurrentPatternOrder:=RestartPosition;
  IF PatternOrder[CurrentPatternOrder]=$FF THEN CurrentPatternOrder:=0;
  CurrentRow:=0;
  NextPatternOrder:=0;                        
  NextRow:=0;
 END;
 FileHandler(TheFile,0,Frequency);
 Size:=0;
 WHILE NOT (ShouldExit AND (Tick=0)) DO BEGIN
  MixBuffer(Buffer);
  INC(Size,OutputBufferSize);
  BLOCKWRITE(TheFile,Buffer^,OutputBufferSize);
  DoReportStatus(50);
 END;
 DoReportStatus(50);
 FileHandler(TheFile,Size,Frequency);
 SEEK(TheFile,FILESIZE(TheFile));
 FREEMEM(Buffer);
 Stop;
 Leave;
 CLOSEFILE(TheFile);
 RESULT:=TRUE;
END;

FUNCTION TTrack.ExportToB4MFile(FileName:STRING;LoopExport:BOOLEAN):BOOLEAN;
VAR TheFile:FILE;
    Buffer:POINTER;
    MaxOrder:LONGWORD;
    ChannelCounter:INTEGER;
    EventCounter:INTEGER;
    LastTick:INTEGER;
    B:BYTE;
    InUse:BOOLEAN;
    InfoData:TSynthInfoData;
 PROCEDURE DoReportStatus(ToAdd:LONGWORD);
 VAR Percent:LONGWORD;
 BEGIN
  IF LoopExport THEN BEGIN
   Percent:=((((CurrentPatternOrder*64)+CurrentRow)*50) DIV (MaxOrder*64));
   INC(Percent,ToAdd);
  END ELSE BEGIN
   Percent:=(((CurrentPatternOrder*64)+CurrentRow)*100) DIV (MaxOrder*64);
  END;
  IF ASSIGNED(WaveStatusReport) THEN WaveStatusReport(Percent);
 END;
BEGIN
 RESULT:=FALSE;
 ASSIGNFILE(TheFile,FileName);
 {$I-}REWRITE(TheFile,1);{$I+}
 IF IOResult<>0 THEN EXIT;
 Enter;
 MaxOrder:=0;
 WHILE (MaxOrder<$FF) AND (PatternOrder[MaxOrder]<$FE) DO INC(MaxOrder);
 GETMEM(Buffer,OutputBufferSize);
 Play;
 IF LoopExport THEN BEGIN
  WHILE NOT (ShouldExit AND (Tick=0)) DO BEGIN
   DoTick;
   DoReportStatus(0);
  END;
  FILLCHAR(Played,SIZEOF(TPlayed),#0);
  ShouldExit:=FALSE;
  CurrentPatternOrder:=RestartPosition;
  IF PatternOrder[CurrentPatternOrder]=$FF THEN CurrentPatternOrder:=0;
  CurrentRow:=0;
  NextPatternOrder:=0;
  NextRow:=0;
 END;
 TickCounter:=0;
 RecordEvents:=TRUE;
 FOR ChannelCounter:=0 TO 15 DO SETLENGTH(Events[ChannelCounter],0);
 AddNewEvent(0,$82,125);
 WHILE NOT (ShouldExit AND (Tick=0)) DO BEGIN
  DoTick;
  DoReportStatus(50);
 END;
 ShouldExit:=FALSE;
 IF TickCounter>0 THEN DEC(TickCounter);
 DoReportStatus(50);
 FOR ChannelCounter:=0 TO 15 DO BEGIN
  IF LENGTH(Events[ChannelCounter])>0 THEN AddNewEvent(ChannelCounter,$83,0);
  SynthData.FileData.EventOffset[ChannelCounter]:=0;
  SynthData.FileData.NoteOffset[ChannelCounter]:=0;
  SynthData.FileData.VolumeOffset[ChannelCounter]:=0;
 END;
 SynthData.InfoData:=0;
 SEEK(TheFile,0);
 BLOCKWRITE(TheFile,SynthData.FileData,SIZEOF(TSynthFileData));
 BLOCKWRITE(TheFile,SynthData.ADSRData,SIZEOF(TSynthADSRData));
 BLOCKWRITE(TheFile,SynthData.InfoData,SIZEOF(LONGWORD));
 FOR ChannelCounter:=0 TO 15 DO BEGIN
  IF LENGTH(Events[ChannelCounter])>0 THEN BEGIN
   InUse:=FALSE;
   FOR EventCounter:=0 TO LENGTH(Events[ChannelCounter])-1 DO BEGIN
    IF NOT (Events[ChannelCounter,EventCounter].Note IN [$83,$93,$FF]) THEN BEGIN
     InUse:=TRUE;
    END;
   END;
   IF NOT InUse THEN SETLENGTH(Events[ChannelCounter],0);
  END;
 END;
 FOR ChannelCounter:=0 TO 15 DO BEGIN
  IF LENGTH(Events[ChannelCounter])>0 THEN BEGIN
   SynthData.FileData.EventOffset[ChannelCounter]:=FILEPOS(TheFile);
   LastTick:=0;
   FOR EventCounter:=0 TO LENGTH(Events[ChannelCounter])-1 DO BEGIN
    B:=Events[ChannelCounter,EventCounter].Tick-LastTick;
    BLOCKWRITE(TheFile,B,SIZEOF(BYTE));
    LastTick:=Events[ChannelCounter,EventCounter].Tick;
   END;
  END;
 END;
 FOR ChannelCounter:=0 TO 15 DO BEGIN
  IF LENGTH(Events[ChannelCounter])>0 THEN BEGIN
   SynthData.FileData.NoteOffset[ChannelCounter]:=FILEPOS(TheFile);
   FOR EventCounter:=0 TO LENGTH(Events[ChannelCounter])-1 DO BEGIN
    B:=Events[ChannelCounter,EventCounter].Note;
    BLOCKWRITE(TheFile,B,SIZEOF(BYTE));
   END;
  END;
 END;
 FOR ChannelCounter:=0 TO 15 DO BEGIN
  IF LENGTH(Events[ChannelCounter])>0 THEN BEGIN
   SynthData.FileData.VolumeOffset[ChannelCounter]:=FILEPOS(TheFile);
   FOR EventCounter:=0 TO LENGTH(Events[ChannelCounter])-1 DO BEGIN
    B:=Events[ChannelCounter,EventCounter].Volume;
    BLOCKWRITE(TheFile,B,SIZEOF(BYTE));
   END;
  END;
 END;
 SynthData.InfoData:=FILEPOS(TheFile);
 InfoData.NameLength:=LENGTH(SongName);
 InfoData.AuthorLength:=LENGTH(SongAuthor);
 InfoData.MessageLength:=LENGTH(SongMessage);
 BLOCKWRITE(TheFile,InfoData,SIZEOF(TSynthInfoData));
 IF InfoData.NameLength>0 THEN BEGIN
  BLOCKWRITE(TheFile,SongName[1],InfoData.NameLength);
 END;
 IF InfoData.AuthorLength>0 THEN BEGIN
  BLOCKWRITE(TheFile,SongAuthor[1],InfoData.AuthorLength);
 END;
 IF InfoData.MessageLength>0 THEN BEGIN
  BLOCKWRITE(TheFile,SongMessage[1],InfoData.MessageLength);
 END;
 SEEK(TheFile,0);
 BLOCKWRITE(TheFile,SynthData.FileData,SIZEOF(TSynthFileData));
 BLOCKWRITE(TheFile,SynthData.ADSRData,SIZEOF(TSynthADSRData));
 BLOCKWRITE(TheFile,SynthData.InfoData,SIZEOF(LONGWORD));
 SEEK(TheFile,FILESIZE(TheFile));
 FOR ChannelCounter:=0 TO 15 DO SETLENGTH(Events[ChannelCounter],0);
 FOR ChannelCounter:=0 TO 15 DO BEGIN
  SynthData.FileData.EventOffset[ChannelCounter]:=0;
  SynthData.FileData.NoteOffset[ChannelCounter]:=0;
  SynthData.FileData.VolumeOffset[ChannelCounter]:=0;
 END;
 RecordEvents:=FALSE;
 FREEMEM(Buffer);
 Stop;
 Leave;
 CLOSEFILE(TheFile);
 RESULT:=TRUE;
END;

END.
