OberonCore

MODULE TestControls;

   IMPORT Dialog, Controls, TextModels, Views, Models, Stores, Properties, Controllers;

   TYPE
      Log* = RECORD END;
      CustomLog = POINTER TO RECORD (Controls.Control)
         model: TextModels.Model;
         view: Views.View
      END;
      LogMsg = RECORD (Models.Message)
         string: Dialog.String
      END;
      Context = POINTER TO RECORD (Models.Context)
         w, h: INTEGER;
         view, base: Views.View;
      END;

   VAR log*: Log;

   (** Log **)
   PROCEDURE (VAR l: Log) Add* (IN s: ARRAY OF CHAR), NEW;
      VAR msg: LogMsg;
   BEGIN
      msg.string := s$; Views.Omnicast(msg)
   END Add;
   
   (** Context **)
   
   PROCEDURE (c: Context) GetSize(OUT w, h: INTEGER);
   BEGIN
      w := c.w; h := c.h
   END GetSize;
   
   PROCEDURE (c: Context) SetSize(w, h: INTEGER);
      VAR msg: Properties.SizePref;
   BEGIN
      msg.h := h; msg.w := w;
      msg.fixedH := FALSE; msg.fixedW := FALSE;
      Views.HandlePropMsg(c.view, msg);
      c.w := msg.w; c.h := msg.h
   END SetSize;

   PROCEDURE (c: Context) ThisModel(): Models.Model;
   BEGIN
      RETURN NIL
   END ThisModel;

   PROCEDURE (c: Context) Normalize(): BOOLEAN;
   BEGIN
      RETURN FALSE
   END Normalize;
   
   PROCEDURE NewContext(view: Views.View; base: Views.View): Context;
      VAR context: Context; msg: Properties.SizePref;
   BEGIN
      ASSERT(view # NIL, 20); ASSERT(base # NIL, 21);
      msg.w := Views.undefined; msg.h := Views.undefined;
      msg.fixedW := FALSE; msg.fixedH := FALSE;
      Views.HandlePropMsg(view, msg);
      IF view.context = NIL THEN
         NEW ( context );
         context.w := msg.w;  context.h := msg.h;
         context.view := view; context.base := base;
         view.InitContext( context );
         Stores.Join(view, base)
      END;
      RETURN context
   END NewContext;
      
   (** CustomLog **)
   
   PROCEDURE PaintLog (c: CustomLog; f: Views.Frame);
      VAR w, h: INTEGER;
   BEGIN
      c.context.GetSize(w, h);
      f.DrawRect(0, 0, w, h, f.dot, Ports.black);
      IF c.model # NIL THEN
         IF c.view # NIL THEN
            c.view.context.SetSize(w, h);
            Views.InstallFrame(f, c.view, 0, 0, 0, TRUE);
         END
      END;
   END PaintLog;
   
   PROCEDURE (c: CustomLog) Externalize2 (VAR wr: Stores.Writer);
   BEGIN
      wr.WriteVersion(maxVersion);
      wr.WriteStore(c.model)
   END Externalize2;
   
   PROCEDURE (c: CustomLog) Internalize2 (VAR rd: Stores.Reader);
      VAR version: INTEGER; store: Stores.Store; context: Context;
   BEGIN
      rd.ReadVersion(minVersion, maxVersion, version);
      rd.ReadStore(store);
      WITH store: TextModels.Model DO
         c.model := store;
         c.view := TextViews.dir.New(c.model);
         context := NewContext(c.view, c);
         (*MtScrollers.AddScrollerOn(c.view)*)
      END;

   END Internalize2;
   
   PROCEDURE (c: CustomLog) Restore (f: Views.Frame; l, t, r, b: INTEGER);
   BEGIN
      PaintLog(c, f)
   END Restore;
   
   PROCEDURE (c: CustomLog) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
                                                                  VAR focus: Views.View);

   BEGIN
      IF ~c.disabled & c.item.Valid() THEN
         focus := c.view
      END;
   END HandleCtrlMsg2;
   
   
   PROCEDURE (c: CustomLog) HandleModelMsg (VAR msg: Models.Message);
      VAR form: TextMappers.Formatter;
   BEGIN
      WITH msg: LogMsg DO
         form.ConnectTo(c.model);
         form.WriteString(msg.string$); form.WriteLn;
         Views.Update(c, Views.keepFrames)
      ELSE (* ignore other messages *)
      END
   END HandleModelMsg;
   
   PROCEDURE (c: CustomLog) HandlePropMsg2 (VAR msg: Properties.Message);
   BEGIN
      WITH msg: Properties.FocusPref DO
         IF ~c.disabled & ~c.readOnly THEN msg.setFocus := TRUE END
      | msg: Properties.SizePref DO
         IF (msg.w = Views.undefined) OR (msg.h = Views.undefined) THEN
            msg.w := 50 * Ports.mm; msg.h := 50 * Ports.mm
         END
      ELSE
      END
   END HandlePropMsg2;
   
   PROCEDURE (c: CustomLog) CheckLink (VAR ok: BOOLEAN);
      VAR mod, name: Meta.Name; v: Meta.Item; control: REAL;
   BEGIN
      ok := FALSE;
      IF (c.item.typ = Meta.recTyp) THEN
         c.item.GetTypeName(mod, name);
         ok := TRUE
      END
   END CheckLink;
   
   PROCEDURE (c: CustomLog) Update (f: Views.Frame; op, from, to: INTEGER);
   BEGIN
      PaintLog(c, f)
   END Update;

   PROCEDURE NewLog* (p: Controls.Prop): Views.View;
      VAR c: CustomLog; context: Context;
   BEGIN
      NEW(c);
      c.model := TextModels.dir.New();
      c.view := TextViews.dir.New(c.model);
      context := NewContext(c.view, c);
      (*MtScrollers.AddScrollerOn(c.view);*)
      Controls.OpenLink(c, p); RETURN c
   END NewLog;

   PROCEDURE DepositLog*;
      VAR p: Controls.Prop;
   BEGIN
      NEW(p); p.link := "TestControls.log";
      p.label := ""; p.guard := ""; p.notifier := "";
      Views.Deposit(NewLog(p))
   END DepositLog;

 log.Add ("my message")