MODULE tree_example;

! these declarations allow procedures to be defined after they
! have been referenced

    FORWARD PROCEDURE list_all_words ( STRING );
    FORWARD PROCEDURE list_all_languages ( STRING );

! these declarations are at the module level so that they
! are available to all procedures

! define a two-level deep tree with a string at the leaves

    DECLARE translation : TREE ( STRING, STRING ) OF STRING;

! or DECLARE translation : TREE ( STRING ) OF TREE( STRING ) of STRING;
    
! this tree pointer handles pointing from the first interior
! node level down to the leaf nodes

    DECLARE languages :
	TREEPTR( STRING ) TO TREE ( STRING ) OF STRING;
    
! this tree pointer handles pointing from the second
! node level down to the leaf nodes

    DECLARE words : TREEPTR( STRING ) TO STRING;
    
! this defines a system status of success

CONSTANT ss$_normal EXTERNAL INTEGER;


! the mainline procedure which returns a status to the system

    PROCEDURE foreign_words MAIN OF INTEGER;

	DECLARE language, word : STRING;

! ordering of population is not important

	translation( 'FRENCH', 'night' ) = 'nuit';
	translation( 'FRENCH', 'love'  ) = 'amour';

	translation( 'SPANISH', 'night'   ) = 'noche';
	translation( 'SPANISH', 'love'    ) = 'amor';
	translation( 'SPANISH', 'chicken' ) = 'pollo';
	translation( 'SPANISH', 'house'   ) = 'casa';


	WRITE ' ';
get_language:
    	READ PROMPT ( 'Enter language: ' ) language;
	
	IF ENDFILE( ) 
	THEN
	    RETURN ss$_normal;
	END IF;

	IF language = '*' 
	THEN
	    CALL list_all_languages ( language );
	    GOTO get_language;
	END IF;

	language = UPPER( language );

! make sure this language has some words stored for it

	IF NOT EXISTS( translation( language ) ) 
	THEN
	    WRITE 'No words for ', language;
	    RETURN ss$_normal;
	END IF;

	WRITE 'Translating to ', language;


	WRITE ' ';
	READ PROMPT ( 'Enter word: ' ) word;
	
! loop, prompting for words, until a ^Z is typed

	WHILE NOT ENDFILE( );

! display all words for the language if * is typed

	    IF word = '*' 
	    THEN
	    	 CALL list_all_words( language );
	    ELSE

! make sure a translation for the normalized word exists

		 word = LOWER( word );

	    	 IF EXISTS( translation( language, word ) ) 
		 THEN
		     WRITE 'In ', language, ' it''s ',
			translation( language, word );
		 ELSE
		     WRITE 'No translation for ', word,
			' in ' , language;
		 END IF;

	    END IF;

	    WRITE ' ';
	    READ PROMPT ( 'Enter word: ' ) word;

	END WHILE /* read word loop */ ;

	WRITE ' ';
	RETURN ss$_normal;

    END PROCEDURE /* foreign_words */;


PROCEDURE list_all_languages ( language : STRING );

! set tree pointer to first language

    languages = FIRST( translation );

    WHILE languages <> NIL;
    	
! write out the language 

	WRITE '   ', SUBSCRIPT( languages );

	languages = NEXT( languages );

    END WHILE;

END PROCEDURE /* list_all_words */;


PROCEDURE list_all_words ( language : STRING );

! set tree pointer to first word for the specified language

    words = FIRST( translation( language ) );

    WHILE words <> NIL;
    	
! write out the english word and its translation

	WRITE '   ', SUBSCRIPT( words ), ' is ', VALUE( words );

	words = NEXT( words );

    END WHILE;

END PROCEDURE /* list_all_words */;


END MODULE /* tree_example */;