[Oberon] FPGA - OberonV4 Dialogs

[Jörg]

I just realized that the „do“ field has to be outside of the inheritance tree.
We should have two inheritance trees: one for the fields (without „do“) and one for the methods.

MODULE Term;

TYPE
  Term* = POINTER TO Desc;
  MethodPtr = POINTER TO Methods;
  Fields* = RECORD (* generic terminal data comes here *) END;
  Methods* = RECORD
    Write*: PROCEDURE(t: Term, ch: CHAR);
    Refresh*: PROCEDURE(t: Term);
    Ln*: PROCEDURE(t: Term);
  END
  Desc = RECORD (Fields)
     do*: MethodPtr
  END

MODULE CapTerm;

TYPE
  Term* = POINTER TO Desc;
  MethodPtr = POINTER TO Methods;
  Fields* = RECORD (Term.Fields)
    (* cap terminal data comes here *)
    col: INTEGER
  END;
  Methods* = RECORD (Term.Methods)
    Write0*: PROCEDURE(ct: Term);
    Write1*: PROCEDURE (ct: Term)
  END;
  Desc = RECORD (Fields)
    do*: MethodPtr
  END;
    
By applying this code pattern you don‘t have to use type guards for the „do“ calls.
You used              c.do(CapTerm.Methods).Write0(c)
You now write      c.do.Write0(c)    as c.do has the correct type

Jörg

> Am 26.11.2018 um 20:17 schrieb Tomas Kral <thomas.kral at email.cz>:
> 
> 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>
> --
> Oberon at lists.inf.ethz.ch mailing list for ETH Oberon and related systems
> https://lists.inf.ethz.ch/mailman/listinfo/oberon