[xiph-commits] r3194 - oogg/trunk
shans at svn.annodex.net
shans at svn.annodex.net
Thu Aug 16 00:38:00 PDT 2007
Author: shans
Date: 2007-08-16 00:38:00 -0700 (Thu, 16 Aug 2007)
New Revision: 3194
Added:
oogg/trunk/streamSort.ml
oogg/trunk/streamSort.mli
Modified:
oogg/trunk/Makefile
oogg/trunk/granules.ml
oogg/trunk/oogg_dump_packets.ml
oogg/trunk/packet.ml
oogg/trunk/packet.mli
oogg/trunk/types.ml
oogg/trunk/types.mli
Log:
Sorting functor, implementation of packet sorting. Still has issues.
Modified: oogg/trunk/Makefile
===================================================================
--- oogg/trunk/Makefile 2007-08-16 04:31:14 UTC (rev 3193)
+++ oogg/trunk/Makefile 2007-08-16 07:38:00 UTC (rev 3194)
@@ -27,8 +27,8 @@
oogg_rip: oogg.cmxa oogg_rip.ml
ocamlopt $(PROF) -o oogg_rip $(LIBINCS) $(LIBS) oogg_rip.ml
-oogg.cmxa: types.cmx crc.cmx file.cmx granules.cmx page.cmx page_util.cmx \
- mediaStream.cmx packet.cmx packet_util.cmx
+oogg.cmxa: types.cmx crc.cmx file.cmx granules.cmx streamSort.cmx page.cmx \
+ page_util.cmx mediaStream.cmx packet.cmx packet_util.cmx
ocamlopt $(PROF) -a -o oogg.cmxa -i $^
%.cmx: %.mli %.ml
Modified: oogg/trunk/granules.ml
===================================================================
--- oogg/trunk/granules.ml 2007-08-16 04:31:14 UTC (rev 3193)
+++ oogg/trunk/granules.ml 2007-08-16 07:38:00 UTC (rev 3194)
@@ -99,6 +99,7 @@
out on a keyframe at the beginning
*)
let theora_last_gp bos prevpack thispack thisgp =
+ if thisgp = Some (0,0,0,0) then Some (0,0,0,0) else
match thisgp with
| None -> None
| Some gp -> (
Modified: oogg/trunk/oogg_dump_packets.ml
===================================================================
--- oogg/trunk/oogg_dump_packets.ml 2007-08-16 04:31:14 UTC (rev 3193)
+++ oogg/trunk/oogg_dump_packets.ml 2007-08-16 07:38:00 UTC (rev 3194)
@@ -3,4 +3,7 @@
let ps = Page.to_pageStream s;;
let pps = Packet.to_packetStream ps;;
let ppps = Packet.reconstruct_timing pps;;
-Packet_util.print_packetStream ppps;;
+let all_streams = Packet.sort ppps;;
+Packet_util.print_packetStream
+ (*ppps;;*)
+ (snd (List.nth all_streams (int_of_string Sys.argv.(2))));;
Modified: oogg/trunk/packet.ml
===================================================================
--- oogg/trunk/packet.ml 2007-08-16 04:31:14 UTC (rev 3193)
+++ oogg/trunk/packet.ml 2007-08-16 07:38:00 UTC (rev 3194)
@@ -1,11 +1,12 @@
open Types
-let new_packet oc page data isLast =
+let new_packet oc page data n isLast =
{
p_data = (match oc with None -> data | Some d -> d ^ data) ;
p_granulepos = if isLast then page.raw.granulepos else None ;
p_time = if isLast then page.time else None ;
- p_page = page
+ p_page = page ;
+ p_pageno = n
};;
type ptp_context = {mutable cont_packet : string option};;
@@ -14,13 +15,13 @@
let sn = page.raw.serialno in
if page.raw.bos then
cont := (sn, {cont_packet = None})::!cont;
- let rec _ptp raw_data =
+ let rec _ptp raw_data n =
let pcont = List.assoc sn !cont in
let oc = pcont.cont_packet in
pcont.cont_packet <- None;
match raw_data with
| h::[l] when not page.raw.last_packet_complete ->
- (pcont.cont_packet <- Some l; [< 'new_packet oc page h true >])
+ (pcont.cont_packet <- Some l; [< 'new_packet oc page h n true >])
| [h] when not page.raw.last_packet_complete ->
((match oc with
| None -> pcont.cont_packet <- Some h
@@ -28,10 +29,10 @@
[< >]
)
| h::[] when page.raw.last_packet_complete ->
- [< 'new_packet oc page h true >]
- | h::t -> [< 'new_packet oc page h false; _ptp t >]
+ [< 'new_packet oc page h n true >]
+ | h::t -> [< 'new_packet oc page h n false; _ptp t (n+1) >]
| [] -> [< >] in
- _ptp page.raw.raw_data;;
+ _ptp page.raw.raw_data 0;;
let to_packetStream pstream =
let cont = ref [] in
@@ -106,3 +107,17 @@
| [< 'pack ; rest >] -> [<reconstruct_packet context pack; _rt rest>]
| [< >] -> [< >] in
_rt pstream;;
+
+module PacketInput =
+ struct
+ type k = serialNo
+ type s = packet
+ let eq = (=)
+ let get_key p = p.p_page.raw.serialno
+ let is_first p = p.p_page.raw.bos && p.p_pageno = 0
+ let is_last p = p.p_page.raw.eos
+ end;;
+
+module PacketSort = StreamSort.StreamSort (PacketInput);;
+
+let sort = PacketSort.sort;;
Modified: oogg/trunk/packet.mli
===================================================================
--- oogg/trunk/packet.mli 2007-08-16 04:31:14 UTC (rev 3193)
+++ oogg/trunk/packet.mli 2007-08-16 07:38:00 UTC (rev 3194)
@@ -1,3 +1,5 @@
val to_packetStream : Types.pageStream -> Types.packetStream;;
val reconstruct_timing : Types.packetStream -> Types.packetStream;;
+
+val sort : Types.packetStream -> (Types.serialNo * Types.packetStream) list;;
Added: oogg/trunk/streamSort.ml
===================================================================
--- oogg/trunk/streamSort.ml (rev 0)
+++ oogg/trunk/streamSort.ml 2007-08-16 07:38:00 UTC (rev 3194)
@@ -0,0 +1,67 @@
+module type INPUT =
+ sig
+ type k
+ type s
+ val eq : k -> k -> bool
+ val get_key : s -> k
+ val is_first : s -> bool
+ val is_last : s -> bool
+ end;;
+
+module StreamSort =
+ functor (I:INPUT) ->
+ struct
+ exception PagesAfterEOS
+
+ let sort i =
+
+ let rec get_first_pages i = match (Stream.peek i) with
+ | None -> []
+ | Some page when I.is_first page ->
+ (
+ Stream.junk i;
+ (I.get_key page, ref (Some [page]))::(get_first_pages i)
+ )
+ | Some page -> [] in
+
+ let starts = get_first_pages i in
+
+ let rec get_next_page k =
+ let cache = List.assoc k starts in
+ match !cache with
+ | None -> None
+ | Some (h::t) ->
+ (
+ if I.is_last h
+ then cache := None
+ else cache := Some t;
+ Some h
+ )
+ | Some [] ->
+ ( let p = Stream.next i in
+ let ik = I.get_key p in
+ if ik = k then (
+ if I.is_last p then cache := None;
+ Some p
+ ) else (
+ let icache = List.assoc ik starts in
+ (match !icache with
+ | None -> raise PagesAfterEOS
+ | Some l -> icache := Some (l @ [p]));
+ get_next_page k
+ )
+ ) in
+
+ let generator k _ = get_next_page k in
+
+ let rec generate_output_streams s = match s with
+ | [] -> []
+ | (key,r)::t ->
+ (
+ let new_stream = Stream.from (generator key) in
+ (key, new_stream)::(generate_output_streams t)
+ ) in
+
+ generate_output_streams starts;
+
+ end ;;
Added: oogg/trunk/streamSort.mli
===================================================================
--- oogg/trunk/streamSort.mli (rev 0)
+++ oogg/trunk/streamSort.mli 2007-08-16 07:38:00 UTC (rev 3194)
@@ -0,0 +1,15 @@
+module type INPUT =
+ sig
+ type k
+ type s
+ val eq : k -> k -> bool
+ val get_key : s -> k
+ val is_first : s -> bool
+ val is_last : s -> bool
+ end;;
+
+module StreamSort :
+ functor (I : INPUT) ->
+ sig
+ val sort : I.s Stream.t -> (I.k * I.s Stream.t) list
+ end;;
Modified: oogg/trunk/types.ml
===================================================================
--- oogg/trunk/types.ml 2007-08-16 04:31:14 UTC (rev 3193)
+++ oogg/trunk/types.ml 2007-08-16 07:38:00 UTC (rev 3194)
@@ -105,7 +105,8 @@
{ p_data : string ;
mutable p_granulepos : granulePos ;
mutable p_time : float option ;
- p_page : page
+ p_page : page ;
+ p_pageno : int
};;
type packetStream = packet Stream.t;;
Modified: oogg/trunk/types.mli
===================================================================
--- oogg/trunk/types.mli 2007-08-16 04:31:14 UTC (rev 3193)
+++ oogg/trunk/types.mli 2007-08-16 07:38:00 UTC (rev 3194)
@@ -68,7 +68,8 @@
{ p_data : string ;
mutable p_granulepos : granulePos ;
mutable p_time : float option ;
- p_page : page
+ p_page : page ;
+ p_pageno : int
};;
type packetStream = packet Stream.t;;
More information about the commits
mailing list