Pascal Stmplay

Stmplay

{$S-,R-,V-,I-,B-,F+,X+,G-,A+}
{$M $4000,$20000,$A0000}

unit
  STMPlay;

interface

USES
  Crt, Dos;

CONST
  SpTab : Array[0..255] of Byte = (
        $01,$01,$01,$01,$01,$01,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,
        $02,$02,$02,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$04,$04,
        $04,$04,$04,$04,$04,$04,$04,$04,$04,$04,$04,$05,$05,$05,$05,$05,
        $05,$05,$05,$05,$05,$05,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,
        $06,$06,$06,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$08,$08,
        $08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$09,$09,$09,$09,$09,
        $09,$09,$0A,$0A,$0A,$0A,$0B,$0B,$0C,$0C,$0D,$0E,$0E,$0F,$10,$11,
        $11,$12,$13,$14,$15,$16,$17,$18,$1A,$1B,$1C,$1D,$1E,$1F,$21,$22,
        $23,$24,$26,$27,$28,$29,$2B,$2C,$2D,$2E,$30,$31,$32,$33,$34,$35,
        $36,$37,$39,$3A,$3A,$3B,$3C,$3D,$3E,$3F,$40,$40,$41,$42,$42,$43,
        $43,$43,$43,$43,$43,$44,$44,$44,$44,$44,$44,$44,$44,$44,$44,$44,
        $44,$44,$45,$45,$45,$45,$45,$45,$45,$45,$45,$45,$45,$46,$46,$46,
        $46,$46,$46,$46,$46,$46,$46,$46,$46,$46,$47,$47,$47,$47,$47,$47,
        $47,$47,$47,$47,$47,$48,$48,$48,$48,$48,$48,$48,$48,$48,$48,$48,
        $48,$48,$49,$49,$49,$49,$49,$49,$49,$49,$49,$49,$49,$4A,$4A,$4A,
        $4A,$4A,$4A,$4A,$4A,$4A,$4A,$4A,$4A,$4A,$4B,$4B,$4B,$4B,$4B,$4B );

  TempoMul : Array[0..17] of Byte = (
        $8C,$32,$19,$0F,$0A,$07,$06,$04,$03,$03,$02,$02,$02,$02,$01,$01,
        $01,$01 );

  VibratoTab : Array[0..63] of Word = (
        $0000,$0018,$0031,$004A,$0061,$0078,$008D,$00A1,
        $00B4,$00C5,$00D4,$00E0,$00EB,$00F4,$00FA,$00FD,
        $00FF,$00FD,$00FA,$00F4,$00EB,$00E0,$00D4,$00C5,
        $00B4,$00A1,$008D,$0078,$0061,$004A,$0031,$0018,
        $0000,$FFE8,$FFCF,$FFB6,$FF9F,$FF88,$FF73,$FF5F,
        $FF4C,$FF3B,$FF2C,$FF20,$FF15,$FF0C,$FF06,$FF03,
        $FF01,$FF03,$FF06,$FF0C,$FF15,$FF20,$FF2C,$FF3B,
        $FF4C,$FF5F,$FF73,$FF88,$FF9F,$FFB6,$FFCF,$FFE8);

  ComVar : Byte = $0A;

  SmBut  : Array[0..1]  OF Char = (#138,#15);
  SmBut1 : Array[0..1]  OF Char = (#11,#12);
  PianP  : Array[0..11] OF Byte = (0,1,2,3,4,6,7,8,9,10,11,12);

TYPE
  OnePat  = Array[0..63,0..4,0..4] of Byte;
  Buffer  = Array[0..65534] of Byte;
  BufPtr  = ^Buffer;

  InsType = RECORD
              Name : String[12];
              Tran : Word;
              Volm : Byte;
              LopS : Word;
              LopE : Word;
              Leng : Word;
              Inst : BufPtr;
              W1   : Word;
              W2   : Word;
              Res1 : Word;
            END;

  SetupTp = RECORD
              PSpeed  : Word;
              Res1    : Byte;
              TimerOn : Boolean;
              Lpt     : Word;
              Sb      : Word;
            END;

  ChnType = RECORD
              OnV     : WORD;
              On      : WORD;
              InsOfs  : Word;
              InsSeg  : Word;
              InsEnd  : Word;
              Loop    : Word;
              Free    : WORD;
              Trans1  : Word;
              Trans2  : Word;
              TAdd    : Word;
              Res1    : Byte;
              Volume  : Byte;
              LstNote : Word;
              LstIns  : Word;
              LstPVol : Word;
              LstCmd  : Word;
              LstInfo : Word;
              NInsOfs : Word;
              InsTrns : Word;
              Row     : Word;
              PatOfs  : Word;
              CVol    : Word;
              IVol    : Word;
              TmpNote : Word;
              TmpTrn1 : Word;
              TmpTrn2 : Word;
              TremVar : Word;
              ArpeVar : Word;
              VibrVar : Word;
              LevVol  : Word;
              LevVol1 : Word;
              Color   : Word;
            END;

VAR
  Cw,Cw1,W  : Word;
  Cb        : Byte;
  Cr        : Real;
  Cl        : LongInt;
  F         : File;
  SName     : Array[1..20] of Char;
  VTab      : Array[0..64,0..255] of Byte;
  NTab      : Array[0..4,0..15] of Word;
  OrdB      : Array[0..127] of Byte;
  InsB      : Array[1..31] of InsType;
  PatB      : BufPtr;
  Ov08      : Procedure;
  GTempo    : Byte;
  GOctave   : Byte;
  GVolume1  : Byte;
  GVolume2  : Byte;
  GVolume3  : Byte;
  GVolume4  : Byte;
  Lpt1      : Word ABSOLUTE $0000:$0408;
  Lpt2      : Word ABSOLUTE $0000:$040A;
  Setup     : SetupTp;
  Ch1       : ChnType;
  Ch2       : ChnType;
  Ch3       : ChnType;
  Ch4       : ChnType;
  FastTime  : Word;
  AddWCur   : Word;
  AddWBegin : Word;
  TempoD16  : Word;
  TempoD16S : Word;
  Play1Note : Boolean;
  ChangePat : Boolean;
  TimerC    : Word;
  TimerA    : Word;
  CTempo    : Word;
  NextPatO  : Word;
  LoopCount : Word;
  FirstOrd  : Word;
  CurOrder  : Word;
  CurPat    : Word;
  NextPat   : Boolean;
  Port40    : Word;
  TotPat    : word;
  SpTabOfs,
  SpTabSeg  : Word;

PROCEDURE SetDefaultSetup;
FUNCTION  ReadSTM(Name:String):Boolean;
PROCEDURE PlayAllPatterns(Device:byte);
procedure Stop;
procedure InitPlayer;

implementation

PROCEDURE InitTabs;
BEGIN
  FillChar(VTab,256,0);
  FOR Cw:= 1 TO 64 DO
  BEGIN
    FOR Cb:=0 TO 127 DO
    BEGIN
      VTab[Cw,Cb]:=Trunc(Cw*cb/256);
      VTab[Cw,255-Cb]:=not VTab[Cw,Cb];
    END;
  END;
  FOR Cw:=0 TO 59 DO
    NTab[Cw DIV 12,Cw MOD 12]:=Round($42B8/(Exp(Ln(2)*Cw/12)));
END;

PROCEDURE SetDefaultSetup;
BEGIN
  Setup.Lpt:=Lpt1;
  Setup.Sb:=$220;
  Setup.TimerOn:=False;
  Setup.PSpeed:=19889;
END;

{
PROCEDURE ClearIns(Num:Byte);
BEGIN
    InsB[Num].Name:='';
    InsB[Num].Tran:=$2100;
    InsB[Num].Volm:=$40;
    InsB[Num].LopS:=0;
    InsB[Num].LopE:=$FFFF;
    InsB[Num].Leng:=0;
    InsB[Num].Inst:=NIL;
    InsB[Num].W1:=0;
    InsB[Num].W2:=0;
END;
}

PROCEDURE ResetTempoVars;NEAR;ASSEMBLER;
ASM
  MOV  CTempo,AX
  MOV  BX,AX
  SHR  BX,1
  SHR  BX,1
  SHR  BX,1
  SHR  BX,1
  MOV  TempoD16S,BX
  AND  AX,0FH
  MOV  CX,AX
  MOV  AL,TempoMul[BX].Byte
  MUL  CX
  SHR  AX,1
  SHR  AX,1
  SHR  AX,1
  SHR  AX,1
  MOV  BX,AX
  MOV  AX,Setup.PSpeed
  MOV  CX,31H
  SUB  CX,BX
  XOR  DX,DX
  DIV  CX
  MOV  AddWBegin,AX
  RET
END;

PROCEDURE MulTran;NEAR;ASSEMBLER;
ASM
  PUSH BX
  PUSH CX
  MOV  CX,ChnType([SI]).TmpTrn1
  CMP  CX,227H
  JNC  @OkCX
  XOR  AX,AX
  MOV  ChnType([SI]).Trans2,AX
  MOV  ChnType([SI]).Trans1,AX
  POP  CX
  POP  BX
  RET
 @OkCX:
  MOV  DX,226H
  MOV  AX,6C34H
  DIV  CX
  XOR  DX,DX
  DIV  Setup.PSpeed
  MOV  CX,AX
  XOR  AX,AX
  DIV  Setup.PSpeed
  MOV  ChnType([SI]).Trans2,AX
  MOV  ChnType([SI]).Trans1,CX
  POP  CX
  POP  BX
  RET
END;

PROCEDURE DoCommand;NEAR;ASSEMBLER;
ASM
  MOV  AH,ChnType([SI]).LstCmd.Byte
  MOV  AL,ChnType([SI]).LstInfo.Byte
  CMP  AH,5
  JZ   @PortUp
  CMP  AH,6
  JZ   @PortDown
  CMP  AH,4
  JZ   @VolSlide
  CMP  AH,9
  JNZ  @C1
  JMP  @Tremor
@C1:
  CMP  AH,0AH
  JNZ  @C2
  JMP  @Arped
@C2:
  MOV  ChnType([SI]).TremVar,0
  MOV  ChnType([SI]).ArpeVar,1
  CMP  AH,7
  JNZ  @C3
  JMP  @GNop
@C3:
  CMP  AH,8
  JNZ  @C4
  JMP  @Vibrato
@C4:
  MOV  ChnType([SI]).VibrVar,0
  RET
 @PortDown:
  XOR  AH,AH
  MUL  ComVar
  SUB  ChnType([SI]).TmpTrn1,AX
  CALL MulTran
  RET
 @PortUp:
  XOR  AH,AH
  MUL  ComVar
  ADD  ChnType([SI]).TmpTrn1,AX
  CALL MulTran
  RET
 @VolSlide:
  MOV  DL,AL
  AND  DL,0FH
  CMP  DL,0
  JZ   @UpVol
  XOR  DH,DH
  SUB  ChnType([SI]).CVol,DX
  CMP  ChnType([SI]).CVol,0FFFFH
  JG   @OkRet
  MOV  ChnType([SI]).CVol,0
 @OkRet:
  RET
 @UpVol:
  XOR  AH,AH
  MOV  CL,4
  SHR  AL,CL
  ADD  ChnType([SI]).CVol,AX
  CMP  ChnType([SI]).CVol,041H
  JC   @OkRet
  MOV  ChnType([SI]).CVol,040H
  RET
 @GNop:
  MOV  AX,ChnType([SI]).TmpTrn1
  CMP  AX,ChnType([SI]).TmpTrn2
  JNZ  @Differ
  RET
 @Differ:
  JA   @SetDown
  ADD  AX,ChnType([SI]).LstInfo
  ADD  AX,ChnType([SI]).LstInfo
  ADD  AX,ChnType([SI]).LstInfo
  ADD  AX,ChnType([SI]).LstInfo
  ADD  AX,ChnType([SI]).LstInfo
  ADD  AX,ChnType([SI]).LstInfo
  ADD  AX,ChnType([SI]).LstInfo
  ADD  AX,ChnType([SI]).LstInfo
  ADD  AX,ChnType([SI]).LstInfo
  ADD  AX,ChnType([SI]).LstInfo
  CMP  AX,ChnType([SI]).TmpTrn2
  JNA  @NoAbove
  MOV  AX,ChnType([SI]).TmpTrn2
 @NoAbove:
  MOV  ChnType([SI]).TmpTrn1,AX
  CALL MulTran
  RET
 @SetDown:
  SUB  AX,ChnType([SI]).LstInfo
  SUB  AX,ChnType([SI]).LstInfo
  SUB  AX,ChnType([SI]).LstInfo
  SUB  AX,ChnType([SI]).LstInfo
  SUB  AX,ChnType([SI]).LstInfo
  SUB  AX,ChnType([SI]).LstInfo
  SUB  AX,ChnType([SI]).LstInfo
  SUB  AX,ChnType([SI]).LstInfo
  SUB  AX,ChnType([SI]).LstInfo
  SUB  AX,ChnType([SI]).LstInfo
  CMP  AX,ChnType([SI]).TmpTrn2
  JNC  @NoAbove1
  MOV  AX,ChnType([SI]).TmpTrn2
 @NoAbove1:
  MOV  ChnType([SI]).TmpTrn1,AX
  CALL MulTran
  RET
 @Vibrato:
  MOV  CL,AL
  MOV  CH,AL
  AND  CL,0FH
  MOV  BX,ChnType([SI]).VibrVar
  MOV  AX,VibratoTab[BX].WORD
  PUSH CX
  XOR  CH,CH
  IMUL CX
  POP  CX
  MOV  CL,6
  SAR  AX,CL
  IMUL ComVar
  ADD  AX,ChnType([SI]).TmpTrn2
  MOV  ChnType([SI]).TmpTrn1,AX
  CALL MulTran
  MOV  CL,4
  SHR  CH,CL
  SHL  CH,1
  ADD  BL,CH
  AND  BL,7EH
  MOV  ChnType([SI]).VibrVar,BX
  RET
 @Tremor:
  MOV  AX,ChnType([SI]).TremVar
  CMP  AX,0
  JZ   @InTrem
  DEC  AX
  MOV  ChnType([SI]).TremVar,AX
  RET
 @InTrem:
  MOV  AX,ChnType([SI]).ArpeVar
  CMP  AX,1
  JZ   @InTrem1
  MOV  ChnType([SI]).ArpeVar,1
  MOV  AX,ChnType([SI]).IVol
  MOV  ChnType([SI]).CVol,AX
  MOV  AX,ChnType([SI]).LstInfo
  SHR  AL,1
  SHR  AL,1
  SHR  AL,1
  SHR  AL,1
  MOV  ChnType([SI]).TremVar,AX
  RET
 @InTrem1:
  MOV  ChnType([SI]).ArpeVar,0
  MOV  AX,0
  MOV  ChnType([SI]).CVol,AX
  MOV  AX,ChnType([SI]).LstInfo
  AND  AX,0FH
  MOV  ChnType([SI]).TremVar,AX
  RET
 @Arped:
  MOV  AX,TempoD16
  MOV  CL,3
  DIV  CL
  MOV  DL,AL
  XOR  AL,AL
  MOV  BL,ChnType([SI]).TmpNote.Byte
  CMP  DL,2
  JZ   @It2
  CMP  DL,1
  JZ   @It1
  MOV  AL,ChnType([SI]).LstInfo.Byte
  AND  AL,0FH
  JMP  @It2
 @It1:
  INC   CL
  SHR   AL,CL
 @It2:
  MOV   BH,BL
  AND   BL,0F0H
  AND   BH,00FH
  ADD   BH,AL
  CMP   BH,0BH
  JBE   @Caron
  SUB   BH,0CH
  ADD   BL,10H
 @Caron:
  OR    BL,BH
  XOR   BH,BH
  SHL   BX,1
  MOV   AX,NTab[BX].WORD
  MOV   CX,2100H
  MUL   CX
  MOV   CX,ChnType([SI]).InsTrns
  CMP   CX,0
  JNZ   @NoZTr
  MOV   CX,22B8H
 @NoZTr:
  DIV   CX
  MOV  ChnType([SI]).TmpTrn1,AX
  MOV  ChnType([SI]).TmpTrn2,AX
  CALL MulTran
  RET
END;

PROCEDURE ChangePattern;NEAR;ASSEMBLER;
ASM
  XOR  AH,AH
  MOV  BX,NextPatO
  MOV  AL,[BX]
  CMP  AX,63H
  JNZ  @NoPlayEnd
  INC  LoopCount
  MOV  BX,FirstOrd
  MOV  AL,[BX]
 @NoPlayEnd:
  MOV  CurOrder,BX
  INC  BX
  CMP  AX,62H
  JNZ  @No62
  INC  LoopCount
  MOV  BX,OFFSET OrdB
  MOV  AL,[BX]
  INC  BX
  MOV  NextPat,True
 @No62:
  MOV  NextPatO,BX
  MOV  CurPat,AX
  MOV  AH,AL
  XOR  AL,AL
  SHL  AX,1
  SHL  AX,1
  ADD  AX,0
  MOV  Ch1.PatOfs,AX
  ADD  AX,4
  MOV  Ch2.PatOfs,AX
  ADD  AX,4
  MOV  Ch3.PatOfs,AX
  ADD  AX,4
  MOV  Ch4.PatOfs,AX
  XOR  AX,AX
  MOV  Ch1.Row,AX
  MOV  Ch2.Row,AX
  MOV  Ch3.Row,AX
  MOV  Ch4.Row,AX
END;

PROCEDURE CheckOptions;NEAR;ASSEMBLER;
ASM
  MOV  AH,ChnType([SI]).LstCmd.Byte
  MOV  AL,ChnType([SI]).LstInfo.Byte
  CMP  AH,1
  JZ   @ChgTempo
  CMP  AH,2
  JZ   @GotoPat
  CMP  AH,3
  JZ   @BreakPat
 @RetFromChk:
  RET
 @ChgTempo:
  CMP  AL,0
  JZ   @RetFromChk
  XOR  AH,AH
  CALL ResetTempoVars
  RET
 @GotoPat:
  XOR  AH,AH
  ADD  AX,OFFSET OrdB
  MOV  NextPatO,AX
  RET
 @BreakPat:
  MOV  ChangePat,True
END;

PROCEDURE SetNoteTrans;NEAR;ASSEMBLER;
ASM
  MOV  AX,ChnType([SI]).LstPVol
  CMP  AX,41H
  JZ   @NoPVol
  MOV  ChnType([SI]).CVol,AX
  MOV  ChnType([SI]).IVol,AX
 @NoPVol:
  CMP  ChnType([SI]).LstCmd,7
  JNZ  @NoGOption
  JMP  @GOption
 @NoGOption:
  MOV  BX,ChnType([SI]).LstIns
  CMP  BX,0
  JZ   @NoInsInPat
  MOV  ChnType([SI]).Color,BX
  SHL  BX,1
  SHL  BX,1
  SHL  BX,1
  SHL  BX,1
  SHL  BX,1
  ADD  BX,(OFFSET InsB)-32
  MOV  ChnType([SI]).NInsOfs,BX
  CMP  ChnType([SI]).LstPVol,41H
  JNZ  @LstPVolNo41
  MOV  AL,InsType([BX]).Volm
  XOR  AH,AH
  MOV  ChnType([SI]).CVol,AX
  MOV  ChnType([SI]).IVol,AX
 @LstPVolNo41:
  MOV  AX,InsType([BX]).Tran
  MOV  ChnType([SI]).InsTrns,AX
  MOV  AX,InsType([BX+2]).Inst.WORD
  CMP  AX,0
  JNZ  @ItIns
  MOV  ChnType([SI]).LstNote,0FEH
 @ItIns:
  MOV  ChnType([SI]).InsSeg,AX
  MOV  AX,InsType([BX]).LopE
  CMP  AX,0FFFFH
  JZ   @NoLoop
  MOV  ChnType([SI]).InsEnd,AX
  MOV  AX,InsType([BX]).LopS
  MOV  ChnType([SI]).Loop,AX
  JMP  @NoInsInPat
 @NoLoop:
  MOV  ChnType([SI]).Loop,AX
  MOV  AX,InsType([BX]).Leng
  MOV  ChnType([SI]).InsEnd,AX
 @NoInsInPat:
  MOV  BX,ChnType([SI]).LstNote
  CMP  BX,0FEH
  JNZ  @ItNote
  XOR  AX,AX
  MOV  ChnType([SI]).TAdd,AX
  MOV  ChnType([SI]).InsOfs,AX
  MOV  ChnType([SI]).InsEnd,AX
  MOV  ChnType([SI]).Loop,0FFFFH
  JMP  @CheckOpt
 @ItNote:
  CMP  BX,0FFH
  JZ   @CheckOpt
  MOV  ChnType([SI]).TmpNote,BX
  MOV  AX,ChnType([SI]).CVol
  SHR  AL,1
  MOV  ChnType([SI]).LevVol,AX
  MOV  ChnType([SI]).LevVol1,AX
  SHL  BX,1
  MOV  AX,NTab[BX].WORD
  MOV  CX,2100H
  MUL  CX
  MOV  CX,ChnType([SI]).InsTrns
  CMP  CX,0
  JNZ  @NoZeroTrans
  MOV  CX,22B8H
 @NoZeroTrans:
  DIV  CX
  MOV  ChnType([SI]).TmpTrn1,AX
  MOV  ChnType([SI]).TmpTrn2,AX
  CALL MulTran
  XOR  AX,AX
  MOV  ChnType([SI]).TAdd,AX
  MOV  ChnType([SI]).InsOfs,AX
 @CheckOpt:
  CALL CheckOptions
  RET
 @GOption:
  MOV  BX,ChnType([SI]).LstNote
  CMP  BX,0FFH
  JZ   @DoneGOp
  SHL  BX,1
  MOV  AX,NTab[BX].WORD
  MOV  ChnType([SI]).TmpTrn2,AX
 @DoneGOp:
END;

PROCEDURE ResetVars;NEAR;ASSEMBLER;
ASM
  MOV  ES,[PatB+2].WORD
  INC  ChnType([SI]).Row
  CMP  ChnType([SI]).Row,40H
  JC   @NoOverPat
  MOV  ChangePat,True
 @NoOverPat:
  CMP  ChnType([SI]).On,0
  JZ   @OFF
  MOV  BX,ChnType([SI]).PatOfs
  XOR  AH,AH
  MOV  AL,ES:[BX]
  MOV  ChnType([SI]).LstNote,AX
  MOV  AL,ES:[BX+1]
  SHR  AL,1
  SHR  AL,1
  SHR  AL,1
  MOV  ChnType([SI]).LstIns,AX
  MOV  AL,ES:[BX+1]
  AND  AL,7
  MOV  DL,ES:[BX+2]
  SHR  DL,1
  AND  DL,78H
  OR   AL,DL
  MOV  ChnType([SI]).LstPVol,AX
  MOV  AL,ES:[BX+2]
  AND  AL,0FH
  MOV  ChnType([SI]).LstCmd,AX
  MOV  AL,ES:[BX+3]
  MOV  ChnType([SI]).LstInfo,AX
  ADD  BX,10H
  MOV  ChnType([SI]).PatOfs,BX
  CALL SetNoteTrans
  CMP  ChnType([SI]).LstCmd,9
  JNZ  @DoneResetVars
  CALL DoCommand
 @DoneResetVars:
  RET
 @OFF:
  ADD  CHNTYPE([SI]).PATOFS,10H
END;

PROCEDURE Stack08;NEAR;ASSEMBLER;
ASM
  DW 0 { For CS IP and FLAGS   }
  DW 0
  DW 0
  DW 0 { Add Play Proc Segment }
  DW 0 { Add Play Proc Offset  }
  DW 0
END;

PROCEDURE SetAddProcAddr(P:Pointer);NEAR;
TYPE
  SO =RECORD
        O,S:Word;
      END;
BEGIN
  MemW[Seg(Stack08):Ofs(Stack08)+6]:=SO(P).O;
  MemW[Seg(Stack08):Ofs(Stack08)+8]:=SO(P).S;
END;

PROCEDURE AddPlay;NEAR;ASSEMBLER;
ASM
  PUSHF
  PUSH   AX
  PUSH   BX
  PUSH   CX
  PUSH   DX
  PUSH   ES
  PUSH   DS
  PUSH   SI
  MOV    AX,SEG Cw
  MOV    DS,AX
  MOV    AX,TempoD16
  CMP    AX,0
  JZ     @Td16z
  DEC    AX
  MOV    TempoD16,AX
  MOV    SI,OFFSET Ch1
  CALL   DoCommand
  MOV    SI,OFFSET Ch2
  CALL   DoCommand
  MOV    SI,OFFSET Ch3
  CALL   DoCommand
  MOV    SI,OFFSET Ch4
  CALL   DoCommand
  JMP    @ResetVol
 @Td16z:
  CMP    Play1Note,False
  JZ     @ResetVol
  CMP    ChangePat,True
  JNZ    @NoChgPat
  MOV    ChangePat,False
  CALL   ChangePattern
 @NoChgPat:
  MOV    SI,OFFSET Ch1
  CALL   ResetVars
  MOV    SI,OFFSET Ch2
  CALL   ResetVars
  MOV    SI,OFFSET Ch3
  CALL   ResetVars
  MOV    SI,OFFSET Ch4
  CALL   ResetVars
  MOV    AX,TempoD16S
  CMP    AX,0
  JZ     @ZeroTempo
  DEC    AX
 @ZeroTempo:
  MOV    TempoD16,AX
 @ResetVol:
  MOV    AX,Ch1.CVol
  MUL    GVolume1
  MOV    CL,6
  SHR    AX,CL
  MOV    Ch1.Volume,AL
  MOV    AX,Ch2.CVol
  MUL    GVolume2
  SHR    AX,CL
  MOV    Ch2.Volume,AL
  MOV    AX,Ch3.CVol
  MUL    GVolume3
  SHR    AX,CL
  MOV    Ch3.Volume,AL
  MOV    AX,Ch4.CVol
  MUL    GVolume4
  SHR    AX,CL
  MOV    Ch4.Volume,AL
  CMP    Setup.TimerOn,False
  JZ     @DoneAddPlay
  MOV    AX,TimerA
  ADD    AX,TimerC
  MOV    TimerA,AX
  JNC    @DoneAddPlay
  PUSHF
  CALL   Ov08
 @DoneAddPlay:
  POP    SI
  POP    DS
  POP    ES
  POP    DX
  POP    CX
  POP    BX
  POP    AX
  POPF
  PUSH   CS:[Stack08+2].WORD
  PUSH   CS:[Stack08+0].WORD
  RETF
END;

PROCEDURE NulInt08;NEAR;ASSEMBLER;
ASM
  PUSH  AX
  PUSH  BX
  PUSH  CX
  PUSH  DX
  PUSH  ES
  PUSH  DS
  MOV   AX,SEG Cw
  MOV   DS,AX
  MOV   DX,0FFFFH
  XOR   CL,CL
  LES   BX,Ch1.InsOfs.Pointer
  CMP   BX,Ch1.InsEnd
  JC    @Calc1
  CMP   Ch1.Loop,DX
  JZ    @ChDone1
  MOV   BX,Ch1.Loop
  MOV   Ch1.InsOfs,BX
  JMP   @Calc1
 @ChDone1:
  MOV   Ch1.Free,1
  JMP   @Ch2
 @Calc1:
  MOV   AX,Ch1.Trans2
  ADD   Ch1.TAdd,AX
  ADC   BX,Ch1.Trans1
  MOV   Ch1.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch1.Volume
  ADD   CL,VTab[BX].Byte
 @Ch2:
  LES   BX,Ch2.InsOfs.Pointer
  CMP   BX,Ch2.InsEnd
  JC    @Calc2
  CMP   Ch2.Loop,DX
  JZ    @ChDone2
  MOV   BX,Ch2.Loop
  MOV   Ch2.InsOfs,BX
  JMP   @Calc2
 @ChDone2:
  MOV   Ch2.Free,1
  JMP   @Ch3
 @Calc2:
  MOV   AX,Ch2.Trans2
  ADD   Ch2.TAdd,AX
  ADC   BX,Ch2.Trans1
  MOV   Ch2.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch2.Volume
  ADD   CL,VTab[BX].Byte
 @Ch3:
  LES   BX,Ch3.InsOfs.Pointer
  CMP   BX,Ch3.InsEnd
  JC    @Calc3
  CMP   Ch3.Loop,DX
  JZ    @ChDone3
  MOV   BX,Ch3.Loop
  MOV   Ch3.InsOfs,BX
  JMP   @Calc3
 @ChDone3:
  MOV   Ch3.Free,1
  JMP   @Ch4
 @Calc3:
  MOV   AX,Ch3.Trans2
  ADD   Ch3.TAdd,AX
  ADC   BX,Ch3.Trans1
  MOV   Ch3.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch3.Volume
  ADD   CL,VTab[BX].Byte
 @Ch4:
  LES   BX,Ch4.InsOfs.Pointer
  CMP   BX,Ch4.InsEnd
  JC    @Calc4
  CMP   Ch4.Loop,DX
  JZ    @ChDone4
  MOV   BX,Ch4.Loop
  MOV   Ch4.InsOfs,BX
  JMP   @Calc4
 @ChDone4:
  MOV   Ch4.Free,1
  JMP   @Ch5
 @Calc4:
  MOV   AX,Ch4.Trans2
  ADD   Ch4.TAdd,AX
  ADC   BX,Ch4.Trans1
  MOV   Ch4.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch4.Volume
  ADD   CL,VTab[BX].Byte
 @Ch5:
  MOV   AL,CL
  ADD   AL,80H
  PUSH  BX
  PUSH  ES
  MOV   BX,SpTabSeg
  MOV   ES,BX
  MOV   BX,SpTabOfs
  XLAT
  POP   ES
  POP   BX
  DEC   AddWCur
  JZ    @Trouble
  INC   FastTime
  MOV   AL,20H
  OUT   20H,AL
  POP   DS
  POP   ES
  POP   DX
  POP   CX
  POP   BX
  POP   AX
  IRET
@Trouble:
  MOV   AX,AddWBegin
  MOV   AddWCur,AX
  INC   FastTime
  MOV   AL,20H
  OUT   20h,AL
  POP   DS
  POP   ES
  POP   DX
  POP   CX
  POP   BX
  POP   AX
  POP   CS:[Stack08+0].Word
  POP   CS:[Stack08+2].Word
  PUSH  CS
  PUSH  CS:[Stack08+6].Word
  IRET
END;

PROCEDURE SpeakerInt08;NEAR;ASSEMBLER;
ASM
  PUSH  AX
  PUSH  BX
  PUSH  CX
  PUSH  DX
  PUSH  ES
  PUSH  DS
  MOV   AX,SEG Cw
  MOV   DS,AX
  MOV   DX,0FFFFH
  XOR   CL,CL
  LES   BX,Ch1.InsOfs.Pointer
  CMP   BX,Ch1.InsEnd
  JC    @Calc1
  CMP   Ch1.Loop,DX
  JZ    @ChDone1
  MOV   BX,Ch1.Loop
  MOV   Ch1.InsOfs,BX
  JMP   @Calc1
 @ChDone1:
  MOV   Ch1.Free,1
  JMP   @Ch2
 @Calc1:
  MOV   AX,Ch1.Trans2
  ADD   Ch1.TAdd,AX
  ADC   BX,Ch1.Trans1
  MOV   Ch1.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch1.Volume
  ADD   CL,VTab[BX].Byte
 @Ch2:
  LES   BX,Ch2.InsOfs.Pointer
  CMP   BX,Ch2.InsEnd
  JC    @Calc2
  CMP   Ch2.Loop,DX
  JZ    @ChDone2
  MOV   BX,Ch2.Loop
  MOV   Ch2.InsOfs,BX
  JMP   @Calc2
 @ChDone2:
  MOV   Ch2.Free,1
  JMP   @Ch3
 @Calc2:
  MOV   AX,Ch2.Trans2
  ADD   Ch2.TAdd,AX
  ADC   BX,Ch2.Trans1
  MOV   Ch2.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch2.Volume
  ADD   CL,VTab[BX].Byte
 @Ch3:
  LES   BX,Ch3.InsOfs.Pointer
  CMP   BX,Ch3.InsEnd
  JC    @Calc3
  CMP   Ch3.Loop,DX
  JZ    @ChDone3
  MOV   BX,Ch3.Loop
  MOV   Ch3.InsOfs,BX
  JMP   @Calc3
 @ChDone3:
  MOV   Ch3.Free,1
  JMP   @Ch4
 @Calc3:
  MOV   AX,Ch3.Trans2
  ADD   Ch3.TAdd,AX
  ADC   BX,Ch3.Trans1
  MOV   Ch3.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch3.Volume
  ADD   CL,VTab[BX].Byte
 @Ch4:
  LES   BX,Ch4.InsOfs.Pointer
  CMP   BX,Ch4.InsEnd
  JC    @Calc4
  CMP   Ch4.Loop,DX
  JZ    @ChDone4
  MOV   BX,Ch4.Loop
  MOV   Ch4.InsOfs,BX
  JMP   @Calc4
 @ChDone4:
  MOV   Ch4.Free,1
  JMP   @Ch5
 @Calc4:
  MOV   AX,Ch4.Trans2
  ADD   Ch4.TAdd,AX
  ADC   BX,Ch4.Trans1
  MOV   Ch4.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch4.Volume
  ADD   CL,VTab[BX].Byte
 @Ch5:
  MOV   AL,CL
  ADD   AL,80H
  PUSH  BX
  PUSH  ES
  MOV   BX,SpTabSeg
  MOV   ES,BX
  MOV   BX,SpTabOfs
  XLAT
  POP   ES
  POP   BX
  OUT   42H,AL
  DEC   AddWCur
  JZ    @Trouble
  INC   FastTime
  MOV   AL,20H
  OUT   20H,AL
  POP   DS
  POP   ES
  POP   DX
  POP   CX
  POP   BX
  POP   AX
  IRET
@Trouble:
  MOV   AX,AddWBegin
  MOV   AddWCur,AX
  INC   FastTime
  MOV   AL,20H
  OUT   20h,AL
  POP   DS
  POP   ES
  POP   DX
  POP   CX
  POP   BX
  POP   AX
  POP   CS:[Stack08+0].Word
  POP   CS:[Stack08+2].Word
  PUSH  CS
  PUSH  CS:[Stack08+6].Word
  IRET
END;

PROCEDURE CovoxInt08;NEAR;ASSEMBLER;
ASM
  PUSH  AX
  PUSH  BX
  PUSH  CX
  PUSH  DX
  PUSH  ES
  PUSH  DS
  MOV   AX,SEG Cw
  MOV   DS,AX
  MOV   DX,0FFFFH
  XOR   CL,CL
  LES   BX,Ch1.InsOfs.Pointer
  CMP   BX,Ch1.InsEnd
  JC    @Calc1
  CMP   Ch1.Loop,DX
  JZ    @ChDone1
  MOV   BX,Ch1.Loop
  MOV   Ch1.InsOfs,BX
  JMP   @Calc1
 @ChDone1:
  MOV   Ch1.Free,1
  JMP   @Ch2
 @Calc1:
  MOV   AX,Ch1.Trans2
  ADD   Ch1.TAdd,AX
  ADC   BX,Ch1.Trans1
  MOV   Ch1.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch1.Volume
  ADD   CL,VTab[BX].Byte
 @Ch2:
  LES   BX,Ch2.InsOfs.Pointer
  CMP   BX,Ch2.InsEnd
  JC    @Calc2
  CMP   Ch2.Loop,DX
  JZ    @ChDone2
  MOV   BX,Ch2.Loop
  MOV   Ch2.InsOfs,BX
  JMP   @Calc2
 @ChDone2:
  MOV   Ch2.Free,1
  JMP   @Ch3
 @Calc2:
  MOV   AX,Ch2.Trans2
  ADD   Ch2.TAdd,AX
  ADC   BX,Ch2.Trans1
  MOV   Ch2.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch2.Volume
  ADD   CL,VTab[BX].Byte
 @Ch3:
  LES   BX,Ch3.InsOfs.Pointer
  CMP   BX,Ch3.InsEnd
  JC    @Calc3
  CMP   Ch3.Loop,DX
  JZ    @ChDone3
  MOV   BX,Ch3.Loop
  MOV   Ch3.InsOfs,BX
  JMP   @Calc3
 @ChDone3:
  MOV   Ch3.Free,1
  JMP   @Ch4
 @Calc3:
  MOV   AX,Ch3.Trans2
  ADD   Ch3.TAdd,AX
  ADC   BX,Ch3.Trans1
  MOV   Ch3.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch3.Volume
  ADD   CL,VTab[BX].Byte
 @Ch4:
  LES   BX,Ch4.InsOfs.Pointer
  CMP   BX,Ch4.InsEnd
  JC    @Calc4
  CMP   Ch4.Loop,DX
  JZ    @ChDone4
  MOV   BX,Ch4.Loop
  MOV   Ch4.InsOfs,BX
  JMP   @Calc4
 @ChDone4:
  MOV   Ch4.Free,1
  JMP   @Ch5
 @Calc4:
  MOV   AX,Ch4.Trans2
  ADD   Ch4.TAdd,AX
  ADC   BX,Ch4.Trans1
  MOV   Ch4.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch4.Volume
  ADD   CL,VTab[BX].Byte
 @Ch5:
  MOV   AL,CL
  ADD   AL,80H
  MOV   DX,Setup.Lpt
  OUT   DX,AL
  DEC   AddWCur
  JZ    @Trouble
  INC   FastTime
  MOV   AL,20H
  OUT   20H,AL
  POP   DS
  POP   ES
  POP   DX
  POP   CX
  POP   BX
  POP   AX
  IRET
@Trouble:
  MOV   AX,AddWBegin
  MOV   AddWCur,AX
  INC   FastTime
  MOV   AL,20H
  OUT   20h,AL
  POP   DS
  POP   ES
  POP   DX
  POP   CX
  POP   BX
  POP   AX
  POP   CS:[Stack08+0].Word
  POP   CS:[Stack08+2].Word
  PUSH  CS
  PUSH  CS:[Stack08+6].Word
  IRET
END;

PROCEDURE BlasterInt08;NEAR;ASSEMBLER;
ASM
  PUSH  AX
  PUSH  BX
  PUSH  CX
  PUSH  DX
  PUSH  ES
  PUSH  DS
  MOV   AX,SEG Cw
  MOV   DS,AX
  MOV   DX,0FFFFH
  XOR   CL,CL
  LES   BX,Ch1.InsOfs.Pointer
  CMP   BX,Ch1.InsEnd
  JC    @Calc1
  CMP   Ch1.Loop,DX
  JZ    @ChDone1
  MOV   BX,Ch1.Loop
  MOV   Ch1.InsOfs,BX
  JMP   @Calc1
 @ChDone1:
  MOV   Ch1.Free,1
  JMP   @Ch2
 @Calc1:
  MOV   AX,Ch1.Trans2
  ADD   Ch1.TAdd,AX
  ADC   BX,Ch1.Trans1
  MOV   Ch1.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch1.Volume
  ADD   CL,VTab[BX].Byte
 @Ch2:
  LES   BX,Ch2.InsOfs.Pointer
  CMP   BX,Ch2.InsEnd
  JC    @Calc2
  CMP   Ch2.Loop,DX
  JZ    @ChDone2
  MOV   BX,Ch2.Loop
  MOV   Ch2.InsOfs,BX
  JMP   @Calc2
 @ChDone2:
  MOV   Ch2.Free,1
  JMP   @Ch3
 @Calc2:
  MOV   AX,Ch2.Trans2
  ADD   Ch2.TAdd,AX
  ADC   BX,Ch2.Trans1
  MOV   Ch2.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch2.Volume
  ADD   CL,VTab[BX].Byte
 @Ch3:
  LES   BX,Ch3.InsOfs.Pointer
  CMP   BX,Ch3.InsEnd
  JC    @Calc3
  CMP   Ch3.Loop,DX
  JZ    @ChDone3
  MOV   BX,Ch3.Loop
  MOV   Ch3.InsOfs,BX
  JMP   @Calc3
 @ChDone3:
  MOV   Ch3.Free,1
  JMP   @Ch4
 @Calc3:
  MOV   AX,Ch3.Trans2
  ADD   Ch3.TAdd,AX
  ADC   BX,Ch3.Trans1
  MOV   Ch3.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch3.Volume
  ADD   CL,VTab[BX].Byte
 @Ch4:
  LES   BX,Ch4.InsOfs.Pointer
  CMP   BX,Ch4.InsEnd
  JC    @Calc4
  CMP   Ch4.Loop,DX
  JZ    @ChDone4
  MOV   BX,Ch4.Loop
  MOV   Ch4.InsOfs,BX
  JMP   @Calc4
 @ChDone4:
  MOV   Ch4.Free,1
  JMP   @Ch5
 @Calc4:
  MOV   AX,Ch4.Trans2
  ADD   Ch4.TAdd,AX
  ADC   BX,Ch4.Trans1
  MOV   Ch4.InsOfs,BX
  MOV   BL,ES:[BX]
  MOV   BH,Ch4.Volume
  ADD   CL,VTab[BX].Byte
 @Ch5:
  MOV   DX,Setup.sb
        add             DX,0ch

@PL0:
        in    al,dx
        and             al,al
        js    @PL0
        mov   al,10h
        out   dx,al

@IL1:
        in    al,dx
        and             al,al
        js    @IL1

  MOV   AL,CL
  ADD   AL,80H
        OUT   DX,AL
  DEC   AddWCur
  JZ    @Trouble
  INC   FastTime
  MOV   AL,20H
  OUT   20H,AL
  POP   DS
  POP   ES
  POP   DX
  POP   CX
  POP   BX
  POP   AX
  IRET
@Trouble:
  MOV   AX,AddWBegin
  MOV   AddWCur,AX
  INC   FastTime
  MOV   AL,20H
  OUT   20h,AL
  POP   DS
  POP   ES
  POP   DX
  POP   CX
  POP   BX
  POP   AX
  POP   CS:[Stack08+0].Word
  POP   CS:[Stack08+2].Word
  PUSH  CS
  PUSH  CS:[Stack08+6].Word
  IRET
END;

FUNCTION ReadSTM(Name:String):Boolean;
TYPE
  STMIns = RECORD
            Name  : Array[1..13] of char;
            Dsk   : Byte;
            Res1  : Word;
            Len   : Word;
            LoopS : Word;
            LoopE : Word;
            Vol   : Byte;
            Res2  : Byte;
            Tran  : Word;
            Res3  : Word;
            Res4  : Word;
            Sef   : Word;
           END;
VAR
  F : file;
  I : STMIns;
  A : word;
  L : longint;

BEGIN
  ReadSTM:=False;
  Assign(F,name);
  Reset(F,1);
  IF IOResult<>0 THEN Exit;
  BlockRead(F,SName,20);
  Seek(F,32);
  BlockRead(F,Gtempo,1);
  BlockRead(F,Cb,1);
  TotPat:=Cb;
  BlockRead(F,GVolume1,1);
  GVolume2:=GVolume1;
  GVolume3:=GVolume1;
  GVolume4:=GVolume1;
  Seek(F,48);
  FOR CW:=1 TO 31 DO
  BEGIN
    BlockRead(f,I,SizeOf(I));
    InsB[cw].Name:='';
    FOR A:=1 TO 13 DO IF I.Name[A]<>#0 THEN
      InsB[Cw].Name:=InsB[Cw].Name+I.Name[A] ELSE InsB[Cw].Name:=InsB[Cw].Name+' ';
    InsB[cw].leng:=I.Len;
    InsB[cw].lops:=I.LoopS;
    InsB[cw].lope:=I.LoopE;
    InsB[cw].volm:=I.Vol;
    InsB[cw].tran:=I.Tran;
    insb[cw].res1:=I.Res1;
  END;
  FOR Cw1:=1 to 31 DO
  BEGIN
    IF InsB[Cw1].Leng<>0 THEN
    BEGIN
      L:=InsB[Cw1].Res1;
      L:=L*16;
      Seek(F,L);
      GetMem(InsB[Cw1].Inst,InsB[Cw1].Leng+4);
      FillChar(InsB[Cw1].Inst^,InsB[Cw1].Leng+4,0);
      IF Word(InsB[Cw1].Inst)<>0 THEN
      BEGIN
        W:=Word(InsB[Cw1].Inst);
        FreeMem(InsB[Cw1].Inst,InsB[Cw1].Leng+4);
        GetMem(InsB[Cw1].Inst,W);
        GetMem(InsB[Cw1].Inst,InsB[Cw1].Leng+4);
        FillChar(InsB[Cw1].Inst^,InsB[Cw1].Leng+4,0);
        IF Word(InsB[Cw1].Inst)<>0 THEN
        BEGIN
          WriteLn('Pointer error');
          Halt(1);
        END;
      END;
      BlockRead(F,InsB[cw1].Inst^,InsB[Cw1].Leng);
    END ELSE InsB[Cw1].Inst:=NIL;
  END;
  Seek(F,$410);
  BlockRead(F,OrdB,SizeOf(OrdB));
  L:=Cb;
  L:=L*1024;
  IF L>=65536 THEN L:=65535;
  BlockRead(F,PatB^,L);
  ReadSTM:=True;
  Close(F);
END;

PROCEDURE PlayAllPatterns(Device:byte);
BEGIN
  SpTabSeg:=Seg(SpTab);
  SpTabOfs:=Ofs(SpTab);
  IF OrdB[0]>=99 THEN Exit;
  FastTime  :=0;
  ASM
    MOV  AL,GTempo
    XOR  AH,AH
    CALL ResetTempoVars
  END;
  AddWCur   :=AddWBegin;
  TempoD16  :=TempoD16S;
  Play1Note :=True;
  ChangePat :=True;
  ASM
    MOV  DX,12H
    MOV  AX,34DCH
    DIV  Setup.PSpeed
    MOV  Port40,AX
  END;
  TimerC    :=Port40*AddWBegin;
  TimerA    :=0;
  CTempo    :=GTempo;
  NextPatO  :=Ofs(OrdB);
  CurOrder  :=Ofs(OrdB);
  LoopCount :=0;
  CurPat    :=OrdB[0];
  FirstOrd  :=Ofs(OrdB);
  NextPat   :=False;
  Ch1.PatOfs:=$00;
  Ch2.PatOfs:=$10;
  Ch3.PatOfs:=$20;
  Ch4.PatOfs:=$30;
  SetAddProcAddr(@AddPlay);
  if Device=1 then
    SetIntVec($08,@SpeakerInt08)
  else
  if Device=2 then
    SetIntVec($08,@CovoxInt08)
  else
  if Device=3 then
    SetIntVec($08,@BlasterInt08)
        else
                SetIntVec($08,@NulInt08);
  if Device=1 then
    begin
      Port[$61]:=Port[$61] OR 3;
      Port[$43]:=$90;
    end;
  if Device=3 then
    begin
                        asm
                                mov             dx,Setup.SB
                                add             dx,6
                                mov             al,1
                                out             dx,al
                                push    ax
                                pop             ax
                                mov             al,0
                                out             dx,al
                                mov   dx,Setup.SB

                        @NL1:
                                in    al,dx
                                rol             al,1
                                jc    @NL1
                                mov   al,0D1h
                                out             dx,al
                        end;
    end;
  Port[$43] :=$36;
  Port[$40] :=Lo(Port40);
  Port[$40] :=Hi(Port40);
END;

procedure Stop;
  begin
    Port[$43]:=$36;
    SetIntVec($08,@Ov08);
    Port[$40]:=0;
    Port[$40]:=0;
  end;

procedure InitPlayer;
BEGIN
  Write('Wait preparate music ... ');
  SetDefaultSetup;
  GetIntVec($08,@Ov08);
  GTempo :=$60;
  GOctave:=$01;
  GVolume1:=$40;
  GVolume2:=$40;
  GVolume3:=$40;
  GVolume4:=$40;
  FillChar(OrdB,128,99);
  InsB[1].Name:='';
  InsB[1].Tran:=$2100;
  InsB[1].Volm:=$40;
  InsB[1].LopS:=0;
  InsB[1].LopE:=$FFFF;
  InsB[1].Leng:=0;
  InsB[1].Inst:=NIL;
  InsB[1].W1:=0;
  InsB[1].W2:=0;
  FOR Cb:=2 TO 31 DO
    InsB[Cb]:=InsB[1];
  GetMem(PatB,65535);
  ASM
    PUSH ES
    LES  DI,PatB
    MOV  CX,0FFFFH
  @Again:
    MOV  WORD PTR ES:[DI+0],01FFH
    MOV  WORD PTR ES:[DI+2],0080H
    ADD  DI,4
    LOOP @Again
    POP  ES
  END;
  InitTabs;
  FillChar(Ch1,SizeOf(Ch1),0);
  FillChar(Ch2,SizeOf(Ch1),0);
  FillChar(Ch3,SizeOf(Ch1),0);
  FillChar(Ch4,SizeOf(Ch1),0);
  Ch1.On:=$1;
  Ch2.On:=$1;
  Ch3.On:=$1;
  Ch4.On:=$1;
  Ch1.OnV:=$1;
  Ch2.OnV:=$1;
  Ch3.OnV:=$1;
  Ch4.OnV:=$1;
  Ch1.Loop:=$FFFF;
  Ch2.Loop:=$FFFF;
  Ch3.Loop:=$FFFF;
  Ch4.Loop:=$FFFF;
  Writeln('Ok');
END;
end.