{$A-,B-,E-,F-,G+,I-,N-,O-,R-,S-,V-,X+}
Unit
  Plays;

interface

Uses
  Songs;

const
  TimerFreq: Byte = $4B;
  GVolume: Byte = 64;
  HiQuality: Boolean = True;
  LoopPlay: Boolean = False;

function RunPlay(ASong: PSong): Boolean;
procedure StopPlay;
procedure SetPorts(Left,Right: Word);
procedure SetGVolume(AVolume : byte);

implementation

type
  TChanel = record
    Nota: Byte;
    Octava: Byte;
    Instr: Byte;
    Volume: Byte;
    Command: Byte;
    Info: Byte;
    SpeedOfC: Word;
    {=============}
    NewVolume: Byte;
    NotaPres: Byte;
    CurPeriod: Word;     { период }
    OldPeriod: Word;     { для Note portamento }
    SomeStep: Integer;   { шаг для всяких целей }
  end;

const
  SizeOfChanel = SizeOf(TChanel);
  SizeOfInstr: Word = SizeOf(TInstr);
  Song: PSong = nil;

var
  OldInt08h: Pointer;
  SaveExit: Pointer;
  TickTack: Word;
  CurChanel: Byte;
  CurOrder: Word;
  CurLine: Word;
  VolTable: array[1..4] of Byte;
  Chanels: array[0..3] of TChanel;
  EndChan: record end; { не убирать и не перемещать }
  MulFreq: Word;       { период таймера * периодC2 }
  RealTemp: Word;      { темп 0..FFh }
  TempLine: Word;      { прерываний на одну линию }
  TempStep: Word;      { если эффект, то TempLine / K }
  TempDec: Word;       { текущий счетчик прерываний }
  EffCount: Word;      { счетчик вызова эффекта }

function GetPeriod: Word; { BL - Нота, CL - октава } assembler;
const
  Periods: array[0..11] of Word =
  (8560,8080,7626,7198,6794,6413,6053,5713,5392,5090,4804,4535);
asm
        MOV     BH,0
        SHL     BX,1
        MOV     AX,Periods[BX].Word
        SHR     AX,CL
end;

function GetStep: { AX период; [SI] -> TChanel } Longint; assembler;
{ (Tдо*Tтаймера) / (T*Tоцифр) }
asm
        MUL     [SI].TChanel.SpeedOfC
        XCHG    CX,DX         { CX = T*Tоцифр }
        XOR     DX,DX
        MOV     AX,MulFreq    { DX:AX = (Tдо*Tтаймера) }
        DIV     CX
        MOV     BX,AX
        XOR     AX,AX
        DIV     CX
        MOV     DX,BX
end;

procedure DriverCall; {(ah - номер функции)} assembler;
asm
        PUSH	BX
        XOR     BX,BX
        MOV	BL,AH
        DEC	BX
        SHL	BX,1
        MOV	BX,WORD PTR DriverHead.Functions[BX]
        MOV	WORD PTR DriverBody,BX
        POP	BX
        CALL	DWORD PTR DriverBody
        MOV	WORD PTR DriverBody,0
end;

function InitPlays: Boolean; assembler;
asm
        MOV     BX,OFFSET VolTable
        PUSH    DS
        POP     ES
        MOV     AH,1
        CALL    DriverCall
        MOV     AL,0
        CMC
        RCL     AL,1
end;

procedure SetPorts(Left,Right: Word); assembler;
asm
        MOV    BX,Left
        MOV    DX,Right
        MOV    AH,2
        CALL   DriverCall
end;

procedure SetTempo; assembler;
asm
        MOV     BL,0
        MOV     CL,2
        CALL    GetPeriod
        XOR     BX,BX
        MOV     BH,TimerFreq
        MUL     BX
        MOV     MulFreq,DX
        MOV     CX,1
        MOV     AL,TimerFreq
        MOV     AH,3
        CALL    DriverCall
end;

function CalcTemp: Word; { AL - RealTemp } assembler;
asm
        XOR     BX,BX
        MOV     CX,5D4h
        MOV     AH,0
        MOV     RealTemp,AX
        MOV     BL,TimerFreq
        MUL     CX
        DIV     BX
        MOV     TempLine,AX
        MOV     TempStep,AX
end;

procedure SetHandler; { DX - Near адрес обработчика } assembler;
asm
        PUSH    CS
        POP     ES
        MOV     AH,4
        CALL    DriverCall
end;

procedure SetFreq; { BL - Chanel; DX:CX - Freq} assembler;
asm
        MOV    AH,5
        CALL   DriverCall
end;

procedure SetVolume;{ BL - Chanel; DL - Volume} assembler;
asm
        MOV    CH,DL
        MOV    CL,DL
        MOV    AH,6
        CALL   DriverCall
end;

procedure SetSample;{ BL Chan; ES:DI Sample; CX/DX LoopS/LoopE} assembler;
asm
        MOV    AH,7
        CALL   DriverCall
end;

procedure SetGVolume(AVolume: Byte); assembler;
asm
        MOV    AL,AVolume
        MOV    GVolume,AL
        MOV    AH,8
        CALL   DriverCall
end;

procedure GetSamples(var PSamples); assembler;
asm
        LES     DI,PSamples
        MOV     AH,9
        CALL    DriverCall
end;

procedure SetEffCount; { выход: ZF если EffCount = 0 }assembler;
asm
        MOV     AX,RealTemp
        SHR     AX,4
        DEC     AX
        JNS     @@1
        XOR     AX,AX
@@1:    MOV     EffCount.Byte,AL
        OR      AL,AL
end;

procedure TimerInt; assembler;
asm
        CMP     HiQuality,True
        JE      @@MyInt
        PUSHF
        CALL    DWORD PTR [OldInt08h]
        JMP     @@Exit
@@MyInt:
        MOV    CX,DS

        MOV    AX,0040h
        MOV    DS,AX

        MOV    SI,6Ch
        MOV    DI,6Eh
        INC    WORD PTR [SI]
        JNE    @@1
        INC    WORD PTR [DI]
@@1:    CMP    WORD PTR [DI],0018h
        JNE    @@2
        CMP    WORD PTR [SI],00B0h
        JNE    @@2
        MOV    WORD PTR [SI],0
        MOV    WORD PTR [DI],0
        MOV    BYTE PTR [DI+02],01h
@@2:

        DEC    BYTE PTR [40h]
        JNE    @@3
        MOV    DX,03F2h
        MOV    AL,0Ch
        AND    BYTE PTR [003Fh],0F0h
        OUT    DX,AL
@@3:
{        MOV    AL,20h
        OUT    20h,AL}
        MOV    DS,CX
@@Exit:
end;


Procedure Tmp;
begin
 WriteLn(Chanels[0].OldPeriod,Chanels[0].CurPeriod:10);
end;

procedure Effects; assembler;
const
  VibTab: array[0..63] of Word =
 ($000,$018,$031,$04A,$061,$078,$08D,$0A1,
  $0B4,$0C5,$0D4,$0E0,$0EB,$0F4,$0FA,$0FD,
  $0FF,$0FD,$0FA,$0F4,$0EB,$0E0,$0D4,$0C5,
  $0B4,$0A1,$08D,$078,$061,$04A,$031,$018,
  $000,$FE8,$FCF,$FB6,$F9F,$F88,$F73,$F5F,
  $F4C,$F3B,$F2C,$F20,$F15,$F0C,$F06,$F03,
  $F01,$F03,$F06,$F0C,$F15,$F20,$F2C,$F3B,
  $F4C,$F5F,$F73,$F88,$F9F,$FB6,$FCF,$FE8);
asm
        MOV    SI,OFFSET Chanels
        MOV    CurChanel,0
@@Loop:
        XOR    BX,BX
        MOV    BL,[SI].TChanel.Command
        SHL    BX,1
        JMP    CS:@@Eff[BX].Word
@@Eff:
        DW      OFFSET @@Next   { 0 }
        DW      OFFSET @@Next   { 1 A }
        DW      OFFSET @@Next   { 2 B }
        DW      OFFSET @@Next   { 3 C }
        DW      OFFSET @@SlideV { 4 D }
        DW      OFFSET @@PortDn { 5 E }
        DW      OFFSET @@PortUp { 6 F }
        DW      OFFSET @@NPort  { 7 G }
        DW      OFFSET @@Vibrat { 8 H }
        DW      OFFSET @@Tremor { 9 I }
        DW      OFFSET @@Next   { 10 }
        DW      OFFSET @@Next   { 11 }
        DW      OFFSET @@Next   { 12 }
        DW      OFFSET @@Next   { 13 }
        DW      OFFSET @@Next   { 14 }
        DW      OFFSET @@Next   { 15 }

@@SlideV:
        MOV     DL,[SI].TChanel.Volume
        ADD     DL,[SI].TChanel.SomeStep.Byte
        CMP     DL,0
        JGE     @@1
        MOV     DL,0
@@1:    CMP     DL,64
        JLE     @@2
        MOV     DL,64
@@2:    MOV     BL,CurChanel
        MOV     [SI].TChanel.Volume,DL
        CALL    SetVolume
        JMP     @@Next
@@PortUp:
        MOV     AX,[SI].TChanel.CurPeriod
        SUB     AX,[SI].TChanel.SomeStep
        CMP     AX,267
        JA      @@Port
@@Close:
        MOV     BL,CurChanel    { слишком высоко }
        MOV     DL,0
        CALL    SetVolume
        JMP     @@Next
@@PortDn:
        MOV     AX,[SI].TChanel.CurPeriod
        ADD     AX,[SI].TChanel.SomeStep
        CMP     AX,8560*2        { до контроктавы }
        JAE     @@Close
@@Port:
        MOV     [SI].TChanel.CurPeriod,AX
        CALL    GetStep
        MOV     CX,AX
@@Freq: MOV     BL,CurChanel
        CALL    SetFreq
        JMP     @@Next
@@NPort:
        MOV     AX,[SI].TChanel.OldPeriod
        MOV     DX,[SI].TChanel.CurPeriod
        CMP     AX,DX
        JE      @@Next
        JA      @@PDec
        ADD     AX,[SI].TChanel.SomeStep
        CMP     AX,DX
        JBE     @@PSet
        MOV     AX,DX
        JMP     @@PSet
@@PDec:
        SUB     AX,[SI].TChanel.SomeStep
        CMP     AX,DX
        JAE     @@PSet
        MOV     AX,DX
@@PSet:
        MOV     [SI].TChanel.OldPeriod,AX
        CALL    GetStep
        MOV     CX,AX
        MOV     BL,CurChanel
        CALL    SetFreq
        JMP     @@Next

@@Tremor:
        CMP     [SI].TChanel.SomeStep.Byte,0
        JE      @@T1
        DEC     [SI].TChanel.SomeStep.Byte
        JMP     @@Next
@@T1:   CMP     [SI+1].TChanel.SomeStep.Byte,True     { включен? }
        JE      @@TOff                                { да, на выкл }
@@TOn:
        MOV     AL,[SI].TChanel.Info
        SHR     AL,4
        MOV     [SI].TChanel.SomeStep.Byte,AL
        MOV     DL,[SI].TChanel.Volume
        MOV     AH,True
        JMP     @@TVol
@@TOff:
        MOV     AL,[SI].TChanel.Info
        AND     AL,0Fh
        MOV     [SI].TChanel.SomeStep.Byte,AL
        MOV     DL,0
        MOV     AH,False
@@TVol:
        MOV     [SI+1].TChanel.SomeStep.Byte,AH
        MOV     BL,CurChanel
        CALL    SetVolume
        JMP     @@Next

@@Vibrat:
        MOV     CL,[SI].TChanel.Info
        AND     CX,0Fh
        MOV     BX,[SI].TChanel.SomeStep
        MOV     AX,VibTab[BX].Word
        IMUL    CX
        SAR     AX,6
        MOV     AH,5
        IMUL    AH
        ADD     AX,[SI].TChanel.CurPeriod
        CALL    GetStep
        MOV     CX,AX
        MOV     BL,CurChanel
        CALL    SetFreq

        MOV     AL,[SI].TChanel.Info
        SHR     AL,3
        ADD     AL,[SI].TChanel.SomeStep.Byte
        AND     AX,007Eh
        MOV     [SI].TChanel.SomeStep,AX
        JMP     @@Next

@@Next:
        ADD     SI,SizeOfChanel
        INC     CurChanel
        CMP     CurChanel,4
        JB      @@Loop
end;

procedure Handler; far; assembler;
const
  D12: Byte = 12;
asm
        PUSH   DS
        PUSH   CX
        PUSH   SI
        PUSH   DI
        MOV    AX,SEG @DATA
        MOV    DS,AX
        DEC    TempDec
        JNZ    @@Poll

        CMP    EffCount.Byte,0
        JZ     @@Again

        CALL   Effects        { обработка эффекта ??? }

        MOV    AX,TempStep
        MOV    TempDec,AX
        DEC    EffCount       { конец эффектов ? }
        JNZ    @@Poll         { нет }

@@Again:
        LES    DI,Song
        MOV    BX,CurOrder
        MOV    BL,ES:[DI].TSong.Orders[BX].Byte
        CMP    BL,99
        JNE    @@Play
        CMP    LoopPlay,True
        JNE    @@Stop
        MOV    CurOrder,0               { зациклить }
        MOV    CurLine,0
        JMP    @@Again                  { на повтор }
@@Stop:
        CALL   StopPlay
        JMP    @@Poll
@@Play:
        MOV    BH,0
        SHL    BX,2
        LES    DI,ES:[DI].TSong.Patterns[BX].DWord

        MOV    SI,OFFSET Chanels
        MOV    AX,CurLine
        SHL    AX,4
        ADD    DI,AX
@@Loop1:
        MOV    AL,ES:[DI]
        MOV    [SI].TChanel.NotaPres,AL
        CMP    AL,0FFh
        JE     @@11
        MOV    AH,AL
        AND    AL,0Fh
        MOV    [SI].TChanel.Nota,AL

        SHR    AH,4
        AND    AH,07                    { октава бывала > 7 !!! }
        MOV    [SI].TChanel.Octava,AH

        MOV    AL,ES:[DI+1]
        SHR    AL,3
        OR     AL,AL
        JZ     @@11
        MOV    [SI].TChanel.Instr,AL
@@11:
        MOV    AL,ES:[DI+1]
        AND    AL,7
        MOV    AH,ES:[DI+2]
        AND    AH,0F0h
        SHR    AH,1
        ADD    AL,AH
        MOV    [SI].TChanel.NewVolume,AL

        MOV    AL,ES:[DI+2]
        AND    AL,0Fh
        MOV    [SI].TChanel.Command,AL
        MOV    AL,ES:[DI+3]
        MOV    [SI].TChanel.Info,AL

        ADD    DI,4
        ADD    SI,SizeOfChanel
        CMP    SI,OFFSET EndChan
        JB     @@Loop1

        MOV    CurChanel,0
        MOV    SI,OFFSET Chanels
@@Loop:
        MOV     DL,[SI].TChanel.NewVolume
        CMP     DL,65
        JB      @@12
        CMP     [SI].TChanel.NotaPres,0FFh
        JE      @@8
@@12:
        LES     DI,Song
        MOV     AL,[SI].TChanel.Instr
        DEC     AL
        JL      @@8
        MUL     SizeOfInstr.Byte
        ADD     DI,AX
        ADD     DI,TSong.Instrs
        CMP     DL,65
        JB      @@SetVol
        MOV     DL,ES:[DI].TInstr.DefVolume
@@SetVol:
        MOV     [SI].TChanel.Volume,DL
        MOV     BL,CurChanel
        CALL    SetVolume

        CMP     [SI].TChanel.NotaPres,0FFh
        JE      @@8

        CMP     [SI].TChanel.Command,7          { NPort ? }
        JE      @@5                             { для каких еще эффектов ??? }
        MOV     AX,ES:[DI].TInstr.SpeedOfC
        MOV     [SI].TChanel.SpeedOfC,AX

        MOV     BX,OFFSET TInstr.LoopE
        MOV     CX,ES:[DI+BX]
        CMP     CX,0FFFFh
        JNE     @@3
        MOV     BX,OFFSET TInstr.Size
@@3:    MOV     CX,ES:[DI+BX]    {в CX заносим размер Sample or LoopEnd}
        MOV     DX,ES:[DI].TInstr.LoopS
        CMP     DX,0           {в DX LoopStart or 0FFFFh если не цикл}
        JNE     @@4
        DEC     DX
@@4:    LES     DI,ES:[DI].TInstr.Sample
        MOV     BL,CurChanel
        CALL    SetSample
@@5:
        MOV     BL,[SI].TChanel.Nota
        MOV     CL,[SI].TChanel.Octava
        CALL    GetPeriod
        MOV     DX,[SI].TChanel.CurPeriod
        MOV     [SI].TChanel.OldPeriod,DX
        MOV     [SI].TChanel.CurPeriod,AX
        CMP     [SI].TChanel.Command,7          { NPort ? }
        JE      @@8
        CALL    GetStep
        MOV     CX,AX
        MOV     BL,CurChanel
        CALL    SetFreq

@@8:
        XOR    BX,BX
        MOV    BL,[SI].TChanel.Command
        SHL    BX,1
        MOV    AL,[SI].TChanel.Info     { Сначала исполняется к-да или нота? ???}
        JMP    CS:Word Ptr @@Eff[BX]
@@Eff:
        DW      OFFSET @@NoCmd   { 0 }
        DW      OFFSET @@Tempo   { 1 A }
        DW      OFFSET @@Jump    { 2 B }
        DW      OFFSET @@Break   { 3 C }
        DW      OFFSET @@SlideV  { 4 D }
        DW      OFFSET @@PortUp  { 5 E }
        DW      OFFSET @@PortDn  { 6 F }
        DW      OFFSET @@NPort   { 7 G }
        DW      OFFSET @@Vibra   { 8 H }
        DW      OFFSET @@Tremor  { 9 I }
        DW      OFFSET @@NoCmd   { 10 }
        DW      OFFSET @@NoCmd   { 11 }
        DW      OFFSET @@NoCmd   { 12 }
        DW      OFFSET @@NoCmd   { 13 }
        DW      OFFSET @@NoCmd   { 14 }
        DW      OFFSET @@NoCmd   { 15 }

@@Tempo:
        CALL    CalcTemp
        JMP     @@NoCmd
@@Jump:
        MOV     CurLine,0
        MOV     CurOrder.Byte,AL { ??? куда надо jmp? }
        JMP     @@Again
@@Break:
        MOV     CurLine,0
        INC     CurOrder
        JMP     @@Again
@@SlideV:
        XCHG    AX,CX
        CALL    SetEffCount
        JZ      @@NoCmd                 { если мало шагов }
        MOV     AL,CL
        AND     AL,0Fh
        JZ      @@Sinc
        NEG     AL
        JMP     @@SSet
@@SInc: XCHG    AL,CL
        SHR     AL,4
@@SSet: MOV     [SI].TChanel.SomeStep.Byte,AL
        JMP     @@NoCmd
@@NPort:
@@PortUp:
@@PortDn:
        XCHG    AX,CX
        CALL    SetEffCount
        JZ      @@NoCmd                 { если мало шагов }
        MOV     AL,5
        MUL     CL
        MOV     [SI].TChanel.SomeStep,AX
        JMP     @@NoCmd
@@Tremor:
@@Vibra:
        CALL    SetEffCount
        MOV     [SI].TChanel.SomeStep,0
        JMP     @@NoCmd
        { ??? куда идти }


@@NoCmd:
        ADD     SI,SizeOfChanel
        INC     CurChanel
        CMP     CurChanel,4
        JB      @@Loop

        MOV     AX,TempLine
        CMP     EffCount,0
        JE      @@9
        XOR     DX,DX
        DIV     EffCount
@@9:                                   {  другой TempStep ??? }
        MOV     TempStep,AX
        MOV     TempDec,AX

        INC     CurLine
        CMP     CurLine,64
        JB      @@Poll
        MOV     CurLine,0
        INC     CurOrder

@@Poll:
        XOR     AX,AX
        MOV     AL,TimerFreq
        ADD     TickTack,AX
        JNC     @@Exit
        CALL    TimerInt
@@Exit:
        POP     DI
        POP     SI
        POP     CX
        POP     DS
end;

procedure StartPlay(RTemp: Byte); assembler;
asm
        XOR     AX,AX
        MOV     CurOrder,AX
        MOV     CurLine,AX
        MOV     EffCount,AX
(*        MOV     CurOrder,3      { ??? }*)

        CALL    InitPlays

        MOV     AL,RTemp
        CALL    CalcTemp

        MOV     TempDec,1
        CALL    SetTempo

        MOV     DX,OFFSET Handler
        CALL    SetHandler
end;

procedure SetTimer(Freq: Word); assembler;
asm
        CLI
        MOV    AL,000110110b
        OUT    43h,AL
        JCXZ   @@1
@@1:    JCXZ   @@2
@@2:    MOV    AX,Freq
        OUT    40h,AL
        XCHG   AL,AH
        JCXZ   @@3
@@3:    JCXZ   @@4
@@4:    OUT    40h,AL
        JCXZ   @@5
@@5:    JCXZ   @@6
@@6:    STI
end;

function GetVec(Vec: Byte): Pointer; assembler;
asm
        XOR     BX,BX
        MOV     ES,BX
        MOV     BL,Vec
        SHL     BX,2
        LES     AX,ES:[BX]
        MOV     DX,ES
end;

procedure SetVec(Vec: Byte; AVector: Pointer); assembler;
asm
        XOR     BX,BX
        MOV     ES,BX
        MOV     BL,Vec
        SHL     BX,2
        MOV     DI,BX
        CLD
        MOV     AX,AVector.Word[0]
        CLI
        STOSW
        MOV     AX,AVector.Word[2]
        STOSW
        STI
end;

procedure StopPlay;
begin
  if Song <> nil then
  begin
    SetTimer(0);
    SetVec($08, OldInt08h);
{     Song^.Free; ??? }
    Song := nil
  end;
end;

function RunPlay(ASong: PSong): Boolean;
begin
  RunPlay := False;
  StopPlay;
  if ASong <> nil then
  begin
    if ASong^.Error = 0 then
    begin
      Song := ASong;
      OldInt08h := GetVec($08);
      Longint(VolTable) := 0;
      SetPorts($378, $278); { ??? }
      SetGVolume(GVolume);
      if TimerFreq < $13 then TimerFreq := $13;
      StartPlay(ASong^.RealTemp);
      RunPlay := True
    end else ASong^.Free;
  end;
end;

begin
  SaveExit := ExitProc;
  ExitProc := @StopPlay
end.
