-- Simple demonstration of the generic tree handling package.

    WITH TEXT_IO ; USE TEXT_IO ; -- make standard text I/O available
    WITH tree_handler ; -- make generic tree handling package available

    PROCEDURE treedemo2 IS

-- Global Types :

    SUBTYPE ubyte IS INTEGER RANGE 0..255 ;

    TYPE sub_rec IS RECORD
       one   : ubyte ;
       two   : ubyte ;
       three : ubyte ;
    END RECORD ;

    TYPE rec_test IS RECORD
       main : ubyte ;
       sub  : sub_rec ;
    END RECORD ;

-- Generic Package Instantiation :

-- have to predeclare ">" & output_rec_test
    FUNCTION ">" ( left, right : rec_test ) RETURN BOOLEAN ;
    PROCEDURE output_rec_test ( rt : rec_test ) ;

    PACKAGE rttree IS NEW
      tree_handler ( rec_test, ">", output_rec_test ) ;
    USE rttree ;

    PACKAGE ubyte_io IS NEW INTEGER_IO ( ubyte ) ;
    USE ubyte_io ;

-- Global Variables :

    rt_tree : tree ; -- input data tree

    test_value : rec_test ; -- input from user

-- Global Exceptions :

    input_finished : exception ; -- raised when data input finished

-- Local Functions :

-- ">" => Is first test record "greater than" the second ?
    FUNCTION ">" ( left, right : rec_test ) RETURN BOOLEAN IS

-- Local Variables :

    result : BOOLEAN := FALSE ; -- initialise result to FALSE

    BEGIN -- ">"

-- test main components
    result := left.main > right.main ;
    IF NOT result AND THEN left.main = right.main THEN

--    test sub components in order
--    test sub.one components
       result := left.sub.one > right.sub.one ;
       IF NOT result AND THEN left.sub.one = right.sub.one THEN

--       test sub.two components
          result := left.sub.two > right.sub.two ;
          IF NOT result AND THEN left.sub.two = right.sub.two THEN

--          test sub.three components
             result := left.sub.three > right.sub.three ;
          END IF ;
       END IF ;
    END IF ;

-- return result
    RETURN result ;

    END ">" ; ----------------------------------------------------------

-- Local Procedures :

-- output_rec_test => Output a test record.
    PROCEDURE output_rec_test ( rt : rec_test ) IS

    BEGIN -- output_rec_test

-- just output components in appropriate order
    PUT ( ">" ) ; PUT ( rt.main ) ; PUT ( " - " ) ;
    PUT ( rt.sub.one ) ; PUT ( " - " ) ;
    PUT ( rt.sub.two ) ; PUT ( " - " ) ;
    PUT ( rt.sub.three ) ; PUT ( "<" ) ;

    END output_rec_test ; ----------------------------------------------

-- input_rec_test => Input a test record one from a line.
    PROCEDURE input_rec_test ( rt : IN OUT rec_test ) IS

    BEGIN -- input_rec_test

-- just get components in appropriate order
    GET ( rt.main ) ;
    GET ( rt.sub.one ) ;
    GET ( rt.sub.two ) ;
    GET ( rt.sub.three ) ;
    SKIP_LINE ;

-- check for data finished ( SUN-255-BLACK-255 ) given
    IF rt.main = 255 AND THEN rt.sub.one = 255 THEN
       IF rt.sub.two = 255 AND THEN rt.sub.three = 255 THEN

--       signal data input finished
          RAISE input_finished ;
       END IF ;
    END IF ;

    END input_rec_test ; -----------------------------------------

    BEGIN -- treedemo2

    LOOP -- loop indefinately
       PUT ( "? Test record value > " ) ;
       input_rec_test ( test_value ) ;
       insert ( rt_tree, test_value ) ;
    END LOOP ;

-- exception handler => catch end of data input
    EXCEPTION

       WHEN input_finished =>

          NEW_LINE ; PUT ( "Tree is as follows :" ) ; NEW_LINE ;
          NEW_LINE ; put ( rt_tree ) ;

    END treedemo2 ; ----------------------------------------------------