home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / progrmng / mcbrntls.sit / FoldDemo.Txt (.txt) < prev    next >
Encoding:
Oberon Text  |  1991-02-13  |  4.5 KB  |  134 lines  |  [.Ob./.Ob2]
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. (* This is a short demo that shows the use of FoldElements.
  4. a) Middle-click at a filled triangle (e.g. behind the procedure Insert). The procedure body is shown.
  5.     Middle-click at the non-filled triangle. The procedure body is collapsed again.
  6. b) Expand procedure Insert and then its local procedure Ins. You find two pseudocode actions that can also be expanded.
  7. c) Make a new fold element by selecting some text and executing FoldElems.Insert
  8. d) Compile this file with FoldComp.Compile */s
  9.     A (deliberate) error is reported. Set the caret at the beginning of the text and execute FoldComp.ShowError .
  10.     The error location is revealed and marked with a small rectangle. middle-click at it to get the error message. *)
  11. MODULE FoldDemo;
  12. IMPORT Oberon, Texts;
  13.     Name = ARRAY 32 OF CHAR;
  14.     Node = POINTER TO NodeDesc;
  15.     NodeDesc = RECORD
  16.         name: Name;
  17.         left, right: Node
  18.     END;
  19. VAR tree: Node; w: Texts.Writer;
  20. PROCEDURE GetName(VAR n: Name);    
  21. PROCEDURE Insert*;    
  22. PROCEDURE Print*;    
  23. PROCEDURE Delete*;    
  24. BEGIN tree := NIL; Texts.OpenWriter(w)
  25. END FoldDemo.
  26. WriteParcs.Alloc
  27. FoldElems.New
  28. Syntax10.Scn.Fnt
  29.     VAR s: Texts.Scanner;
  30. BEGIN
  31.     Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  32.     IF s.class = Texts.Name THEN COPY(s.s, n) ELSE n := "" END
  33. END GetName;
  34. WriteParcs.Alloc
  35. FoldElems.New
  36. FoldElems.New
  37. Syntax10.Scn.Fnt
  38. Syntax10i.Scn.Fnt
  39.     VAR x: Node;
  40.     PROCEDURE Ins(elem: Node);    
  41.         VAR p, father: Node;
  42.     BEGIN elem.left := NIL; elem.right := NIL;
  43. find insertion place (father)
  44. insert elem under father
  45.     END Ins;
  46. BEGIN
  47.     NEW(x); GetName(x.name); Ins(x)
  48. END Insert;
  49. WriteParcs.Alloc
  50. FoldElems.New
  51. WriteParcs.Alloc
  52. FoldElems.New
  53. Syntax10.Scn.Fnt
  54. Syntax10i.Scn.Fnt
  55. p := tree; father := NIL;
  56.         WHILE p # NIL DO
  57.             IF elem.name = p.name THEN RETURN END;
  58.             father := p;
  59.             IF elem.name < p.name THEN p := p.left ELSE p := p.right END
  60.         END;    
  61. see picture
  62. WriteParcs.Alloc
  63. FoldElems.New
  64. Syntax10.Scn.Fnt
  65. WriteParcs.Alloc
  66. GraphicElems.Alloc
  67. Rectangles
  68. Syntax10.Scn.Fnt
  69. new element is inserted as the right or left child
  70. father
  71. FoldElems.New
  72. FoldElems.New
  73. FoldElems.New
  74. Syntax10.Scn.Fnt
  75. IF father = NIL THEN tree := elem
  76.         ELSIF elem.name < father.name THEN father.left := elem
  77.         ELSE father.right := elem
  78.         END
  79. WriteParcs.Alloc
  80. FoldElems.New
  81. FoldElems.New
  82. FoldElems.New
  83. FoldElems.New
  84. Syntax10.Scn.Fnt
  85.     PROCEDURE P(x: Node);    
  86. BEGIN
  87.     P(tree); Texts.Append(Oberon.Log, w.buf)
  88. END Print;
  89. WriteParcs.Alloc
  90. FoldElems.New
  91. Syntax10.Scn.Fnt
  92.     BEGIN
  93.         IF x # NIL THEN
  94.             P(x.left); Texts.WriteString(x.name); Texts.WriteLn(w); P(x.right)
  95.         END
  96.     END P;
  97. WriteParcs.Alloc
  98. FoldElems.New
  99. FoldElems.New
  100. FoldElems.New
  101. Syntax10.Scn.Fnt
  102.     VAR name: Name;
  103.     PROCEDURE Del(name: Name);    
  104. BEGIN
  105.     GetName(name); Del(name);
  106. END Delete;
  107. WriteParcs.Alloc
  108. FoldElems.New
  109. Syntax10.Scn.Fnt
  110.         VAR p, x, y, father: Node;
  111.     BEGIN
  112.         p := tree; father := NIL;
  113.         WHILE (p # NIL) & (name # p.name) DO
  114.             father := p;
  115.             IF name < p.name THEN p := p.left ELSE p := p.right END
  116.         END;
  117.         IF p # NIL THEN
  118.             IF p.right = NIL THEN x := p.left
  119.             ELSIF p.right.left = NIL THEN x := p.right; x.left := p.left
  120.             ELSE
  121.                 x := p.right; WHILE x.left # NIL DO y := x; x := x.left END;
  122.                 y.left := x.right;
  123.                 x.left := p.left; x.right := p.right
  124.             END;
  125.             IF father = NIL THEN tree := x
  126.             ELSIF name < father.name THEN father.left := x 
  127.             ELSE father.right := x 
  128.             END
  129.         END
  130.     END Del;
  131. WriteParcs.Alloc
  132. FoldElems.New
  133. FoldElems.New
  134.