| Home | Submit | Free Hosting | Link To Us | Contacts |
Pascal Stmplay Pascal
 Download (.zip){$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.
|
