BeepTune.vbs

'BeepTune v1.0.1, February 2022.
'https://www.reddit.com/user/jcunews1
'https://pastebin.com/u/jcunews
'https://greasyfork.org/en/users/85671-jcunews
'
'Usage: BeepTune [options] [code]
'
'Options:
'/i:x  Read input from file x (override code from command line).
'/o:x  Write audio output into file x.
'/r    Render the code only. Does not play.
'
'Code: one or more events, each separated by space(s).
'
'Events:
'{note[[+/-]octave]}[.length]
'  Generate a note using default or specified octave and/or length.
'  Notes: c, c#, d, d#, e, f, f#, g, g#, a, a#, b.
'  Octave: 0-9. default=4.
'  Length: 1-999 in beats. default=4. higher = longer.
'  If octave is specified, sets the octave for the note and default octave.
'  If "+"/"-" is specified, octave is changed relative to default octave.
'  If length is specified, sets the length in beats for this note only.
'  e.g.: c, or c5, or c+1, or c.4, or c5.4, or c+1.4, etc.
'{.length}
'  Generate a rest of specified length. See below. e.g.: .16
'{commod{value}}
'  Commands/modifiers:
'    In       Set signal type. 0/else=squareWave, 1=sineWave
'    Ln       Set default note/rest length in beats.
'             default = 4 (4/16). i.e. length 4 = 1 beat, length 2 = 1/2 beat.
'    Mn       Set measure length in beats. 1-9999. 0=1. default = 16 (16/16).
'             Time Signature = measureLength / length.
'    On       Set default octave. 0-9. default = 4 (middle C's octave).
'    Sn       Set speed in beats per minute (BPM). 1-9999. 0=1. default=100.
'    Tn       Set track number. 0-999. default = 0.
'    V[+/-]n  Set volume. 0-100. default=50.
'    Xn       Custom note with frequency n.
'  e.g.: i1 l4 m4 o5 s100 t1 v50 x500
'
'For file input, empty lines and lines which start with ";", are ignored.

'Changelog:
'v1.0.1:
'- Initial release.
'- Known problem: clicking noise at start/end of a note.
'  Anyone know how to smoothly transition between two different sine waveform,
'  please contact me.

'note frequency table:
'https://www.liutaiomottola.com/formulae/freqtab.htm
noteLabels = array("C","C#","D","D#","E","F","F#","G","G#","A","A#","B")
set noteIndexes = createobject("scripting.dictionary")
for i = 0 to 11
  noteIndexes.add noteLabels(i), i
next
'noteFreqs: [octave, note] [0..9, 0..11] C4=middleC
noteFreqs = array( _
  array(16.351,17.324,18.354,19.445,20.601,21.827, _
    23.124,24.499,25.956,27.5,29.135,30.868), _
  array(32.703,34.648,36.708,38.891,41.203,43.654, _
    46.249,48.999,51.913,55,58.27,61.735), _
  array(65.406,69.296,73.416,77.782,82.407,87.307, _
    92.499,97.999,103.826,110,116.541,123.471), _
  array(130.813,138.591,146.832,155.563,164.814,174.614, _
    184.997,195.998,207.652,220,233.082,246.942), _
  array(261.626,277.183,293.665,311.127,329.628,349.228, _
    369.994,391.995,415.305,440,466.164,493.883), _
  array(523.251,554.365,587.33,622.254,659.255,698.456, _
    739.989,783.991,830.609,880,932.328,987.767), _
  array(1046.502,1108.731,1174.659,1244.508,1318.51,1396.913, _
    1479.978,1567.982,1661.219,1760,1864.655,1975.533), _
  array(2093.005,2217.461,2349.318,2489.016,2637.021,2793.826, _
    2959.955,3135.964,3322.438,3520,3729.31,3951.066), _
  array(4186.009,4434.922,4698.636,4978.032,5274.042,5587.652, _
    5919.91,6271.928,6644.876,7040,7458.62,7902.132), _
  array(8372.018,8869.844,9397.272,9956.064,10548.084,11175.304, _
    11839.82,12543.856,13289.752,14080,14917.24,15804.264) _
)
'supported rates for stream. !16-bit signed mono PCM only!
sampleRates = array( _
  8000, 11025, 12000, 16000, 22050, 24000, 32000, 44100, 48000)

'generate and replace with signal from previous to neutral zero
function genNeutral(byref buf, byref bufPos, sampleRate, seconds, _
  byref prevPhase)
  dim dataLen, i, pdelta
  if not ((sampleRate >= 8000) and (sampleRate <= 48000)) then
    sampleRate = 44100
  end if
  sampleRate = int(sampleRate)
  if not ((seconds >= 0) and (seconds <= 1.79769313486231580779e308)) then
    seconds = 1
  end if
  dataLen = sampleRate * seconds
  redim preserve buf(bufPos + dataLen - 1)
  pdelta = (prevPhase / (sampleRate * seconds)) * -1
  for i = 1 to dataLen
    buf(bufPos) = cint(prevPhase * 32767)
    prevPhase = prevPhase + pdelta
    bufPos = bufPos + 1
  next
  genNeutral = dataLen
end function

'generate and replace with slience
'prevPhase will be reset to zero
function genSilence(byref buf, byref bufPos, sampleRate, seconds, _
  byref prevPhase)
  dim dataLen, i
  if not ((sampleRate >= 8000) and (sampleRate <= 48000)) then
    sampleRate = 44100
  end if
  sampleRate = int(sampleRate)
  if not ((seconds >= 0) and (seconds <= 1.79769313486231580779e308)) then
    seconds = 1
  end if
  dataLen = sampleRate * seconds
  redim preserve buf(bufPos + dataLen - 1)
  for i = 1 to dataLen
    buf(bufPos) = cint(0)
    bufPos = bufPos + 1
  next
  prevPhase = 0
  genSilence = dataLen
end function

'generate and replace with sine/square signal
'prevPhase is used for sine wave only
function genWaveform(byref buf, byref bufPos, signalType, sampleRate, _
  frequency, seconds, volume, byref prevPhase)
  dim dataLen, i, data, t, tdelta, phase, pdelta, p
  if not ((sampleRate >= 8000) and (sampleRate <= 48000)) then
    sampleRate = 44100
  end if
  sampleRate = int(sampleRate)
  if not ((frequency >= 0.001) and (frequency <= sampleRate)) then
    frequency = 500
  end if
  if not ((seconds >= 0) and (seconds <= 1.79769313486231580779e308)) then
    seconds = 1
  end if
  if not ((volume >= 0) and (volume <= 1)) then
    volume = 0.5
  end if
  dataLen = sampleRate * seconds
  redim preserve buf(bufPos + dataLen - 1)
  t = 0
  tdelta = 1 / sampleRate
  data = atn(1) * 4 * frequency
  if signalType = 1 then 'sine
    phase = 0
    if prevPhase > 0 then
      pdelta = -prevPhase / (sampleRate * seconds / 1000)
    elseif prevPhase < 0 then
      pdelta = abs(prevPhase) / (sampleRate * seconds / 1000)
    else
      pdelta = 0
    end if
    for i = 1 to dataLen
      phase = sin(data * t) * volume
      p = phase * 32767
      p = (phase + prevPhase) * 32767
      if p > 32767 then
        p = 32767
      elseif p < -32768 then
        p = -32768
      end if
      buf(bufPos) = cint(p)
      t = t + tdelta
      prevPhase = prevPhase + pdelta
      if ((pdelta > 0) and (prevPhase > 0)) or _
        ((pdelta < 0) and (prevPhase < 0)) then
        prevPhase = 0
        pdelta = 0
      end if
      bufPos = bufPos + 1
    next
    prevPhase = phase
  else 'square
    for i = 1 to dataLen
      buf(bufPos) = cint(sgn(sin(data * t)) * volume * 32767)
      t = t + tdelta
      bufPos = bufPos + 1
    next
  end if
  genWaveform = dataLen
end function

'get best matching wave type and its sampling rate.
'return array [type, sampleRate]
function getBestMatchingWaveType(sampleRate)
  dim t, a, i
  t = 0
  for i = 0 to ubound(sampleRates)
    if sampleRates(i) = sampleRate then
      t = i * 4 + 6
      exit for
    elseif (i + 1) < ubound(sampleRates) then
      if (sampleRates(i) < sampleRate) and _
        (sampleRate < sampleRates(i + 1)) then
        t = sampleRate - sampleRates(i)
        a = sampleRates(i + 1) - sampleRate
        if a < t then
          sampleRate = sampleRates(i + 1)
          t = (i + 1) * 4 + 6
        else
          sampleRate = sampleRates(i)
          t = i * 4 + 6
        end if
        exit for
      end if
    end if
  next
  if t = 0 then
    sampleRate = 44100
    t = 34
  end if
  getBestMatchingWaveType = array(t, sampleRate)
end function

'make wave memory stream.
'sampleRate rate is rounded to nearest or down
function makeWaveformStream(sampleRate)
  set makeWaveformStream = createobject("sapi.spmemorystream")
  makeWaveformStream.format.type = getBestMatchingWaveType(sampleRate)(0)
  makeWaveformStream.seek 0
end function

function newbuf
  dim ar
  redim ar(-1)
  newbuf = ar
end function

'render audio. returns array [stream, buffer]
function render(code, sampleRate, byref signalType, byref speedBpm, _
  byref measureLen, byref noteRestLen, byref defaultOctave, byref defaultVolume)
  dim posSec, prevPhase, bufs, bufPoss, bufIdx, bufPos, _
    xs, xp, stm, m, a, nt, ln, dr
  sampleRate = getBestMatchingWaveType(sampleRate)(1)
  if speedBpm <= 0 then
    speedBpm = 1
  elseif speedBpm > 9999 then
    speedBpm = 9999
  elseif not ((speedBpm >= 1) and (speedBpm <= 9999)) then
    speedBpm = 100
  end if
  if measureLen <= 0 then
    measureLen = 1
  elseif measureLen > 999 then
    measureLen = 999
  elseif not ((measureLen >= 1) and (measureLen <= 999)) then
    measureLen = 4
  end if
  if noteRestLen <= 0 then
    noteRestLen = 1
  elseif noteRestLen > 999 then
    noteRestLen = 999
  elseif not ((noteRestLen >= 1) and (noteRestLen <= 999)) then
    noteRestLen = 4
  end if
  if defaultOctave < 0 then
    defaultOctave = 0
  elseif defaultOctave > 9 then
    defaultOctave = 9
  elseif not ((defaultOctave >= 0) and (defaultOctave <= 9)) then
    defaultOctave = 4
  end if
  if defaultVolume < 0 then
    defaultVolume = 0
  elseif defaultVolume > 100 then
    defaultVolume = 100
  elseif not ((defaultVolume >= 0) and (defaultVolume <= 100)) then
    defaultVolume = 50
  end if

  posSec = 0 'pointer in seconds. internal
  prevPhase = 0 'previous sine wave phase. internal

  redim bufs(0)
  redim bufPoss(0)
  bufIdx = 0
  bufs(0) = newbuf
  bufPoss(0) = 0
  set xs = new regexp 'code splitter
  xs.global = true
  xs.pattern = "\S+"
  set xp = new regexp 'code parser
  xp.global = true
  xp.ignorecase = true
  xp.pattern = _
    "^(?:" & _
      "(?:" & _
        "(c#?|d#?|e|f#?|g#?|a#?|b)([+-]?\d)?(\.\d{1,3})?" & _
      ")" & _
      "|" & _
      "(\.\d{1,3})?" & _
      "|" & _
      "(" & _
        "i\d|l\d{1,3}|m\d{1,4}|o\d|s\d{1,4}|" & _
        "t\d{1,3}|v\d{1,3}|w\d|x\d{1,5}" & _
      ")" & _
    ")$"

  set stm = makeWaveformStream(sampleRate)
  sampleRate = stm.format.getwaveformatex.samplespersec
  genSilence bufs(0), bufPoss(0), sampleRate, 0.01, prevPhase
  for each m in xs.execute(code)
    set a = xp.execute(m)
    if a.count = 0 then
      wsh.echo "Invalid code at column " & (m.firstindex + 1) & "."
      wsh.quit 1
    end if
    if a(0).submatches(4) <> "" then 'command/modifier
      select case ucase(left(a(0).submatches(4), 1))
        case "I" 'set signal type
          signalType = cint(mid(a(0).submatches(4), 2))
          if signalType <> 1 then signalType = 0
        case "L" 'set default length
          noteRestLen = cint(mid(a(0).submatches(4), 2))
        case "M" 'set measure length
          measureLen = cint(mid(a(0).submatches(4), 2))
          if measureLen = 0 then measureLen = 1
        case "O" 'set default octave
          defaultOctave = cint(mid(a(0).submatches(4), 2))
        case "S" 'set speed
          speedBpm = cint(mid(a(0).submatches(4), 2))
          if speedBpm = 0 then speedBpm = 1
        case "T" 'track number
          bufIdx = cint(mid(a(0).submatches(4), 2))
          nt = ubound(bufs)
          if bufIdx > nt then
            redim preserve bufs(bufIdx)
            redim preserve bufPoss(bufIdx)
          end if
          if isempty(bufs(bufIdx)) then
            bufs(bufIdx) = newbuf
            bufPoss(bufIdx) = 0
          end if
        case "V" 'set volume
          defaultVolume = cint(mid(a(0).submatches(4), 2))
          if defaultVolume > 100 then defaultVolume = 100
        case "W" 'set signal type
          signalType = cint(mid(a(0).submatches(4), 2))
          if signalType <> 1 then signalType = 0
        case "X" 'custom note
          nt = cint(mid(a(0).submatches(4), 2))
          if nt < 1 then
            nt = 1
          elseif nt > sampleRate then
            nt = sampleRate
          end if
          dur = (60 / speedBpm) * (noteRestLen / measureLen)
          genWaveform bufs(bufIdx), bufPoss(bufIdx), signalType, sampleRate, _
            nt, dur, defaultVolume / 100, prevPhase
          posSec = posSec + dur
      end select
    else 'note
      nt = a(0).submatches(0) 'specify note
      if nt <> "" then
        nt = noteIndexes(ucase(nt))
      else
        nt = -1
      end if
      ln = a(0).submatches(1) 'update default octave
      if ln <> "" then
        if left(ln, 1) = "+" then
          defaultOctave = defaultOctave + cint(right(ln, 1))
        elseif left(ln, 1) = "-" then
          defaultOctave = defaultOctave - cint(right(ln, 1))
        else
          defaultOctave = cint(ln)
        end if
      end if
      ln = a(0).submatches(2) 'override note/rest length
      if ln = "" then ln = a(0).submatches(3)
      if (ln <> "") and (ln <> ".") then
        ln = cint(mid(ln, 2))
      else
        ln = noteRestLen
      end if
      dr = (60 / speedBpm) * (ln / (measureLen / 4))
      if nt >= 0 then 'generate note
        genWaveform bufs(bufIdx), bufPoss(bufIdx), signalType, sampleRate, _
          noteFreqs(defaultOctave)(nt), dr, defaultVolume / 100, prevPhase
      elseif ln > 0 then 'generate rest
        genSilence bufs(bufIdx), bufPoss(bufIdx), sampleRate, dr, prevPhase
      end if
      posSec = posSec + dr
    end if
  next

  dim buf()
  xp = -1 'max data length
  for a = 0 to ubound(bufs)
    if ubound(bufs(a)) > xp then xp = ubound(bufs(a))
  next
  redim buf(xp)
  for a = 0 to xp
    nt = 0
    for xs = 0 to ubound(bufs)
      if ubound(bufs(xs)) >= a then
        if not isempty(bufs(xs)(a)) then nt = nt + bufs(xs)(a)
      end if
    next
    nt = cint(nt / (ubound(bufs) + 1))
    if nt > 32767 then
      buf(a) = 32767
    elseif nt < -32768 then
      buf(a) = -32768
    else
      buf(a) = nt
    end if
  next
  bufPos = ubound(buf)
  genNeutral buf, bufPos, sampleRate, 0.001, prevPhase
  stm.write buf
  stm.seek 0
  render = array(stm, buf)
end function

sub help
  set f = fs.opentextfile(wsh.scriptfullname)
  a = ""
  do while not f.atendofstream
    s = f.readline
    if s <> "" then
      a = a & mid(s, 2) & vbcrlf
    else
      exit do
    end if
  loop
  wsh.echo left(a, len(a) - 2)
  wsh.quit 1
end sub

function readCode(f)
  s = ""
  do while not f.atendofstream
    l = trim(f.readline)
    if l <> "" then
      if left(l, 1) <> ";" then s = s & l & " "
    end if
  loop
  readCode = s
end function

set fs = createobject("scripting.filesystemobject")
fin = ""
fout = ""
play = true
code = ""
for each a in wsh.arguments.named
  select case ucase(a)
    case "I"
      fin = wsh.arguments.named(a)
    case "O"
      fout = wsh.arguments.named(a)
    case "R"
      play = false
    case else
      help
  end select
next
if fin <> "" then
  set fi = fs.opentextfile(fin)
  code = readCode(fi)
  fi.close
elseif wsh.arguments.unnamed.count > 0 then
  code = wsh.arguments.unnamed(0)
else
  set fi = fs.getstandardstream(0)
  if fi.atendofstream then
    code = ""
  else
    code = readCode(fi)
  end if
end if

sampleRate = 44100
signalType = 1 'sine
speedBpm = 100
measureLen = 16 '16/16
noteRestLen = 4 '4/16 = 1/4
defaultOctave = 4
defaultVolume = 50

a = render(code, sampleRate, signalType, speedBpm, measureLen, noteRestLen, _
  defaultOctave, defaultVolume)

if fout <> "" then
  a(0).seek 0
  a(0).read b, (ubound(a(1)) + 1) * 2
  set fo = createobject("sapi.spfilestream")
  set fo.format = a(0).format
  fo.open fout, 3
  fo.write b
  fo.close
end if

if play then
  a(0).seek 0
  set vc = createobject("sapi.spvoice")
  vc.speakstream a(0)
end if