open Types

(*
let extract_be_int32 str pos = 
  let substr = IO.input_string (String.sub str pos 4) in
  let a = IO.read_byte substr in
  let b = IO.read_byte substr in
  let c = IO.read_byte substr in
  let d = IO.read_byte substr in
  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_int32 str pos = 
  let substr = IO.input_string (String.sub str pos 4) in
  let d = IO.read_byte substr in
  let c = IO.read_byte substr in
  let b = IO.read_byte substr in
  let a = IO.read_byte substr in
  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_int8 str pos = 
  let substr = IO.input_string (String.sub str pos 1) in
  IO.read_byte substr;;
*)

let granulerate_time num denom gp =
  Int64.to_float num *. gp /. Int64.to_float denom;;

let vorbis_time bos_packet gp = match gp with
  | None -> None 
  | Some gp -> (
    let granule_rate = extract_le_int32 bos_packet 12 in
    Some (granulerate_time 1L granule_rate (oogg64_to_float gp))
    );;

let theora_shift bos_packet = 
  ((extract_int8 bos_packet 40 land 0x03) lsl 3)
  lor
  ((extract_int8 bos_packet 41 land 0xe0) lsr 5);;

let theora_gp_to_frames shift gpv =
  let igp = oogg64_to_int64 gpv in
  let keyframe = Int64.shift_right igp shift in
  let offset = Int64.logand igp 
      (Int64.sub (Int64.shift_left Int64.one shift) Int64.one) in
  (keyframe, offset)

let theora_time bos_packet gp = match gp with
  | None -> None
  | Some gp -> (
    let num = extract_be_int32 bos_packet 22 in
    let denom = extract_be_int32 bos_packet 26 in
    let shift = theora_shift bos_packet in
    let (keyframe, offset) = theora_gp_to_frames shift gp in
    let gpv = Int64.to_float (Int64.add keyframe offset) in
    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 =
  let long_size = 1 lsl ((extract_int8 bos_packet 28) lsr 4) in
  let short_size = 1 lsl ((extract_int8 bos_packet 28) land 0xF) in
  (long_size, short_size);;

let vorbis_length packet long short = 
  if ((extract_int8 packet 0) lsr 1) land 1 = 1
  then long
  else short;;

(* there are pretty much always 2 modes, with size bits of 0 and 1 respectively.
   for now we'll assume that is *always* the case. *)
let vorbis_last_gp bos prevpack thispack thisgp = 
  let (long_size, short_size) = vorbis_sizes bos in
  if thisgp = Some (0,0,0,0) then Some (0,0,0,0) else
  (
    let thislen = vorbis_length thispack long_size short_size in
    let lastlen = vorbis_length prevpack long_size short_size in
    match thisgp with
      | None -> None
      | Some gp -> 
                Some (int64_to_oogg64 (Int64.sub (oogg64_to_int64 gp) 
                    (Int64.of_int ((thislen + lastlen) / 4))))
  );;

let theora_frames_to_gp shift keyframe frame = 
  int64_to_oogg64 (Int64.add (Int64.shift_left keyframe shift) frame);;

(* assume that we only do negative generation at the beginning, and
   that we never go over more than 1 keyframe.  At worst we just miss
   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 -> (
      let shift = theora_shift bos in
      let (keyframe, offset) = theora_gp_to_frames shift gp in
      if offset = 0L
      then Some (theora_frames_to_gp shift 0L (Int64.sub keyframe 1L))
      else Some (theora_frames_to_gp shift keyframe (Int64.sub offset 1L)));;

let last_gp_function id bos = match id with
  | Vorbis -> vorbis_last_gp bos
  | Theora -> theora_last_gp bos
  | _      -> fun _ _ _ -> None

let vorbis_next_gp bos prevpack thispack lastgp =
  let (long_size, short_size) = vorbis_sizes bos in
  let prevlen = vorbis_length prevpack long_size short_size in
  let thislen = vorbis_length thispack long_size short_size in
  match lastgp with
    | None    -> None
    | Some gp -> (
              Some (int64_to_oogg64 (Int64.add (oogg64_to_int64 gp)
                  (Int64.of_int ((thislen + prevlen) / 4)))) 
                  );;
 
let theora_next_gp bos prevpack thispack lastgp =
  match lastgp with
    | None -> None
    | Some gp -> (
      let shift = theora_shift bos in
      let (keyframe, offset) = theora_gp_to_frames shift gp in
      let fb = extract_int8 thispack 0 in
      if (fb land 0x80) = 0x80 (* header packet *)
      then Some (0,0,0,0)
      else (
        if (fb land 0x40) = 0x40 (* inter packet *)
        then Some (theora_frames_to_gp shift keyframe (Int64.add offset 1L))
        else Some (theora_frames_to_gp shift 
            (Int64.add (Int64.add keyframe offset) 1L) 0L)
      ));;

let next_gp_function id bos = match id with
  | Vorbis -> vorbis_next_gp bos
  | Theora -> theora_next_gp bos
  | _      -> fun _ _ _ -> None