diff options
Diffstat (limited to 'tests/projects/plugins/project/src/pli/center.pli')
| -rw-r--r-- | tests/projects/plugins/project/src/pli/center.pli | 212 |
1 files changed, 212 insertions, 0 deletions
diff --git a/tests/projects/plugins/project/src/pli/center.pli b/tests/projects/plugins/project/src/pli/center.pli new file mode 100644 index 00000000000..d6d79e5bebd --- /dev/null +++ b/tests/projects/plugins/project/src/pli/center.pli @@ -0,0 +1,212 @@ + /* Copyright (c) 1995 by R. A. Vowels, from "Introduction to PL/I, Algorithms, and */ + /* Structured Programming". Permission is given to reproduce and to use these procedures */ + /* as part of a program, and to include them as part of a larger work to be sold for profit. */ + /* However, the user is not permitted to sell the procedures separately. Provided always */ + /* that these procedures and this copyright notice are reproduced in full. */ + + DECLARE CENTERLEFT GENERIC + (CENTER_LEFT_2 WHEN (*, *), + CENTER_LEFT_3 WHEN (*, *, *) ); + DECLARE CENTER GENERIC + (CENTER_LEFT_2 WHEN (*, *), + CENTER_LEFT_3 WHEN (*, *, *) ); + DECLARE CENTERRIGHT GENERIC + (CENTER_RIGHT_2 WHEN (*, *), + CENTER_RIGHT_3 WHEN (*, *, *) ); + DECLARE CENTRELEFT GENERIC + (CENTER_LEFT_2 WHEN (*, *), + CENTER_LEFT_3 WHEN (*, *, *) ); + DECLARE CENTRERIGHT GENERIC + (CENTER_RIGHT_2 WHEN (*, *), + CENTER_RIGHT_3 WHEN (*, *, *) ); + /* This procedure returns a string of length LEN, with STRING in the dead center, or one */ + /* position to the left of dead center if it cannot be dead center. */ + CENTER_LEFT_2: + PROCEDURE (STRING, LEN) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be centered; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* centered. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + + DECLARE WORK CHARACTER (LEN); + DECLARE (K, L) FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + K = (LEN - L + 2)/2; + + WORK = ''; + SUBSTR (WORK, K, L) = STRING; + RETURN (WORK); + END CENTER_LEFT_2; + + /* This procedure returns a string of length LEN, with STRING in the dead center, or one */ + /* position to the left of dead center if it cannot be dead center. A specified fill */ + /* character FILL extends STRING right and left. */ + CENTER_LEFT_3: + PROCEDURE (STRING, LEN, FILL) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be centered; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* centered. */ + /* FILL = a fill character used to extend STRING at both ends. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + DECLARE FILL CHARACTER (1); + + DECLARE WORK CHARACTER (LEN); + DECLARE (K, L) FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + K = (LEN - L + 2)/2; + + WORK = REPEAT (FILL, LEN-1); + SUBSTR (WORK, K, L) = STRING; + RETURN (WORK); + END CENTER_LEFT_3; + + /* This procedure returns a string of length LEN, with STRING in the dead center, or one */ + /* position to the right of dead center if it cannot be dead center. */ + CENTER_RIGHT_2: + PROCEDURE (STRING, LEN) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be centered; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* centered. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + + DECLARE WORK CHARACTER (LEN); + DECLARE (K, L) FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + K = (LEN - L + 3)/2; + + WORK = ''; + SUBSTR (WORK, K, L) = STRING; + RETURN (WORK); + END CENTER_RIGHT_2; + + /* This procedure returns a string of length LEN, with STRING in the dead center, or one */ + /* position to the right of dead center if it cannot be dead center. A specified fill */ + /* character FILL extends STRING right and left. */ + CENTER_RIGHT_3: + PROCEDURE (STRING, LEN, FILL) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be centered; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* centered. */ + /* FILL = a fill character used to extend STRING at both ends. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + DECLARE FILL CHARACTER (1); + + DECLARE WORK CHARACTER (LEN); + DECLARE (K, L) FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + K = (LEN - L + 3)/2; + + WORK = REPEAT (FILL, LEN-1); + SUBSTR (WORK, K, L) = STRING; + RETURN (WORK); + END CENTER_RIGHT_3; + + DECLARE LEFT GENERIC + (LEFT_blank WHEN (*,*), + LEFT_other WHEN (*,*,*) ); + + /* This procedure returns STRING in a string of length LEN, with blank characters padded on */ + /* the right. */ + LEFT_blank: + PROCEDURE (STRING, LEN) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be positioned left; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* placed. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + + DECLARE WORK CHARACTER (LEN); + DECLARE L FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + WORK = ''; + SUBSTR (WORK, 1, L) = STRING; + RETURN (WORK); + END LEFT_blank; + + /* This procedure returns STRING in a string of length LEN, padded with the character */ + /* FILL on the right. */ + LEFT_other: + PROCEDURE (STRING, LEN, FILL) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be positioned left; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* positioned left; */ + /* FILL = the character to be used to fill out the finished string. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + DECLARE FILL CHARACTER (1); + + DECLARE WORK CHARACTER (LEN); + DECLARE L FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + WORK = STRING || REPEAT (FILL, LEN-L-1); + RETURN (WORK); + END LEFT_other; + + DECLARE RIGHT GENERIC + (RIGHT_blank WHEN (*,*), + RIGHT_other WHEN (*,*,*) ); + + /* This procedure returns STRING right-adjusted in a string of length N, padded with blanks */ + /* on the left. */ + RIGHT_blank: + PROCEDURE (STRING, LEN) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be positioned right; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* positioned right. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + + DECLARE WORK CHARACTER (LEN); + DECLARE L FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + WORK = ''; + SUBSTR (WORK, LEN-L+1, L) = STRING; + RETURN (WORK); + END RIGHT_blank; + + /* This procedure returns STRING right-adjusted in a string of length N, padded with the */ + /* character FILL on the left. */ + RIGHT_other: + PROCEDURE (STRING, LEN, FILL) RETURNS (CHARACTER(1000) VARYING); + /* INCOMING: STRING = the string to be positioned right; */ + /* LEN = the length of the produced string in which STRING is to be */ + /* positioned right; */ + /* FILL = the character to be used to fill out the finished string. */ + DECLARE STRING CHARACTER (*) VARYING; + DECLARE LEN FIXED BINARY; + DECLARE FILL CHARACTER (1); + + DECLARE WORK CHARACTER (LEN); + DECLARE L FIXED BINARY; + + L = LENGTH (STRING); + IF L >= LEN THEN RETURN (STRING); + + WORK = REPEAT (FILL, LEN-L-1) || STRING; + RETURN (WORK); + END RIGHT_other; |