MODULE HostBitmaps;
(**

   project   = "BlackBox"
   organization   = "www.oberon.ch"
   contributors   = "Oberon microsystems"
   version   = "System/Rsrc/About"
   copyright   = "System/Rsrc/About"
   license   = "Docu/BB-License"
   changes   = ""
   issues   = ""

**)

   IMPORT

      SYSTEM, WinApi, WinOle,
      Files, Fonts, Ports, Stores, Models, Views, Controllers, Containers, Properties, Dialog, Converters,
      HostPorts, HostWindows;
   CONST

      minVersion = 0; maxVersion = 1;
   TYPE

      Model = POINTER TO RECORD
         file: Files.File;
         pos, len: INTEGER;
         ref: WinApi.HBITMAP
      END;
      StdView = POINTER TO RECORD (Views.View)

         model: Model;
         w, h: INTEGER;   (* in pixels *)
         bits: INTEGER;   (* bit per pixel *)
      END;
      
      BITMAPINFO8 = RECORD [untagged]
         header: WinApi.BITMAPINFOHEADER;
         colors: ARRAY 256 OF INTEGER
      END;
      
      RootContext = POINTER TO RECORD (Models.Context)
         w, h: INTEGER
      END;
      
      RootView = POINTER TO RECORD (Views.View)
         view: Views.View;
      END;
      
   
   (* helpers for painting to bitmap *)   
   
   PROCEDURE (c: RootContext) ThisModel (): Models.Model;
   BEGIN
      RETURN NIL
   END ThisModel;
   PROCEDURE (c: RootContext) GetSize (OUT w, h: INTEGER);

   BEGIN
      w := c.w; h := c.h
   END GetSize;
      
   PROCEDURE (c: RootContext) Normalize (): BOOLEAN;
   BEGIN
      RETURN TRUE
   END Normalize;
   
   PROCEDURE (d: RootView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
   BEGIN
      Views.InstallFrame(f, d.view, 0, 0, 0, FALSE)
   END Restore;
   
   PROCEDURE (d: RootView) GetNewFrame (VAR frame: Views.Frame);
      VAR f: Views.RootFrame;
   BEGIN
      NEW(f); frame := f
   END GetNewFrame;
   PROCEDURE (d: RootView) GetBackground (VAR color: Ports.Color);

   BEGIN
      color := Ports.background
   END GetBackground;
   
   PROCEDURE Paint (dc: WinApi.HDC; v: Views.View; w, h, unit: INTEGER);
      VAR d: RootView; c: RootContext; p: HostPorts.Port; f: Views.RootFrame; g: Views.Frame;
   BEGIN
      NEW(p);
      p.Init(unit, Ports.screen);
      p.SetSize(w, h);
      p.SetDC(dc, 0);
      NEW(c);
      c.w := w * p.unit;
      c.h := h * p.unit;
      NEW(d);
      d.view := Views.CopyOf(v, Views.shallow);
      Stores.Join(d, d.view);
      d.InitContext(c);
      d.view.InitContext(c);
      Stores.InitDomain(d);
      d.GetNewFrame(g); f := g(Views.RootFrame); f.ConnectTo(p);
      Views.SetRoot(f, d, FALSE, {});
      Views.AdaptRoot(f);
      Views.RestoreRoot(f, 0, 0, c.w, c.h);
   END Paint;
   
   

   PROCEDURE GetHeader (v: StdView; OUT hdr: WinApi.BITMAPINFOHEADER; OUT colors: INTEGER);
   BEGIN
      hdr.biSize := SIZE(WinApi.BITMAPINFOHEADER);
      hdr.biWidth := v.w;
      hdr.biHeight := v.h;
      hdr.biPlanes := 1;
      hdr.biBitCount := SHORT(v.bits);
      IF v.bits = 8 THEN   (* use 8 bit & run length encoding *)
         hdr.biCompression := WinApi.BI_RLE8;
         colors := 256
      ELSIF v.bits = 24 THEN   (* use 24 bit true color *)
         hdr.biCompression := WinApi.BI_RGB;
         colors := 0
      ELSIF v.bits = 0 THEN   (* use jpeg *)
         hdr.biCompression := 4 (* WinApi.BI_JPEG *);
         colors := 0
      ELSE
         HALT(100)   (* unsupported format *)
      END;
      hdr.biSizeImage := 0;
      hdr.biXPelsPerMeter := 0;
      hdr.biYPelsPerMeter := 0;
      hdr.biClrUsed := 0;
      hdr.biClrImportant := 0
   END GetHeader;
   
   PROCEDURE Evaluate (v: StdView; dc: WinApi.HDC);
      VAR len, adr, res, colors, i: INTEGER;
         rd: Stores.Reader; info: BITMAPINFO8; data: POINTER TO ARRAY OF BYTE;
   BEGIN
      rd.ConnectTo(v.model.file);
      rd.SetPos(v.model.pos);
      len := v.model.len;
      GetHeader(v, info.header, colors);
      i := 0; WHILE i < colors DO rd.ReadInt(info.colors[i]); INC(i); DEC(len, 4) END;
      NEW(data, len);
      rd.rider.ReadBytes(data^, 0, len);
      v.model.ref := WinApi.CreateCompatibleBitmap(dc, v.w, v.h);
      info.header.biSizeImage := len;
      res := WinApi.SetDIBits(dc, v.model.ref, 0, v.h, SYSTEM.ADR(data[0]),
         SYSTEM.VAL(WinApi.BITMAPINFO, info), WinApi.DIB_RGB_COLORS);
      IF res = 0 THEN
         res := WinApi.GetLastError();
         IF res = WinApi.ERROR_NOT_ENOUGH_MEMORY THEN HALT(101) ELSE HALT(100) END
      END;
      ASSERT(v.model.ref # 0, 102)
   END Evaluate;
   (* Model *)


   
   PROCEDURE (m: Model) FINALIZE;
      VAR res: INTEGER;
   BEGIN
      IF m.ref # 0 THEN
         res := WinApi.DeleteObject(m.ref);
         m.ref := 0
      END
   END FINALIZE;
   
   (* View *)

   PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);

      VAR m: Model; thisVersion: INTEGER;
   BEGIN
      v.Internalize^(rd);
      IF rd.cancelled THEN RETURN END;
      rd.ReadVersion(minVersion, maxVersion, thisVersion);
      IF rd.cancelled THEN RETURN END;
      rd.ReadInt(v.w);
      rd.ReadInt(v.h);
      IF thisVersion > 0 THEN rd.ReadInt(v.bits) ELSE v.bits := 24 END;
      NEW(m); m.file := rd.rider.Base();
      rd.ReadInt(m.len);
      m.pos := rd.Pos();
      m.ref := 0;   (* lazy allocation of bitmap data *)
      v.model := m;
      rd.SetPos(m.pos + m.len)
   END Internalize;
   PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);

      VAR len, res, colors, i: INTEGER;
         r: Files.Reader; b: BYTE; info: BITMAPINFO8; data: POINTER TO ARRAY OF BYTE;
   BEGIN
      v.Externalize^(wr);
      wr.WriteVersion(maxVersion);
      wr.WriteInt(v.w);
      wr.WriteInt(v.h);
      wr.WriteInt(v.bits);
      IF v.model.file # NIL THEN
         len := v.model.len;
         wr.WriteInt(len);
         r := v.model.file.NewReader(NIL); r.SetPos(v.model.pos);
         WHILE len # 0 DO r.ReadByte(b); wr.WriteSChar(SHORT(CHR(b))); DEC(len) END
      ELSE
         ASSERT(v.model.ref # 0, 100);
         GetHeader(v, info.header, colors);
         res := WinApi.GetDIBits(WinApi.GetDC(HostWindows.main), v.model.ref, 0, v.h, 0,
            SYSTEM.VAL(WinApi.BITMAPINFO, info), WinApi.DIB_RGB_COLORS);
         IF res = 0 THEN res := WinApi.GetLastError(); HALT(100) END;
         len := info.header.biSizeImage;
         NEW(data, len);
         res := WinApi.GetDIBits(WinApi.GetDC(HostWindows.main), v.model.ref, 0, v.h,
            SYSTEM.ADR(data[0]),
            SYSTEM.VAL(WinApi.BITMAPINFO, info), WinApi.DIB_RGB_COLORS);
         IF res = 0 THEN res := WinApi.GetLastError(); HALT(100) END;
         INC(len, 4 * colors);
         wr.WriteInt(len);
         i := 0; WHILE i < colors DO wr.WriteInt(info.colors[i]); INC(i) END;
         wr.rider.WriteBytes(data^, 0, LEN(data));
         v.model.len := len
      END;
   END Externalize;
   PROCEDURE (v: StdView) CopyFromSimpleView (source: Views.View);

   BEGIN
      WITH source: StdView DO
         v.model := source.model;
         v.w := source.w;
         v.h := source.h;
         v.bits := source.bits;
      END
   END CopyFromSimpleView;
   PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);

      VAR rd: HostPorts.Rider; res, w, h: INTEGER; dc, pdc, bdc, bdc1: WinApi.HDC; memBM: WinApi.HBITMAP;
   BEGIN
      ASSERT(v.model # NIL, 20);
      v.context.GetSize(w, h);
      dc := f.rider(HostPorts.Rider).port.homedc;
      IF WinApi.WindowFromDC(dc) = 0 THEN dc := WinApi.GetDC(HostWindows.main) END;
      IF v.model.ref = 0 THEN Evaluate(v, dc) END;
      IF Views.IsPrinterFrame(f) THEN (* need to make a print copy of the existing bitmap *)
         bdc1 := WinApi.CreateCompatibleDC(dc);
         res := WinApi.SelectObject(bdc1, v.model.ref);
         pdc := f.rider(HostPorts.Rider).port.dc;
         bdc := WinApi.CreateCompatibleDC(pdc);
         memBM := WinApi.CreateCompatibleBitmap(pdc, v.w, v.h);
         res := WinApi.SelectObject(bdc, memBM);
         res := WinApi.BitBlt(bdc, 0, 0, v.w, v.h, bdc1, 0, 0, 00CC0020H);   (* copy *)
         res := WinApi.DeleteDC(bdc1)
      ELSE
         bdc := WinApi.CreateCompatibleDC(dc);
         res := WinApi.SelectObject(bdc, v.model.ref)
      END;
      f.rider(HostPorts.Rider).DrawBitmap(bdc, v.w, v.h, f.gx, f.gy, w, h);
      res := WinApi.DeleteDC(bdc)
   END Restore;
   PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);

   BEGIN
      WITH msg: Properties.SizePref DO
         IF (msg.w > Views.undefined) & (msg.h > Views.undefined) THEN
            Properties.ProportionalConstraint(v.w, v.h, msg.fixedW, msg.fixedH, msg.w, msg.h)
         ELSE
            IF (v.w > 0) & (v.h > 0) THEN   (* default sizes *)
               msg.w := v.w * HostWindows.unit; msg.h := v.h * HostWindows.unit
            END
         END
      ELSE
      END
   END HandlePropMsg;
   
   PROCEDURE TurnToBitmap* (bits: INTEGER);

      VAR v: Views.View; f: Views.Frame; rd: HostPorts.Rider; dc, bdc: WinApi.HDC; bm: WinApi.HBITMAP;
         res, w, h: INTEGER; obj: StdView;
   BEGIN
      ASSERT((bits = 0) OR (bits = 8) OR (bits = 24), 20);
      v := Containers.FocusSingleton();
      IF v # NIL THEN
         f := Controllers.FocusFrame();
         f := Views.ThisFrame(f, v);
         rd := f.rider(HostPorts.Rider);
         dc := rd.port.homedc;
         bdc := WinApi.CreateCompatibleDC(dc);
         res := WinApi.SetBkMode(bdc, WinApi.TRANSPARENT);
         v.context.GetSize(w, h);
         w := w DIV f.unit; h := h DIV f.unit;
         bm := WinApi.CreateCompatibleBitmap(dc, w, h);
         res := WinApi.SelectObject(bdc, bm);
         Paint(bdc, v, w, h, f.unit);
         res := WinApi.DeleteDC(bdc);
         NEW(obj); obj.w := w; obj.h := h; obj.bits := bits;
         NEW(obj.model); obj.model.ref := bm;
         Containers.Focus().ThisView().ThisModel().ReplaceView(v, obj)
      END
   END TurnToBitmap;
(*
   PROCEDURE TurnThisToBitmap* (v: Views.View; owner: Containers.Model; bits: INTEGER);
      VAR dc, bdc: WinApi.HDC; bm: WinApi.HBITMAP; res, w, h: INTEGER; obj: StdView;
   BEGIN
      dc := WinApi.GetDC(HostWindows.main);
      bdc := WinApi.CreateCompatibleDC(dc);
      res := WinApi.SetBkMode(bdc, WinApi.TRANSPARENT);
      v.context.GetSize(w, h);
      w := w DIV HostWindows.unit; h := h DIV HostWindows.unit;
      bm := WinApi.CreateCompatibleBitmap(dc, w, h);
      res := WinApi.SelectObject(bdc, bm);
      Paint(bdc, v, w, h, HostWindows.unit);
      res := WinApi.DeleteDC(bdc);
      NEW(obj); obj.w := w; obj.h := h; obj.bits := bits;
      NEW(obj.model); obj.model.ref := bm;
      owner.ReplaceView(v, obj)
   END TurnThisToBitmap;
*)
   PROCEDURE ViewToBitmap* (v: Views.View; bits: INTEGER): Views.View;
      VAR dc, bdc: WinApi.HDC; bm: WinApi.HBITMAP; res, w, h: INTEGER; obj: StdView;
   BEGIN
      ASSERT(v # NIL, 20);
      IF v IS StdView THEN
         RETURN v
      ELSE
         ASSERT((bits = 0) OR (bits = 8) OR (bits = 24), 21);
         dc := WinApi.GetDC(HostWindows.main);
         bdc := WinApi.CreateCompatibleDC(dc);
         res := WinApi.SetBkMode(bdc, WinApi.TRANSPARENT);
         v.context.GetSize(w, h);
         w := w DIV HostWindows.unit; h := h DIV HostWindows.unit;
         bm := WinApi.CreateCompatibleBitmap(dc, w, h);
         res := WinApi.SelectObject(bdc, bm);
         Paint(bdc, v, w, h, HostWindows.unit);
         res := WinApi.DeleteDC(bdc);
         NEW(obj); obj.w := w; obj.h := h; obj.bits := bits;
         NEW(obj.model); obj.model.ref := bm;
         RETURN obj
      END
   END ViewToBitmap;
   PROCEDURE ImportBitmap* (f: Files.File; OUT s: Stores.Store);


      TYPE Str = POINTER TO ARRAY [untagged] OF CHAR;
      VAR name: Str; bm: WinApi.HBITMAP; obj: StdView; res: INTEGER;
         info: WinApi.BITMAP;
   BEGIN
      name := SYSTEM.VAL(Str, SYSTEM.VAL(INTEGER, f) + 40);   (* f(HostFiles.File).name *)
      bm := WinApi.LoadImageW(0, name, WinApi.IMAGE_BITMAP, 0, 0, ORD(WinApi.LR_LOADFROMFILE));
      IF bm = 0 THEN res := WinApi.GetLastError(); HALT(100) END;
      res := WinApi.GetObjectW(bm, SIZE(WinApi.BITMAP), SYSTEM.ADR(info));
      NEW(obj); obj.w := info.bmWidth; obj.h := info.bmHeight;
      IF info.bmBitsPixel > 8 THEN obj.bits := 24 ELSE obj.bits := 8 END;
      NEW(obj.model); obj.model.ref := bm;
      s := obj
   END ImportBitmap;
   PROCEDURE ExportBitmap* (v: Stores.Store; f: Files.File);

      VAR w: Stores.Writer; info: BITMAPINFO8; i, col, res: INTEGER; data: POINTER TO ARRAY OF BYTE;
   BEGIN
      ASSERT(v # NIL, 20); ASSERT(f # NIL, 21);
      WITH v: StdView DO
         GetHeader(v, info.header, col);
         res := WinApi.GetDIBits(WinApi.GetDC(HostWindows.main), v.model.ref, 0, v.h, 0,
            SYSTEM.VAL(WinApi.BITMAPINFO, info), WinApi.DIB_RGB_COLORS);
         IF res = 0 THEN res := WinApi.GetLastError(); HALT(100) END;
         NEW(data, info.header.biSizeImage);
         res := WinApi.GetDIBits(WinApi.GetDC(HostWindows.main), v.model.ref, 0, v.h,
            SYSTEM.ADR(data[0]),
            SYSTEM.VAL(WinApi.BITMAPINFO, info), WinApi.DIB_RGB_COLORS);
         IF res = 0 THEN res := WinApi.GetLastError(); HALT(100) END;
         w.ConnectTo(f);
         w.SetPos(0);
         (* file header *)
         w.WriteSInt(4D42H);   (* type *)
         w.WriteInt(14 + 40 + 4 * col + LEN(data));   (* size *)
         w.WriteInt(0);
         w.WriteInt(14 + 40 + 4 * col);   (* offset *)
         (* bitmap header *)
         w.WriteInt(info.header.biSize);
         w.WriteInt(info.header.biWidth);
         w.WriteInt(info.header.biHeight);
         w.WriteSInt(info.header.biPlanes);
         w.WriteSInt(info.header.biBitCount);
         w.WriteInt(info.header.biCompression);
         w.WriteInt(info.header.biSizeImage);
         w.WriteInt(info.header.biXPelsPerMeter);
         w.WriteInt(info.header.biYPelsPerMeter);
         w.WriteInt(info.header.biClrUsed);
         w.WriteInt(info.header.biClrImportant);
         (* colors *)
         i := 0; WHILE i < col DO w.WriteInt(info.colors[i]); INC(i) END;
         (* bits *)
         w.rider.WriteBytes(data^, 0, LEN(data))
      ELSE
      END
   END ExportBitmap;
   PROCEDURE ImportDPictAsBitmap* (VAR med: WinOle.STGMEDIUM;


      OUT v: Views.View; OUT w, h: INTEGER; OUT isSingle: BOOLEAN
   );
      VAR hm: WinApi.HMETAFILEPICT; mp: WinApi.PtrMETAFILEPICT;
         dc, bdc: WinApi.HDC; res, u: INTEGER; bm: WinApi.HBITMAP; obj: StdView; s: SET;
   BEGIN
      hm := med.u.hMetaFilePict;
      mp := SYSTEM.VAL(WinApi.PtrMETAFILEPICT, WinApi.GlobalLock(hm));
      CASE mp.mm OF
      | 1: u := HostWindows.unit
      | 2: u := Ports.point DIV 20
      | 3: u := Ports.mm DIV 100
      | 4: u := Ports.inch DIV 100
      | 5: u := Ports.inch DIV 1000
      | 6: u := Ports.mm DIV 10
      | 7: u := Ports.mm DIV 100
      | 8: u := Ports.mm DIV 100
      END;
      w := mp.xExt * u; h := mp.yExt * u;
      NEW(obj); obj.bits := 24;
      obj.w := w DIV HostWindows.unit;
      obj.h := h DIV HostWindows.unit;
      dc := WinApi.GetDC(HostWindows.main);
      bdc := WinApi.CreateCompatibleDC(dc);
      res := WinApi.SetBkMode(bdc, WinApi.TRANSPARENT);
      bm := WinApi.CreateCompatibleBitmap(dc, obj.w, obj.h);
      res := WinApi.SelectObject(bdc, bm);
      res := WinApi.SetMapMode(bdc, mp.mm);
      res := WinApi.SetViewportOrgEx(bdc, 0, 0, NIL);
      res := WinApi.SetViewportExtEx(bdc, obj.w, obj.h, NIL);
      s := WinApi.SetTextAlign(bdc, {});
      res := WinApi.PlayMetaFile(bdc, mp.hMF);
      res := WinApi.GlobalUnlock(hm);
      res := WinApi.DeleteDC(bdc);
      WinOle.ReleaseStgMedium(med);
      NEW(obj.model); obj.model.ref := bm;
      v := obj; isSingle := FALSE
   END ImportDPictAsBitmap;
   PROCEDURE ImportDBitmap* (VAR med: WinOle.STGMEDIUM;

      OUT v: Views.View; OUT w, h: INTEGER; OUT isSingle: BOOLEAN
   );
      VAR obj: StdView; res: INTEGER;
         bm, bm0: WinApi.HBITMAP; info: WinApi.BITMAP; dc, bdc, bdc0: WinApi.HDC;
   BEGIN
      ASSERT(med.tymed = WinOle.TYMED_GDI, 20);
      bm0 := med.u.hBitmap;
      ASSERT(bm0 # 0, 20);
      res := WinApi.GetObjectW(bm0, SIZE(WinApi.BITMAP), SYSTEM.ADR(info));
      NEW(obj);
      obj.w := info.bmWidth;
      obj.h := info.bmHeight;
      IF info.bmBitsPixel > 8 THEN obj.bits := 24 ELSE obj.bits := 8 END;
      dc := WinApi.GetDC(HostWindows.main);
      bdc0 := WinApi.CreateCompatibleDC(dc);
      res := WinApi.SelectObject(bdc0, bm0);
      bdc := WinApi.CreateCompatibleDC(dc);
      bm := WinApi.CreateCompatibleBitmap(dc, obj.w, obj.h);
      res := WinApi.SelectObject(bdc, bm);
      res := WinApi.BitBlt(bdc, 0, 0, obj.w, obj.h, bdc0, 0, 0, 00CC0020H);   (* copy *)
      IF res = 0 THEN res := WinApi.GetLastError(); HALT(100) END;
      res := WinApi.DeleteDC(bdc0);
      res := WinApi.DeleteDC(bdc);
      WinOle.ReleaseStgMedium(med);
      NEW(obj.model); obj.model.ref := bm;
      v := obj; w := obj.w * HostWindows.unit; h := obj.h * HostWindows.unit; isSingle := FALSE
   END ImportDBitmap;
   PROCEDURE ExportDBitmap* (v: Views.View; w, h, x, y: INTEGER; isSingle: BOOLEAN;

      VAR med: WinOle.STGMEDIUM
   );
   BEGIN
      ASSERT(v # NIL, 20);
      WITH v: StdView DO
         IF v.model.ref = 0 THEN Evaluate(v, WinApi.GetDC(HostWindows.main)) END;
         med.tymed := WinOle.TYMED_GDI;
         med.u.hBitmap := v.model.ref;
         med.pUnkForRelease := NIL
      ELSE
      END
   END ExportDBitmap;
END HostBitmaps.