MODULE Mis;  

(*
   This module contain "miscelaneus" procedures reused without extensive
   modifications, created by J. Stolfi and R. Marcone. See the copyright
   and authorship futher down.

   Last Modification: 06-01-00 by lozada

*)

IMPORT Wr, Rd, TextRd, TextWr, Thread, Fmt, R3, LR4, Random, Lex, LR3,
       Date, Time;

PROCEDURE InitLongReal(coins: Random.T; radius: REAL:= 0.20): LONGREAL =
  BEGIN
    WITH
      r = FLOAT(radius, LONGREAL),
      p = coins.longreal(-r,r)
    DO
      RETURN p;
    END
  END InitLongReal;

PROCEDURE WriteLong(wr: Wr.T; x: LONGREAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, Fmt.Pad(Fmt.LongReal(x, Fmt.Style.Fix, prec := 2), 8));
  END WriteLong;

PROCEDURE WriteInt(wr: Wr.T; x: INTEGER) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, Fmt.Pad(Fmt.Int(x), 4));
  END WriteInt;

PROCEDURE WriteCoord(wr: Wr.T; x: LONGREAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, Fmt.Pad(Fmt.LongReal(x, Fmt.Style.Fix, prec := 5), 10));
  END WriteCoord;

PROCEDURE WritePoint(wr: Wr.T; READONLY c: LR4.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    WriteCoord(wr, c[0]);
    Wr.PutText(wr, " ");
    WriteCoord(wr, c[1]);
    Wr.PutText(wr, " ");
    WriteCoord(wr, c[2]);
    Wr.PutText(wr, " ");
    WriteCoord(wr, c[3]);
  END WritePoint;

PROCEDURE WritePoint3D(wr: Wr.T; READONLY c: LR3.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    WriteCoord(wr, c[0]);
    Wr.PutText(wr, " ");
    WriteCoord(wr, c[1]);
    Wr.PutText(wr, " ");
    WriteCoord(wr, c[2]);
    Wr.PutText(wr, " ");
  END WritePoint3D;

PROCEDURE WriteIntensity(wr: Wr.T; r: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, Fmt.Real(r, Fmt.Style.Fix, prec := 2));
  END WriteIntensity;

PROCEDURE WriteColor(wr: Wr.T; READONLY c: R3.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    WriteIntensity(wr, c[0]);
    Wr.PutText(wr, " ");                     
    WriteIntensity(wr, c[1]);
    Wr.PutText(wr, " ");                     
    WriteIntensity(wr, c[2]);
  END WriteColor;
        
PROCEDURE WriteRadius(wr: Wr.T; r: REAL) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(wr, Fmt.Real(r, prec := 2));
  END WriteRadius;

EXCEPTION MissingFinalNewLine;

PROCEDURE WriteCommentsJS(wr: Wr.T; comments: TEXT; prefix: CHAR) =
  (* 
    Writes the given "comments" text to "wr", with a "prefix" character and
    a blank in front of every line.  Supplies a final '\n' if the text is 
    non-empty but does not end with newline.
  *)

  VAR rd: Rd.T := TextRd.New(comments);

  PROCEDURE CopyLine() RAISES {Rd.EndOfFile} =
    (*
    Copy one line from "rd" to "wr", prefixed by "prefix" and a space. 
    Supplies a final '\n' if the next line exists but does NOT
    end with newline. Raises "Rd.EndOfFile" if there are no more
    lines in "rd".
    *)  
    <* FATAL Rd.Failure, Wr.Failure, Thread.Alerted *>
    VAR c: CHAR;
    BEGIN
      c := Rd.GetChar(rd); (* If EOF here, propagate to caller *)
      Wr.PutChar(wr, prefix);
      Wr.PutChar(wr, ' ');
      Wr.PutChar(wr, c);
      WHILE c # '\n' DO
        TRY c := Rd.GetChar(rd) EXCEPT Rd.EndOfFile => c := '\n' END;
        Wr.PutChar(wr, c)
      END
    END CopyLine;

  BEGIN
    TRY LOOP CopyLine() END EXCEPT Rd.EndOfFile => (* Ok *) END;
  END WriteCommentsJS;
  
PROCEDURE ReadBool(rd: Rd.T): BOOLEAN RAISES {Lex.Error} =
  <* FATAL Rd.Failure, Rd.EndOfFile, Thread.Alerted *>
  BEGIN
    WITH c = Rd.GetChar(rd) DO
      IF c = 'T' THEN 
        RETURN TRUE
      ELSIF c = 'F' THEN
        RETURN FALSE
      ELSE 
        Rd.UnGetChar(rd);
        RAISE Lex.Error
      END
    END
  END ReadBool;

PROCEDURE ReadCommentsJS(rd: Rd.T; prefix: CHAR): TEXT =

  VAR wr: Wr.T := TextWr.New();

  PROCEDURE CopyLine() RAISES {Rd.EndOfFile} =
    (*
    Copy one comment line from "rd" to "wr", removing the "prefix" and the
    following blank, but leaving the final (mandatory) newline.
    Raises "Rd.EndOfFile" if "rd" is exhausted or the next char is 
    not "prefix".
    *)
    <* FATAL Rd.Failure, Wr.Failure, Thread.Alerted *>
    <* FATAL MissingFinalNewLine *>
    
    VAR c: CHAR;
    BEGIN
      c := Rd.GetChar(rd); (* If EOF here, propagate to caller *)
      IF c # prefix THEN Rd.UnGetChar(rd); RAISE Rd.EndOfFile END;
      TRY c := Rd.GetChar(rd) EXCEPT Rd.EndOfFile =>
	                        RAISE MissingFinalNewLine END;
      IF c = ' ' THEN
        TRY c := Rd.GetChar(rd) EXCEPT Rd.EndOfFile =>
	                        RAISE MissingFinalNewLine END;
      END;
      WHILE c # '\n' DO
        Wr.PutChar(wr, c);
        TRY c := Rd.GetChar(rd) EXCEPT Rd.EndOfFile =>
	                        RAISE MissingFinalNewLine END;
      END;
      Wr.PutChar(wr, c);  
    END CopyLine;

  BEGIN
    TRY LOOP CopyLine() END EXCEPT Rd.EndOfFile => (* Ok *) END;
    RETURN TextWr.ToText(wr);
  END ReadCommentsJS;

PROCEDURE NumDigits(n: CARDINAL): CARDINAL =
  (* Width of "n" when printed. *)
  VAR w: CARDINAL := 1;
  BEGIN
    WHILE n > 9 DO INC(w); n := n DIV 10 END;
    RETURN w
  END NumDigits;

PROCEDURE InsertionSort(n: CARDINAL; VAR a: REF ARRAY OF INTEGER) =

  PROCEDURE cmp(a,b: INTEGER) : INTEGER =
    (* compare two integer values *)
    BEGIN
     IF a > b
       THEN RETURN 1;
       ELSIF  a < b THEN RETURN -1;
       ELSE RETURN 0;
     END;
    END cmp;

  VAR
    j,lo,hi,key: INTEGER;
  BEGIN
    lo := 0;
    hi := n+1;
    FOR i := lo+1 TO hi-1 DO
      key := a[i];
      j := i-1;
      WHILE (j >= lo) AND cmp (key, a[j]) < 0 DO
        a[j+1] := a[j];
        DEC (j);
      END;
      a[j+1] := key;
    END;
  END InsertionSort;



PROCEDURE Sort(n: CARDINAL; VAR a: REF ARRAY OF CARDINAL) =

  PROCEDURE cmp(a,b: CARDINAL) : INTEGER =
    (* compare two CARDINAL values *)
    BEGIN
     IF a > b
       THEN RETURN 1;
       ELSIF  a < b THEN RETURN -1;
       ELSE RETURN 0;
     END;
    END cmp;

  VAR
    j,lo,hi,key: INTEGER;
  BEGIN
    lo := 0;
    hi := n+1;
    FOR i := lo+1 TO hi-1 DO
      key := a[i];
      j := i-1;
      WHILE (j >= lo) AND cmp (key, a[j]) < 0 DO
        a[j+1] := a[j];
        DEC (j);
      END;
      a[j+1] := key;
    END;
  END Sort;


  
PROCEDURE Today(): TEXT =
  (* Print the character chain with the actual date and time. *)
  BEGIN
    WITH
      d = Date.FromTime(Time.Now(), Date.Local)
    DO
      RETURN
        Fmt.Pad(Fmt.Int(d.year - 0), 4, '0') &
        "-" &
        Fmt.Pad(Fmt.Int(ORD(d.month)+1), 2, '0') &
        "-" &
        Fmt.Pad(Fmt.Int(d.day), 2, '0') &
        " at " &
        Fmt.Pad(Fmt.Int(d.hour), 2, '0') &
        ":" &
        Fmt.Pad(Fmt.Int(d.minute), 2, '0') &
        ":" &
        Fmt.Pad(Fmt.Int(d.second), 2, '0')
    END
  END Today;

(* use so:

       VAR f : REF ARRAY OF INTEGER
         f := NEW(REF ARRAY OF INTEGER, n)
         FOR i := 0 TO n-1 DO
           f[i] := 
         END
         InsertionSort(n-1,f);
*)

BEGIN
END Mis.




(*

***************** START OF COPYRIGHT AND AUTHORSHIP NOTICE **********

All files in this directory tree are Copyright 1996 by Jorge Stolfi,
Rober Marcone Rosi, and Universidade Estadual de Campinas, Brazil---
unless stated otherwise in the files themselves.

THESE FILES ARE DISTRIBUTED WITH NO GUARANTEE OF ANY KIND.  Neither
the authors nor their employers may be held responsible for any losses
or damages attributed to their use.

These files may be freely copied, distributed, modified, and used for
any purpose; provided that any subtantial excerpt of these files that
is redistributed or incorporated in other software packages is
accompanied by this copyright and authorship notice, and is made freely
available under these same terms.

***************** END OF COPYRIGHT AND AUTHORSHIP NOTICE ************

*)