<*PRAGMA LL*>

MODULE Cursor;

IMPORT Palette, PlttFrnds, ScrnCursor, ScreenType, TrestleComm, Text;

PROCEDURE FromRaw (READONLY r: Raw): T =
  VAR rr := r;
  BEGIN
    FixRGB(rr.color1);
    FixRGB(rr.color2);
    FixRGB(rr.color3);
    LOCK PlttFrnds.con DO
      IF PlttFrnds.con.cursors # NIL THEN
        FOR i := 0 TO PlttFrnds.con.nextCursor - 1 DO
          TYPECASE PlttFrnds.con.cursors[i] OF
            NULL =>              (* skip *)
          | Closure (cl) => IF cl.raw = rr THEN RETURN T{i} END
          ELSE
          END
        END
      END
    END;
    RETURN Palette.FromCursorClosure(NEW(Closure, raw := rr))
  END FromRaw;

PROCEDURE FixRGB(VAR c: RGB) =

adjust c.gray so that it is in [0..1], and c.bw so that it is not UseIntensity.

  BEGIN
    IF c.gray < 0.0 THEN
      c.gray := MIN(1.0, MAX(0.0, 0.2390 * c.r + 0.6860 * c.g + 0.0750 * c.b))
    END;
    IF c.bw = BW.UseIntensity THEN
      IF c.r = 0.0 AND c.g = 0.0 AND c.b = 0.0 THEN
        c.bw := BW.UseFg
      ELSE
        c.bw := BW.UseBg
      END
    END
  END FixRGB;

TYPE Closure = Palette.CursorClosure OBJECT
    raw: Raw;
  OVERRIDES
    apply := Apply
  END;

PROCEDURE Apply(cl: Closure; st: ScreenType.T): ScrnCursor.T =
  BEGIN
    TRY
      RETURN st.cursor.load(cl.raw)
    EXCEPT
      TrestleComm.Failure => RETURN Palette.ResolveCursor(st, DontCare)
    END
  END Apply;

PROCEDURE FromName (READONLY names: ARRAY OF TEXT): T =
  VAR tl := NEW(REF ARRAY OF TEXT, NUMBER(names));
  BEGIN
    FOR i := 0 TO LAST(names) DO tl[i] := names[i] END;
    LOCK PlttFrnds.con DO
      IF PlttFrnds.con.cursors # NIL THEN
        FOR i := 0 TO PlttFrnds.con.nextCursor - 1 DO
          TYPECASE PlttFrnds.con.cursors[i] OF
            NULL =>              (* skip *)
          | NameClosure (cl) =>
              IF NUMBER(cl.names^) = NUMBER(tl^) THEN
                VAR match := TRUE;
                BEGIN
                  FOR j := 0 TO LAST(tl^) DO
                    match := match AND Text.Equal(cl.names[j], tl[j])
                  END;
                  IF match THEN RETURN T{i} END
                END
              END
          ELSE
          END
        END
      END
    END;
    RETURN Palette.FromCursorClosure(NEW(NameClosure, names := tl))
  END FromName;

TYPE NameClosure = Palette.CursorClosure OBJECT
    names: REF ARRAY OF TEXT;
  OVERRIDES
    apply := NameApply
  END;

PROCEDURE NameApply(cl: NameClosure; st: ScreenType.T): ScrnCursor.T =
  VAR res: ScrnCursor.T;
  BEGIN
    FOR i := FIRST(cl.names^) TO LAST(cl.names^) DO
      TRY
        res := st.cursor.lookup(cl.names[i]);
        IF res # NIL THEN RETURN res END;
      EXCEPT
        TrestleComm.Failure=> (*skip*)
      END
    END;
    RETURN Palette.ResolveCursor(st, DontCare)
  END NameApply;

 BEGIN END Cursor.