(* Copyright (C) 1990, Digital Equipment Corporation.         *)
(* All rights reserved.                                       *)
(* See the file COPYRIGHT for a full description.             *)

(* Last modified on Tue Oct 27 16:48:10 PST 1992 by steveg   *)

MODULE VBTSnap;

IMPORT Axis, Cursor, Filter, Image, Pixmap, Pkl, Point, Rd, Rect, Region,
       RigidVBT, Scale, ScrnPixmap, Split, TextRd, TextWr, Thread, Trestle,
       TrestleComm, VBT, VBTClass, VBTRep, Wr;

<* FATAL Wr.Failure, Thread.Alerted, Pkl.Error, Rd.Failure *>

PROCEDURE Photo (v: VBT.T; width, height: REAL): Image.T =
  VAR
    trsl                 := Trestle.ScreenOf(v, Point.Origin).trsl;
    st                   := VBT.ScreenTypeOf(v);
    parent               := v.parent;
    pred  : VBT.T;
    pm    : ScrnPixmap.T;
    br    : Region.T;
    res   : Image.T;
  <* FATAL TrestleComm.Failure, Split.NotAChild *>
  BEGIN
    IF trsl = NIL OR st = NIL THEN RETURN Pixmap.Solid END;
    TYPECASE parent OF
    | NULL =>
    | Filter.T (f) => EVAL Filter.Replace(f, NIL);
    | Split.T (s) => pred := Split.Pred(s, v); Split.Delete(s, v);
    END;

    TRY
      WITH filter = NEW(Filter.T).init(v),
           scale  = NEW(Scale.T).init(filter),
           srH    = RigidVBT.SizeRange{width, width, width},
           srV    = RigidVBT.SizeRange{height, height, height},
           off    = NEW(RigidVBT.T).init(scale, RigidVBT.Shape{srH, srV}) DO
        Trestle.Attach(off, trsl);
        Trestle.InstallOffscreen(
          off, ROUND(VBT.MMToPixels(parent, width, Axis.T.Hor)),
          ROUND(VBT.MMToPixels(parent, height, Axis.T.Ver)), st);
        pm := VBT.Capture(v, v.domain, br);
        EVAL Filter.Replace(filter, NIL);
        Trestle.Delete(off);
        VBT.Discard(off);
      END;

      TYPECASE parent OF
      | NULL =>
      | Filter.T (f) => EVAL Filter.Replace(f, v);
      | Split.T (s) => Split.Insert(s, pred, v);
      END;

      TRY
        res := Image.Unscaled(Image.FromScrnPixmap(pm, st));
      EXCEPT
      | TrestleComm.Failure => RETURN Pixmap.Solid
      END;
      RETURN res;
    FINALLY
      IF pm # NIL THEN pm.free() END;
    END
  END Photo;

<* UNUSED *> PROCEDURE Clone (v: VBT.Leaf): VBT.Leaf =
  VAR
    wr       := TextWr.New();
    rd: Rd.T;
  BEGIN
    Pkl.Write(v, wr);
    rd := TextRd.New(TextWr.ToText(wr));
    RETURN Pkl.Read(rd)
  END Clone;

PROCEDURE Writer(ra: REFANY) =
  VAR v: VBT.T := ra;
  BEGIN
    v.parent := NIL;
    v.upRef := NIL;
    v.domain := Rect.Empty;
    v.st := NIL;
    v.cursor := Cursor.DontCare;
    v.cageType := VBTClass.VBTCageType.Gone;
    v.props := VBTRep.NoProps;
    v.batch := NIL;
    v.remaining := 0; 
    v.propset:= NIL;
    v.miscRef := NIL;
  END Writer;

PROCEDURE Reader(<* UNUSED *> ra: REFANY) =
  BEGIN
  END Reader;

BEGIN
  Pkl.RegisterConvertProcs(TYPECODE(VBT.T), Writer, Reader);
END VBTSnap.