MODULE XYplane;
(**

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

**)

   IMPORT WinApi, Ports, Stores, Views, Properties, HostPorts, HostWindows;

   CONST

      erase* = 0; draw* = 1;
      maxW = 256; maxH = 256;
   TYPE

      View = POINTER TO RECORD (Views.View)
         dc: WinApi.HANDLE;
         map: WinApi.HANDLE
      END;
   VAR

      X*, Y*, W*, H*: INTEGER;
      current: View;
      frame: Views.Frame;
   PROCEDURE (v: View) FINALIZE;

      VAR res: INTEGER;
   BEGIN
      res := WinApi.DeleteDC(v.dc);
      res := WinApi.DeleteObject(v.map);
      v.dc := 0; v.map := 0
   END FINALIZE;
   PROCEDURE Open*;

      VAR res: INTEGER; v: View; dc: WinApi.HANDLE;
   BEGIN
      NEW(v);
      dc := WinApi.GetDC(0);
      v.dc := WinApi.CreateCompatibleDC(dc);
      v.map := WinApi.CreateCompatibleBitmap(dc, W, H);
      res := WinApi.SelectObject(v.dc, v.map);
      res := WinApi.ReleaseDC(0, dc);
      res := WinApi.SelectObject(v.dc, WinApi.GetStockObject(WinApi.WHITE_BRUSH));
      res := WinApi.SelectObject(v.dc, WinApi.GetStockObject(WinApi.NULL_PEN));
      res := WinApi.Rectangle(v.dc, 0, 0, W + 1, H + 1);
      Views.OpenAux(v, "XYplane");
      current := v
   END Open;
   PROCEDURE Dot* (x, y, mode: INTEGER);

      VAR res, u: INTEGER; p: HostPorts.Port; col: Ports.Color;
   BEGIN
      IF (x >= 0) & (x < maxW) & (y >= 0) & (y < maxH) THEN
         y := maxH - 1 - y;
         IF mode = draw THEN col := Ports.black ELSE col := Ports.white END;
         res := WinApi.SetPixel(current.dc, x, y, col);
         IF (frame # NIL) & (frame.rider # NIL) THEN
            u := frame.unit; p := frame.rider(HostPorts.Rider).port;
            res := WinApi.SetPixel(p.dc, frame.gx DIV u + x, frame.gy DIV u + y, col);
            IF res = -1 THEN
               frame.DrawRect(x * u, y * u, (x + 1) * u, (y + 1) * u, Ports.fill, col)
            END
         END
      END
   END Dot;
   PROCEDURE IsDot* (x, y: INTEGER): BOOLEAN;

   BEGIN
      RETURN WinApi.GetPixel(current.dc, x, maxH - 1 - y) # Ports.white
   END IsDot;
   PROCEDURE ReadKey* (): CHAR;

      VAR res: INTEGER; msg: WinApi.MSG;
   BEGIN
      IF WinApi.PeekMessageW(msg, 0, WinApi.WM_KEYDOWN, WinApi.WM_CHAR, 1) # 0 THEN
         IF msg.message = WinApi.WM_CHAR THEN
            RETURN CHR(msg.wParam)
         ELSE
            res := WinApi.TranslateMessage(msg);
            res := WinApi.DispatchMessageW(msg)
         END
      END;
      RETURN 0X
   END ReadKey;
   PROCEDURE Clear*;

      VAR res: INTEGER;
   BEGIN
      res := WinApi.Rectangle(current.dc, 0, 0, W + 1, H + 1);
      Views.Update(current, Views.keepFrames)
   END Clear;
   PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);


      VAR version: INTEGER; res, x, y, i: INTEGER; dc: WinApi.HANDLE; s: SET;
   BEGIN
      v.Internalize^(rd);
      IF ~rd.cancelled THEN
         rd.ReadVersion(0, 0, version);
         IF ~rd.cancelled THEN
            dc := WinApi.GetDC(0);
            v.dc := WinApi.CreateCompatibleDC(dc);
            v.map := WinApi.CreateCompatibleBitmap(dc, W, H);
            res := WinApi.SelectObject(v.dc, v.map);
            res := WinApi.ReleaseDC(0, dc);
            res := WinApi.SelectObject(v.dc, WinApi.GetStockObject(WinApi.WHITE_BRUSH));
            res := WinApi.SelectObject(v.dc, WinApi.GetStockObject(WinApi.NULL_PEN));
            res := WinApi.Rectangle(v.dc, 0, 0, W + 1, H + 1);
            y := 0;
            WHILE y < maxH DO
               x := 0;
               WHILE x < maxW DO
                  rd.ReadSet(s); i := 0;
                  WHILE i < 32 DO
                     IF i IN s THEN res := WinApi.SetPixel(v.dc, x, y, Ports.black) END;
                     INC(i); INC(x)
                  END
               END;
               INC(y)
            END
         END
      END
   END Internalize;
   PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);

      VAR x, y, i: INTEGER; s: SET;
   BEGIN
      v.Externalize^(wr);
      wr.WriteVersion(0);
      y := 0;
      WHILE y < maxH DO
         x := 0;
         WHILE x < maxW DO
            i := 0; s := {};
            WHILE i < 32 DO
               IF WinApi.GetPixel(v.dc, x, y) # Ports.white THEN INCL(s, i) END;
               INC(i); INC(x)
            END;
            wr.WriteSet(s)
         END;
         INC(y)
      END
   END Externalize;
   PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);

      VAR res: INTEGER;
   BEGIN
      WITH source: View DO v.dc := source.dc;
         v.dc := WinApi.CreateCompatibleDC(source.dc);
         v.map := WinApi.CreateCompatibleBitmap(source.dc, W, H);
         res := WinApi.SelectObject(v.dc, v.map);
         res := WinApi.BitBlt(v.dc, 0, 0, W, H, source.dc, 0, 0, 00CC0020H)
      END
   END CopyFromSimpleView;
   PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);

      VAR rd: HostPorts.Rider; x, y, u, rl, rt, rr, rb: INTEGER;
   BEGIN
      rd := f.rider(HostPorts.Rider);
      IF rd.port.wnd # 0 THEN   (* copy to screen *)
         frame := f;
         f.rider.GetRect(rl, rt, rr, rb);
         rd.CopyFrom(v.dc, rl - f.gx DIV f.unit, rt - f.gy DIV f.unit)
      ELSE   (* copy to printer *)
         u := HostWindows.unit; y := 0;
         WHILE y < maxH DO
            x := 0;
            WHILE x < maxW DO
               IF WinApi.GetPixel(v.dc, x, y) # Ports.white THEN
                  f.DrawRect(x * u, y * u, (x + 1) * u, (y + 1) * u, Ports.fill, Ports.black)
               END;
               INC(x)
            END;
            INC(y)
         END
      END
   END Restore;
   
   PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
   BEGIN
      WITH msg: Properties.SizePref DO
         msg.w := W * HostWindows.unit;
         msg.h := H * HostWindows.unit
      | msg: Properties.ResizePref DO
         msg.fixed := TRUE
      ELSE
      END
   END HandlePropMsg;
   
BEGIN
   X := 0; Y := 0; W := maxW; H := maxH
END XYplane.