vgm2vortextracker/vgm2furnaceclipboard/Vgm2FurnaceClipboardTxt_ym2203_02.sdlbas

#! /usr/bin/sdlbrt
finp$="song.vgm"
cbstr$="org.tildearrow.furnace - Pattern Data (103)"

'- .vgm to furnace tracker clipboard converter - YM2203
'- copyleft nitrofurano, aug'22
'-------------------------------
'- bugs:
'- - 
'-------------------------------

ltxtmp$="...........|"
ltxtm$="":for i=1 to 6:ltxtm$+=ltxtmp$:next
'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

'debug=1 '- remove this linecode later... xD
  
'- fix: 0x0FE=440hz=A-4 
function nttfrqo$(freqb,opc)
  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..."
  if opc=0 then
    tmq=141-(int((log(freqb*.99)/log(2))*12))
  else
    tmq=(int((log(freqb)/log(2))*12))-112-12
    end if
  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
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
'- ym2203 
  
  '- token 0x55 gets registers and values to ym2203 output
  if q0=0x55 then
    q0=readbyte(1)

'-------------------------------------------------------------------------------
'- frequencies/notes on psg - channel 3 to 5

    if (q0>=0 and q0<=5) then
      q0qq=q0
      qqch=int(q0/2)+3
      q0=readbyte(1)
      if q0qq mod 2=0 then
        frqaa[qqch]=bitwiseor((bitwiseand(frqaa[qqch],0xF00)),(bitwiseand(q0,0x0FF)))     '- fine
      else
        frqaa[qqch]=bitwiseor((bitwiseand(q0*256,0xF00)),(bitwiseand(frqaa[qqch],0x0FF))) '- coarse
        end if
      ltxtm1$=ltxtm$
      ltxtm2$=replace$((12*qqch),ltxtm1$,nttfrqo$(frqaa[qqch],0)+"00")
      ltxcr$=replace$((12*qqch),ltxcr$,nttfrqo$(frqaa[qqch],0)+"00")
      print #3,ltxtm2$
      trg=1
      end if
'-------------------------------------------------------------------------------
'- volume on psg, channels 3 to 5

    if (q0>=8 and q0<=10) then
      chqq=(q0-8)+3
      q0=readbyte(1)
      volaa[chqq]=bitwiseand(q0,0x0F)
      ltxtm1$=ltxtm$
      ltxtm2$=replace$((12*chqq)+5,ltxtm1$,""+ucase$(right$(hex$(0x100+volaa[chqq]*1),2)))
      ltxcr$=replace$((12*chqq)+5,ltxcr$,""+ucase$(right$(hex$(0x100+volaa[chqq]*1),2)))
      print #3,ltxtm2$
      trg=1
      end if
'-------------------------------------------------------------------------------
'-fnum1
   if bitwiseand(q0,0xFC)=0xA0 then
      q3=bitwiseand(q0,0x03)
      q0=readbyte(1)
      fnuml[q3]=q0
      fnumw[q3]=fnuml[q3]+(bitwiseand(fnumh[q3],0x07)*256)
      fblk[q3]=(bitwiseand(fnumh[q3],0x38)/8)
      ffqv[q3]=fnumw[q3]*(2^fblk[q3]) 
      ltxtm1$=ltxtm$
      ltxtm2$=replace$((12*q3),ltxtm1$,nttfrqo$(ffqv[q3],1)+"00")
      ltxcr$=replace$((12*q3),ltxcr$,nttfrqo$(ffqv[q3],1)+"00")
      print #3,ltxtm2$
      trg=1
     end if

'-fnum2,block
   if bitwiseand(q0,0xFC)=0xA4 then
      q3=bitwiseand(q0,0x03)
      q0=readbyte(1)
      fnumh[q3]=q0
      fnumw[q3]=fnuml[q3]+(bitwiseand(fnumh[q3],0x07)*256)
      fblk[q3]=(bitwiseand(fnumh[q3],0x38)/8)
      ffqv[q3]=fnumw[q3]*(2^fblk[q3]) 
      ltxtm1$=ltxtm$
      ltxtm2$=replace$((12*q3),ltxtm1$,nttfrqo$(ffqv[q3],1)+"00")
      ltxcr$=replace$((12*q3),ltxcr$,nttfrqo$(ffqv[q3],1)+"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