home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 July / Chip_2004-07_cd1.bin / tema / aos / files / Oberon.exe / Oberon / Docu.exe / Docu / Complex.Mod (.txt) < prev    next >
Oberon Text  |  2000-02-29  |  4KB  |  117 lines
  1. Oberon10.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. (* ETH Oberon, Copyright 2000 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
  4. Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
  5.     Complex.Mod, jm 8.11.93
  6.     Example of how to program an own abstract gadget. Note that this gadget
  7.     should do its own type conversion when the values "Real" or "Imag" are set.
  8. MODULE Complex; (** portable *)
  9. IMPORT
  10.     Math, Files, Objects, Gadgets, Strings;
  11.     Complex* = POINTER TO ComplexDesc;
  12.     ComplexDesc* = RECORD (Gadgets.ObjDesc)
  13.         real*, imag*: REAL
  14.     END;
  15. PROCEDURE Phi(obj: Complex): REAL;
  16. VAR x: REAL;
  17. BEGIN
  18.     IF obj.real = 0.0 THEN
  19.         IF obj.imag < 0.0 THEN x := (Math.pi / 2)*3
  20.         ELSIF obj.imag = 0.0 THEN x := 0.0
  21.         ELSE x := Math.pi / 2
  22.         END
  23.     ELSE
  24.         IF obj.imag = 0.0 THEN
  25.             IF obj.real < 0.0 THEN x := Math.pi
  26.             ELSE x := 0.0
  27.             END
  28.         ELSE
  29.             x := Math.arctan(obj.imag/obj.real);
  30.             IF obj.real < 0 THEN x := Math.pi + x
  31.             ELSIF obj.imag < 0 THEN x := Math.pi*2 + x
  32.             END
  33.         END
  34.     END;
  35.     RETURN x
  36. END Phi;
  37. PROCEDURE Copy*(VAR M: Objects.CopyMsg; from, to: Complex);
  38. BEGIN
  39.     to.real := from.real; to.imag := from.imag;
  40.     Gadgets.CopyObject(M, from, to)
  41. END Copy;
  42. PROCEDURE Handler*(obj: Objects.Object; VAR M: Objects.ObjMsg);
  43. VAR obj0: Complex; x: LONGREAL;
  44. BEGIN
  45.     WITH obj: Complex DO
  46.         IF M IS Objects.AttrMsg THEN
  47.             WITH M: Objects.AttrMsg DO
  48.                 IF M.id = Objects.get THEN
  49.                     IF M.name = "Gen" THEN M.class := Objects.String; COPY("Complex.New", M.s); M.res := 0
  50.                     ELSIF M.name = "Real" THEN M.class := Objects.Real; M.x := obj.real; M.res := 0
  51.                     ELSIF M.name = "Imag" THEN M.class := Objects.Real; M.x := obj.imag; M.res := 0
  52.                     ELSIF M.name = "Rho" THEN M.class := Objects.Real; M.x := Math.sqrt(obj.real*obj.real + obj.imag*obj.imag); M.res := 0
  53.                     ELSIF M.name = "Phi" THEN M.class := Objects.Real; M.x := Phi(obj); M.res := 0
  54.                     ELSE Gadgets.objecthandle(obj, M)
  55.                     END
  56.                 ELSIF M.id = Objects.set THEN
  57.                     IF M.name = "Real" THEN
  58.                         IF M.class = Objects.String THEN Strings.StrToReal(M.s, x); M.x := SHORT(x); M.class := Objects.Real END;
  59.                         IF M.class = Objects.Real THEN obj.real := M.x; M.res := 0 END
  60.                     ELSIF M.name = "Imag" THEN
  61.                         IF M.class = Objects.String THEN Strings.StrToReal(M.s, x); M.x := SHORT(x); M.class := Objects.Real END;
  62.                         IF M.class = Objects.Real THEN obj.imag := M.x; M.res := 0 END
  63.                     ELSIF M.name = "Rho" THEN
  64.                         IF M.class = Objects.String THEN Strings.StrToReal(M.s, x); M.x := SHORT(x); M.class := Objects.Real END;
  65.                         IF M.class = Objects.Real THEN
  66.                             x := Phi(obj);
  67.                             obj.real := M.x*Math.cos(SHORT(x)); obj.imag := M.x*Math.sin(SHORT(x));
  68.                             M.res := 0
  69.                         END
  70.                     ELSIF M.name = "Phi" THEN
  71.                         IF M.class = Objects.String THEN Strings.StrToReal(M.s, x); M.x := SHORT(x); M.class := Objects.Real END;
  72.                         IF M.class = Objects.Real THEN
  73.                             x := Math.sqrt(obj.real*obj.real + obj.imag*obj.imag);
  74.                             obj.real := SHORT(x*Math.cos(M.x)); obj.imag := SHORT(x*Math.sin(M.x));
  75.                             M.res := 0
  76.                         END
  77.                     ELSIF M.name = "Value" THEN (* cannot be set *)
  78.                     ELSE Gadgets.objecthandle(obj, M)
  79.                     END
  80.                 ELSIF M.id = Objects.enum THEN
  81.                     M.Enum("Real"); M.Enum("Imag"); M.Enum("Rho"); M.Enum("Phi"); Gadgets.objecthandle(obj, M)
  82.                 END
  83.             END
  84.         ELSIF M IS Objects.CopyMsg THEN
  85.             WITH M: Objects.CopyMsg DO
  86.                 IF M.stamp = obj.stamp THEN M.obj := obj.dlink    (* copy msg arrives again *)
  87.                 ELSE (* first time copy message arrives *)
  88.                     NEW(obj0); obj.stamp := M.stamp; obj.dlink := obj0;
  89.                     Copy(M, obj, obj0); M.obj := obj0
  90.                 END
  91.             END
  92.         ELSIF M IS Objects.FileMsg THEN
  93.             WITH M: Objects.FileMsg DO
  94.                 IF M.id = Objects.store THEN
  95.                     Files.WriteReal(M.R, obj.real);
  96.                     Files.WriteReal(M.R, obj.imag)
  97.                 ELSIF M.id = Objects.load THEN
  98.                     Files.ReadReal(M.R, obj.real);
  99.                     Files.ReadReal(M.R, obj.imag)
  100.                 END;
  101.                 Gadgets.objecthandle(obj, M)
  102.             END
  103.         ELSE Gadgets.objecthandle(obj, M)
  104.         END
  105. END Handler;
  106. PROCEDURE Init*(obj: Complex);
  107. BEGIN
  108.     obj.handle := Handler; obj.real := 0.0; obj.imag := 0.0
  109. END Init;
  110. PROCEDURE New*;
  111. VAR obj: Complex;
  112. BEGIN
  113.     NEW(obj); Init(obj); Objects.NewObj := obj
  114. END New;
  115. END Complex.
  116. System.Free Complex ~
  117.