fix track parser, apparently the track length is in bytes, not in message count, which makes sense to allow to skip tracks, or chunks.

defined a repeatTillPosition parser primitive

Files with sysex are still broken (infinite loop?)

Author: smoothdeveloper

demo/scratch.fsx

@@ -1,39 +1,52 @@
+
+
 //#load "../src/zmidi/datatypes.fs"
 //#load "../src/zmidi/extratypes.fs"
 //#load "../src/zmidi/internal/utils.fs"
 //#load "../src/zmidi/internal/parsermonad.fs"
 //#load "../src/zmidi/read.fs"
 #r "../build/Debug/AnyCPU/net45/zmidi-fs-core.dll"
-
-
 open System.IO
 open ZMidi.Internal.ParserMonad
 open ZMidi
+//ZMidi.Internal.ParserMonad.debug <- true
+(*
+
+
+ 
+let pp = parseMidi {
+  return boundRepeat 10 readByte
+}
+
+
+let d = Seq.initInfinite (fun i -> byte (i % 255)) |> Seq.truncate 10 |> Seq.toArray 
+let s = State.initial
+
+let (Ok(ParserMonad f)) = (ZMidi.Internal.ParserMonad.runParser pp d s)
+f d s
+*)
 
 let folder = 
   Path.Combine(__SOURCE_DIRECTORY__ , ".." , "data", "midifiles")
   |> DirectoryInfo
 
 for file in folder.EnumerateFiles() do
   let buffer = File.ReadAllBytes file.FullName
+  printfn "======================= %s" file.FullName 
 
   let parseResult = 
     ZMidi.Internal.ParserMonad.runParser
       ZMidi.ReadFile.midiFile
       buffer
       State.initial
 
-
-  printfn "%s" file.FullName 
-
   match parseResult with 
   | Ok result -> 
 
     printfn "%i tracks" result.tracks.Length
     for t in result.tracks do
-      t.Length
-      printfn "track: %A" t
-    ()
+      printfn "track: %A events" t.Length
+    
   | Error something -> printfn "ERR: %s %A" file.FullName something
 
 
@@ -65,6 +78,39 @@ do
 
 //do printfn "hello"; let a = 1; printfn "world %i" a;
 
+
+
+
+
+
+
+
+let d = [|    0xffuy
+              0x08uy
+              0x0euy
+              0x41uy
+              0x6Duy
+              0x61uy
+              0x7Auy
+              0x69uy
+              0x6euy
+              0x67uy
+              0x20uy
+              0x47uy
+              0x72uy
+              0x61uy
+              0x63uy
+              0x65uy
+              0x00uy
+              |]
+
+let p = ZMidi.ReadFile.event 
+let s = State.initial
+
+let (Ok(ParserMonad f)) = (ZMidi.Internal.ParserMonad.runParser p d s)
+f d s
+
+
 open ZMidi.ReadFile
 open ZMidi.DataTypes
 let p = parseMidi {
@@ -78,14 +124,8 @@ let p = parseMidi {
            timeDivision = timeDiv
            format = format }
 
-  let! _ = assertString "MTrk"
-  let! l = readUInt32be
-  let! t = deltaTime
-  let! e = event
-  return (l,t,e)
-  //let! track1 = track
-  //return track1
-}
+  return! track
+}    
 
 
 
@@ -105,3 +145,13 @@ for file in folder.EnumerateFiles() do
   | Ok result -> 
     printfn "%A" result
   | Error something -> printfn "ERR: %s %A" file.FullName something
+
+
+
+let pp = parseMidi {
+  return boundRepeat 5 readByte
+}
+
+let (Ok(ParserMonad f)) = (ZMidi.Internal.ParserMonad.runParser pp [|1uy..5uy|] State.initial)
+
+f [|1uy..5uy|] State.initial

src/ZMidi/Internal/ParserMonad.fs

@@ -290,6 +290,29 @@ module ParserMonad =
 
 
     /// Run a parser within a bounded section of the input stream.
+    let repeatTillPosition (maxPosition: Pos) (p: ParserMonad<'a>) : ParserMonad<'a array> =
+        ParserMonad(fun data state ->
+            let results = ResizeArray()
+            let mutable firstError = Ok (Array.empty, state) 
+            let mutable lastState = state
+            let rec loop () =
+                if lastState.Position < int maxPosition then
+                    match apply1 p data lastState with
+                    | Ok (result, state) ->
+                        lastState <- state
+                        results.Add result
+                        loop ()
+                    | Error e ->
+                        firstError <- Error e
+
+            loop ()
+            match firstError with
+            | Ok _ ->
+                Ok(results.ToArray(), lastState)
+            | Error _ ->
+                firstError
+        )
+                        
     let inline boundRepeat (n: ^T) (p: ParserMonad<'a>) : ParserMonad<'a array> =
         ParserMonad(fun data state ->
             let result = Array.zeroCreate (int n)
@@ -299,6 +322,7 @@ module ParserMonad =
             let mutable i = LanguagePrimitives.GenericZero
             let mutable errorOccured = false
             logf "bound repeat %i" n
+
             while i < n && not errorOccured do
                 logf "bound repeat %i/%i" i n
 
@@ -321,7 +345,7 @@ module ParserMonad =
     let inline gencount (plen: ParserMonad<'T>) (p: ParserMonad<'a>) (constr: ^T -> 'a array -> 'answer) : ParserMonad<'answer> =
         parseMidi {
           let! l = plen
-          printfn "gen count: l: %i" l
+          logf "gen count: l: %i" l
           let! items = boundRepeat l p
           return constr l items
         }

src/ZMidi/Read.fs

@@ -428,7 +428,10 @@ event = peek >>= step
         }
     let messages i = 
       parseMidi {
-          return! boundRepeat (int i) message
+          
+          let! lastPos = getPos
+          let maxPos = lastPos + int i
+          return! repeatTillPosition maxPos message
       }
     let track : ParserMonad<MidiTrack> =
         parseMidi {