summaryrefslogtreecommitdiff
path: root/web/clip/unix/ex01_a.pas
blob: cf22984f72acdf2df3051a99d9e944819d89cec5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
    (***************  #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;

    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.  #optional  **)
            (********************************************************)

            (*****************  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  ********************)