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.