PROGRAM Huffman_Decoding
!-----------------------------------------------------------------------------
! Program to decode compressed text using a Huffman decoding tree.  Allowed
! characters and their codes (assumed to have been assigned using Huffman's
! algorithm) are read from a file.  Variable used:
!   Root : pointer to root of decoding tree
!
! Input(keyboard):  Name of file containing Huffman codes and  the name
!                   of a compressed file
! Input(file):      Characters and their Huffman codes from CodeFile
!                   Compressed text from CompressedFile
! Output:           A graphical representation of the Huffman tree
!                   and the decoded text
!-----------------------------------------------------------------------------

  IMPLICIT NONE
  TYPE :: BinTreeNode
    CHARACTER(1) :: Data
    TYPE(BinTreeNode), POINTER :: LChild, RChild
  END TYPE BinTreeNode


  TYPE (BinTreeNode), POINTER :: Root

  CALL BuildDecodingTree(Root)
  CALL PrintTree(Root, 8)
  PRINT *
  PRINT *
  CALL Decode(Root)
  STOP
CONTAINS

  !-BuildDecodingTree---------------------------------------------------------
  ! Subroutine that reads characters and their codes (assumed to be assigned
  ! using Huffman's algorithm) from CodeFile and constructs the Huffman
  ! decoding tree.  Local variables used are:
  !   CodeFile       : name of file containing characters and their codes
  !   OpenStatus     : status variable for OPEN
  !   InputStatus    : status variable for READ
  !   AllocateStatus : status variable for ALLOCATE
  !   Ch             : character from code file
  !   Code           : Huffman code for Ch
  !
  ! Input (file): Characters and their Huffman codes
  ! Return:       Root
  !---------------------------------------------------------------------------

  SUBROUTINE BuildDecodingTree(Root)

    TYPE(BinTreeNode), POINTER :: Root
    CHARACTER(20) :: CodeFile
    CHARACTER(1) ::  Ch
    CHARACTER(10) :: Code
    INTEGER :: OpenStatus, InputStatus, AllocateStatus

    ! Create an empty binary tree
    ALLOCATE(Root, STAT = AllocateStatus)
    IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"

    Root%Data = "*"
    NULLIFY(Root%LChild)
    NULLIFY(Root%RChild)

    ! Get name of file containing Huffman codes and open it for input
    WRITE (*, '(1X, A)', ADVANCE = "NO") &
          "Enter name of file containing Huffman codes: "
    READ *, CodeFile
    OPEN (UNIT = 10, FILE = CodeFile, STATUS = "OLD", ACTION = "READ", &
          POSITION = "REWIND", IOSTAT = OpenStatus)
    IF (OpenStatus > 0) STOP "*** Cannot open code file ***"

    PRINT *
    ! Read characters and their codes from CodeFile
    DO
       READ(10, '(A, 1X, A)', IOSTAT = InputStatus) Ch, Code
       IF (InputStatus > 0) STOP "*** File input error ***"
       IF (InputStatus < 0) EXIT  ! End of file, terminate repetition

! Otherwise proceed
       CALL AddToTree (Ch, Code, Root)
    END DO
    RETURN

  END SUBROUTINE BuildDecodingTree


 !-AddToTree-----------------------------------------------------------------
  ! Subroutine that creates a node for character Ch and adds it to the
  ! Huffman decoding tree with root node pointed to by Root. Local variables
  ! used are:
  !   AllocateStatus : status variable for ALLOCATE
  !   I       : subscript
  !   TempPtr : pointer to new node(s)
  !   P       : pointer to nodes in path labeled by Code
  !
  ! Accepts:  Ch, Code, Root
  ! Returns:  Modified Huffman tree with specified Root
  !---------------------------------------------------------------------------

  SUBROUTINE AddToTree(Ch, Code, Root)

    TYPE(BinTreeNode), POINTER :: Root
    TYPE(BinTreeNode), POINTER :: TempPtr, P
    CHARACTER(1), INTENT(IN) :: Ch
    CHARACTER(10), INTENT(IN) :: Code
    INTEGER :: AllocateStatus, I

    ! Descend the Huffman tree using characters in Code
    I = 1
    P => Root

    DO
       IF (I > LEN_TRIM(Code)) EXIT
       ! If end of Code reached, terminate descent in tree

       ! Otherwise continue descent
       IF (Code(I:I) == "0") THEN                ! Descend left
          IF (.NOT. ASSOCIATED(p%LChild)) THEN   ! Create node along path
             ALLOCATE(TempPtr, STAT = AllocateStatus)
             IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"

             TempPtr%Data = "*"
             NULLIFY(TempPtr%LChild)
             NULLIFY(TempPtr%RChild)
             P%LChild => TempPtr
          END IF
          I = I + 1
          P => P%LChild
       ELSE IF (Code(I:I) == "1") THEN           ! Descend right
          IF (.NOT. ASSOCIATED(p%RChild)) THEN   ! Create node along path
             ALLOCATE(TempPtr, STAT = AllocateStatus)
             IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"

             TempPtr%Data = "*"
             NULLIFY(TempPtr%LChild)
             NULLIFY(TempPtr%RChild)
             P%RChild => TempPtr
          END IF
          I = I + 1
          P => P%RChild
       END IF

    END DO
    P%Data = Ch
    RETURN

  END SUBROUTINE AddToTree


  !-PrintTree-----------------------------------------------------------------
  ! Subroutine that uses recursion to display a binary tree.   The tree is
  ! displayed "on its side" with each level indented by a specified value
  ! Indent, but with no arcs sketched in.  Local variable used is:
  !   I : DO-loop counter
  !
  ! Accepts:  Root and Indent
  ! Output :  Graphical representation of the binary tree
  !---------------------------------------------------------------------------

  RECURSIVE SUBROUTINE PrintTree(Root, Indent)

    TYPE(BinTreeNode), POINTER :: Root
    INTEGER :: I
    INTEGER, INTENT(IN) :: Indent

    IF (ASSOCIATED(Root)) THEN
       CALL PrintTree(Root%RChild, Indent + 7)
       DO I = 1, Indent
          WRITE (*, '(A)', ADVANCE = "NO") " "
       END DO
       PRINT *, Root%Data
       CALL PrintTree(Root%LChild, Indent + 7)
    END IF
    RETURN

   END SUBROUTINE PrintTree


  !-Decode--------------------------------------------------------------------
  ! Subroutine that reads compressed text (a string of bits) from a file
  ! and decodes it using the Huffman decoding tree with specified Root.
  ! Local variables used are:
  !   CompressedFile : name of  file containing text to be decoded
  !   Bit            : next bit
  !   P              : pointer to trace path in decoding tree
  !   EndOfFile      : indicates end of compressed file
  !
  ! Accepts:      Root
  ! Input (file): Individual bits from CompressedFile
  ! Output:       Decoded text
  !---------------------------------------------------------------------------

  SUBROUTINE Decode (Root)

    TYPE(BinTreeNode), POINTER :: Root, P
    CHARACTER(1) :: Bit
    CHARACTER(20) :: CompressedFile
    INTEGER :: EndOfFile

    ! Get name of compressed file and open it for input
    WRITE (*, '(1X, A)', ADVANCE = "NO") &
          "Enter name of file containing compressed text: "
    READ *, CompressedFile
    OPEN (UNIT = 20, FILE = CompressedFile, STATUS = "OLD", &
          ACTION = "READ", POSITION = "REWIND")

    READ(20, '(A1)', IOSTAT = EndOfFile, ADVANCE = "NO") Bit

    PRINT *
    DO
       IF (EndOfFile < 0) EXIT
       ! If end of file, terminate decoding

       ! Otherwise continue descent in Huffman tree to find character
       P => Root
       DO
          IF (.NOT. ASSOCIATED(P%LChild) .AND. &
              .NOT. ASSOCIATED(P%RChild)) EXIT
          ! If leaf node reached, terminate descent

          ! Otherwise, continue descent
          WRITE(*,'(" ",A)', ADVANCE = "NO") Bit
          IF (Bit == "0") THEN
             P => P%LChild
          ELSE IF (Bit == "1") THEN
             P => P%RChild
          END IF
          READ(20, '(A)', IOSTAT = EndOfFile, ADVANCE = "NO") Bit
       END DO

       ! Print the decoded character
       PRINT *, "-- ", P%Data
    END DO
    RETURN

   END SUBROUTINE Decode

END PROGRAM Huffman_Decoding