(***************  #file "palindrome.pas"  ***********************)
    (****************************************************************)
    (* Program: Palindrome filter program.                          *)
    (* Purpose: To filter the palindromic lines from a given input  *)
    (*          file to a specified output file.                    *)
    (****************************************************************)
    PROGRAM PALINDROME (INPUT, OUTPUT, IN_FILE, OUT_FILE);

    CONST
        MAX_L = 132;
    TYPE
        ABSTRACT  = (DEFINED, UNDEFINED);
        TEXT_LINE =     RECORD
                            CHARS: ARRAY[1..MAX_L] OF CHAR;
                            LENGTH: 0..MAX_L;
                        END (*RECORD*);
    VAR
        IN_FILE, OUT_FILE: TEXT;
        IN_LINE,
        LETTERS:        TEXT_LINE;
        IS_PALINDROME:  BOOLEAN;
        IN_CHAR:    CHAR;
        I:          INTEGER;
        J:          INTEGER;
        T :         INTEGER;

    BEGIN
        OPEN (IN_FILE,  'TESTDATA.IN',  'old');     RESET   (IN_FILE);
        OPEN (OUT_FILE, 'TESTDATA.OUT', 'unknown'); REWRITE (OUT_FILE);

        (*****************  Palindrome (body)  **********************)
        (** Copy the lines of the IN_FILE that are palindromic to  **)
        (** the OUT_FILE.                                          **)
        WHILE NOT EOF (IN_FILE) DO
        BEGIN
            (*****************  Palindrome (1)  *********************)
            (** Read a line from IN_FILE into IN_LINE. The letters **)
            (** of this line are copied to LETTERS.                **)
            IN_LINE.LENGTH := 0;
            LETTERS.LENGTH := 0;
            WITH IN_LINE DO
            WHILE NOT EOLN (IN_FILE) DO
            BEGIN
                READ (IN_FILE, IN_CHAR);
                LENGTH := LENGTH + 1;
                CHARS[LENGTH] := IN_CHAR;
                IF IN_CHAR IN ['A'..'Z', 'a'..'z'] THEN
                WITH LETTERS DO
                BEGIN
                    LENGTH := LENGTH + 1;
                    CHARS[LENGTH] := IN_CHAR;
                END (*WITH/IF*);
            END (*WHILE/WITH*);

            (*****************  Palindrome (test)  ******************)
            (** Check contents of IN_LINE and LETTERS.             **)
            WRITELN;
            WRITELN ('============  DEBUGGING INFORMATION  ===============');
            WRITELN ('Contents of buffer IN_LINE: ');
            WRITE   ('>>>>');
            WITH IN_LINE DO
            FOR T := 1 TO LENGTH DO WRITE (OUTPUT, CHARS[T]);
            WRITE   ('<<<<');
            WRITELN;
            WRITELN ('Contents of buffer LETTERS:  ');
            WRITE   ('>>>>');
            WITH LETTERS DO
            FOR T := 1 TO LENGTH DO WRITE (OUTPUT, CHARS[T]);
            WRITE   ('<<<<');
            WRITELN;
            WRITELN ('==========  END OF DEBUGGING INFORMATION  ==========');
            WRITELN;
            (*************  End of Palindrome (test)  ***************)

            (*****************  End of Palindrome (1)  **************)

            READLN (IN_FILE);

            (*****************  Palindrome (2)  *********************)
            (** Test palindromicity of LETTERS. Set IS_PALINDROME  **)
            (** to reflect the result of the test.                 **)
            WITH LETTERS DO
            BEGIN
                (* Transform lowercase to uppercase.                *)
                FOR I := 1 TO LENGTH DO
                IF CHARS[I] IN ['a'..'z']
                THEN CHARS[I] :=
                     CHR(ORD(CHARS[I]) - ORD('a') + ORD('A'));

                (* Perform the palindromicity test.                 *)
                IS_PALINDROME := TRUE;
                I := 1;
                WHILE IS_PALINDROME AND (I <= LENGTH DIV 2) DO
                IF CHARS[I] = CHARS[LENGTH-I+1] THEN
                    I := I + 1
                ELSE
                    IS_PALINDROME := FALSE;
            END (*WITH*);
            (*****************  End of Palindrome (2)  **************)


            IF IS_PALINDROME THEN
            BEGIN
                (*****************  Palindrome (3)  *****************)
                (** Write IN_LINE to OUT_FILE.                     **)
                WITH IN_LINE DO
                BEGIN
                    FOR J := 1 TO LENGTH DO
                        WRITE (OUT_FILE, CHARS[J]);
                END (*WITH*);
                (*************  End of Palindrome (3)  **************)

                WRITELN (OUT_FILE);
            END (*IF*);
        END (*WHILE*);
        (*************  End of Palindrome (body)  *******************)

    END (*PALINDROME*).
    (*******************  End of palindrome.pas  ********************)