(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)

(* Created by stolfi on Sun Aug  6 14:33:22 1989               *)
(* Last modified on Fri Mar 13 14:54:46 PST 1992 by muller     *)
(*      modified on Wed Nov 20 18:59:40 PST 1991 by stolfi     *)
(*      modified on Mon Nov 11 16:28:48 PST 1991 by steveg     *)
(*      modified on Tue May 22 23:11:33 PDT 1990 by chan       *)
(*      modified on Thu May 10 11:21:01 PDT 1990 by mcjones    *)

MODULE RGBIO;

IMPORT Fmt, Convert, Scan, Rd, TextRd, Wr, TextWr, Char;
IMPORT ColorName, RGB, Thread;

PROCEDURE Write (wr: Wr.T; READONLY rgb: RGB.T) 
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    IF rgb = RGB.Undefined THEN
      Wr.PutText (wr, "()")
    ELSE
      Wr.PutText (wr, "(" 
        & Fmt.Real (rgb[0], 4, Fmt.Style.Flo)
        & " " 
        & Fmt.Real (rgb[1], 4, Fmt.Style.Flo)
        & " " 
        & Fmt.Real (rgb[2], 4, Fmt.Style.Flo)
        & ")"
      )
    END;
  END Write;

PROCEDURE ToText (READONLY rgb: RGB.T): TEXT RAISES {} =
  <* FATAL Wr.Failure, Thread.Alerted *>
  VAR wr := TextWr.New();
  BEGIN
    Write (wr, rgb);
    RETURN TextWr.ToText (wr)
  END ToText;

PROCEDURE WriteArray (wr: Wr.T; READONLY table: ARRAY OF RGB.T)
  RAISES {Wr.Failure, Thread.Alerted} =
  VAR empty: BOOLEAN;
  BEGIN
    empty := TRUE;
    Wr.PutText (wr, "(");
    FOR i := 0 TO LAST (table) DO
      IF table[i] = RGB.Undefined THEN
        (* Skip it *)
      ELSE
        Wr.PutText (wr, "\n  (" 
          & Fmt.Pad (Fmt.Int (i), 3) 
          & " (" 
          & Fmt.Real (table[i][0], 4, Fmt.Style.Flo)
          & " "
          & Fmt.Real (table[i][1], 4, Fmt.Style.Flo)
          & " "
          & Fmt.Real (table[i][2], 4, Fmt.Style.Flo)
          & "))"
        );
        empty := FALSE
      END;
    END;
    IF  NOT empty THEN Wr.PutText (wr, "\n") END;
    Wr.PutText (wr, ")");
    Wr.Flush (wr);
  END WriteArray;

(**********************************************************)
(*                                                        *)
(* PARSING                                                *)
(*                                                        *)
(**********************************************************)

(* I should use Sx.Read instead of rollling my own parsing routines.
   But what the heck... *)

PROCEDURE Read (rd: Rd.T): RGB.T
  RAISES {Scan.BadFormat, Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  <* FATAL Wr.Failure, Thread.Alerted *>
  VAR rgb: RGB.T;
      c: CHAR;
  BEGIN
    REPEAT c := Rd.GetChar(rd) UNTIL NOT c IN Char.Spaces;
    TRY
      IF c = '(' THEN
        REPEAT c := Rd.GetChar(rd) UNTIL NOT c IN Char.Spaces;
        IF c = ')' THEN RETURN RGB.Undefined END;
        Rd.UnGetChar(rd);
        rgb[0] := ScanReal(rd);
        rgb[1] := ScanReal(rd);
        rgb[2] := ScanReal(rd);
        REPEAT c := Rd.GetChar(rd) UNTIL NOT c IN Char.Spaces;
        IF c # ')' THEN Rd.UnGetChar(rd); RAISE Scan.BadFormat END;
        RETURN rgb
      ELSIF c = '\"' THEN
        WITH wr = TextWr.New() DO
          c := Rd.GetChar(rd);
          WHILE (c IN Char.Letters) OR (c = ' ') DO
            Wr.PutChar(wr, c);
            c := Rd.GetChar(rd)
          END;
          IF c # '\"' THEN Rd.UnGetChar(rd); RAISE Scan.BadFormat END;
          RETURN ColorName.ToRGB(TextWr.ToText(wr))
        END
      ELSIF c IN Char.Letters THEN
        WITH wr = TextWr.New() DO
          TRY
            REPEAT
              Wr.PutChar(wr, c);
              c := Rd.GetChar(rd)
            UNTIL NOT (c IN Char.Letters);
            Rd.UnGetChar(rd); 
          EXCEPT
          | Rd.EndOfFile => (* OK *)
          END;
          RETURN ColorName.ToRGB(TextWr.ToText(wr))
        END
      ELSE
        Rd.UnGetChar(rd); RAISE Scan.BadFormat
      END;
    EXCEPT
    | Rd.EndOfFile => RAISE Scan.BadFormat;
    | ColorName.NotFound => RAISE Scan.BadFormat;
    END
  END Read;

PROCEDURE FromText (text: TEXT): RGB.T 
  RAISES {Scan.BadFormat} =
  <* FATAL Rd.Failure, Rd.EndOfFile, Thread.Alerted *>
  VAR rd := TextRd.New(text);
      rgb: RGB.T;
      c: CHAR;
  BEGIN
    rgb := Read(rd);
    TRY 
      REPEAT c := Rd.GetChar(rd) UNTIL NOT c IN Char.Spaces;
      Rd.UnGetChar(rd); RAISE Scan.BadFormat
    EXCEPT 
    | Rd.EndOfFile => RETURN rgb
    END;
  END FromText;

PROCEDURE ReadArray (rd: Rd.T; maxSize: NAT := LAST (NAT)): REF ARRAY OF RGB.T
  RAISES {Scan.BadFormat, Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  VAR i: INTEGER;
      size: NAT;
      c: CHAR;
      rgb := RGB.NewArray(MIN(256, maxSize), RGB.Undefined);
  BEGIN
    REPEAT c := Rd.GetChar(rd) UNTIL NOT c IN Char.Spaces;
    IF c # '(' THEN Rd.UnGetChar(rd); RAISE Scan.BadFormat END;
    TRY
      size := 0;
      LOOP
        REPEAT c := Rd.GetChar(rd) UNTIL NOT c IN Char.Spaces;
        IF c = ')' THEN
          EXIT
        ELSIF c # '(' THEN
          Rd.UnGetChar(rd); RAISE Scan.BadFormat
        END;
        i := ScanInteger(rd);
        IF (i < 0) OR (i >= maxSize) THEN
          RAISE Scan.BadFormat
        END;
        IF (i > LAST(rgb^)) THEN
          WITH 
            tmp = RGB.NewArray(MIN(maxSize, 2*NUMBER(rgb^)), RGB.Undefined)
          DO
            FOR i := 0 TO LAST(rgb^) DO tmp[i] := rgb[i] END;
            rgb := tmp;
          END
        ELSE
          IF rgb[i] # RGB.Undefined THEN RAISE Scan.BadFormat END;
        END;
        
        rgb[i] := Read(rd);
        IF rgb[i] # RGB.Undefined THEN size := MAX(size, i+1) END;
        
        REPEAT c := Rd.GetChar(rd) UNTIL NOT c IN Char.Spaces;
        IF c # ')' THEN Rd.UnGetChar(rd); RAISE Scan.BadFormat END;
      END;
      (* Truncate array: *)
      WITH
        tmp = RGB.NewArray(size, RGB.Undefined)
      DO
        FOR i := 0 TO size - 1 DO tmp[i] := rgb[i] END;
        RETURN tmp
      END
    EXCEPT
    | Rd.EndOfFile => RAISE Scan.BadFormat
    END
  END ReadArray;

PROCEDURE Gobble(
    rd: Rd.T; 
    VAR (*OUT*) buf: ARRAY OF CHAR; 
    VAR (*OUT*) size: CARDINAL;
    READONLY legal: SET OF CHAR
  ) RAISES {Scan.BadFormat, Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  VAR c: CHAR;
  BEGIN
    size := 0;
    c := Rd.GetChar(rd);
    TRY
      WHILE (size < NUMBER(buf)) AND (c IN legal) DO
        buf[size] := c; INC(size);
        c := Rd.GetChar(rd)
      END;
      Rd.UnGetChar(rd); 
      IF c IN legal THEN RAISE Scan.BadFormat END;
     EXCEPT
     | Rd.EndOfFile => (* OK *)
     END;
  END Gobble;

CONST IntegerChars = Char.Digits + SET OF CHAR{'+', '-'};

PROCEDURE ScanInteger(rd: Rd.T): INTEGER
  RAISES {Scan.BadFormat, Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  VAR buf: ARRAY [0..255] OF CHAR;
      size:CARDINAL;
      n: INTEGER;
      r: INTEGER;
  BEGIN
    Gobble(rd, buf, size, IntegerChars);
    TRY 
      r := Convert.ToInt(SUBARRAY(buf, 0, size), n);
      IF n < size THEN RAISE Scan.BadFormat END;
    EXCEPT
    | Convert.Failed => RAISE Scan.BadFormat
    END;
    RETURN r
  END ScanInteger;

CONST RealChars = Char.Digits + SET OF CHAR{'+', '-', '.', 'e', 'E', 'd', 'D', 'x', 'X'};

PROCEDURE ScanReal(rd: Rd.T): REAL
  RAISES {Scan.BadFormat, Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  VAR buf: ARRAY [0..255] OF CHAR;
      size:CARDINAL;
      n: INTEGER;
      r: REAL;
  BEGIN
    Gobble(rd, buf, size, RealChars);
    TRY 
      r := Convert.ToFloat(SUBARRAY(buf, 0, size), n);
      IF n < size THEN RAISE Scan.BadFormat END;
    EXCEPT
    | Convert.Failed => RAISE Scan.BadFormat
    END;
    RETURN r
  END ScanReal;

BEGIN
END RGBIO.