vgm2vortextracker/pianorollpicture2txttrackers/pianorollpicture2famitracker/pianorollpicture2famitracker.sdlbas

#! /usr/bin/sdlbrt

finp$="test.png"
if argc>2 then:finp$=argv(2):end if
fout$=finp$+"_famitracker.txt"

shell("identify -format \'%w\n\' "+finp$+" > _width_.txt")
open "_width_.txt" for input as #1
file input #1,picwst$
picw=val(picwst$)
print picw
close #1
shell("rm _width_.txt")

qtxoub$=": ... .. . ... "
qtxou$=""
for i=1 to 13:qtxou$+=qtxoub$:next
qtxou$="ROW xx "+qtxou$
qtxouf$=qtxou$

dim chn[50]

'convert image -format "%wx%h" info:
'identify -format "%wx%h" image
'convert image -format "%b" info:
'identify -format "%b" image

function nttnte$(noteb)
  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=noteb
  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

function hfromrgbhex(hexvl)
  tcvl=hexvl
  rv=bitwiseand(tcvl,255):tcvl=int(tcvl/256)
  gv=bitwiseand(tcvl,255):tcvl=int(tcvl/256)
  bv=bitwiseand(tcvl,255)
  minv=255
  if rv<minv then:minv=rv:end if
  if gv<minv then:minv=gv:end if
  if bv<minv then:minv=bv:end if
  maxv=0
  if rv>maxv then:maxv=rv:end if
  if gv>maxv then:maxv=gv:end if
  if bv>maxv then:maxv=bv:end if
  deltav=maxv-minv
  if deltav<.1 then:deltav=.1:end if
  if maxv=0 then:hv=0:end if
  if gv=maxv then:hv=2+((bv-rv)/deltav):end if
  if bv=maxv then:hv=4+((rv-gv)/deltav):end if
  if rv=maxv then:hv=((gv-bv)/deltav):end if
  hv=((int(hv*60))+36000)mod 360
  return hv
  end function

function sfromrgbhex(hexvl)
  tcvl=hexvl
  rv=bitwiseand(tcvl,255):tcvl=int(tcvl/256)
  gv=bitwiseand(tcvl,255):tcvl=int(tcvl/256)
  bv=bitwiseand(tcvl,255)
  minv=255
  if rv<minv then:minv=rv:end if
  if gv<minv then:minv=gv:end if
  if bv<minv then:minv=bv:end if
  maxv=0
  if rv>maxv then:maxv=rv:end if
  if gv>maxv then:maxv=gv:end if
  if bv>maxv then:maxv=bv:end if
  deltav=maxv-minv
  if deltav<.1 then:deltav=.1:end if
  if maxv<>0 then:sv=deltav/maxv:end if
  if maxv=0 then:sv=0:end if
  sv=int(sv*255)
  return sv
  end function

function vfromrgbhex(hexvl)
  tcvl=hexvl
  rv=bitwiseand(tcvl,255):tcvl=int(tcvl/256)
  gv=bitwiseand(tcvl,255):tcvl=int(tcvl/256)
  bv=bitwiseand(tcvl,255)
  maxv=0
  if rv>maxv then:maxv=rv:end if
  if gv>maxv then:maxv=gv:end if
  if bv>maxv then:maxv=bv:end if
  vv=maxv
  return vv
  end function

setdisplay(512,128,32,1)
if picw<>0 then:setdisplay(picw,128,32,1):end if


paper(8^8-1):ink(0):pen(0):cls
loadimage(finp$,1):pasteicon(0,0,1)

for x=0 to 31
  u=point(x,0)
  qh=hfromrgbhex(u)
  qs=sfromrgbhex(u)
  if qs>50 then
    chn[int(qh/10)]=x
    end if
  next

open fout$ for output as #2

print #2,"# FamiTracker text format"
print #2,"# Module information"
print #2,"TITLE \"\""
print #2,"AUTHOR \"\""
print #2,"COPYRIGHT \"\""
print #2,"# Module comment"
print #2,"COMMENT \"\""
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,"# Namco 163 global settings"
print #2,"N163CHANNELS 5"
print #2,"# Macros"
print #2,"# DPCM samples"
print #2,"# Detune settings"
print #2,"# Grooves"
print #2,"# Tracks using default groove"
print #2,"# Instruments"
print #2,"INST2A03 0 -1 -1 -1 -1 -1 \"instrument00\""
print #2,"INSTN163 1 -1 -1 -1 -1 -1 32 0 1 \"instrument01\""
print #2,"# Tracks"
print #2,"TRACK 64 6 128 \"test\""
print #2,"COLUMNS : 1 1 1 1 1 1 1 1 1 1 1 1 1"
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"

lml=1
for x=0 to picw-1
  if x mod 64=0 then:print #2," ":print #2,"Pattern "+ucase$(right$("00"+hex$(int(x/64)),2)):end if
  qtxou$=qtxouf$
  if x>32 then:lml=0:end if
  for y=95 to lml step -1
    u=point(x,y)
    qs=sfromrgbhex(u)
    qh=hfromrgbhex(u)
    vs=vfromrgbhex(u)
    if qs>10 then
      qtxou$=replace$(chn[int(qh/10)]*15+9,qtxou$,nttnte$(y))

      if chn[int(qh/10)]<5 then
        qtxou$=replace$(chn[int(qh/10)]*15+13,qtxou$,"00")
      else
        qtxou$=replace$(chn[int(qh/10)]*15+13,qtxou$,"01")
        end if

      qtxou$=replace$(chn[int(qh/10)]*15+16,qtxou$,   ucase$(right$("0"+hex$( int(qs/16)  ),1))   )
      'qtxou$=replace$(chn[int(qh/10)]*15+18,qtxou$,  str$(qh)  )
      end if
    next
  qtxou$=replace$(4,qtxou$,ucase$(right$("00"+hex$(x mod 64),2)))
  print #2,qtxou$
  if x mod 64=63 then:print:end if
  next

print #2," "

for x=0 to picw-1 step 64
  txou8$=ucase$(right$("00"+hex$(int(x/64)),2))
  txou9$="ORDER "+txou8$+" : "
  for z=1 to 13:txou9$+=txou8$:txou9$+=" ":next
  print #2,txou9$
  next

print #2," "

print #2,"# End of export"
close #2

'waitkey