home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system1 / exprbessel.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  5KB  |  112 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 7 Mar 95
  6. Syntax10b.Scn.Fnt
  7. MODULE ExprBessel; (* ww 
  8.     IMPORT
  9.         Files, Fonts, Expressions, ExprViews, ExprStd;
  10.     TYPE
  11.         BesselFunction* = POINTER TO RECORD(Expressions.ExpressionDesc)
  12.             name-: CHAR;
  13.             index-, argument-: Expressions.Expression
  14.         END;
  15.     PROCEDURE Min(x, y: LONGINT): LONGINT;
  16.     BEGIN IF x < y THEN RETURN x ELSE RETURN y END
  17.     END Min;
  18.     PROCEDURE Max(x, y: LONGINT): LONGINT;
  19.     BEGIN IF x < y THEN RETURN y ELSE RETURN x END
  20.     END Max;
  21.     PROCEDURE Draw(b: ExprViews.Box; p: ExprViews.Port; x, y: LONGINT; col: INTEGER);
  22.     BEGIN p.DrawChar(b.exp(BesselFunction).name, x, y, b.fnt, col);
  23.         ExprViews.DrawDesc(b, p, x, y, col)
  24.     END Draw;
  25.     PROCEDURE Box(e: BesselFunction; port: ExprViews.Port; depth: LONGINT; fnt: Fonts.Font): ExprViews.Box;
  26.         VAR w, bot, top, lH, eH: LONGINT; b, ind, arg: ExprViews.Box; fnt1: Fonts.Font;
  27.     BEGIN
  28.         IF depth > 0 THEN NEW(b);
  29.             fnt1 := port.SmallerFont(fnt);
  30.             ind := ExprViews.ExprBox(e.index, b, 0, port, depth -1, fnt1);
  31.             arg := ExprViews.ExprBox(e.argument, b, 1, port, depth -1, fnt);
  32.             arg := ExprViews.BracketBox("(", arg, port, fnt); arg.y := 0;
  33.             IF fnt1 # fnt THEN top := arg.top; bot := arg.bot;
  34.                 lH := ind.top - ind.bot; eH := top - bot;
  35.                 IF lH < eH THEN ind.y := bot - ind.bot - lH DIV 2 ELSE ind.y := bot + eH DIV 2 - ind.top END;
  36.                 bot := ind.y + ind.bot
  37.             ELSE ind := ExprViews.BracketBox("[", ind, port, fnt);
  38.                 ind.y := 0;
  39.                 bot := Min(ind.bot, arg.bot); top := Max(ind.top, arg.top)
  40.             END;
  41.             w := port.CharWidth(e.name, fnt);
  42.             ind.x := w; w := w + ind.w; ind.next := arg;
  43.             arg.x := w; w := w + arg.w;
  44.             b.desc := ind; b.w := w; b.bot := bot; b.top := top; b.fnt := fnt; b.draw := Draw
  45.         ELSE b := ExprViews.EllipsisBox(NIL, port, fnt)
  46.         END;
  47.         RETURN b
  48.     END Box;
  49.     PROCEDURE Init(e: BesselFunction);
  50.         VAR r: Expressions.Rider;
  51.     BEGIN
  52.         ASSERT((Expressions.LengthOf(e.successors) = 2) &
  53.             ((e.name = "I") OR (e.name = "J") OR (e.name = "K") OR (e.name = "Y"))
  54.         Expressions.OpenRider(r, e.successors); e.index := r.exp; Expressions.Forward(r); e.argument := r.exp
  55.     END Init;
  56.     PROCEDURE Handler(e: Expressions.Expression; VAR m: Expressions.Message);
  57.         VAR self, c: BesselFunction; s: ARRAY 8 OF CHAR;
  58.     BEGIN self := e(BesselFunction);
  59.         WITH m: Expressions.IdentifyMsg DO m.mod := "ExprBessel"; m.proc := "AllocBesselFunction"
  60.         | m: Expressions.FileMsg DO
  61.             IF m.store THEN Files.Write(m.r, self.name)
  62.             ELSE Files.Read(m.r, self.name); Init(self)
  63.             END
  64.         | m: Expressions.CloneMsg DO NEW(c);
  65.             Expressions.Init(c, self.handle, self.binding, ORD(self.name), m.successors);
  66.             c.name := self.name; Init(c);
  67.             m.clone := c
  68.         | m: Expressions.TestMsg DO
  69.             m.equal := (m.with IS BesselFunction) & (m.with(BesselFunction).name = self.name)
  70.                 & Expressions.EqualLists(m.with.successors, self.successors)
  71.         | m: ExprViews.GetBoxMsg DO m.box := Box(self, m.port, m.depth, m.fnt)
  72.         | m: ExprStd.ExpansionMsg DO
  73.             s := "Bessel "; s[6] := self.name;
  74.             m.exp := ExprStd.NewFunction(s, self.successors)
  75.         ELSE (* ignore *)
  76.         END
  77.     END Handler;
  78.     PROCEDURE AllocBesselFunction*;
  79.         VAR e: BesselFunction;
  80.     BEGIN NEW(e); Expressions.Alloc(e, Handler)
  81.     END AllocBesselFunction;
  82.     PROCEDURE NewBesselFunction*(name: CHAR; index, argument: Expressions.Expression): BesselFunction;
  83.         VAR e: BesselFunction; r: Expressions.Rider;
  84.     BEGIN ASSERT((name = "I") OR (name = "J") OR (name = "K") OR (name = "Y"));
  85.         NEW(e);
  86.         Expressions.OpenRider(r, Expressions.emptyList);
  87.         Expressions.Insert(r, index, 0); Expressions.Insert(r, argument, 0);
  88.         Expressions.Init(e, Handler, Expressions.AtomBind, ORD(name), Expressions.ThisList(r));
  89.         e.name := name; e.index := index; e.argument := argument;
  90.         RETURN e
  91.     END NewBesselFunction;
  92.     PROCEDURE Substitute*(VAR exp: Expressions.Expression);
  93.         VAR e: BesselFunction; name: ExprStd.Name;
  94.     BEGIN
  95.         IF (exp IS ExprStd.Function) & (Expressions.LengthOf(exp.successors) = 2) THEN
  96.             name := exp(ExprStd.Function).name;
  97.             IF (name = "BesselI") OR (name = "BesselJ") OR (name = "BesselK") OR (name = "BesselY") THEN
  98.                 NEW(e); e.name := name[6];
  99.                 Expressions.Init(e, Handler, Expressions.AtomBind, ORD(e.name), exp.successors);
  100.                 Init(e);
  101.                 exp := e
  102.             END
  103.         END
  104.     END Substitute;
  105.     PROCEDURE Install*;
  106.     BEGIN ExprStd.Register(Substitute)
  107.     END Install;
  108.     PROCEDURE Remove*;
  109.     BEGIN ExprStd.Remove(Substitute)
  110.     END Remove;
  111. END ExprBessel.
  112.