home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / UTILITY / OBRONM11.ZIP / OETREE.MOD < prev    next >
Encoding:
Text File  |  1991-02-24  |  3.6 KB  |  104 lines
  1. (* General Tree Handler Module        
  2.   (Oberon Example)    (c) Copyright E. R. Videki 1991 *)
  3. MODULE OETree ;
  4.  
  5.  
  6. TYPE    ApplePtr * = POINTER TO Apple ;    (* One blob on a tree stem... *)
  7.  
  8.     CmdHandler * = PROCEDURE ( p : ApplePtr ;  cmd : INTEGER );
  9.     (* general handler of commands sent to a particular node; set by creator
  10.     of the extended record type *)
  11.  
  12.     Apple * =    
  13.         RECORD    (* a node on the tree.  You may extend this any way you like. *)
  14.         left  , right  : ApplePtr ;    (* notice that the fields are not 
  15.                         exported, because
  16.                         they are only handled by this module *)
  17.         refptr  * : ApplePtr ;    (* application-specific reference to another node *)
  18.         method * : CmdHandler     (* application-specific handler of events to this node*)
  19.         END;
  20.  
  21.  
  22.     SearchProc = PROCEDURE ( p , ref : ApplePtr ;  VAR result : INTEGER );
  23.     (* search procedure is called to inform us whether we need to
  24.     descend to the left (ie: lower collating sequence) or right
  25.     branches of the tree, or to stop.  The result variable must indicate:
  26.         < 0    - continue search at left branch (lower sequence)
  27.         zero    - stop the search, node 'p' is the matching one
  28.         > 0    - continue search at right branch (higher in sequence)
  29.     The 'ref' parameter is passed unchanged from calling Search (cf. below), so you can
  30.     use it to compare the 'p' node under consideration with some field of
  31.     your own in 'ref' (or not, as you wish) . *)
  32.  
  33.  
  34.     TraverseProc = PROCEDURE ( p : ApplePtr ) ;    
  35.     (* a procedure used in the TraverseTree procedure below, which you supply,
  36.      which does whatever you wish at each node of the tree as the tree is
  37.      traversed from low-to-high order *)
  38.                                
  39.  
  40.  
  41.  
  42. PROCEDURE Search * (  treehead, ref : ApplePtr ;  
  43.             VAR found : ApplePtr ;  VAR result : INTEGER ;
  44.             searchproc : SearchProc );
  45. (* result has 0 when search was successful, non zero if not.  When successful,
  46. then 'found' points to the searched-for tree element.  You define the way the search
  47. happens by your searchproc.  'ref' is as explained above in the search proc type definition.*)
  48. BEGIN
  49.     result := 1 ;   found := NIL ; (*assume failure at first *)
  50.     LOOP
  51.         IF treehead = NIL THEN EXIT END;
  52.         searchproc( treehead , ref , result );
  53.         IF result = 0 THEN EXIT
  54.         ELSIF result < 0 THEN treehead := treehead.left
  55.         ELSE treehead := treehead.right
  56.         END
  57.     END ; 
  58.     found := treehead
  59. END Search;
  60.  
  61.  
  62.  
  63. PROCEDURE AddNew * ( treehead , new : ApplePtr ; 
  64.             VAR result : INTEGER;  searchproc : SearchProc ) ;
  65. (* add a new tree node, which you must have performed a NEW on (and filled in any 
  66. extensions you need to the data type).  'result' will contain 0 only if there was no other
  67. matching node (as you decide in the searchproc) and the new node was added to the
  68. tree *)
  69. VAR p : ApplePtr ;  ans : INTEGER;
  70. BEGIN
  71.     result := 0 ;    (* assume success *)
  72.     new.left := NIL;   new.right := NIL ;
  73.     p := treehead ;
  74.     LOOP
  75.         IF p = NIL THEN EXIT END;
  76.         searchproc( p , new , ans );
  77.         IF ans  < 0 THEN
  78.             IF p.left # NIL THEN p := p.left  ELSE  p.left := new ; EXIT END
  79.         ELSIF ans  > 0 THEN
  80.             IF p.right # NIL THEN p := p.right  ELSE  p.right := new ;  EXIT END
  81.         ELSE  result  := 1 ; EXIT  (*node already present; can't add same one again *)
  82.         END
  83.     END (* LOOP *)
  84. END AddNew ;
  85.  
  86.  
  87. PROCEDURE TraverseTree * (  userproc : TraverseProc ;  treehead : ApplePtr  ) ;
  88.  
  89.     PROCEDURE NeXT( p : ApplePtr ) ;
  90.     BEGIN
  91.         LOOP
  92.             IF p = NIL THEN EXIT END ;
  93.             IF p.left # NIL THEN NeXT(p.left) END ;
  94.             userproc(p) ;
  95.             p := p.right
  96.         END
  97.     END NeXT ;
  98.  
  99. BEGIN  NeXT(treehead)
  100. END TraverseTree ;
  101.  
  102.  
  103. END OETree .                            
  104.