(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* by Steve Glassman, Mark Manasse and Greg Nelson           *)
(* Last modified on Tue Mar 10 19:04:56 1992 by steveg   *)
(*      modified on Mon Feb 24 13:57:21 PST 1992 by muller   *)
(*      modified on Sat Nov  2 17:20:48 PST 1991 by gnelson  *)
(*      modified on Wed Sep 11 15:23:00 PDT 1991 by msm      *)
<*PRAGMA LL*>

MODULE PaintOp;

IMPORT Palette, VBT, ScrnPaintOp, ScreenType, ScrnColorMap, 
  TrestleComm;

TYPE RGBClosure = Palette.OpClosure OBJECT
    rgb: ScrnColorMap.RGB;
    mode: Mode;
    gray: REAL;
    bw: BW
  OVERRIDES
    apply := RGBApply
  END;

PROCEDURE FromRGB(
   r, g, b: REAL; 
   mode := Mode.Normal;
   gray := -1.0;
   bw := BW.UseIntensity): T =
  BEGIN
    IF gray < 0.0 THEN
      gray := MIN(1.0, MAX(0.0, 0.2390 * r + 0.6860 * g + 0.0750 * b))
    END;
    IF bw = BW.UseIntensity THEN
      IF r = 0.0 AND g = 0.0 AND b = 0.0 THEN
        bw := BW.UseFg
      ELSE
        bw := BW.UseBg
      END
    END;
    RETURN Palette.FromOpClosure(
      NEW(RGBClosure, rgb := ScrnColorMap.RGB{r,g,b}, mode := mode,
        gray := gray, bw := bw))
  END FromRGB;

PROCEDURE RGBApply(cl: RGBClosure; st: VBT.ScreenType): ScrnPaintOp.T =
<*FATAL ScrnPaintOp.Failure*>
  BEGIN
    TRY
      IF st.cmap # NIL AND st.depth # 1 THEN
        VAR rgb := cl.rgb; gray := cl.gray; pix: ScrnColorMap.Pixel; BEGIN
          IF NOT st.color THEN 
            rgb := ScrnColorMap.RGB{gray, gray, gray}
          END;
          TRY
            pix := st.cmap.standard().fromRGB(rgb, cl.mode)
          EXCEPT
            ScrnColorMap.Failure =>
              TRY
                pix := st.cmap.standard().fromRGB(rgb, Mode.Normal)
              EXCEPT
                ScrnColorMap.Failure => 
                  RETURN Palette.ResolveOp(st, Bg)
              END
          END;
          RETURN st.op.opaque(pix)
        END
      ELSE
        IF cl.bw = BW.UseBg THEN
          RETURN Palette.ResolveOp(st, Bg)
        ELSE
          RETURN Palette.ResolveOp(st, Fg)
        END
      END
    EXCEPT
      TrestleComm.Failure => RETURN Palette.ResolveOp(st, Fg)
    END;
  END RGBApply;
        
TYPE 
  PairClosure = Palette.OpClosure OBJECT
    op0, op1: T
  OVERRIDES
    apply := ApplyPair
  END;

PROCEDURE Pair(op0, op1: T): T =
  BEGIN
    RETURN Palette.FromOpClosure(NEW(PairClosure, op0 := op0, op1 := op1)) 
  END Pair;

PROCEDURE ApplyPair(cl: PairClosure; st: VBT.ScreenType): ScrnPaintOp.T =
  VAR sop0 := Palette.ResolveOp(st, cl.op0); 
    sop1 := Palette.ResolveOp(st, cl.op1);
  BEGIN
    TRY
      RETURN st.op.bgfg(sop0, sop1)
    EXCEPT
      ScrnPaintOp.Failure, TrestleComm.Failure => 
        RETURN Palette.ResolveOp(st, Transparent)
    END
  END ApplyPair;
  
TYPE SwapClosure = Palette.OpClosure OBJECT
    fg, bg: T;
  OVERRIDES
    apply := ApplySwap
  END;

PROCEDURE ApplySwap(cl: SwapClosure; st: VBT.ScreenType): ScrnPaintOp.T =
  VAR 
    fg := Palette.ResolveOp(st, cl.fg).pix; 
    bg := Palette.ResolveOp(st, cl.bg).pix;
  BEGIN
    IF fg = -1 OR bg = -1 OR bg = fg THEN 
      RETURN Palette.ResolveOp(st, Transparent)
    ELSE
      TRY
        RETURN st.op.swap(bg, fg)
      EXCEPT
        ScrnPaintOp.Failure, TrestleComm.Failure => 
          RETURN Palette.ResolveOp(st, Transparent)
      END
    END
  END ApplySwap;

PROCEDURE SwapPair(bg, fg: T): T =
  BEGIN
    RETURN Palette.FromOpClosure(NEW(SwapClosure, fg := fg, bg := bg));
  END SwapPair;

PROCEDURE MakeColorScheme(bg, fg: T): ColorScheme RAISES {} =
  VAR res:= NEW(ColorScheme); BEGIN
    res.bg := bg;
    res.fg := fg;
    res.bgFg := Pair(bg, fg);
    res.transparentFg := Pair(Transparent, fg);
    res.swap := SwapPair(bg, fg);
    res.bgTransparent := Pair(bg, Transparent);
    res.bgSwap := Pair(bg, res.swap);
    res.fgBg := Pair(fg, bg);
    res.fgTransparent := Pair(fg, Transparent);
    res.fgSwap := Pair(fg, res.swap);
    res.transparentBg := Pair(Transparent, bg);
    res.transparentSwap := Pair(Transparent, res.swap);
    res.swapBg := Pair(res.swap, bg);
    res.swapFg := Pair(res.swap, fg);
    res.swapTransparent := Pair(res.swap, Transparent);
    RETURN res
  END MakeColorScheme;

PROCEDURE MakeColorQuad(bg, fg: T): ColorQuad RAISES {} =
  VAR res:= NEW(ColorQuad); BEGIN
    res.bg := bg;
    res.fg := fg;
    res.bgFg := Pair(bg, fg);
    res.transparentFg := Pair(Transparent, fg);
    RETURN res
  END MakeColorQuad;

BEGIN
  bgFg := NEW(ColorScheme, bgFg := BgFg, bg := Bg, fg := Fg,
    transparentFg := TransparentFg, swap:= Swap, bgTransparent :=
    BgTransparent, bgSwap := BgSwap, fgBg := FgBg, fgTransparent :=
    FgTransparent, fgSwap := FgSwap, transparentBg := TransparentBg,
    transparentSwap := TransparentSwap, swapBg := SwapBg, swapFg :=
    SwapFg, swapTransparent := SwapTransparent)
END PaintOp.