MODULE; IMPORT IntRefTbl, Palette, PaintOp, PlttFrnds, ScrnColorMap, ScrnPaintOp, TrestleComm, VBT, VBTRep; TYPE Closure = Palette.OpClosure OBJECT rgb: RGB; OVERRIDES apply := Apply; END; VAR mu := NEW(MUTEX); (* protects table *) table := NEW(IntRefTbl.Default).init(); PROCEDURE MGPaintOp New (rgb: RGB): PaintOp.T = VAR cl := NEW(Closure, rgb := rgb); op := Palette.FromOpClosure(cl); BEGIN LOCK mu DO EVAL table.put(op.op, cl); END; RETURN op END New; PROCEDURERGBTo24BitPixel (rgb: RGB): INTEGER = BEGIN RETURN ROUND(rgb.r * 255.0) * 256 * 256 + ROUND(rgb.g * 255.0) * 256 + ROUND(rgb.b * 255.0) END RGBTo24BitPixel; <* FATAL TrestleComm.Failure, ScrnPaintOp.Failure *> PROCEDUREApply (cl: Closure; st: VBT.ScreenType): ScrnPaintOp.T = VAR cmap: ScrnColorMap.T; pix : INTEGER; t : ScrnPaintOp.T; BEGIN IF st.depth = 24 THEN t := st.op.opaque(RGBTo24BitPixel(cl.rgb)); ELSIF st.cmap = NIL THEN t := st.op.opaque(1); ELSE TRY cmap := st.cmap.standard(); pix := cmap.new(1).lo; EXCEPT | ScrnColorMap.Failure => RETURN st.op.opaque(1); END; t := st.op.opaque(pix); TRY cmap.write(ARRAY [0 .. 0] OF ScrnColorMap.Entry{ScrnColorMap.Entry{pix, cl.rgb}}); EXCEPT | ScrnColorMap.Failure => END; END; RETURN t END Apply; PROCEDURESet (st: VBT.ScreenType; op: PaintOp.T; rgb: RGB) = VAR cl: Closure; ra: REFANY; BEGIN LOCK mu DO EVAL table.get(op.op, ra); cl := NARROW(ra, Closure); END; cl.rgb := rgb; IF st.depth = 24 THEN
VAR po := st.ops[op.op]; BEGIN po.pix := RGBTo24BitPixel(rgb); END;
    ELSE
      IF st.cmap # NIL THEN
        VAR
          cmap := st.cmap.standard();
          po   := st.ops[op.op];
        BEGIN
          IF po = NIL OR po = PlttFrnds.noOp THEN
            po := Palette.ResolveOp(st, op)
          END;
          TRY
            cmap.write(
              ARRAY [0 .. 0] OF
                ScrnColorMap.Entry{ScrnColorMap.Entry{po.pix, rgb}});
          EXCEPT
          | ScrnColorMap.Failure =>
          END;
        END;
      END;
    END;
  END Set;
PROCEDURE Get  (op: PaintOp.T): RGB =
  VAR
    ra: REFANY;
  BEGIN
    LOCK mu DO
      EVAL table.get(op.op, ra);
      RETURN NARROW(ra, Closure).rgb;
    END;
  END Get;
BEGIN
END MGPaintOp.