vgm2vortextracker/pianorollpicture2txttrackers/pianorollpicture2openmptclipboard/pianorollpicture2openmptclipboard.sdlbas

#! /usr/bin/sdlbrt

finp$="test.png"
if argc>2 then:finp$=argv(2):end if
fout$=finp$+"_openmptclipboard.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 8:qtxou$+=qtxoub$:next
qtxouf$=qtxou$

dim chn[50]

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 7
  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,"[Module]"
print #2,"Format:mod"
print #2,"Title:"
print #2," "
print #2,"[MoreInfo]"
print #2,"SongLenght:"+str$(int(picw/64))
print #2,"VersionFlag1:0x00"

txou9$="PlayOrder:0"
for x=64 to picw-1 step 64
  txou9$+=","+str$(int(x/64))
  next
print #2,txou9$

print #2,"VersionFlag2:8CHN"
print #2," "
print #2,"[SampleInfo0]"
print #2,"Name:SquareWave"
print #2,"Lenght:0x0020"
print #2,"Finetune:0"
print #2,"Volume:0x40"
print #2,"RepeatPoint:0x0000"
print #2,"RepeatLenght:0x0020"
print #2," "
print #2,"[Sample0]"
print #2,"7F7F7F7F7F7F7F7F7F7F7F7F7F7F7F7F80808080808080808080808080808080"

lml=1
for x=0 to picw-1
  if x mod 64=0 then:print #2," ":print #2,"[Pattern"+str$(int(x/64))+"]":print #2,"ModPlug Tracker MOD":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)]*12+1,qtxou$,nttnte$(y))
      qtxou$=replace$(chn[int(qh/10)]*12+4,qtxou$,"00")
      qtxou$=replace$(chn[int(qh/10)]*12+9,qtxou$,"C"+ucase$(right$("00"+hex$( (int(qs/16))*4  ),2))   )
      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," "

close #2

'waitkey