(* $Id$
 * ----------------------------------------------------------------------
 *
 *)


type t =
    { s_channel : in_channel;
      s_maxlength : int option;
      s_blocksize : int;
      mutable s_current_length : int;
      mutable s_at_eos : bool;
      mutable s_win_pos : int;
      mutable s_win_len : int;
      s_netbuf : Netbuffer.t;
      s_iobuf : string;
    }
;;


let dump s text = 
  print_string ("*** NETSTREAM DUMP " ^ text ^ "\n");
  Printf.printf "current_length=%d  at_eos=%b  win_pos=%d  win_len=%d\n"
                s.s_current_length s.s_at_eos s.s_win_pos s.s_win_len;
  Printf.printf "netbuffer_length=%d  netbuffer_size=%d\n"
                (Netbuffer.length s.s_netbuf)
                (String.length(Netbuffer.unsafe_buffer s.s_netbuf));
  Printf.printf "netbuffer=\"%s\"\n"
                (String.escaped(Netbuffer.contents s.s_netbuf));
  print_string "*** ---------------\n";
  flush stdout
;;


let want_another_block s =
  if not s.s_at_eos then begin
    (* How much are we allowed to read? *)
    let m =
      match s.s_maxlength with
	  None   -> s.s_blocksize
	| Some k -> min (k - s.s_current_length) s.s_blocksize
    in
    (* Read this. *)
    let rec read_block k =
      if k < m then
	let n = 
	  input s.s_channel s.s_iobuf k (m - k) in
	( if n > 0 then
	    read_block (k+n)
	  else (* EOF *)
	    k
	)
      else
	k
    in
    let n = read_block 0 in
    (* If n < blocksize, EOS is reached. *)
    Netbuffer.add_sub_string s.s_netbuf s.s_iobuf 0 n;
    s.s_win_len        <- s.s_win_len + n;
    s.s_current_length <- s.s_current_length + n;
    s.s_at_eos         <- n < s.s_blocksize;

    (* dump s "After appending block"; *)
  end
;;


let want s n =
  while not s.s_at_eos && s.s_win_len < n do
    want_another_block s
  done
;;


let want_minimum s =
  want s (s.s_blocksize + s.s_blocksize)
;;


let move s n =
  Netbuffer.delete s.s_netbuf 0 n;
  s.s_win_pos <- s.s_win_pos + n;
  s.s_win_len <- s.s_win_len - n;
  want_minimum s;
  (* dump s "After move"; *)
;;


let create_from_channel ch maxlength blocksize =
  let s =
    { s_channel = ch;
      s_maxlength = maxlength;
      s_blocksize = blocksize;
      s_current_length = 0;
      s_at_eos = false;
      s_win_pos = 0;
      s_win_len = 0;
      s_netbuf = Netbuffer.create (2*blocksize);
      s_iobuf = String.create blocksize;
    }
  in
  want_minimum s;
  s
;;


let create_from_string str =
  let l = String.length str in
  { s_channel = stdin;
    s_maxlength = None;
    s_blocksize = l;
    s_current_length = l;
    s_at_eos = true;
    s_win_pos = 0;
    s_win_len = l;
    s_netbuf =
      ( let nb = Netbuffer.create l in
	Netbuffer.add_string nb str;
	nb
      );
    s_iobuf = "";
  }
;;


let block_size s = s.s_blocksize;;

let current_length s = s.s_current_length;;

let at_eos s = s.s_at_eos;;

let window_position s = s.s_win_pos;;

let window_length s = s.s_win_len;;

let window s = s.s_netbuf;;

let print_stream s =
  Format.printf
    "<NETSTREAM window:%d/%d total_length:%d eof=%b>"
    s.s_win_pos
    s.s_win_len
    s.s_current_length
    s.s_at_eos
;;


(* ======================================================================
 * History:
 * 
 * $Log$
 * Revision 1.1  2000/11/17 09:57:27  lpadovan
 * Initial revision
 *
 * Revision 1.2  2000/06/24 20:20:33  gerd
 * 	Added the toploop printer.
 *
 * Revision 1.1  2000/04/15 13:07:48  gerd
 * 	Initial revision.
 *
 * 
 *)