summaryrefslogtreecommitdiff
path: root/web/clip/vax_vms/ex01_b.pas
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /web/clip/vax_vms/ex01_b.pas
Initial commit
Diffstat (limited to 'web/clip/vax_vms/ex01_b.pas')
-rw-r--r--web/clip/vax_vms/ex01_b.pas119
1 files changed, 119 insertions, 0 deletions
diff --git a/web/clip/vax_vms/ex01_b.pas b/web/clip/vax_vms/ex01_b.pas
new file mode 100644
index 0000000000..922466572a
--- /dev/null
+++ b/web/clip/vax_vms/ex01_b.pas
@@ -0,0 +1,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 ********************)