123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211 |
- #! /usr/bin/sdlbrt
- finp$="song.vgm"
- cbstr$="org.tildearrow.furnace - Pattern Data (103)"
- '- .vgm to furnace tracker clipboard converter - YM3812
- '- copyleft nitrofurano, may'22
- '-------------------------------
- '- bugs:
- '- - pattern-long delay maybe related to sample data transfering?
- '-------------------------------
- ltxtm$="...........|...........|...........|...........|...........|...........|...........|...........|...........|":ltxcr$=ltxtm$
- instch$="0102030404040404"
- dim frqaa[16],frqka[16],volaa[16],volka[16],wfca[32,32]
- dim hdrv[256],wfc0[32],wfc1[32],wfc2[32],wfc3[32],wfc4[32]
- dim fnuml[16],fnumh[16],fblk[16],fnumw[16],ffqv[16]
- frqaa[0]=0:frqaa[1]=0:frqaa[2]=0:volaa[0]=0:volaa[1]=0:volaa[2]=0
- patsz=64:patc=0:patid=0:freqq=0:hdram=0x40:vgmv=0:veof=0
- frqka[0]=0:frqka[1]=0:frqka[2]=0:frqka[3]=0:frqka[4]=0
- volka[0]=0:volka[1]=0:volka[2]=0:volka[3]=0:volka[4]=0
-
- if argc>2 then:finp$=argv(2):end if
- fout2$=finp$+"_furnaceclipboard.txt":fout3$=finp$+"_furnaceclipboard_debug.txt"
-
- frmc=0:frmr=300:trg=0
-
- frmi=735
- if argc>3 then:
- if argv(3)="1" or ucase$(argv(2))="-PAL" then
- frmi=882:end if:end if
-
- debug=0
- if argc>4 then:
- if argv(4)="1" or ucase$(argv(2))="-DEBUG" then
- debug=1:end if:end if
-
- function nttfrq$(freqb)
- e$= "C-1C#1D-1D#1E-1F-1F#1G-1G#1A-1A#1B-1"
- e$=e$+"C-2C#2D-2D#2E-2F-2F#2G-2G#2A-2A#2B-2"
- e$=e$+"C-3C#3D-3D#3E-3F-3F#3G-3G#3A-3A#3B-3"
- e$=e$+"C-4C#4D-4D#4E-4F-4F#4G-4G#4A-4A#4B-4"
- e$=e$+"C-5C#5D-5D#5E-5F-5F#5G-5G#5A-5A#5B-5"
- e$=e$+"C-6C#6D-6D#6E-6F-6F#6G-6G#6A-6A#6B-6"
- e$=e$+"C-7C#7D-7D#7E-7F-7F#7G-7G#7A-7A#7B-7"
- e$=e$+"B-7B-7B-7B-7B-7B-7B-7B-7B-7B-7B-7B-7"
- e$=e$+"B-7B-7B-7B-7B-7B-7B-7B-7B-7B-7B-7B-7..."
- 'tmq=141-(int((log(freqb*.99)/log(2))*12))
- tmq=(int((log(freqb)/log(2))*12))-112
- if tmq<1 then:tmq=1:end if
- if tmq>97 then:tmq=97:end if
- return mid$(e$,(tmq*3)-2,3)
- end function
-
- open finp$ for input as #1
- for i=0 to 255
- hdrv[i]=readbyte(1)
- next
- close #1
-
- hdram=0x040
- vgmv=hdrv[8]+hdrv[9]*256
- if vgmv>=0x0150 then:hdram=0x080:end if
- if vgmv>=0x0160 then:hdram=0x0C0:end if
- if vgmv>=0x0170 then:hdram=0x100:end if
- '- wrong information???
- ttsam=hdrv[0x18]+hdrv[0x19]*256+hdrv[0x1A]*65536+hdrv[0x1B]*16777216
- hsam$="PlayOrder=L0"
- for i=1 to (ttsam/(frmi*patsz))-1
- hsam$=hsam$+","+str$(i)
- next
-
- open finp$ for input as #1
- open fout2$ for output as #2
- open fout3$ for output as #3
- print #2,"---------8<----------------------------------------------"
- print #2,"[Pattern00]"
- print #2," "
- print #2,cbstr$
- print #2,"0"
- '- the amount of header bytes depends on vgm format version
- for eee=0 to hdram-1:q0=readbyte(1):next '- read offset byte first
- txou1$=" #("+str$(0)+")"
-
- while veof=0:
- q0=readbyte(1)
-
- '- vgm eof command
- if q0=0x66 then:
- veof=1
- print #3,"--vgm-eof--"
- print #2," "
- end if
-
- '- delay 1 byte (1..16 samples)
- if bitwiseand(q0,0x70)=0x70 then
- frmc=frmc+bitwiseand(q0,0xF)+1
- txou1$=" #("+str$(frmc)+")"
- 'print #3,txou1$
- end if
-
- '- delay 3 bytes (0..65535 samples)
- if q0=0x61 then
- q0=readbyte(1)
- frmc=frmc+q0
- q0=readbyte(1)
- frmc=frmc+(q0*256)
- txou1$=" #("+str$(frmc)+")"
- 'print #3,txou1$
- end if
-
- '- 1 ntsc frame delay, 735 samples
- if q0=0x62 then
- frmc=frmc+735
- txou1$=" #("+str$(frmc)+")"
- 'print #3,txou1$
- end if
-
- '- 1 pal frame delay, 882 samples
- if q0=0x63 then
- frmc=frmc+882
- txou1$=" #("+str$(frmc)+")"
- 'print #3,txou1$
- end if
- '- updates frameout pulses
- while frmr<frmc
-
- '- creates a new pattern
- if patc>(patsz-1) then:
- print #2," "
- patid=patid+1:patc=0
- txou9$="[Pattern"+ucase$(right$(hex$(0x100+patid),2))+"]"
- print #2,"---------8<----------------------------------------------"
- print #2,txou9$
- print #2,""
- print #2,cbstr$
- print #2,"0"
- end if
-
- '- writes a pattern line in each frame
- if trg=0 then
- print #3,"--frameout-unchanged--"
- print #2,ltxtm$
- else
- print #3,"--frameout--"
- print #2,ltxcr$
- ltxcr$=ltxtm$
- trg=0
- end if
-
- frmr=frmr+frmi
- patc=patc+1
- end while
- '-------------------------------------------------------------------------------
- '- YM3812
- '- token 0x5A gets registers and values to YM3526 output
- if q0=0x5A then
- q0=readbyte(1)
- '-------------------------------------------------------------------------------
- if bitwiseand(q0,0xF0)=0xA0 then '- fnuml
- q3=bitwiseand(q0,0x0F)
- q0=readbyte(1)
- fnuml[q3]=q0
- fnumw[q3]=fnuml[q3]+(bitwiseand(fnumh[q3],0x03)*256)
- fblk[q3]=(bitwiseand(fnumh[q3],0x1C)/4)
- ffqv[q3]=fnumw[q3]*(2^fblk[q3]) '- 440hz=9280 (21.0909090909090909)
- ltxtm1$=ltxtm$
- ltxtm2$=replace$((12*q3),ltxtm1$,nttfrq$(ffqv[q3])+"00")
- ltxcr$=replace$((12*q3),ltxcr$,nttfrq$(ffqv[q3])+"00")
- print #3,ltxtm2$
- trg=1
- end if
- if bitwiseand(q0,0xF0)=0xB0 then '- fnumh
- q3=bitwiseand(q0,0x0F)
- q0=readbyte(1)
- fnumh[q3]=q0
- fnumw[q3]=fnuml[q3]+(bitwiseand(fnumh[q3],0x03)*256)
- fblk[q3]=(bitwiseand(fnumh[q3],0x1C)/4)
- ffqv[q3]=fnumw[q3]*(2^fblk[q3]) '- 440hz=9280 (21.0909090909090909)
- ltxtm1$=ltxtm$
- ltxtm2$=replace$((12*q3),ltxtm1$,nttfrq$(ffqv[q3])+"00")
- ltxcr$=replace$((12*q3),ltxcr$,nttfrq$(ffqv[q3])+"00")
- print #3,ltxtm2$
- trg=1
- end if
- end if
- '-------------------------------------------------------------------------------
- if eof(1)<>0 then:veof=1:end if
- wend
- '--------------------------------
- close #1:close #2:close #3
-
- if debug=0 then:
- shell("rm "+fout3$)
- end if
|