[xiph-commits] r3487 - oogg/trunk
shans at svn.annodex.net
shans at svn.annodex.net
Tue Feb 19 03:44:13 PST 2008
Author: shans
Date: 2008-02-19 03:44:12 -0800 (Tue, 19 Feb 2008)
New Revision: 3487
Modified:
oogg/trunk/Makefile
oogg/trunk/granules.ml
oogg/trunk/oogg_sort_stream.ml
oogg/trunk/packet.ml
oogg/trunk/page.ml
oogg/trunk/page.mli
oogg/trunk/streamSort.ml
oogg/trunk/streamSort.mli
oogg/trunk/types.ml
oogg/trunk/types.mli
Log:
Added merge functionality to the streamSort functor
Added CMML timeval reconstruction
Modified: oogg/trunk/Makefile
===================================================================
--- oogg/trunk/Makefile 2008-02-19 09:19:24 UTC (rev 3486)
+++ oogg/trunk/Makefile 2008-02-19 11:44:12 UTC (rev 3487)
@@ -1,5 +1,5 @@
PROGRAMS = oogg_dump_pages oogg_copy_file oogg_rip oogg_check_checksums \
- oogg_info oogg_dump_packets oogg_sort_stream oogg_remove_excess \
+ oogg_info oogg_dump_packets oogg_sort_stream \
oogg_dump_complete_packets
LIBINCS = -I +extlib
LIBS = unix.cmxa extLib.cmxa oogg.cmxa
Modified: oogg/trunk/granules.ml
===================================================================
--- oogg/trunk/granules.ml 2008-02-19 09:19:24 UTC (rev 3486)
+++ oogg/trunk/granules.ml 2008-02-19 11:44:12 UTC (rev 3487)
@@ -59,9 +59,21 @@
Some (granulerate_time denom num gpv)
);;
+let cmml_time bos_packet gp = match gp with
+ | None -> None
+ | Some gp -> (
+ let num = extract_le_int64 bos_packet 12 in
+ let denom = extract_le_int64 bos_packet 20 in
+ let shift = extract_int8 bos_packet 28 in
+ let (last, offset) = theora_gp_to_frames shift gp in
+ let gpv = Int64.to_float (Int64.add last offset) in
+ Some (granulerate_time denom num gpv)
+ );;
+
let granulerate_function id bos = match id with
| Vorbis -> vorbis_time bos
| Theora -> theora_time bos
+ | CMML -> cmml_time bos
| _ -> fun x -> None
let vorbis_sizes bos_packet =
Modified: oogg/trunk/oogg_sort_stream.ml
===================================================================
--- oogg/trunk/oogg_sort_stream.ml 2008-02-19 09:19:24 UTC (rev 3486)
+++ oogg/trunk/oogg_sort_stream.ml 2008-02-19 11:44:12 UTC (rev 3487)
@@ -2,6 +2,9 @@
let g = File.file_open ~writable:true Sys.argv.(2);;
let s = File.to_stream f 0;;
let ps = Page.to_pageStream s;;
-let sps = Page.sort ps;;
+
+let streams = Page.to_streams ps;;
+let sorted_ps = Page.from_streams streams;;
+
let ostream = File.to_output_stream g 0;;
-Page.write_pageStream ostream sps;;
+Page.write_pageStream ostream sorted_ps;;
Modified: oogg/trunk/packet.ml
===================================================================
--- oogg/trunk/packet.ml 2008-02-19 09:19:24 UTC (rev 3486)
+++ oogg/trunk/packet.ml 2008-02-19 11:44:12 UTC (rev 3487)
@@ -252,6 +252,7 @@
module PacketInput =
struct
+ exception DontSortPacketStreamsYet
type k = serialNo
type s = packet
let eq = (=)
@@ -259,6 +260,7 @@
let is_first p = p.p_bos
let is_last p = p.p_eos
let printKey s = print_oogg32 s
+ let lt a b = raise DontSortPacketStreamsYet
end;;
module PacketSort = StreamSort.StreamSort (PacketInput);;
Modified: oogg/trunk/page.ml
===================================================================
--- oogg/trunk/page.ml 2008-02-19 09:19:24 UTC (rev 3486)
+++ oogg/trunk/page.ml 2008-02-19 11:44:12 UTC (rev 3487)
@@ -267,6 +267,7 @@
module RawPageInput =
struct
+ exception DontAttemptToMergeRawStreams
type k = serialNo
type s = rawPage
let eq = (=)
@@ -274,6 +275,7 @@
let is_first p = p.bos
let is_last p = p.eos
let printKey s = print_oogg32 s
+ let lt a b = raise DontAttemptToMergeRawStreams
end;;
module RawPageSort = StreamSort.StreamSort (RawPageInput);;
@@ -288,10 +290,20 @@
let is_first p = p.raw.bos
let is_last p = p.raw.eos
let printKey s = print_oogg32 s
+ let lt a b =
+ if a.raw.bos then true
+ else if b.raw.bos then false
+ else match a.time with
+ | None -> true
+ | Some t1 -> (
+ match b.time with
+ | None -> false
+ | Some t2 -> t1 < t2)
end;;
module PageSort = StreamSort.StreamSort (PageInput);;
let to_streams = PageSort.sort;;
+let from_streams = PageSort.merge;;
let _cmp a b =
if a = None then true
Modified: oogg/trunk/page.mli
===================================================================
--- oogg/trunk/page.mli 2008-02-19 09:19:24 UTC (rev 3486)
+++ oogg/trunk/page.mli 2008-02-19 11:44:12 UTC (rev 3487)
@@ -21,4 +21,6 @@
val to_streams : Types.pageStream -> (Types.serialNo * Types.pageStream) list;;
+val from_streams : (Types.serialNo * Types.pageStream) list -> Types.pageStream
+
val sort : Types.pageStream -> Types.pageStream;;
Modified: oogg/trunk/streamSort.ml
===================================================================
--- oogg/trunk/streamSort.ml 2008-02-19 09:19:24 UTC (rev 3486)
+++ oogg/trunk/streamSort.ml 2008-02-19 11:44:12 UTC (rev 3487)
@@ -7,13 +7,43 @@
val is_first : s -> bool
val is_last : s -> bool
val printKey : k -> unit
+ val lt : s -> s -> bool
end;;
module StreamSort =
functor (I:INPUT) ->
struct
exception PagesAfterEOS
+ exception EmptyList
+ exception EmptyStream
+ let rec merge l =
+ let peekStrip h = match Stream.peek h with
+ | None -> raise EmptyStream
+ | Some v -> v in
+
+ let rec min_of l = match l with
+ | [] -> raise EmptyList
+ | [a] -> (a, [])
+ | h::t ->
+ (
+ let (m, r) = min_of t in
+ if I.lt (peekStrip (snd h)) (peekStrip (snd m))
+ then (h, m::r)
+ else (m, h::r)
+ ) in
+
+ match l with
+ | [] -> [< >]
+ | _ ->
+ (
+ let ((_, mlist), rest) = min_of l in
+ let elt = Stream.next mlist in
+ if Stream.peek mlist = None
+ then [< 'elt; merge rest >]
+ else [< 'elt; merge l >]
+ );;
+
let sort i =
let rec get_first_pages i = match (Stream.peek i) with
Modified: oogg/trunk/streamSort.mli
===================================================================
--- oogg/trunk/streamSort.mli 2008-02-19 09:19:24 UTC (rev 3486)
+++ oogg/trunk/streamSort.mli 2008-02-19 11:44:12 UTC (rev 3487)
@@ -7,10 +7,12 @@
val is_first : s -> bool
val is_last : s -> bool
val printKey : k -> unit
+ val lt : s -> s -> bool
end;;
module StreamSort :
functor (I : INPUT) ->
sig
val sort : I.s Stream.t -> (I.k * I.s Stream.t) list
+ val merge : (I.k * I.s Stream.t) list -> I.s Stream.t
end;;
Modified: oogg/trunk/types.ml
===================================================================
--- oogg/trunk/types.ml 2008-02-19 09:19:24 UTC (rev 3486)
+++ oogg/trunk/types.ml 2008-02-19 11:44:12 UTC (rev 3487)
@@ -171,6 +171,11 @@
let e = (a lsl 8) + b in
let f = (c lsl 8) + d in
Int64.add (Int64.shift_left (Int64.of_int e) 16) (Int64.of_int f);;
+
+let extract_le_int64 str pos =
+ let a = extract_le_int32 str pos in
+ let b = extract_le_int32 str (pos + 4) in
+ Int64.add (Int64.shift_left a 32) b;;
let extract_int8 str pos =
let substr = IO.input_string (String.sub str pos 1) in
Modified: oogg/trunk/types.mli
===================================================================
--- oogg/trunk/types.mli 2008-02-19 09:19:24 UTC (rev 3486)
+++ oogg/trunk/types.mli 2008-02-19 11:44:12 UTC (rev 3487)
@@ -93,5 +93,6 @@
val extract_be_int32 : string -> int -> int64;;
val extract_le_int32 : string -> int -> int64;;
+val extract_le_int64 : string -> int -> int64;;
val extract_le_oogg64 : string -> int -> oogg64;;
val extract_int8 : string -> int -> int;;
More information about the commits
mailing list