MODULE bpuu
  ! Moduulissa toteutetaan lisäys ja etsintä binääripuussa
  IMPLICIT NONE
  PRIVATE
  INTEGER, PARAMETER :: avain_pituus = 4, &
      tiedon_pituus = 30, rivin_pituus = 80
  TYPE puu
     CHARACTER(LEN=avain_pituus) :: avain
     CHARACTER(LEN=tiedon_pituus) :: tieto
     TYPE(puu), POINTER :: vasen, oikea
  END TYPE puu
  TYPE(puu), POINTER :: juuri, loppu
  CHARACTER(LEN=avain_pituus), PARAMETER :: pienin_avain = ''
  CHARACTER(LEN=*), PARAMETER :: puu_ei_loydy = 'Ei löytynyt'
  PUBLIC :: avain_pituus, tiedon_pituus, etsi, syota, &
      alusta_puu, tulosta_puu
CONTAINS

  SUBROUTINE alusta_puu()
    ! Tämä aliohjelma alustaa binääripuun juuren sekä
    ! loppumerkin.
    ! Juuressa avain on 'pienin_avain', loppumerkin
    ! osoittimet osoittavat loppumerkkiin.
    ALLOCATE(juuri, loppu)
    juuri%avain = pienin_avain
    juuri%oikea => loppu
    loppu%tieto = puu_ei_loydy
    loppu%vasen => loppu; loppu%oikea => loppu
  END SUBROUTINE alusta_puu

  FUNCTION etsi (avain) RESULT(tieto)
    ! Tämä aliohjelma etsii avainta taulukosta ja palauttaa
    ! tieto-alkion.
    IMPLICIT NONE
    CHARACTER(LEN=avain_pituus), INTENT(IN) :: avain
    CHARACTER(LEN=tiedon_pituus) :: tieto
    TYPE(puu), POINTER :: mina

    mina => juuri%oikea
    loppu%avain = avain
    DO WHILE (avain /= mina%avain)
       IF (avain < mina%avain) THEN
          mina => mina%vasen
       ELSE
          mina => mina%oikea
       END IF
    END DO
    tieto = mina%tieto
  END FUNCTION etsi

  SUBROUTINE syota(avain, tieto)
    ! Tämä aliohjelma tekee puuhun uuden solmun, jonka
    ! tunnukset ovat avain ja tieto.
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN) :: avain
    CHARACTER(LEN=*), INTENT(IN) :: tieto
    TYPE(puu), POINTER :: isa, mina

    isa => juuri; mina => juuri%oikea
    DO WHILE (.NOT. ASSOCIATED(mina, loppu))
       isa => mina
       IF (avain < mina%avain) THEN
          mina => mina%vasen
       ELSE
          mina => mina%oikea
       END IF
    END DO
    ALLOCATE(mina)
    mina%avain = avain; mina%tieto = tieto
    mina%vasen => loppu; mina%oikea => loppu
    IF (avain < isa%avain) THEN
       isa%vasen => mina
    ELSE
       isa%oikea => mina
    END IF
  END SUBROUTINE syota

  SUBROUTINE tulosta_puu()
    ! Tämä on päällystakki tulostusrutiinille
    WRITE (*,*) 'Listaus tiedoista puurakenteen &
        &mukaan sisennettyinä:'
    CALL tulosta_sisainen(juuri%oikea, 1)
  END SUBROUTINE tulosta_puu

  RECURSIVE SUBROUTINE tulosta_sisainen(mina, taso)
    ! Tämä rutiini tulostaa rekursiivisesti puun
    IMPLICIT NONE
    TYPE(puu), POINTER :: mina
    INTEGER, INTENT(IN) :: taso

    IF (.NOT. ASSOCIATED(mina, loppu)) THEN
       CALL tulosta_sisainen(mina%vasen, taso+1)
       WRITE (*,*) REPEAT(' ',2*taso), mina%avain, mina%tieto
       CALL tulosta_sisainen(mina%oikea, taso+1)
    END IF
  END SUBROUTINE tulosta_sisainen

END MODULE bpuu