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

(* Created by stolfi on Mon Jun  6 20:44:08 PDT 1988           *)
(* Last modified on Tue Feb 11 21:39:42 PST 1992 by muller     *)
(*      modified on Thu Oct 25  0:16:01 PDT 1990 by stolfi     *)

MODULE RGB;

FROM RGBCIE IMPORT
  rY, gY, bY;

PROCEDURE R (READONLY c: T): REAL =
  BEGIN
    RETURN c[0]
  END R;

PROCEDURE G (READONLY c: T): REAL =
  BEGIN
    RETURN c[1]
  END G;

PROCEDURE B (READONLY c: T): REAL =
  BEGIN
    RETURN c[2]
  END B;

PROCEDURE New (value: T): REF T =
  VAR r: REF T;
  BEGIN
    r := NEW(REF T);
    r^ := value;
    RETURN r
  END New;

PROCEDURE NewArray (size: CARDINAL; value: T): REF ARRAY OF T =
  VAR arr: REF ARRAY OF T;
  BEGIN
    arr := NEW(REF ARRAY OF T, size);
    FOR i := 0 TO size - 1 DO arr[i] := value END;
    RETURN arr
  END NewArray;

PROCEDURE Brightness (READONLY c: T): REAL =
  BEGIN
    RETURN c[0] * rY + c[1] * gY + c[2] * bY
  END Brightness;

PROCEDURE Gray (y: REAL): T =
  BEGIN
    RETURN T{y, y, y}
  END Gray;

PROCEDURE Grey (y: REAL): T =
  BEGIN
    RETURN T{y, y, y}
  END Grey;

(**********************************************************)
(*                                                        *)
(* COLOR OPERATIONS                                       *)
(*                                                        *)
(**********************************************************)

PROCEDURE Add (READONLY a, b: T): T =
  BEGIN
    RETURN T{
      a[0] + b[0],
      a[1] + b[1],
      a[2] + b[2]
    }
  END Add;

PROCEDURE Sub (READONLY a, b: T): T =
  BEGIN
    RETURN T{
      a[0] - b[0],
      a[1] - b[1],
      a[2] - b[2]
    }
  END Sub;

PROCEDURE Scale (alpha: REAL; READONLY a: T): T =
  BEGIN
    RETURN T{
      alpha * a[0],
      alpha * a[1],
      alpha * a[2]
    }
  END Scale;

PROCEDURE Weigh (READONLY a, b: T): T =
  BEGIN
    RETURN T{
      a[0] * b[0],
      a[1] * b[1],
      a[2] * b[2]
    }
  END Weigh;

PROCEDURE Mix(a: T; alpha: REAL; b: T; beta: REAL): T =
  BEGIN
    RETURN T{
      alpha * a[0] + beta * b[0],
      alpha * a[1] + beta * b[1],
      alpha * a[2] + beta * b[2]
    }
  END Mix;

PROCEDURE Interpolate (a: T; alpha: REAL; b: T; beta: REAL): T =
  VAR w: REAL;
  BEGIN
    w := alpha + beta;
    alpha := alpha / w;
    beta := beta / w;
    RETURN T{
      alpha * a[0] + beta * b[0],
      alpha * a[1] + beta * b[1],
      alpha * a[2] + beta * b[2]
    }
  END Interpolate;

PROCEDURE Clip (a: T): T =
  VAR d, c: T; y, s: REAL;
  BEGIN
    y := Brightness(a);
    d := Sub(a, Grey(y));
    c := Grey(MIN(1.0, MAX(0.0, y)));
    s := MaxStep(c, d);
    RETURN T{
      c[0] + s * d[0],
      c[1] + s * d[1],
      c[2] + s * d[2]
    }
  END Clip;

PROCEDURE MaxStep (READONLY p, d: T): REAL =
  VAR c: REAL;
  BEGIN
    c := 100000.0;
    IF d[0] <  -0.000001 THEN c := MIN(c, (0.0 - p[0]) / d[0]) END;
    IF d[0] >   0.000001 THEN c := MIN(c, (1.0 - p[0]) / d[0]) END;
    IF d[1] <  -0.000001 THEN c := MIN(c, (0.0 - p[1]) / d[1]) END;
    IF d[1] >   0.000001 THEN c := MIN(c, (1.0 - p[1]) / d[1]) END;
    IF d[2] <  -0.000001 THEN c := MIN(c, (0.0 - p[2]) / d[2]) END;
    IF d[2] >   0.000001 THEN c := MIN(c, (1.0 - p[2]) / d[2]) END;
    RETURN c
  END MaxStep;

BEGIN
END RGB.