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