summaryrefslogtreecommitdiff
path: root/web/clip/vax_vms/ex01_b.pas
blob: 922466572aacad89251737e82ac0bb36bb47ff32 (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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
    (***************  #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',  HISTORY := OLD); RESET   (IN_FILE);
        OPEN (OUT_FILE, 'TESTDATA.OUT', HISTORY := NEW); 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  ********************)