MODULE SqlObxViews;
(**

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

**)

   IMPORT

      Mechanisms, Fonts, Ports, Views, Controllers, Properties,
      TextModels, TextMappers, TextViews, SqlObxNets;
   CONST d = 3 * Ports.mm; w = 40 * Ports.mm; h = 6 * Ports.mm;

   TYPE

      View = POINTER TO RECORD (Views.View)
         g: SqlObxNets.Net;
         c: SqlObxNets.Company;
         w, h: INTEGER
      END;
   (* drawing *)


   PROCEDURE DrawCompany (f: Views.Frame; c: SqlObxNets.Company; first: BOOLEAN);

      VAR s, sw, x, y, asc, dsc, fw: INTEGER; col: Ports.Color; fnt: Fonts.Font;
   BEGIN
      IF first THEN s := 2 * f.unit; col := Ports.red ELSE s := f.unit; col := Ports.black END;
      x := c.x; y := c.y;
      f.DrawRect(x, y, x + w, y + h, s, col);
      fnt := Fonts.dir.Default();
      sw := fnt.StringWidth(c.name);
      fnt.GetBounds(asc, dsc,fw);
      x := x + (w - sw) DIV 2; y := y + h DIV 2 + (asc + dsc) DIV 3;
      f.DrawString(x, y, col, c.name, fnt)
   END DrawCompany;
   PROCEDURE Draw (c: SqlObxNets.Company; time: INTEGER; f: Views.Frame);

      VAR p: SqlObxNets.Node; c0: SqlObxNets.Company;
   BEGIN   (* c.x and c.y must be set up *)
      c.time := time;
      p := c.owns;
      WHILE p # NIL DO
         c0 := p.company;
         IF c0.time < time THEN
            DrawCompany(f, c0, FALSE);
            Draw(c0, time, f)
         END;
         f.DrawLine(c.x + w DIV 2, c.y + h, c0.x + w DIV 2, c0.y, f.unit, Ports.black);
         p := p.next
      END
   END Draw;
   (* mouse handling *)


   PROCEDURE TestHit (v: View; x, y: INTEGER; VAR l, t, r, b: INTEGER; VAR inside: BOOLEAN;

                           VAR p: SqlObxNets.Company);
      VAR c: SqlObxNets.Company;
   BEGIN
      c := SqlObxNets.CompanyAt(v.g, x, y, w, h);
      IF c # NIL THEN
         IF p = NIL THEN p := c; l := c.x; t := c.y; r := l + w; b := t + h END;
         inside := p = c
      ELSE
         inside := FALSE
      END
   END TestHit;
   PROCEDURE Text (s: ARRAY OF CHAR): TextViews.View;

      VAR t: TextModels.Model; f: TextMappers.Formatter;
   BEGIN
      t := TextModels.dir.New();
      f.ConnectTo(t); f.WriteString(s);
      RETURN TextViews.dir.New(t)
   END Text;
   (* placement *)


   PROCEDURE ShiftDown (c: SqlObxNets.Company; time: INTEGER; dy: INTEGER; VAR b: INTEGER);

      VAR p: SqlObxNets.Node; c0: SqlObxNets.Company;
   BEGIN
      c.time := time; INC(c.y, dy);
      IF c.y + h + d > b THEN b := c.y + h + d END;
      p := c.owns;
      WHILE p # NIL DO
         c0 := p.company;
         IF c0.time < time THEN ShiftDown(c0, time, dy, b) END;
         p := p.next
      END
   END ShiftDown;
   PROCEDURE Place (c: SqlObxNets.Company; x, y, t0: INTEGER; VAR time, r, b: INTEGER);

      VAR p: SqlObxNets.Node; c0: SqlObxNets.Company;
   BEGIN
      (* place company c *)
      c.time := time; c.x := x; c.y := y;
      r := x + w + d;
      y := y + h + d; IF y > b THEN b := y END;
      (* handle companies owned by c *)
      p := c.owns;
      WHILE p # NIL DO
         c0 := p.company;
         IF c0.time < t0 THEN   (* placement is not up-to-date *)
            Place(c0, x, y, t0, time, r, b);
            x := r   (* placement above may have produced a block several companies wide *)
         ELSIF c0.y < y THEN
            INC(time); ShiftDown(c0, time, y - c0.y, b)
         END;
         p := p.next
      END
   END Place;
   (* View *)


   PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);

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

      VAR time: INTEGER;
   BEGIN
      IF v.g # NIL THEN
         DrawCompany(f, v.c, TRUE);
         time := v.c.time + 1; Draw(v.c, time, f)
      END
   END Restore;
   PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);

      VAR x, y, l, t, r, b, dx, dy: INTEGER; inside: BOOLEAN;
         c: SqlObxNets.Company; destX, destY: INTEGER; dest: Views.Frame; op: INTEGER; buttons: SET;
         tv: TextViews.View;
   BEGIN
      (* When the mouse is dragged from within one company to be dropped somewhere else,
         the name of the company isdropped there as a text. This demonstrates how a drop
         source of a drag & drop operation is implemented. *)
      WITH msg: Controllers.PollOpsMsg DO
         msg.type := "TextViews.StdView"
      | msg: Controllers.TrackMsg DO
         c := NIL; x := msg.x; y := msg.y;
         TestHit(v, x, y, l, t, r, b, inside, c);
         IF inside THEN
            dx := x - c.x; dy := y - c.y ;
            op := Mechanisms.copy;
            tv := Text(c.name);
            Mechanisms.TrackToDrop(f, tv, FALSE, w, h, dx, dy, dest, destX, destY, op, x, y, buttons);
            IF op # Mechanisms.cancelDrop THEN
               Controllers.Drop(x, y, f, msg.x, msg.y, tv, FALSE, w, h, dx, dy)
            END
         END
      | msg: Controllers.PollDropMsg DO
         IF msg.mark THEN
            f.MarkRect(msg.x - msg.rx, msg.y - msg.ry, msg.x + msg.w - msg.rx,
                        msg.y + msg.h - msg.ry, f.dot, Ports.invert, msg.show)
         END
      ELSE   (* ignore other messages *)
      END
   END HandleCtrlMsg;
   PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);

   BEGIN
      WITH msg: Properties.SizePref DO
         IF msg.w = Views.undefined THEN msg.w := v.w END;
         IF msg.h = Views.undefined THEN msg.h := v.h END
      ELSE
      END
   END HandlePropMsg;
   (* miscellaneous *)


   PROCEDURE New* (g: SqlObxNets.Net; c: SqlObxNets.Company): Views.View;

      VAR v: View;
   BEGIN
      ASSERT(g # NIL, 20); ASSERT(c # NIL, 21);
      NEW(v); v.g := g; v.c := c;
      c.time := 1;
      Place(c, d, d, c.time, c.time, v.w, v.h);
      RETURN v
   END New;
END SqlObxViews.