home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mod201j.zip / modula2.exe / os2demo / oops / typeproc.mod < prev   
Text File  |  1995-03-06  |  1KB  |  63 lines
  1. MODULE TYPEPROC;
  2.  
  3. (*$XL+*)
  4. (* type bound procedure demo *)
  5.  
  6.  
  7. FROM Storage  IMPORT ALLOCATE, DEALLOCATE;
  8. FROM InOut    IMPORT WriteString, WriteLn, WriteLongHex;
  9. FROM SYSTEM   IMPORT ADDRESS;
  10.  
  11.  
  12. TYPE
  13.   TREE =  POINTER TO NODE;
  14.   NODE =  RECORD
  15.     key   : INTEGER;
  16.     left  : TREE;
  17.     right : TREE;
  18.           END;
  19.  
  20. TYPE
  21.   CENTERTREE = POINTER TO CENTERNODE;
  22.   CENTERNODE = RECORD( NODE )
  23.     width      : INTEGER;
  24.     subnode    : TREE;
  25.                END;
  26.  
  27. VAR
  28.   CenterTree   : CENTERTREE;
  29.   Tree         : TREE;
  30.  
  31.  
  32. (* declaring method Insert for TREE *)
  33. PROCEDURE( self : TREE ) Insert( node : TREE );
  34. BEGIN
  35.   InOut.WriteString( "TREE.Insert: called" );
  36.   InOut.WriteLn();
  37. END Insert;
  38.  
  39. (* overriding method Insert for extended CENTERTREE *)
  40. PROCEDURE( self : CENTERTREE ) Insert( node : TREE );
  41. BEGIN
  42.   InOut.WriteString( "CENTERTREE.Insert: called" );
  43.   InOut.WriteLn();
  44.   (* now calling parent method bound to TREE *)
  45.   self^.Insert^( node );
  46. END Insert;
  47.  
  48. BEGIN
  49.   WriteString( "TYPEPROC: This is a type-bound procedure demo ..." );
  50.   WriteLn();
  51.   WriteString( "TYPEPROC: Creating new 'CENTERTREE' object" );
  52.   WriteLn();
  53.   NEW( CenterTree );
  54.   Tree := CenterTree;
  55.   WriteString( "TYPEPROC: New 'CENTERTREE' object created = " );
  56.   WriteLongHex( ADDRESS( Tree ), 12 );
  57.   WriteLn();
  58.   Tree^.Insert( CenterTree );
  59.   WriteString( "TYPEPROC: Disposing 'CENTERTREE' object" );
  60.   WriteLn();
  61.   DISPOSE( CenterTree );
  62. END TYPEPROC.
  63.