(* Copyright (C) 1992, Digital Equipment Corporation *)
(* All rights reserved. *)
(* See the file COPYRIGHT for a full description. *)
(* *)
(* by Steve Glassman, Mark Manasse and Greg Nelson *)
(* Last modified on Fri Nov  6 19:56:00 PST 1992 by msm    *)
(*      modified on Mon Feb 24 13:59:53 PST 1992 by muller *)
<*PRAGMA LL*>

UNSAFE MODULE XScrnPxmp;

IMPORT Ctypes, Palette, Pixmap, Point, Rect, ScrnPixmap, ScreenType,
       TrestleComm, Word, X, XClientF, XScreenType, XScrnTpRep, TrestleOnX,
       PaintPrivate;

REVEAL
  T = T_Pub BRANDED OBJECT
        copyGC := ARRAY BOOLEAN OF X.GC{NIL, NIL};
        (* copyGC[FALSE] is for initializing depth 1 pixmaps, copyGC[TRUE]
           is for initializing deep pixmaps. *)
        bestX, bestY := ARRAY BOOLEAN OF INTEGER{-1, ..};
        (* [FALSE] => stipple, [TRUE] => tile *)
        tileGC            := ARRAY BOOLEAN OF X.GC{NIL, ..};
        pmcount: CARDINAL := 0
        (* number of entries in pmtable *)
      END;

TYPE
  XPixmap = ScrnPixmap.T OBJECT
              st: XScreenType.T;
            OVERRIDES
              unload   := PixmapUnregister;
              localize := PixmapLocalize;
              free     := PixmapFree
            END;

  PixmapOracle = ScrnPixmap.Oracle OBJECT
                   st: XScreenType.T;
                 OVERRIDES
                   load    := PixmapRegister;
                   list    := PixmapList;
                   lookup  := PixmapLookup;
                   builtIn := PixmapBuiltIn
                 END;

PROCEDURE NewOracle (st: XScreenType.T): ScrnPixmap.Oracle =
  BEGIN
    RETURN NEW(PixmapOracle, st := st)
  END NewOracle;

PROCEDURE FromXPixmap (         st   : XScreenType.T;
                                xpm  : X.Pixmap;
                       READONLY dom  : Rect.T;
                                depth: INTEGER        ): ScrnPixmap.T =
  BEGIN
    RETURN NewPixmap(st, XScrnTpRep.PixmapRecord{
                           pixmap := xpm, domain := dom, depth := depth})
  END FromXPixmap;

PROCEDURE PixmapDomain (st: XScreenType.T; pmId: INTEGER): Rect.T =
  BEGIN
    IF pmId < 0 THEN
      IF pmId = XScrnTpRep.SolidPixmap THEN RETURN rawSolid.bounds END;
      pmId := XScrnTpRep.SolidPixmap - pmId;
      st := st.bits
    END;
    IF pmId < NUMBER(st.pmtable^) THEN
      RETURN st.pmtable[pmId].domain
    ELSE
      RETURN Rect.Empty
    END
  END PixmapDomain;

PROCEDURE NewPixmap (         st : XScreenType.T;
                     READONLY rec: XScrnTpRep.PixmapRecord): XPixmap
  <* LL.sup = st.trsl *> =
  VAR res := NEW(XPixmap, depth := rec.depth, bounds := rec.domain);
  BEGIN
    IF rec.depth = 1 THEN st := st.bits END;
    res.st := st;
    WITH n = NUMBER(st.pmtable^) DO
      IF n = st.pmcount THEN
        WITH new = NEW(REF ARRAY OF XScrnTpRep.PixmapRecord, 2 * n) DO
          FOR i := 0 TO n - 1 DO new[i] := st.pmtable[i] END;
          st.pmtable := new
        END
      END
    END;
    IF st.bits = st THEN
      res.id := XScrnTpRep.SolidPixmap - st.pmcount
    ELSE
      res.id := st.pmcount
    END;
    st.pmtable[st.pmcount] := rec;
    INC(st.pmcount);
    RETURN res
  END NewPixmap;

<*INLINE*> PROCEDURE XDestroyImage (xim: X.XImageStar) =
  BEGIN
    EVAL xim.f.destroy_image(xim)
  END XDestroyImage;

<*INLINE*> PROCEDURE XGetPixel (xim: X.XImageStar; x, y: Ctypes.Int):
  Ctypes.UnsignedLong =
  BEGIN
    RETURN xim.f.get_pixel(xim, x, y)
  END XGetPixel;

EXCEPTION FatalError;

<* FATAL FatalError *>

(* PixmapRegister, List, and Lookup must be changed to use the names. *)

PROCEDURE PixmapRegister (                    orc: PixmapOracle;
                                     READONLY pm : ScrnPixmap.Raw;
                          <*UNUSED*>          nm : TEXT             := NIL):
  ScrnPixmap.T RAISES {TrestleComm.Failure} =
  VAR rec: XScrnTpRep.PixmapRecord;
  BEGIN
    WITH st   = orc.st,
         trsl = st.trsl,
         dpy  = trsl.dpy DO
      TrestleOnX.Enter(trsl);
      TRY
        IF pm.depth # 1 AND pm.depth # st.depth THEN RAISE FatalError END;
        rec.domain := pm.bounds;
        rec.depth := pm.depth;
        rec.pixmap := PixmapFromRaw(st, pm);
        RETURN NewPixmap(st, rec)
      FINALLY
        TrestleOnX.Exit(trsl)
      END
    END
  END PixmapRegister;

PROCEDURE PixmapFromRaw (st: XScreenType.T; pm: ScrnPixmap.Raw): X.Pixmap
  RAISES {TrestleComm.Failure} <* LL.sup = st.trsl *> =
  VAR
    gcv: X.XGCValues;
    xim: X.XImageStar;
    res: X.Pixmap;
  BEGIN
    IF Rect.IsEmpty(pm.bounds) THEN RETURN X.None END;
    WITH dpy    = st.trsl.dpy,
         width  = Rect.HorSize(pm.bounds),
         height = Rect.VerSize(pm.bounds),
         depth  = pm.depth                 DO
      res := X.XCreatePixmap(dpy, st.root, width, height, depth);
      WITH deep = (depth # 1) DO
        IF st.copyGC[deep] = NIL THEN
          gcv.graphics_exposures := X.False;
          st.copyGC[deep] :=
            X.XCreateGC(dpy, res, X.GCGraphicsExposures, ADR(gcv))
        END;
        IF st.bestX[deep] = -1 THEN
          IF deep THEN
            EVAL X.XQueryBestTile(dpy, st.root, width, height,
                                  ADR(st.bestX[deep]), ADR(st.bestY[deep]))
          ELSE
            EVAL
              X.XQueryBestStipple(dpy, st.root, width, height,
                                  ADR(st.bestX[deep]), ADR(st.bestY[deep]))
          END
        END;
        xim := X.XCreateImage(
                 dpy, st.visual, depth, X.ZPixmap,
                 pm.bounds.west MOD (Word.Size DIV pm.bitsPerPixel),
                 ADR(pm.pixels[pm.offset]), width, height, Word.Size,
                 BYTESIZE(Word.T) * pm.wordsPerRow);
        TRY
          IF pm.pixelOrder = ScrnPixmap.ByteOrder.LSBFirst THEN
            xim.bitmap_bit_order := X.LSBFirst
          ELSE
            xim.bitmap_bit_order := X.MSBFirst
          END;
          IF PaintPrivate.HostByteOrder = PaintPrivate.ByteOrder.LSBFirst THEN
            xim.byte_order := X.LSBFirst
          ELSE
            xim.byte_order := X.MSBFirst
          END;
          xim.bitmap_unit := Word.Size;
          xim.bits_per_pixel := pm.bitsPerPixel;
          X.XPutImage(
            dpy, res, st.copyGC[deep], xim, 0, 0, 0, 0, width, height);
          IF width <= st.bestX[deep] AND height <= st.bestY[deep]
               AND (width # st.bestX[deep] OR height # st.bestY[deep])
               AND st.bestX[deep] MOD width = 0
               AND st.bestY[deep] MOD height = 0 THEN
            VAR
              tmp := X.XCreatePixmap(
                       dpy, st.root, st.bestX[deep], st.bestY[deep], depth);
            BEGIN
              IF st.tileGC[deep] = NIL THEN
                gcv.graphics_exposures := X.False;
                gcv.fill_style := X.FillTiled;
                st.tileGC[deep] := X.XCreateGC(dpy, tmp,
                                               X.GCGraphicsExposures
                                                 + X.GCFillStyle, ADR(gcv))
              END;
              X.XSetTile(dpy, st.tileGC[deep], res);
              X.XFreePixmap(dpy, res);
              res := tmp;
            END;
            X.XFillRectangle(dpy, res, st.tileGC[deep], 0, 0,
                             st.bestX[deep], st.bestY[deep])
          END
        FINALLY
          xim.data := NIL;
          XDestroyImage(xim)
        END
      END
    END;
    RETURN res
  END PixmapFromRaw;

PROCEDURE PixmapList (<*UNUSED*> orc       : PixmapOracle;
                      <*UNUSED*> pat       : TEXT;
                      <*UNUSED*> maxResults: CARDINAL       := 1):
  REF ARRAY OF TEXT RAISES {TrestleComm.Failure} =
  BEGIN
    RETURN NIL
  END PixmapList;

PROCEDURE PixmapLookup (<*UNUSED*> orc: PixmapOracle; <*UNUSED*> name: TEXT):
  ScrnPixmap.T RAISES {TrestleComm.Failure} =
  BEGIN
    RETURN NIL
  END PixmapLookup;

PROCEDURE PixmapBuiltIn (orc: PixmapOracle; pm: Pixmap.Predefined):
  ScrnPixmap.T =
  VAR res: ScrnPixmap.T;
  BEGIN
    IF orc.st.bits # orc.st THEN
      res := Palette.ResolvePixmap(orc.st.bits, Pixmap.T{pm});
      IF pm = Pixmap.Empty.pm THEN orc.st.empty := res.id END;
      RETURN res
    END;
    TRY
      CASE pm OF
        Pixmap.Solid.pm =>
          WITH res = PixmapRegister(orc, rawSolid) DO
            res.id := XScrnTpRep.SolidPixmap;
            RETURN res
          END
      | Pixmap.Gray.pm => RETURN PixmapRegister(orc, rawGray)
      | Pixmap.Empty.pm =>
          res := PixmapRegister(orc, rawEmpty);
          orc.st.empty := res.id;
          RETURN res
      ELSE
        RAISE FatalError
      END
    EXCEPT
      TrestleComm.Failure =>
        RETURN NEW(XPixmap, id := 0, depth := 1, bounds := Rect.Empty)
    END
  END PixmapBuiltIn;

PROCEDURE PixmapLocalize (pm: XPixmap; READONLY rect: Rect.T):
  ScrnPixmap.Raw RAISES {TrestleComm.Failure} =
  VAR
    res: ScrnPixmap.Raw;
    id                  := pm.id;
  BEGIN
    IF id = XScrnTpRep.SolidPixmap THEN RETURN rawSolid END;
    WITH r      = Rect.Meet(rect, pm.bounds),
         st     = pm.st,
         trsl   = st.trsl,
         dpy    = trsl.dpy,
         width  = Rect.HorSize(r),
         height = Rect.VerSize(r)             DO
      IF Rect.IsEmpty(r) THEN RETURN NIL END;
      IF id < 0 THEN id := XScrnTpRep.SolidPixmap - id END;
      TrestleOnX.Enter(trsl);
      TRY
        WITH xim = X.XGetImage(
                     dpy, st.pmtable[id].pixmap, r.west - pm.bounds.west,
                     r.north - pm.bounds.north, width, height, -1,
                     X.ZPixmap) DO
          res := ScrnPixmap.NewRaw(xim.depth, r);
          FOR v := r.north TO r.south - 1 DO
            FOR h := r.west TO r.east - 1 DO
              res.set(
                Point.T{h, v}, XGetPixel(xim, h - r.west, v - r.north))
            END
          END;
          XDestroyImage(xim)
        END
      FINALLY
        TrestleOnX.Exit(trsl)
      END
    END;
    RETURN res
  END PixmapLocalize;

PROCEDURE PixmapUnregister (<*UNUSED*> pm: ScrnPixmap.T)
  RAISES {TrestleComm.Failure} =
  BEGIN
  END PixmapUnregister;

PROCEDURE PixmapFree (pm: XPixmap) RAISES {TrestleComm.Failure} =
  VAR
    id   := pm.id;
    st   := pm.st;
    trsl := st.trsl;
    dpy  := trsl.dpy;
  BEGIN
    IF id = XScrnTpRep.SolidPixmap THEN RETURN END;
    IF id < 0 THEN id := XScrnTpRep.SolidPixmap - id END;
    TrestleOnX.Enter(trsl);
    TRY
      WITH xpm = st.pmtable[id].pixmap DO
        IF xpm # X.None THEN X.XFreePixmap(dpy, xpm) END;
        xpm := X.None
      END
    FINALLY
      TrestleOnX.Exit(trsl)
    END
  END PixmapFree;

VAR rawSolid, rawGray, rawEmpty: ScrnPixmap.Raw;

BEGIN 
  rawSolid := ScrnPixmap.NewRaw(1, Rect.FromSize(1, 1));
  rawSolid.pixels[rawSolid.offset] := -1;
  rawEmpty := ScrnPixmap.NewRaw(1, Rect.FromSize(1, 1));
  rawEmpty.pixels[rawEmpty.offset] := 0;
  rawGray := ScrnPixmap.NewRaw(1, Rect.FromSize(2, 2));
  rawGray.pixels[rawGray.offset] := 16_55555555;
  rawGray.pixels[rawGray.offset + rawGray.wordsPerRow] :=
    Word.Not(16_55555555);
END XScrnPxmp.