with TEXT_IO ; use TEXT_IO ;

procedure TACCESS4 is  -- NOW, add a  FIND function that takes a
--                             name and returns a phone number

  type NODE ;  -- just introduce type name
  type NODE_PTR is access NODE ;  -- define an access type
--                                   i.e. the type of a pointer

  type NODE is  -- now, really define the type NODE
     
    record BF : INTEGER ;  -- balance factor for later use
      LEFT : NODE_PTR ;  -- this records predecessor
      RIGHT : NODE_PTR ;  -- this records sucessor
      NAME : STRING ( 1 .. 2 ) ;  -- data, the "sort" key
      PHONE : STRING ( 1 .. 2 ) ;  -- more tag along data
    end record ;

  ROOT_PTR : NODE_PTR := null ;  -- initially null
  MY_NAME : STRING ( 1 .. 2 ) ;
  MY_PHONE : STRING ( 1 .. 2 ) ;
  DEPTH : INTEGER := 1 ;  -- indentation depth


  procedure OUTPUT ( T : NODE_PTR ) is

    procedure INDENT is
    begin
      for I in 1 .. DEPTH loop
        PUT ( "    " ) ;
      end loop ;
    end INDENT ;

  begin
    DEPTH := DEPTH + 1 ;  -- count depth "down" upon entry
    if T /= null then
      OUTPUT ( T.LEFT ) ;
      INDENT ;
      PUT ( T.NAME ) ;
      PUT_LINE ( T.PHONE ) ;
      OUTPUT ( T.RIGHT ) ;
    end if ;
    DEPTH := DEPTH - 1 ;  -- count depth "up" upon exit
  end OUTPUT ;


  procedure INSERT ( T : in out NODE_PTR ;
                     NAME , PHONE : STRING ) is

  begin
    if T = null then
      T := new NODE' ( 0 , null , null , NAME , PHONE ) ;
    else
      if NAME < T.NAME then
        INSERT ( T.LEFT , NAME , PHONE ) ;
      else
        INSERT ( T.RIGHT , NAME , PHONE ) ;
      end if ;
    end if ;
  end INSERT ;


  function FIND ( T : NODE_PTR ;
                  NAME : STRING ) return STRING is

    PHONE : STRING ( 1 .. 2 ) := "**" ;  -- default ** for no find
  begin
    if T /= null then  -- this stops search for "no find"
      if NAME < T.NAME then
        PHONE := FIND ( T.LEFT , NAME ) ;  -- go looking left
      elsif NAME > T.NAME then
        PHONE := FIND ( T.RIGHT , NAME ) ;  -- go looking right
      else
        PHONE := T.PHONE ;  -- found
      end if ;
    end if ;
    return PHONE ;
  end FIND ;

begin

  PUT_LINE ( " TREE INSERTION AND PRINTOUT" ) ;

-- build a tree using the INSERT procedure
  INSERT ( ROOT_PTR , "D " , "4 " ) ;  -- initial node at root

-- first tier
  INSERT ( ROOT_PTR , "B " , "2 " ) ;
  INSERT ( ROOT_PTR , "F " , "6 " ) ;

-- second tier
  INSERT ( ROOT_PTR , "A " , "1 " ) ;
  INSERT ( ROOT_PTR , "C " , "3 " ) ;
  INSERT ( ROOT_PTR , "E " , "5 " ) ;
  INSERT ( ROOT_PTR , "G " , "7 " ) ;
  OUTPUT ( ROOT_PTR ) ;  -- look at tree produced. The order of the tree

-- build was carefully planned to get a balanced binary tree

  MY_NAME := "E " ;
  MY_PHONE := FIND ( ROOT_PTR , MY_NAME ) ;  -- test FIND function
  PUT_LINE ( MY_NAME & " has a phone number " & MY_PHONE ) ;

  MY_PHONE := FIND ( ROOT_PTR , "D " ) ;  -- test FIND function on root
  PUT_LINE ( "D " & " has a phone number " & MY_PHONE ) ;

  MY_PHONE := FIND ( ROOT_PTR , "XX" ) ;  -- test FIND function on name

-- not in directory
  PUT_LINE ( "XX" & " has a phone number " & MY_PHONE ) ;

end TACCESS4 ;