(* Wrap *)
(* $Id$ *)

(*** counter *)
class counter =
  object(self)
    val mutable row = 0
    val mutable col = 0
    method row = row
    method col = col
    method private count_char c =
      match c with
      | '\n' -> col <- 0; row <- row + 1
      | '\t' -> col <- col + 4 - (col land 3)
      | _ -> col <- col + 1
    method output_char c = self#count_char c
    method output_substring u i m =
      for k = 0 to m - 1 do
        self#count_char u.[i + k]
      done
    method output_string u =
      for i = 0 to String.length u - 1 do
        self#count_char u.[i]
      done
    method flush = ()
  end
;;
(* ***)
(*** writer_of_output_channel *)
class writer_of_output_channel oc =
  object(self)
    inherit counter as super
    method output_string u =
      super#output_string u;
      output_string oc u
    method output_substring u i m =
      super#output_substring u i m;
      output oc u i m
    method output_char c =
      super#output_char c;
      output_char oc c
    method flush =
      super#flush;
      flush oc
  end
;;
(* ***)
(*** word_wrapper *)
class word_wrapper ?(columns=75) writer =
  object(self)
    val mutable j = 0

    method columns = columns

    method flush = if j > 0 then self#newline

    method newline = writer#output_char '\n'; j <- 0

    method output_word u =
      let m = String.length u in
      if j > 0 then
        if j + m + 1 >= columns then
          begin
            writer#output_char '\n';
            j <- 0;
          end
        else
          ()
      else ();

      if j > 0 then begin
        writer#output_char ' ';
        j <- j + 1
      end;

      writer#output_string u;

      if j + m >= columns then
        begin
          writer#output_char '\n';
          j <- 0;
        end
      else
        j <- j + m

    method output u =
      let m = String.length u in
      let f c = writer#output_char c
      and g u i m =
        writer#output_substring u i m
      in
      (* beginning of line space *)
      (* i: current index *)
      (* j: pending beginning-of-line spaces (i.e., indent) *)
      let rec loop0 i j =
        if i = m then
          if j > 0 then
            f '\n'
          else
            ()
        else match u.[i] with
        | ' ' -> loop0 (i + 1) (j + 1)
        | '\t' -> loop0 (i + 1) (j + (4 - j land 3))
        | '\n' ->
            f '\n';
            loop0 (i + 1) 0
        | _ ->
            if j < columns then
              loop2 i i 0 j
            else
              begin
                f '\n';
                loop2 i i 0 0
              end
      (* inter-word space *)
      (* i: current index *)
      (* j: actual column *)
      and loop1 i j =
        if i >= m then
          if j > 0 then
            f '\n'
          else
            ()
        else match u.[i] with (* XXX bug here *)
        | ' '|'\t' -> loop1 (i + 1) j
        | '\n' ->
            f '\n';
            loop0 (i + 1) 0
        | _ -> loop2 i i j 1
      (* word *)
      (* i0: index of beginning of word *)
      (* i: current index *)
      (* j: actual cursor column *)
      (* k: number of pending spaces *)
      and loop2 i0 i j k =
        if i = m or u.[i] = ' ' or u.[i] = '\t' or u.[i] = '\n' then
          let l = i - i0 in
          if j + k + l >= columns then
            begin
              f '\n';
              g u i0 l;
              if i < m & u.[i] = '\n' then
                begin
                  f '\n';
                  loop0 (i + 1) 0
                end
              else
                if l >= columns then
                  begin
                    f '\n';
                    loop1 (i + 1) 0
                  end
                else
                  loop1 (i + 1) l
            end
          else
            begin
              for h = 1 to k do
                f ' '
              done;
              g u i0 l;
              if i = m or i < m && u.[i] = '\n' then
                begin
                  f '\n';
                  if i < m then loop0 (i + 1) 0
                end
              else
                loop1 (i + 1) (j + k + l)
            end
        else
          loop2 i0 (i + 1) j k
      in
      loop0 0 j
  end
;;
(* ***)
(*** word_non_wrapper *)
class word_non_wrapper ?(columns=75) writer =
  object(self)
    method columns = columns

    method flush = if writer#col > 0 then self#newline

    method newline = writer#output_char '\n'

    method output_word u =
      if writer#col > 0 then
        begin
          writer#output_char ' '
        end;
      writer#output_string u

    method output (u : string) : unit = writer#output_string u
  end
;;
(* ***)
