(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Created by meehan on Thu Aug 13 18:24:21 PDT 1992                         *)
(* Last modified on Wed Aug 26 17:04:57 1992 by meehan                       *)

MODULE MakeBasicTable EXPORTS Main;

(* This program reads a list of rgb-triples and color-names from stdin
   and writes the Modula-3 interface for ColorNameTable onto stdout.  Each
   line of input should look like this one:
255 250 250		snow
   which is the first line of /usr/lib/X11/rgb/rgb.txt.  The output
   is a Modula-3 interface in which the input data is represented as
   a CONST.  *)

IMPORT ColorName, ColorNameF, Convert, Cstdlib, Fmt, Lex, List, Rd, 
       RdUtils, RGB, Text, Thread, Wr; 

FROM Stdio IMPORT stdin, stdout, stderr;

CONST
  BoilerPlate = "(* Copyright (C) 1992, Digital Equipment Corporation *)\n"
                  & "(* All rights reserved. *)\n"
                  & "(* See the file COPYRIGHT for a full description. *)\n\n"
                  & "(* THIS CODE WAS AUTOMATICALLY GENERATED\n"
                  & "   by MakeBasicTable in /proj/m3/pkg/color/tools\n"
                  & "   DO NOT MODIFY THIS FILE. *)\n\n"
                  & "INTERFACE ColorNameTable;\n\n" & "IMPORT RGB;\n\n"
                  & "TYPE BCEntry = RECORD name: TEXT; rgb: RGB.T END;\n\n"
                  & "CONST Basic = ARRAY OF BCEntry {\n";

  ClosingBoilerPlate = "\n   };\n\nEND ColorNameTable.\n";

PROCEDURE MakeRGB (r, g, b: INTEGER): RGB.T =
  (* Simply divide these by 255 to produce "true" RGB triples. An
     earlier, incorrect version did the inverse-gamma correction. *)
  PROCEDURE f (n: INTEGER): REAL =
    BEGIN
      RETURN FLOAT (FLOAT (n, LONGREAL) / 255.0d0)
    END f;
  BEGIN
    RETURN RGB.T {f (r), f (g), f (b)}
  END MakeRGB;

PROCEDURE PrintRGB (READONLY rgb: RGB.T): TEXT =
  PROCEDURE fmt (x: REAL): TEXT =
    BEGIN
      IF x = 0.0 THEN
        RETURN "0.0"
      ELSIF x = 1.0 THEN
        RETURN "1.0"
      ELSE
        RETURN Fmt.Real (x)
      END
    END fmt;
  BEGIN
    RETURN Fmt.F ("RGB.T {%s, %s, %s}", fmt (rgb [0]), fmt (rgb [1]),
                  fmt (rgb [2]))
  END PrintRGB;

PROCEDURE main () = 
VAR
  first                   := TRUE;
  r, g, b    : CARDINAL;
  name       : TEXT;
  lineNum                 := 0;
  pass2names : List.T     := NIL;
  rgb        : RGB.T;
  rgbRef     : REF RGB.T;

<* FATAL Thread.Alerted, Wr.Failure *>
(* That's only for the output to stderr. *)

BEGIN
  ColorNameF.table.clear ();
  ColorNameF.nameCache.table.clear ();
  TRY
    LOOP
      Lex.Skip (stdin);
      IF Rd.EOF (stdin) THEN EXIT END;
      r := Lex.Int (stdin);
      Lex.Skip (stdin);
      g := Lex.Int (stdin);
      Lex.Skip (stdin);
      b := Lex.Int (stdin);
      Lex.Skip (stdin);
      name := ColorNameF.NormalizeName (Rd.GetLine (stdin));
      rgb := MakeRGB (r, g, b);
      PROCEDURE f (base: TEXT): RGB.T RAISES {ColorName.NotFound} =
        VAR value: REFANY;
        BEGIN
          IF Text.Equal (base, name) THEN
            IF ColorNameF.nameCache.table.in (name, value) THEN
              rgbRef := value;
              IF rgbRef^ # rgb THEN
                (* BadRgb (rgb, rgbRef^, name);*)
                Wr.PutText (stderr, "Bad name: " & name & "\n");
                RETURN RGB.Undefined
              END
            ELSE
              rgbRef := NEW (REF RGB.T);
              rgbRef^ := rgb;
              EVAL ColorNameF.nameCache.table.put (name, rgbRef)
            END;
            EVAL ColorNameF.table.put (base, 0);
            RETURN rgb
          ELSE
            (* Wr.PutText (stderr, name & "\n"); *)
            List.Push (pass2names, name);
            RAISE ColorName.NotFound
          END
        END f;
      BEGIN
        TRY
          EVAL ColorNameF.LowerCaseToRGB (name, f)
        EXCEPT
        | ColorName.NotFound => (* ignore *)
        END
      END
    END;

    (* Pass2: now re-try all the pass2names to see whether they were simply
       modified versions of pass1 names. *)
    Wr.PutText (stderr, "; Starting pass 2...\n");
    PROCEDURE g (<* UNUSED *> base: TEXT): RGB.T RAISES {ColorName.NotFound} =
      BEGIN
        RAISE ColorName.NotFound
      END g;
    BEGIN
      WHILE pass2names # NIL DO
        name := List.Pop (pass2names);
        TRY
          EVAL ColorNameF.LowerCaseToRGB (name, g)
        EXCEPT
        | ColorName.NotFound => Wr.PutText (stderr, name & " ???\n")
        END
      END
    END;

    (* Pass3: Print results. *)
    PROCEDURE CompareCar (<* UNUSED *> arg: REFANY; item1, item2: REFANY):
      [-1 .. 1] =
      VAR
        l1: List.T := item1;
        l2: List.T := item2;
      BEGIN
        RETURN Text.Compare (l1.first, l2.first)
      END CompareCar;
    VAR
      alist         := ColorNameF.nameCache.table.toAssocList ();
      pair : List.T;
    BEGIN
      alist := List.SortD (alist, CompareCar);
      Wr.PutText (stdout, BoilerPlate);
      WHILE alist # NIL DO
        pair := List.Pop (alist);
        name := List.Pop (pair);
        rgbRef := pair.first;
        IF NOT first THEN Wr.PutText (stdout, ",\n") ELSE first := FALSE END;
        Wr.PutText (stdout, Fmt.F ("    BCEntry {\"%s\",", name));
        FOR i := 1 TO 20 - Text.Length (name) DO Wr.PutChar (stdout, ' ') END;
        Wr.PutText (stdout, PrintRGB (rgbRef^));
        Wr.PutChar (stdout, '}');
        INC (lineNum)
      END;
      Wr.PutText (stdout, ClosingBoilerPlate);
      Wr.Close (stdout);
      Wr.Close (stderr);
      Cstdlib.exit (0)
    END
  EXCEPT
  | Rd.EndOfFile =>
      Wr.PutText (
        stderr, "Premature end of input file on line " & Fmt.Int (lineNum))
  | Rd.Failure (ref) =>
      Wr.PutText (
        stderr, Fmt.F ("Read failure on line %s: %s", Fmt.Int (lineNum),
                       RdUtils.FailureText (ref)))
  | Convert.Failed, Lex.Error =>
      Wr.PutText (stderr, "Invalid number on line " & Fmt.Int (lineNum))
  | Wr.Failure (ref) =>
      Wr.PutText (
        stderr, Fmt.F ("Write failure on line %s: %s", Fmt.Int (lineNum),
                       RdUtils.FailureText (ref)))
  | Thread.Alerted =>
  END;
  Wr.PutChar (stderr, '\n');
  Cstdlib.exit (1)
  END main;

BEGIN main () END MakeBasicTable.