/* 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;