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', '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 ********************)
|
