Option Explicit

Dim StdErr, StdIn, StdOut, LineIn, Look, FillBar, NoteLength, Duration, Triplet
Dim Extract, Lengths, Types, N, BarLength, AllaBreve, Common
'Name: Empty Bars
'Command: WScript Scripts\EmptyBars.vbs

'Purpose: Removes detail from the selection (or entire staff) and replaces it with
'empty bars. The structure of the staff is retained. Useful for replicating a
'staff for layering. Just copy an existing staff and then empty it.
 
Set StdErr = WScript.StdErr
Set StdIn = WScript.StdIn
Set StdOut = WScript.StdOut
Set Look = New RegExp
Look.Global = True
Look.IgnoreCase = True
Set Lengths = CreateObject("Scripting.Dictionary")
Types = Array("64th", "32nd", "16th", "8th", "4th", "Half", "Whole")
For N = 0 to UBound(Types)
  Lengths(Types(N)) = 2 ^ N
  Lengths(2 ^ N) = Types(N) 'create two-way dictionary of note values
Next
Lengths("Dotted") = 1.5
Lengths(1.5) = "Dotted"
Lengths("DblDotted") = 1.75
Lengths(1.75) = "DblDotted"
AllaBreve = 1
Common = 1
BarLength = 64 'set to length of a whole rest until a time signature is encountered

While Not StdIn.AtEndOfStream
  LineIn = StdIn.ReadLine
  If Left(LineIn, 1) = "!" Then
    WriteRest 'write final bar - doesn't do anything at start
    StdOut.WriteLine LineIn 'NWC Clip header or tail
  Else
    Look.Pattern = "\w+"
    Select Case Look.Execute(LineIn).Item(0)
    Case "Bar" 'write out the previous bar as invisible rest(s) and then this bar line
      WriteRest
      StdOut.WriteLine LineIn 
    Case "TimeSig" 'calculate the length of the bar (in 64ths) and write time signature
      WriteRest 'mistake if this is actually needed
      Look.Pattern = "Common|AllaBreve|\d+/\d+"
      BarLength = Eval(Look.Execute(LineIn).Item(0)) * 64
      StdOut.WriteLine LineIn 
    Case "Clef", "Key", "Ending", "Instrument", "Flow" 'retain these elements unaltered
      WriteRest 'position item correctly
      StdOut.WriteLine LineIn 
    Case "Rest", "Note", "Chord", "RestChord" 'elements to be replaced cumulatively by rests
      Look.Pattern = "Grace" 'ignore grace notes
      If Not Look.Test(LineIn) Then
        Look.Pattern = "Dur:\w+(,(Dbl)?Dotted)?"
        Duration = Look.Execute(LineIn).Item(0)
        Look.Pattern = "(\w+)"
        Set Extract = Look.Execute(Duration)
        NoteLength = Lengths(Extract(1).Value)
        If Extract.Count > 2 Then NoteLength = NoteLength * Lengths(Extract(2).Value)
        Look.Pattern = "Triplet"
        If Look.Test(LineIn) Then
            Triplet = Triplet + NoteLength
        Else
          FillBar = FillBar + NoteLength
        End If
      End If
    End Select
  End If
Wend

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub WriteRest

Dim DotRest

FillBar = FillBar + Triplet * 2 / 3 'this is incorrect if only part of a triplet is picked up
Triplet = 0

If FillBar = BarLength Then 
  StdOut.WriteLine "|Rest|Dur:Whole|Visibility:Never"
Else
  DotRest = FillBar - Int(FillBar)
  If DotRest > 0 Then
    DotRest = DotRest + 1 'need something to dot
    FillBar = FillBar - DotRest  
  End If
  N = 64
  While FillBar > 0
    If FillBar >= N Then
      StdOut.WriteLine "|Rest|Dur:" & Lengths(N) & "|Visibility:Never"
      FillBar = FillBar - N
    End If
    If FillBar < N Then N = N / 2
  Wend
  If DotRest > 0 Then StdOut.WriteLine "|Rest|Dur:" & Types(0) & "," & Lengths(DotRest) & "|Visibility:Never"    
End If
FillBar = 0
End Sub