[xiph-commits] r3197 - oogg/trunk

shans at svn.annodex.net shans at svn.annodex.net
Thu Aug 16 22:58:37 PDT 2007


Author: shans
Date: 2007-08-16 22:58:36 -0700 (Thu, 16 Aug 2007)
New Revision: 3197

Modified:
   oogg/trunk/packet.ml
Log:
Some packet-to-page code (not finished!)



Modified: oogg/trunk/packet.ml
===================================================================
--- oogg/trunk/packet.ml	2007-08-17 01:42:06 UTC (rev 3196)
+++ oogg/trunk/packet.ml	2007-08-17 05:58:36 UTC (rev 3197)
@@ -41,6 +41,51 @@
     | [< >] -> [< >] in 
   _tps pstream;;
 
+let create_fresh_page packet = 
+  let raw_page = 
+    {
+      continued             = false;
+      bos                   = packet.page.raw.bos;
+      eos                   = packet.page.raw.eos;
+      last_packet_complete  = true;
+      granulepos            = packet.p_granulepos;
+      serialno              = packet.page.raw.serialno;
+      sequenceno            = 
+
+let packet_to_page context packet = 
+  let _flush _ =
+    let old_page = !context in
+    let page = create_fresh_page packet in
+    context := Some page;
+    [< flush_page old_page >] in
+  match !context with
+    | None -> 
+      (
+        let page = create_fresh_page packet true in
+        context := Some page
+      )
+    | Some page -> 
+      (
+        if not (page.raw.serialno = packet.page.raw.serialno)
+        then [< _flush () >]
+        else (
+          let size = page_size page in
+          let new_size = size + (String.length (packet.p_data)) in
+          let diff = abs (size - 4096) in
+          let new_diff = abs (new_size - 4096) in
+          if (diff > new_diff)
+          then add_packet_to_page page packet
+          else [< _flush () >]
+      );;
+
+let packetStream_to_pageStream pstream = 
+  let context = ref None in
+  let rec _ptp _ =
+    match pstream with parser 
+      | [< 'packet >] -> [< packet_to_page context packet; _ptp () >]
+      | [< >] -> [< flush_page !context >] in
+  _ptp ();;
+
 type reconstruct_context = {
   rc_tf : granulePos -> float option;
   mutable rc_cache : packet list;



More information about the commits mailing list