<*PRAGMA LL*>

MODULE PaintOp;

IMPORT Palette, PlttFrnds, 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 =
  VAR rgb := ScrnColorMap.RGB{r, g, b};
  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;
    LOCK PlttFrnds.con DO
      IF PlttFrnds.con.ops # NIL THEN
        FOR i := 0 TO PlttFrnds.con.nextOp - 1 DO
          TYPECASE PlttFrnds.con.ops[i] OF
            NULL =>              (* skip *)
          | RGBClosure (op) =>
              IF op.rgb = rgb AND op.mode = mode AND op.gray = gray
                   AND op.bw = bw THEN
                RETURN T{i}
              END
          ELSE
          END
        END
      END
    END;
    RETURN Palette.FromOpClosure(NEW(RGBClosure, rgb := rgb, 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 =>
                  IF cl.bw = BW.UseBg THEN
                    RETURN Palette.ResolveOp(st, Bg)
                  ELSE
                    RETURN Palette.ResolveOp(st, Fg)
                  END
              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
    LOCK PlttFrnds.con DO
      IF PlttFrnds.con.ops # NIL THEN
        FOR i := 0 TO PlttFrnds.con.nextOp - 1 DO
          TYPECASE PlttFrnds.con.ops[i] OF
            NULL =>              (* skip *)
          | PairClosure (cl) =>
              IF cl.op0 = op0 AND cl.op1 = op1 THEN RETURN T{i} END
          ELSE
          END
        END
      END
    END;
    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
    LOCK PlttFrnds.con DO
      IF PlttFrnds.con.ops # NIL THEN
        FOR i := 0 TO PlttFrnds.con.nextOp - 1 DO
          TYPECASE PlttFrnds.con.ops[i] OF
            NULL =>              (* skip *)
          | SwapClosure (cl) =>
              IF cl.fg = fg AND cl.bg = bg THEN RETURN T{i} END
          ELSE
          END
        END
      END
    END;
    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.