vgm2vortextracker/vgm2famitracker/Vgm2FamiTrackerTxtSaa1099.sdlbasic

#! /usr/bin/sdlbrt
finp$="tune.vgm"

'- .vgm to FamiTracker .txt converter - SAA1099 version
'- copyleft Paulo Silva, oct'20
'-------------------------------
'- bugs:
'- - an acute sound might appear because an issue related to volume 0 that VortexTracker doesnt support, R-- note used instead (and the converter should store which note/frequency is for a probable volume changing, and set back the note/frequency value back)
'- - doesn't read yet the author/title information
'- - 'L' will be useful for the loop point location
'- - probably will need a sample counter before converting
'- - missing noise support
'- - frequncy inaccuracy from the germanic notation formula probably fixed, needs more testing
'-------------------------------

ltxtm$="ROW .. : ... .. . ... : ... .. . ... : ... .. . ... : ... .. . ... : ... .. . ... : ... .. . ... : ... .. . ... : ... .. . ... : ... .. . ... : ... .. . ... : ... .. . ... : ... .. . ... : ... .. . ...":ltxcr$=ltxtm$
freq0=0:freq1=0:freq2=0:vol0=0:vol1=0:vol2=0
patsz=48:patc=0:patid=0:freqq=0
hdram=0x40:vgmv=0:veof=0
dim hdrv[256]
  
if argc>2 then:finp$=argv(2):end if
fout2$=finp$+"_famitracker.txt":fout3$=finp$+"_famitracker_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

octave0=0:octave1=0:octave2=0:octave3=0:octave4=0:octave5=0
note0=0:note1=0:note2=0:note3=0:note4=0:note5=0

';- 12 notes:
';-   5,  32,  60,  85, - 05 20 3C 55 - c  c+ d  d+
';- 110, 132, 153, 173, - 6E 84 99 AD - e  f  f+ g 
';- 192, 210, 227, 243, - C0 D2 E3 F3 - g+ a  a+ b
 
' registos:
'     0x10 - oitava canais 0 e 1
'     0x08 - frequência canal 0
'     0x09 - frequência canal 1
'     0x00 - volume canal 0 (stereo)
'     0x01 - volume canal 1 (stereo)

'- frequencia: nota=int(byte/22.05)
 
'- fix: 0x0FE=440hz=A-4 
function nttfrqsaa$(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$+"C-8C#8D-8D#8E-8F-8F#8G-8G#8A-8A#8B-8..."
  'tmq=141-(int((log(freqb*.99)/log(2))*12))
  tmq=freqb-12
  if tmq<1 then:tmq=1:end if
  if tmq>85 then:tmq=85: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>=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,"# FamiTracker text format":print #2,""
print #2,"# Module information"
print #2,"TITLE \"\""
print #2,"AUTHOR \"\""
print #2,"COPYRIGHT \"\"":print #2,""
print #2,"# Module comment"
print #2,"COMMENT \"\"":print #2,""
print #2,"# Global settings"
print #2,"MACHINE 0"
print #2,"FRAMERATE 0"
print #2,"EXPANSION 16"
print #2,"VIBRATO 1"
print #2,"SPLIT 32":print #2,""

print #2,"# Namco 163 global settings"
print #2,"N163CHANNELS 3":print #2,""

print #2,"# Macros":print #2,""
print #2,"# DPCM samples":print #2,""
print #2,"# Detune settings":print #2,""
print #2,"# Grooves":print #2,""
print #2,"# Tracks using default groove"

print #2,"# Instruments"
print #2,"INST2A03 0 -1 -1 -1 -1 -1 \"instrument01\""
print #2,"INSTN163 1 -1 -1 -1 -1 -1 32 0 1 \"instrument02\""
print #2,"N163WAVE 1 0 : 15 15 15 15 15 15 15 15 15 15 15 15 15 15 15 15 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0":print #2,""

print #2,"# Tracks":print #2,""
print #2,"TRACK "+str$(patsz)+" 1 128 \"test\""
print #2,"COLUMNS : 1 1 1 1 1 1 1 1 1 1 1 1 1":print #2,""






print #2,"Pattern 00"
  
'- 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,""
    print #2,"# End of export"
    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

    '- writes 1F in the first line of the first pattern
    'if (patc<1 and patid=0) then
      'ltxcr$=replace$(12,ltxcr$,"1F")
      'ltxcr$=replace$(26,ltxcr$,"1F")
      'ltxcr$=replace$(40,ltxcr$,"1F")
      'end if
  
    '- creates a new pattern  
    if patc>(patsz-1) then:
      print #2," "
      patid=patid+1:patc=0
      'txou9$="Pattern "+str$(patid)+"]"
      txou9$="Pattern "+right$("00000"+ucase$(hex$(patid)),2)
      print #2,txou9$
      end if
  
    '- writes a pattern line in each frame
    if trg=0 then
      print #3,"--frameout-unchanged--"
      'print #2,ltxtm$
      ltxcr$=ltxtm$
      ltxcr$=replace$(4,ltxcr$, right$("00000"+ucase$(hex$(patc)),2) ) '?????? <-----
      print #2,ltxcr$
    else
      print #3,"--frameout--"
      ltxcr$=replace$(4,ltxcr$, right$("00000"+ucase$(hex$(patc)),2) ) '?????? <-----
      print #2,ltxcr$
      ltxcr$=ltxtm$
      trg=0
      end if
  
    frmr=frmr+frmi
    patc=patc+1
    end while

  '- token 0xBD gets registers and values to SAA1099 output
  if q0=0xBD then
    q0=readbyte(1)
  
    '- channel 0, note
    if q0=0x08 then
      q0=readbyte(1)
      note0=int(q0/22.05)
      'freq0= bitwiseor((bitwiseand(freq0,0xF00)),(bitwiseand(q0,0x0FF)))
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(9,ltxtm1$,nttfrqsaa$(octave0*12+note0))
      ltxcr$=replace$(9,ltxcr$,nttfrqsaa$(octave0*12+note0))
      ltxcr$=replace$(13,ltxcr$,"00")
      print #3,ltxtm2$
      trg=1
      end if
  
    '- channel 1, note
    if q0=0x09 then
      q0=readbyte(1)
      note1=int(q0/22.05)
      'freq1= bitwiseor ( (bitwiseand(freq1,0xF00)),(bitwiseand(q0,0x0FF)) )
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(24,ltxtm1$,nttfrqsaa$(octave1*12+note1))
      ltxcr$=replace$(24,ltxcr$,nttfrqsaa$(octave1*12+note1))
      ltxcr$=replace$(28,ltxcr$,"00")
      print #3,ltxtm2$
      trg=1
      end if
  
    '- channel 2, note
    if q0=0x0A then
      q0=readbyte(1)
      note2=int(q0/22.05)
      'freq2= bitwiseor ( (bitwiseand(freq2,0xF00)),(bitwiseand(q0,0x0FF)) )
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(39,ltxtm1$,nttfrqsaa$(octave2*12+note2))
      ltxcr$=replace$(39,ltxcr$,nttfrqsaa$(octave2*12+note2))
      ltxcr$=replace$(43,ltxcr$,"00")
      print #3,ltxtm2$
      trg=1
      end if

    '- channel 3, note
    if q0=0x0B then
      q0=readbyte(1)
      note3=int(q0/22.05)
      'freq3= bitwiseor((bitwiseand(freq0,0xF00)),(bitwiseand(q0,0x0FF)))
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(9+45+30,ltxtm1$,nttfrqsaa$(octave3*12+note3))
      ltxcr$=replace$(9+45+30,ltxcr$,nttfrqsaa$(octave3*12+note3))
      ltxcr$=replace$(13+45+30,ltxcr$,"01")
      print #3,ltxtm2$
      trg=1
      end if
  
    '- channel 4, note
    if q0=0x0C then
      q0=readbyte(1)
      note4=int(q0/22.05)
      'freq4= bitwiseor ( (bitwiseand(freq1,0xF00)),(bitwiseand(q0,0x0FF)) )
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(24+45+30,ltxtm1$,nttfrqsaa$(octave4*12+note4))
      ltxcr$=replace$(24+45+30,ltxcr$,nttfrqsaa$(octave4*12+note4))
      ltxcr$=replace$(28+45+30,ltxcr$,"01")
      print #3,ltxtm2$
      trg=1
      end if
  
    '- channel 5, note
    if q0=0x0D then
      q0=readbyte(1)
      note5=int(q0/22.05)
      'freq5= bitwiseor ( (bitwiseand(freq2,0xF00)),(bitwiseand(q0,0x0FF)) )
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(39+45+30,ltxtm1$,nttfrqsaa$(octave5*12+note5))
      ltxcr$=replace$(39+45+30,ltxcr$,nttfrqsaa$(octave5*12+note5))
      ltxcr$=replace$(43+45+30,ltxcr$,"01")
      print #3,ltxtm2$
      trg=1
      end if








    '- channels 0 and 1, octave
    if q0=0x10 then
      q0=readbyte(1)
      octave0=bitwiseand(q0,0x0F)
      octave1=bitwiseand(q0,0xF0)/16
      freq0= bitwiseor ( (bitwiseand(q0*256,0xF00)),(bitwiseand(freq0,0x0FF)) )
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(9,ltxtm1$,nttfrqsaa$(octave0*12+note0))
      ltxcr$=replace$(9,ltxcr$,nttfrqsaa$(octave0*12+note0))
      ltxcr$=replace$(13,ltxcr$,"00")
      ltxtm2$=replace$(24,ltxtm1$,nttfrqsaa$(octave1*12+note1))
      ltxcr$=replace$(24,ltxcr$,nttfrqsaa$(octave1*12+note1))
      ltxcr$=replace$(28,ltxcr$,"00")
      print #3,ltxtm2$
      trg=1
      end if

    '- channels 2 and 3, octave
    if q0=0x11 then
      q0=readbyte(1)
      octave2=bitwiseand(q0,0x0F)
      octave3=bitwiseand(q0,0xF0)/16
      freq2= bitwiseor ( (bitwiseand(q0*256,0xF00)),(bitwiseand(freq2,0x0FF)) )
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(39,ltxtm1$,nttfrqsaa$(octave2*12+note2))
      ltxcr$=replace$(39,ltxcr$,nttfrqsaa$(octave2*12+note2))
      ltxcr$=replace$(43,ltxcr$,"00")
      ltxtm2$=replace$(9+45+30,ltxtm1$,nttfrqsaa$(octave3*12+note3))
      ltxcr$=replace$(9+45+30,ltxcr$,nttfrqsaa$(octave3*12+note3))
      ltxcr$=replace$(13+45+30,ltxcr$,"01")
      print #3,ltxtm2$
      trg=1
      end if

    '- channels 4 and 5, octave
    if q0=0x12 then
      q0=readbyte(1)
      octave4=bitwiseand(q0,0x0F)
      octave5=bitwiseand(q0,0xF0)/16
      freq2= bitwiseor ( (bitwiseand(q0*256,0xF00)),(bitwiseand(freq2,0x0FF)) )
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(24+45+30,ltxtm1$,nttfrqsaa$(octave4*12+note4))
      ltxcr$=replace$(24+45+30,ltxcr$,nttfrqsaa$(octave4*12+note4))
      ltxcr$=replace$(28+45+30,ltxcr$,"01")
      ltxtm2$=replace$(39+45+30,ltxtm1$,nttfrqsaa$(octave5*12+note5))
      ltxcr$=replace$(39+45+30,ltxcr$,nttfrqsaa$(octave5*12+note5))
      ltxcr$=replace$(43+45+30,ltxcr$,"01")
      print #3,ltxtm2$
      trg=1
      end if

  
    '- channel 0, volume
    if q0=0x00 then
      q0=readbyte(1)
      vol0l= bitwiseand(q0,0xF)
      vol0r= bitwiseand(q0,0xF0)/16
      vol0=int((vol0l+vol0r)/2)
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(16,ltxtm1$,ucase$(right$(hex$(0x10+vol0),1)))
      ltxcr$=replace$(16,ltxcr$,ucase$(right$(hex$(0x10+vol0),1)))
      print #3,ltxtm2$
      trg=1
      end if
  
    '- channel 1, volume
    if q0=0x01 then
      q0=readbyte(1)
      vol1l= bitwiseand(q0,0xF)
      vol1r= bitwiseand(q0,0xF0)/16
      vol1=int((vol1l+vol1r)/2)
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(31,ltxtm1$,ucase$(right$(hex$(0x10+vol1),1)))
      ltxcr$=replace$(31,ltxcr$,ucase$(right$(hex$(0x10+vol1),1)))
      print #3,ltxtm2$
      trg=1
      end if
  
    '- channel 2, volume
    if q0=0x02 then
      q0=readbyte(1)
      vol2l= bitwiseand(q0,0xF)
      vol2r= bitwiseand(q0,0xF0)/16
      vol2=int((vol2l+vol2r)/2)
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(46,ltxtm1$,ucase$(right$(hex$(0x10+vol2),1)))
      ltxcr$=replace$(46,ltxcr$,ucase$(right$(hex$(0x10+vol2),1)))
      print #3,ltxtm2$
      trg=1
      end if

    '- channel 3, volume
    if q0=0x03 then
      q0=readbyte(1)
      vol3l= bitwiseand(q0,0xF)
      vol3r= bitwiseand(q0,0xF0)/16
      vol3=int((vol3l+vol3r)/2)
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(16+45+30,ltxtm1$,ucase$(right$(hex$(0x10+vol3),1)))
      ltxcr$=replace$(16+45+30,ltxcr$,ucase$(right$(hex$(0x10+vol3),1)))
      print #3,ltxtm2$
      trg=1
      end if
  
    '- channel 4, volume
    if q0=0x04 then
      q0=readbyte(1)
      vol4l= bitwiseand(q0,0xF)
      vol4r= bitwiseand(q0,0xF0)/16
      vol4=int((vol4l+vol4r)/2)
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(31+45+30,ltxtm1$,ucase$(right$(hex$(0x10+vol4),1)))
      ltxcr$=replace$(31+45+30,ltxcr$,ucase$(right$(hex$(0x10+vol4),1)))
      print #3,ltxtm2$
      trg=1
      end if
  
    '- channel 5, volume
    if q0=0x05 then
      q0=readbyte(1)
      vol5l= bitwiseand(q0,0xF)
      vol5r= bitwiseand(q0,0xF0)/16
      vol5=int((vol5l+vol5r)/2)
      ltxtm1$=ltxtm$
      ltxtm2$=replace$(46+45+30,ltxtm1$,ucase$(right$(hex$(0x10+vol5),1)))
      ltxcr$=replace$(46+45+30,ltxcr$,ucase$(right$(hex$(0x10+vol5),1)))
      print #3,ltxtm2$
      trg=1
      end if





    '?????
    if q0=6 then
      print #3,ltxtm$
      end if
  
    '?????
    'if q0=7 then
    '  q0=readbyte(1)
    '  ltxtm1$=ltxtm$
    '  ltxtm2$=left$(ltxtm1$,31)+  right$(bin$(512+q0),8)  +right$(ltxtm1$,2)+txou1$
    '  print #3,ltxtm2$
    '  trg=1
    '  end if
  
    end if

  if eof(1)<>0 then
    veof=1
    print #2,""
    print #2,"# End of export"
    end if

  wend



for eeq=0 to patid
  txou$="ORDER "+right$(hex$(0x100+eeq),2)+" :"
  for eer=0 to 12
    txou$=txou$+" "+right$(hex$(0x100+eeq),2)
    next
  print #2,txou$
  next
print #2,""




'print #2,"ORDER 00 : 00 00 00 00 00 00 00 00 00 00 00 00 00"
'print #2,"ORDER 01 : 01 01 01 01 01 01 01 01 01 01 01 01 01"
'print #2,"ORDER 02 : 02 02 02 02 02 02 02 02 02 02 02 02 02"
'print #2,"ORDER 03 : 03 03 03 03 03 03 03 03 03 03 03 03 03"
'print #2,"ORDER 04 : 04 04 04 04 04 04 04 04 04 04 04 04 04"
'print #2,"ORDER 05 : 05 05 05 05 05 05 05 05 05 05 05 05 05"
'print #2,"ORDER 06 : 06 06 06 06 06 06 06 06 06 06 06 06 06"
'print #2,"ORDER 07 : 07 07 07 07 07 07 07 07 07 07 07 07 07"
'print #2,"ORDER 08 : 08 08 08 08 08 08 08 08 08 08 08 08 08"
'print #2,"ORDER 09 : 09 09 09 09 09 09 09 09 09 09 09 09 09"
'print #2,"ORDER 0A : 0A 0A 0A 0A 0A 0A 0A 0A 0A 0A 0A 0A 0A"
'print #2,"ORDER 0B : 0B 0B 0B 0B 0B 0B 0B 0B 0B 0B 0B 0B 0B"
'print #2,"ORDER 0C : 0C 0C 0C 0C 0C 0C 0C 0C 0C 0C 0C 0C 0C"
'print #2,"ORDER 0D : 0D 0D 0D 0D 0D 0D 0D 0D 0D 0D 0D 0D 0D"
'print #2,"ORDER 0E : 0E 0E 0E 0E 0E 0E 0E 0E 0E 0E 0E 0E 0E"
'print #2,"ORDER 0F : 0F 0F 0F 0F 0F 0F 0F 0F 0F 0F 0F 0F 0F"
'print #2,""




close #1:close #2:close #3
  
if debug=0 then:
  shell("rm "+fout3$)
  end if





'print #2,"[Module]"
'print #2,"VortexTrackerII=1"
'print #2,"Version=3.6"
'print #2,"Title="
'print #2,"Author="
'print #2,"NoteTable=2"
'print #2,"Speed=1"
'print #2,hsam$
'print #2," "
'print #2,"[Ornament1]":print #2,"L0":print #2," "
'print #2,"[Sample1]":print #2,"Tne +000_ +00_ F_ L":print #2," "