[Oberon] FPGA - OberonV4 Dialogs

[Tomas Kral]

On Mon, 26 Nov 2018 15:22:28 +0100
Jörg <joerg.straube at iaeth.ch> wrote:

> Dialog Texts will call the init procedure of Dialog Objects to
> initialize its "method" RECORD with the base procedures. Afterwards
> will overwrite some (or all) of the procedure with the own ones.

Hi,

Yes this helps. I have revisited `Term' OOP example, in effort to set a
good coding template. I added methods to extended `CapTerm' type, that are
initialised and called along the base methods. Type guard needed.

Is this any good?

MODULE Term; (* TK 16.8.2018 / 26.11.2018  revised OOP example *)
  IMPORT Texts, Oberon;

  TYPE
    Term* = POINTER TO TDesc;
    Methods* = POINTER TO MDesc;

    (* Base method suite *)

    MDesc* = RECORD
      Write*: PROCEDURE(t: Term; ch: CHAR);
      Refresh*: PROCEDURE(t: Term);
      Ln*: PROCEDURE(t: Term)
      (* other methods come here *)
    END ;

    (* Base data suite *)

    TDesc* = RECORD
      do*: Methods;
      (* generic terminal data comes here *)
    END ;

  VAR W: Texts.Writer; methods: Methods;

  (* ------ Initialisation for clients ------ *)

  PROCEDURE Init*(t: Term);
  BEGIN t.do := methods
  END Init;

  PROCEDURE Clone*((*VAR*)m: Methods);
  BEGIN m^ := methods^
  END Clone;

  PROCEDURE Get*(VAR m: Methods);
  BEGIN m := methods
  END Get;

  (* ------ Term base methods ----- *)

  PROCEDURE Write(t: Term; ch: CHAR);
  BEGIN Texts.Write(W, ch)
  END Write;

  PROCEDURE Refresh(t: Term);
  BEGIN Texts.Append(Oberon.Log, W.buf)
  END Refresh;

  PROCEDURE Ln(t: Term);
  BEGIN Texts.WriteLn(W)
  END Ln;
    
BEGIN Texts.OpenWriter(W); NEW(methods); methods.Write := Write; methods.Refresh := Refresh; methods.Ln := Ln
END Term.


MODULE CapTerm;
  IMPORT Term;

  TYPE
    CapTerm* = POINTER TO CTDesc;
    Methods* = POINTER TO MDesc;

    (* CapTerm specific methods *)

    MDesc* = RECORD(Term.MDesc)
      Write0*: PROCEDURE(t: CapTerm);
      Write1*: PROCEDURE(t: CapTerm);
      (* other methods come here *)
    END ;

    (* CapTerm specific data *)

    CTDesc* = RECORD (Term.TDesc)
      (* cap terminal data comes here *)
      col: INTEGER 
    END ;
     
  VAR self: Methods; super: Term.Methods;

  PROCEDURE Init*(t: CapTerm; color: INTEGER (* other data for the CapTerm if any *) );
  BEGIN t.do := self; t.col := color
  END Init;

  PROCEDURE CAP(ch: CHAR): CHAR;
    VAR up: CHAR;
  BEGIN
    IF (ch >= "a") & (ch <= "z") THEN
      up := CHR(ORD(ch) + ORD("A") - ORD("a"))
    ELSE up := ch END
  RETURN up END CAP;

  (* --------- Methods added to CapTerm ------- *)

  PROCEDURE Write0(t: CapTerm);
  BEGIN
    super.Write(t, "0") (* upcalls base Term.Write() *)
  END Write0;

  PROCEDURE Write1(t: CapTerm);
  BEGIN
    super.Write(t, "1") (* upcalls base Term.Write() *)
  END Write1;

  (* --------- Methods overriden from Term base ------- *)

  PROCEDURE Write(t: Term.Term; ch: CHAR);
  (* Write method specific for CapTerm *)
  BEGIN
    ch := CAP(ch); super.Write(t, ch) (* upcalls base Term.Write() *)
  END Write;

  (* Refresh() method not to be overriden *)
  (* Ln() method not to be overriden *)

BEGIN NEW(self); Term.Clone(self); Term.Get(super); self.Write := Write; self.Write0 := Write0; self.Write1 := Write1;
END CapTerm.


MODULE TestTerm;
  IMPORT Texts, Term, CapTerm, Oberon;

  VAR t: Term.Term; c: CapTerm.CapTerm;

  PROCEDURE Run*;
    VAR S: Texts.Scanner;
  BEGIN
    Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
    WHILE S.class = Texts.Name DO
      t.do.Write(t, S.s[0]); t.do.Refresh(t); 
      c.do.Write(c, S.s[0]); c.do.Refresh(c); (* calls Term.Refresh() *)
      Texts.Scan(S)
    END ;
	c.do(CapTerm.Methods).Write0(c); c.do(CapTerm.Methods).Write1(c); (* prints 01, note do(typeguard) *)
    c.do.Ln(c); t.do.Ln(t); c.do.Refresh(c) (* calls Term.Ln() twice *)
  END Run;

BEGIN NEW(t); Term.Init(t); NEW(c); CapTerm.Init(c, 20)
END TestTerm.

TestTerm.Run  a b c ~



-- 
Tomas Kral <thomas.kral at email.cz>