diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /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.pas | 119 |
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 ********************) |