PROTRACKER372 PTTFC H
From MSX MUSIC WIKI
pttfc C��BK�L�бssg=0 ;в компиляторе пока не поддерживается
- TODO begin&end только в одном канале
newtfm=1 ;0=revision A, 1=revision C
IFN ?tfcinclude
- IMER=#5B5B
IMTAB=#BE00
ENDIF
IF0 newtfm-1
statuschip0=%11111000 statuschip1=%11111001
ELSE
IF0 newtfm-2 ;US031DX
statuschip0=%11111110 statuschip1=%11111111
ELSE ;newtfm=0
statuschip0=%11111100 statuschip1=%11111101
ENDIF
ENDIF
MACRO WaitStatus
IFN newtfm-2
;OUT (C),D ;statuschip0/1
INF
JP M,$-2
ENDIF
ENDM
;не нужен?
MACRO ssgprewait
WaitStatus
ENDM
;или этот не нужен?
MACRO ssgpostwait
WaitStatus
ENDM
IFN ?tfcinclude
MACRO HALTER
LOCAL
PUSH DE,HL
LD HL,23672
LD DE,3095;0
LD A,(HL)
DEC DE ;INC
CP (HL)
JP Z,$-2 ;23t
;DE=(Tframe-Tplayer)/30
;если >30000t
;(т.е. осталось < номинала), то левота
;LD HL,304 ;7000t
;LD HL,435 ;10000t
;LD HL,652 ;15000t
LD HL,1739 ;40000t
;LD HL,2174 ;50000t
;LD HL,3043 ;70000t
OR A
SBC HL,DE ;CY: DE>HL
JC halterskip
LD HL,sum
LD A,(HL)
ADD A,E
LD (HL),A
INC HL
LD A,(HL)
ADC A,D
LD (HL),A
INC HL
LD A,(HL)
ADC A,0
LD (HL),A
INC HL
LD A,(HL)
ADC A,0
LD (HL),A
LD HL,(min)
OR A
SBC HL,DE ;CY: old min <
JC $+6
LD (min),DE
LD HL,(max)
OR A
SBC HL,DE ;NC: old max >=
JNC $+6
LD (max),DE
LD HL,(frames)
INC HL
LD (frames),HL
JR halterQ
halterskip
LD HL,0
LD A,(HL)
ADD A,E
LD (HL),A
INC HL
LD A,(HL)
ADC A,D
LD (HL),A
INC HL
LD A,(HL)
ADC A,0
LD (HL),A
INC HL
LD A,(HL)
ADC A,0
LD (HL),A
LD HL,(min)
OR A
SBC HL,DE ;CY: old min <
JC $+6
LD (0),DE
LD HL,(max)
OR A
SBC HL,DE ;NC: old max >=
JNC $+6
LD (0),DE
LD HL,(badframes)
INC HL
LD (badframes),HL
halterQ
POP HL,DE
ENDL
ENDM
ORG #6000
begin GO
LD SP,#6000
GOFREE
LD (QUITSP),SP
IM 1
LD HL,#4000
LD DE,#4001
LD BC,6911
LD (HL),L
LDIR
LD A,#46
LD (PR88col),A
LD DE,#4000
LD HL,tTITLE
CALL PRMSG
LD DE,#4060
CALL PRMSG
LD DE,#40C0
CALL PRMSG
LD HL,tfmmuz
IFN ssg
LD BC,#32
ELSE
LD BC,#22
ENDIF
ADD HL,BC
LD A,7
LD (PR88col),A
LD DE,#4020
CALL PRMSG
LD DE,#4080
CALL PRMSG
LD DE,#40E0
CALL PRMSG
EI
HALT
LD HL,IMTAB
LD BC,256
LD D,H,E,B
LD (HL),IMER
LD A,H
LDIR
LD I,A
IM 2
LD HL,tfmmuz
CALL tfmini
HALT
;wait 1000t - не мин и не макс
LD B,1000/13
DJNZ $
LOOP
HALTER
nehalt
LD A,2
OUT (-2),A
CALL tfm
LD A,0
OUT (-2),A
LD A,#7F
IN A,(-2)
RRA
JP_JPC JP LOOP QUIT QUITSP=$+1
LD SP,0
CALL tfmshut
LD B,D
WaitStatus
LD A,#FF ;выкл. FM
OUT (C),A
IM 1
LD HL,(min)
CALL MUL23
LD DE,#5000
CALL PR12345
LD HL,(max)
CALL MUL23
LD DE,#5020
CALL PR12345
LD HL,(sum)
LD DE,(sum+2)
LD BC,(frames)
CALL DIV3216
CALL MUL23
LD DE,#5040
CALL PR12345
LD HL,(frames)
LD DE,#5060
CALL PR12345
LD HL,(badframes)
LD DE,#5080
PR12345
LD BC,10000
CALL PRDIG
LD BC,1000
CALL PRDIG
LD BC,100
CALL PRDIG
LD C,10
CALL PRDIG
LD C,1
PRDIG
LD A,"0"-1
OR A
INC A
SBC HL,BC
JNC $-3
ADD HL,BC
PR88
PUSH HL
ADD A,A
LD L,A
LD H,15
ADD HL,HL
ADD HL,HL
PUSH DE
DUP 8
LD A,(HL),(DE),A
INC L,D
EDUP
ORG $-1
LD A,D
RRA
RRA
RRA
AND 3
ADD A,88
LD D,A
PR88col=$+1
LD A,0
LD (DE),A
POP DE
INC E
POP HL
RET NZ
LD A,D
ADD A,8
LD D,A
RET
PRCR
LD A,E
AND #E0
ADD A,32
LD E,A
RET NC
LD A,D
ADD A,8
LD D,A
RET
PRCRMSG
INC HL ;skip LF
CALL PRCR
PRMSG
LD A,(HL)
INC HL
OR A
RET Z
CP 13
JZ PRCRMSG
CALL PR88
JR PRMSG
MUL23
LD B,H,C,L
ADD HL,HL
ADD HL,BC ;3
ADD HL,HL
ADD HL,HL
ADD HL,HL ;24
SBC HL,BC ;23
RET
DIV3216
- DEHL/BC -> HL
LD A,B
OR C
JNZ $+3
INC BC
LD IX,-1
DIV32160
INC IX
OR A
SBC HL,BC
JNC $+3
DEC DE
BIT 7,D
JZ DIV32160
PUSH IX
POP HL
RET
tTITLE
DB "Track name:",0
DB "Author:",0
DB "Message:",0
ENDIF
tfmplayer tfmini
EXD
LD HL,9
ADD HL,DE
LD A,(HL)
INC HL
CP 50
LD A,201
JZ $+4
LD A,62
LD (tfm60hz),A
EXX
LD HL,tfminitab
IFN ssg
LD BC,#14FD
ELSE
LD BC,#06FD
ENDIF
tfmini0
LD DE,tfminiHL
LDI
LDI
EXX
LD A,(HL)
INC HL
PUSH HL
LD H,(HL)
LD L,A
ADD HL,DE
tfminiHL=$+1
LD (0),HL
POP HL
INC HL
EXX
DJNZ tfmini0
XOR A
LD (blkcntA),A
LD (blkcntB),A
LD (blkcntC),A
LD (blkcntD),A
LD (blkcntE),A
LD (blkcntF),A
IFN ssg
LD (blkcntT0),A
LD (blkcntTA),A
LD (blkcntMA),A
LD (blkcntTB),A
LD (blkcntMB),A
LD (blkcntTC),A
LD (blkcntMC),A
LD (blkcntT1),A
LD (blkcntTD),A
LD (blkcntMD),A
LD (blkcntTE),A
LD (blkcntME),A
LD (blkcntTF),A
LD (blkcntMF),A
ENDIF
DEC A
LD (skipA),A
LD (skipB),A
LD (skipC),A
LD (skipD),A
LD (skipE),A
LD (skipF),A
IFN ssg
LD (skipT0),A
LD (skipTA),A
LD (skipMA),A
LD (skipTB),A
LD (skipMB),A
LD (skipTC),A
LD (skipMC),A
LD (skipT1),A
LD (skipTD),A
LD (skipMD),A
LD (skipTE),A
LD (skipME),A
LD (skipTF),A
LD (skipMF),A
ENDIF
tfmshut
LD DE,#FFBF
LD C,#FD
CALL selChip0
CALL tfminiPP
CALL selChip1
CALL tfminiPP
LD B,D
OUT (C),D ;fm off
RET
tfminiPP
XOR A
EXA
LD A,#0D ;SSG
regClrS CALL WRITEREG
DEC A
JP P,regClrS
LD A,#B3
regClrZ CP #4F
JR NZ,$+4
LD A,#3F ;skip TL, чтобы не было щелчка
CALL WRITEREG
DEC A
CP #30
JR NC,regClrZ
LD A,#0F ;max speed
EXA
LD A,#8F ;RR
regClrR CALL WRITEREG
DEC A
JP M,regClrR
; LD A,#F0
; EXA
; LD A,#28 ;key
; CALL WRITEREG ;key on A
; EXA
; INC A ;#F1
; EXA
; CALL WRITEREG ;key on B
; EXA
; INC A ;#F2
; EXA
; CALL WRITEREG ;key on C
XOR A
EXA
LD A,#28 ;key
CALL WRITEREG ;key off A
EXA
INC A ;#01
EXA
CALL WRITEREG ;key off B
EXA
INC A ;#02
EXA
CALL WRITEREG ;key off C
DEC A ;#27 ;channel 3 mode
CALL WRITEREG ;normal mode
LD A,#7F ;тишина
EXA
LD A,#4F ;TL
regClrT CALL WRITEREG
DEC A
CP #40
JR NC,regClrT
;LD A,#2F ;любое
;EXA
LD A,#2F
CALL WRITEREG ;без этого частота левая
;LD A,#2D ;любое
;EXA
LD A,#2D
;без этого частота левая
WRITEREG
- A=REG
- A'=VALUE
LD B,D
WaitStatus
OUT (C),A ;reg
EXA
WaitStatus
LD B,E
OUT (C),A ;value
EXA
RET
tfminitab
DW addrA
DW addrB
DW addrC
DW addrD
DW addrE
DW addrF
IFN ssg
DW addrT0
DW addrTA
DW addrMA
DW addrTB
DW addrMB
DW addrTC
DW addrMC
DW addrT1
DW addrTD
DW addrMD
DW addrTE
DW addrME
DW addrTF
DW addrMF
ENDIF
selChip0
LD A,statuschip0
LD B,D
OUT (C),A
RET
selChip1
LD A,statuschip1
LD B,D
OUT (C),A
RET
OUTA
PUSH BC
LD BC,32765
OUT (C),A
POP BC
RET
tfm
LD DE,#FFBF
LD C,#FD
LD B,D
LD A,statuschip0
OUT (C),A
CALL tfmA
CALL tfmB
CALL tfmC
LD B,D
LD A,statuschip1
OUT (C),A
CALL tfmD
CALL tfmE
CALL tfmF
;SSG
;CALL SSG
;
tfm60hz cnt60=$+1
LD A,6
DEC A
JNZ $+4
LD A,6
LD (cnt60),A
JZ tfm
RET
MACRO TestKeyOff
LOCAL
JP P,noffX
EXA
LD B,D ;%11111xxx
LD A,#28
WaitStatus
OUT (C),A
IF0 \0
XOR A
ELSE
LD A,\0
ENDIF
WaitStatus
LD B,E ;#BF
OUT (C),A
EXA
noffX
ENDL
ENDM
MACRO TestFreq
LOCAL
RRA
JNC nofrqX
EXA
LD B,D ;%11111xxx
LD A,#A4+\1
WaitStatus
OUT (C),A
LD A,(HL)
INC HL
LD (tfmhigh\0),A
WaitStatus
LD B,E ;#BF
OUT (C),A
LD B,D ;%11111xxx
LD A,#A0+\1
WaitStatus
OUT (C),A
LD A,(HL)
INC HL
LD (tfmlow\0),A
WaitStatus
LD B,E ;#BF
OUT (C),A
EXA
nofrqX
ENDL
ENDM
MACRO TestOutRegs
LOCAL
AND #1F
CALL NZ,regsX
ENDL
ENDM
MACRO KeyOn
LD B,D ;%11111xxx
LD A,#28
WaitStatus
OUT (C),A
LD A,#F0+\0
WaitStatus
LD B,E ;#BF
OUT (C),A
ENDM
- %11111111,-disp8 = данные кадра лежат по смещению -disp8
- %111ttttt = skip 32..2 frames
- %110ddddd = slide d-16
- %11010000,frames,-disp16 = repeat block (skips = 1 frame)
- %10111111,-disp16 = данные кадра лежат по смещению -disp16
- %10NNNNNf = keyoff,[freq,]0..30 regs, keyon
- %01111111 = end
- %01111110 = begin
- %01NNNNNf = keyoff,[freq,]0..31 regs
- %00NNNNNf = [freq,]0..30 regs
bb=%01111110 be=%01111111
MACRO MacroTFM
block\0
LD A,(HL) ;N frames
;1 now, N-1 later
;skip command is used as 1 frame
INC HL
LD (blkcnt\0),A
LD B,(HL)
INC HL
LD C,(HL) ;disp
INC HL
LD (blkretaddr\0),HL
ADD HL,BC
LD C,#FD
JP tfmframe\0
OLDfar\0
LD B,(HL)
INC HL
OLDnear\0
LD C,(HL)
INC HL
PUSH HL
ADD HL,BC
LD C,#FD
CALL tfmframe\0
POP HL
LD (addr\0),HL
RET
HLskiper\0
JZ OLDfar\0
CP %11100000
JC slide\0
LD B,A
CP #FF
JZ OLDnear\0
LD (addr\0),HL
skiper\0 LD (skip\0),A
RET
slide\0
;A=-64..-33
ADD A,48
;A=-16..15
JZ block\0
tfmlow\0=$+1
ADD A,0
LD (tfmlow\0),A
LD (addr\0),HL
LD B,D ;%11111xxx
tfmhigh\0=$+2
LD HL,#A4+\1
WaitStatus
OUT (C),L
WaitStatus
LD B,E ;#BF
OUT (C),H
LD B,D ;%11111xxx
LD L,#A0+\1
WaitStatus
OUT (C),L
WaitStatus
LD B,E ;#BF
OUT (C),A
RET
begin\0
LD (loopaddr\0),HL
JP tfmframe\0
end\0 loopaddr\0=$+1
LD HL,0
JP tfmframe\0
tfm\0 skip\0=$+1
LD A,-1
INC A
JNZ skiper\0
addr\0=$+1
LD HL,0
blkcnt\0=$+1
OR 0
JZ tfmframe\0
DEC A
LD (blkcnt\0),A
JNZ tfmframe\0
blkretaddr\0=$+1
LD HL,0
tfmframe\0
LD A,(HL)
INC HL
CP bb
JZ begin\0
CP be
JZ end\0
CP E ;#BF
JNC HLskiper\0
TestKeyOff \1
OR A
PUSH AF
TestFreq \0,\1
TestOutRegs
LD (addr\0),HL
POP AF
RET P
KeyOn \1
RET
ENDM
regsX
LD B,D ;%11111xxx
WaitStatus
OUTI ;reg
WaitStatus
LD B,E ;#BF
OUTI ;value
DEC A
JNZ regsX ;в turbo JR=JP
RET
MacroTFM A,0
MacroTFM B,1
MacroTFM C,2
MacroTFM D,0
MacroTFM E,1
MacroTFM F,2
IFN ssg
SSG
LD D,32
LD A,(ssgmaskA)
LD E,A
CALL ssgT0
CALL ssgTA
CALL ssgMA
CALL ssgTB
CALL ssgMB
CALL ssgTC
CALL ssgMC
LD A,E
LD (ssgmaskA),A
LD BC,#FFFD
LD DE,#FFBF
LD A,statuschip0
OUT (C),A
LD HL,ssglowA
CALL OUTSSG
LD D,32
LD A,(ssgmaskD)
LD E,A
CALL ssgT1
CALL ssgTD
CALL ssgMD
CALL ssgTE
CALL ssgME
CALL ssgTF
CALL ssgMF
LD A,E
LD (ssgmaskD),A
LD BC,#FFFD
LD DE,#FFBF
LD A,statuschip1
OUT (C),A
LD HL,ssglowD
OUTSSG
DUP 13
LD B,D ;%11111xxx
ssgprewait
OUT (C),L ;reg
ssgpostwait
LD B,E ;#BF
OUTI ;value
EDUP
LD A,(HL)
OR A
RET Z
LD B,D
ssgprewait
OUT (C),L
ssgpostwait
LD B,E
OUT (C),A
LD (HL),0
RET
- tone channel
- 1 1 1 HIGHTONE5 - set hightone, read lowtone
- 1 1 0 N, disp16 - LZ
- 1 0 1 N, disp8 - LZ
- 1 0 0 SKIP5 - skip 32..1 frames
- 0 dTONE7 - tone+=(dTONE7-64)
- begin=#A0
- end=#C0
MACRO ToneSSG
farT\0
LD B,(HL)
INC HL
nearT\0
LD C,(HL)
INC HL
;A = N frames
;1 now, N-1 later
;skip command is used as 1 frame
LD (blkcntT\0),A
LD (blkretaddrT\0),HL
ADD HL,BC
JP frameT\0
markT\0
ADD A,D
JC sethighT\0
ADD A,D
JZ endT\0
JC farT\0
LD B,-1
ADD A,D
JZ beginT\0
JC nearT\0
LD (addrT\0),HL
skiperT\0 LD (skipT\0),A
RET
beginT\0
LD (loopaddrT\0),HL
JP frameT\0
endT\0 loopaddrT\0=$+1
LD HL,0
JP frameT\0
ssgT\0 skipT\0=$+1
LD A,-1
INC A
JNZ skiperT\0
addrT\0=$+1
LD HL,0
blkcntT\0=$+1
OR 0
JZ frameT\0
DEC A
LD (blkcntT\0),A
JNZ frameT\0
blkretaddrT\0=$+1
LD HL,0
frameT\0
LD A,(HL)
INC HL
OR A
JP M,markT\0
SUB 64
;A=-63..63
LD (addrT\0),HL
LD HL,ssglow\0
ADD A,(HL)
LD (HL),A
RET
sethighT\0
LD (ssghigh\0),A
LD A,(HL)
INC HL
LD (ssglow\0),A
LD (addrT\0),HL
RET
ENDM
- NM=TM=0 is incompatible with volume set
- mask channel
- 1 1 1 NOISE5 - set noise, continue
- 1 1 0 N, disp16 - LZ
- 1 0 1 N, disp8 - LZ
- 1 0 0 SKIP5 - skip 32..1 frames
- 0 TM NM ...
;0 v3 v2 v1 v0 - env OFF (this byte to vol reg)
;1 1 e2 e1 e0 - ini env (type 8..F),
;env ON (this byte to vol reg)
;1 0 ? ? ? - env ON (this byte to vol reg)
- begin=#A0
- end=#C0
MACRO MaskSSG
farM\0
LD B,(HL)
INC HL
nearM\0
LD C,(HL)
INC HL
;A = N frames
;1 now, N-1 later
;skip command is used as 1 frame
LD (blkcntM\0),A
LD (blkretaddrM\0),HL
ADD HL,BC
JP frameM\0
markM\0
ADD A,D
JC setnoiseM\0
ADD A,D
JZ endM\0
JC farM\0
LD B,-1
ADD A,D
JZ beginM\0
JC nearM\0
LD (addrM\0),HL
skiperM\0 LD (skipM\0),A
RET
beginM\0
LD (loopaddrM\0),HL
JP frameM\0
endM\0 loopaddrM\0=$+1
LD HL,0
JP frameM\0
ssgM\0 skipM\0=$+1
LD A,-1
INC A
JNZ skiperM\0
addrM\0=$+1
LD HL,0
blkcntM\0=$+1
OR 0
JZ frameM\0
DEC A
LD (blkcntM\0),A
JNZ frameM\0
blkretaddrM\0=$+1
LD HL,0
frameM\0
LD A,(HL)
INC HL
OR A
JP M,markM\0
LD (addrM\0),HL
LD (ssgvol\0),A
BIT 4,A
JZ nenvM\0
BIT 3,A
JZ nenvM\0
LD (ssgenv\0),A
nenvM\0
RLA
RLA
JNC $+4
SET \1+3,E ;noisemask (3,4,5) OFF
RLA
RET NC
SET \1,E ;tonemask (0,1,2) OFF
RET
setnoiseM\0
LD (ssgnoise\0),A
JP frameM\0
ENDM
ToneSSG 0 ToneSSG A MaskSSG A,0 ToneSSG B MaskSSG B,1 ToneSSG C MaskSSG C,2 ToneSSG 1 ToneSSG D MaskSSG D,0 ToneSSG E MaskSSG E,1 ToneSSG F MaskSSG F,2
DS .(-$)
ssglowA DB 0 ssghighA DB 0 ssglowB DB 0 ssghighB DB 0 ssglowC DB 0 ssghighC DB 0 ssgnoiseA ssgnoiseB ssgnoiseC DB 0 ssgmaskA ssgmaskB ssgmaskC DB 0 ssgvolA DB 0 ssgvolB DB 0 ssgvolC DB 0 ssglow0 DB 0 ssghigh0 DB 0 ssgenvA ssgenvB ssgenvC DB 0
DS .(-$)
ssglowD DB 0 ssghighD DB 0 ssglowE DB 0 ssghighE DB 0 ssglowF DB 0 ssghighF DB 0 ssgnoiseD ssgnoiseE ssgnoiseF DB 0 ssgmaskD ssgmaskE ssgmaskF DB 0 ssgvolD DB 0 ssgvolE DB 0 ssgvolF DB 0 ssglow1 DB 0 ssghigh1 DB 0 ssgenvD ssgenvE ssgenvF DB 0
ENDIF ;ssg
DISPLAY "player size=",$-tfmplayer
IFN ?tfcinclude
min DW -1 max DW 0 sum DS 4 frames DW 0 badframes DW 0
;ORG #C000
tfmmuz
INCBIN "t*.t"
DISPLAY $
;ORG IMER
DS .(-$)
DS '$
IMER
PUSH AF
INC (IY+62)
POP AF
EI
RET
end
ORG #5CDD
DB "ducktaleB"
INCLUDE "B:m2hr*",#C0
ORG $
CALL 8026
JP NC,nenado
LD A,218 ;JPC
LD (JP_JPC),A
JP GOFREE
ENDIF
drT\0),HL
RET
ENDM
- NM=TM=0 is incompatible with volume set
- mask channel
- 1 1 1 NOISE5 - set noise, continue
- 1 1 0 N, disp16 - LZ
- 1 0 1 N, disp8 - L
