# banner --- produce banner from arguments on Standard Output # Original Fortran version: # by Joseph J. Greiner, Jr. # Department of Civil Engineering # Virginia Polytechnic Institute # Blacksburg, Virginia # July, 1975 # With modifications by: # Daniel S. Cox # Department of Electrical Engineering # Georgia Institute of Technology # February, 1978 # Typeface: Fortune Light by Bauer Type Foundry; # nominal size, 8 inches high # Most 029 (EBCDIC) keypunch symbols, plus lower-case multi- # punching, can be interpreted by this program. define(div,/) define(MAXKARD,78) define(MAXSYM,89) define(DEFAULT_CHAR,RUBOUT) define(TEN2,100) define(TEN3,1000) define(TEN4,10000) define(TEN5,100000) define(TEN6,1000000) define(TEN7,10000000) define(DB,#) include "banner_com.r.i" integer col, i, maxl, minl, ncols, ntotal, nspare, banner_text (MAXKARD), lmax (MAXSYM), lmin (MAXSYM) integer index data lmax / _ 80, 57, 80, 73, 80, 57, 80, 57, 80, 74, 80, 57, 80, 57, 80, 80, 80, 57, 80, 80, 80, 80, 80, 55, 80, 80, 80, 57, 80, 80, 80, 57, 80, 74, 80, 80, 80, 57, 80, 57, 80, 57, 80, 55, 80, 55, 80, 55, 80, 55, 80, 55, 80, 80, 80, 80, 80, 80, 80, 80, 80, 80, 70, 48, 80, 55, 80, 80, 80, 64, 80, 80, 80, 80, 80, 80, 80, 88, 80, 80, 15, 15, 47, 47, 80, 80, 76, 80, 1/ data lmin / _ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, -1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, -1, 1, 1, 1, 1, 1, 1, 1, -24, 1, -24, 1, 1, 1, 1, 1, -24, -11, -24, 1, 1, 1, 1, 1, 1, 1, -24, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 11, 33, 1, 26, 1, 1, 61, 19, 1, 1, 1, 1, 1, 1, 1, -7, 1, 1, -9, 1, 1, 11, 41, 41, 4, 1, 1/ call do_args (foreground_sym, background_sym, banner_text) maxl = -100 # must be less than anything in lmax array minl = 100 # must be greater than anything in lmin array ntotal = 0 for (col = 1; banner_text (col) ~= EOS; col += 1) { i = index (syma, banner_text (col)) if (i == 0) i = MAXSYM # index of ' 'c if (lmax (i) > maxl) maxl = lmax (i) if (lmin (i) < minl) minl = lmin (i) ntotal += symn (i) / TEN4 + 4 banner_text (col) = i # replace character by its index } ncols = maxl - minl + 1 move = (132 - ncols) / 2 - minl nspare = (int (float (ntotal) / 66. + 1.5) * 66 - ntotal - 6) / 2 call baxx (nspare, 2) for (i = 1; i < col; i += 1) call prnt (banner_text (i)) call baxx (nspare + 50, 2) stop end # prnt --- manage the printing of a single character subroutine prnt (i) integer i include "banner_com.r.i" integer j, k, jout, na, nb, nc, nd, ne, nf, ng, nh, nchk, nsi, ntemp integer nshift (MAXSYM) longint nch data nshift / _ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 25, 0, 25, 0, 0, 0, 0, 0, 25, 12, 25, 0, 0, 0, 0, 0, 0, 0, 25, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, 10, 0, 0, 0, 0, 0, 0, 0, 0/ call baxx (2, 2) if (i == MAXSYM) { # print a blank call baxx (50, 2) return } select (i) when (16, 22, 36) call legl (25, 0) when (40) call legl (25, 25) when (12, 18, 38) call legl (0, 0) when (8, 20, 28, 42) call ohav (1) when (1, 9, 15, 17, 19, 21, 25, 29, 35, 39) call legu (7) when (11, 37) call legu (4) when (7, 27, 31, 41) call ohaf (1) if (i ~= 8 && i ~= 12 && i ~= 16) { j = mod (symn (i), TEN4) - 1 jout = mod (symn (i + 1), TEN4) nsi = nshift (i) repeat { ne = 0 ng = 0 call baxx (1, 1) j += 1 if (j >= jout) break nch = nchar (j) # split character description into its fields na = nch div TEN7 nb = mod (nch div TEN5, TEN2) nc = mod (nch div TEN3, TEN2) nd = mod (nch div 10, TEN2) nchk = mod (nch, 10) if (na > nb || nb > nc || nc > nd) { ntemp = na na = nd nd = ntemp ntemp = nb nb = nc nc = ntemp } if (nchk == 1) { j += 1 nch = nchar (j) ne = nch div TEN7 nf = mod (nch div TEN5, TEN2) ng = mod (nch div TEN3, TEN2) nh = mod (nch div 10, TEN2) nchk = mod (nch, 10) if (ne > nf || nf > ng || ng > nh) { ntemp = ne ne = nh nh = ntemp ntemp = nf nf = ng ng = ntemp } } if (nchk == 0) nchk = 1 if (na == 0 && nb == 0) { call baxx (nchk, 2) next } call frnt (na - nsi, nb - nsi) if (nc ~= 0) { call frnt (nc - nsi, nd - nsi) if (ne ~= 0) { call frnt (ne - nsi, nf - nsi) if (ng ~= 0) call frnt (ng - nsi, nh - nsi) } } do k = 1, nchk call output (line) } } select (i) when (8, 26, 40) call ohav (-1) when (12, 16) call achn when (7, 19) call ohaf (-1) call baxx (2, 2) return end # achn --- print the second part of lower case 'h' and 'n' subroutine achn include "banner_com.r.i" integer k, na, nb, nc, nd longint kline (30), klk data kline / _ 123849, 94249, 84651, 74753, 64854, 64955, 50550000, 51560000, 51560000, 51570000, 51570000, 51570000, 65057, 64957, 74857, 84757, 94656, 124156, 550000, 530000, 520000, 500000, 480000, 440000, 120000, 90000, 80000, 70000, 60000, 60000/ DB call print (ERROUT, "call achn*n.") do k = 1, 30; { call baxx (1, 1) klk = kline (k) na = klk div TEN6 nb = mod (klk div TEN4, TEN2) nc = mod (klk div TEN2, TEN2) nd = mod (klk, TEN2) call frnt (na, nb) if (nc ~= 0) call frnt (nc, nd) call output (line) } return end # ohaf --- print common segment of 'C', 'D', 'G', 'O' and 'Q' subroutine ohaf (kstep) integer kstep # kstep == 1 means print left segment # kstep == -1 means print right segment include "banner_com.r.i" integer i, k, n, na, nb, nc, nd longint kline (30), klk data kline / _ 32480000, 26540000, 23570000, 20600000, 18620000, 16640000, 14660000, 12680000, 11334769, 9275371, 8245672, 7206073, 6186274, 5166475, 4146676, 4136776, 3126877, 2116978, 2107078, 2097178, 1087279, 1087279, 1077379, 77380, 67480, 67480, 67480, 67480, 67480, 67480/ DB call print (ERROUT, "call ohaf (*i)*n.", kstep) if (kstep == 1) { k = 0 n = 17 } else { k = 31 n = 30 } do i = 1, n; { call baxx (1, 1) k += kstep klk = kline (k) # extract fields na = klk div TEN6 nb = mod (klk div TEN4, TEN2) nc = mod (klk div TEN2, TEN2) nd = mod (klk, TEN2) call frnt (na, nb) if (nc ~= 0) call frnt (nc, nd) call output (line) } return end # legl --- print initial part of 'h', 'k', 'l', 'm', 'n', 'p' and 'r' subroutine legl (n, nx) integer n, nx # The parameters n and nx indicate the desired letter as follows: # h k l m n p r # n: 25 25 25 0 0 25 0 # nx: 0 0 0 0 0 25 0 include "banner_com.r.i" integer i, k integer ks (16) data ks /6, 7, 48, 51, 7, 8, 47, 48, 8, 9, 46, 47, 9, 12, 43, 46/ DB call print (ERROUT, "call legl (*i, *i)*n.", n, nx) call baxx (1, 1) call frnt (-nx, 6 - nx) call frnt (49 + n - nx, 55 + n - nx) call output (line) call output (line) do i = 1, 4; { k = 4 * (i - 1) + 1 call frnt (ks (k) - nx, ks (k + 1) - nx) call frnt (ks (k + 2) + n - nx, ks (k + 3) + n - nx) call output (line) } call frnt (12 - nx, 43 + n - nx) do k =1, 6 call output (line) return end # ohav --- print common segment of 'b', 'c', 'd', 'o', 'p' and 'q' subroutine ohav (kstep) # kstep == 1 means print left segment # kstep == -1 means print right segment include "banner_com.r.i" integer i, k, na, nb, nc, nd longint kline (17), klk data kline / _ 20370000, 16410000, 13440000, 11460000, 9480000, 7500000, 6510000, 5203752, 4164153, 3144354, 2124555, 1104756, 1094856, 1084956, 75057, 75057, 65157/ DB call print (ERROUT, "call ohav (*i)*n.", kstep) if (kstep == 1) k = 0 else k = 18 do i = 1, 17; { call baxx (1, 1) k += kstep klk = kline (k) na = klk div TEN6 nb = mod (klk div TEN4, TEN2) nc = mod (klk div TEN2, TEN2) nd = mod (klk, TEN2) call frnt (na, nb) if (nc ~= 0) call frnt (nc, nd) call output (line) } return end # legu --- do first part of 'B', 'D', 'E', 'F', 'H', 'I', 'K', 'L', 'M', 'N', 'P' and 'R' subroutine legu (n) integer n # For letters 'M' and 'N', the parameter n has value 4 # For all other letters, the parameter n has value 7 include "banner_com.r.i" integer i, k integer ks (16) data ks /7, 8, 72, 73, 8, 9, 71, 72, 9, 10, 70, 71, 10, 13, 67, 70/ DB call print (ERROUT, "call legu (*i)*n.", n) call baxx (1, 1) call frnt (0, 6) call frnt (74, 80) do i = 1, 3 call output (line) call frnt (6, 7) call frnt (73, 74) do i = 1, 3 call output (line) do i = 1, 4; { k = 4 * (i - 1) + 1 call frnt (ks (k), ks (k + 1)) call frnt (ks (k + 2), ks (k + 3)) call output (line) } call frnt (13, 67) do i = 1, n call output (line) return end # baxx --- put background symbols in output lines subroutine baxx (n, j) integer n, j # for j ~= 1, print n lines of background include "banner_com.r.i" integer i DB call print (ERROUT, "call baxx (*i, *i)*n.", n, j) do i = 1, 132 line (i) = background_sym if (j == 1) return do i = 1, n call output (line) return end # frnt --- put foreground symbols in buffer from na+move through nb+move subroutine frnt (na, nb) integer na, nb include "banner_com.r.i" integer i, j, k DB call print (ERROUT, "call frnt (*i, *i)*n.", na, nb) i = na + move j = nb + move - 1 DB call print (ERROUT, "start = *i, end = *i*n.", i, j) do k = i, j line (k) = foreground_sym return end # do_args --- get banner text and mode from argument list subroutine do_args (foreground_sym, background_sym, banner_text) character foreground_sym, background_sym, banner_text (MAXKARD) integer getarg integer i, reverse_video, junk (2) character c, last_arg (MAXKARD) if (getarg (1, banner_text, 2) == EOF) call error ("Usage: banner { - | -c } .") reverse_video = NO c = DEFAULT_CHAR for (i = 1; getarg (i, last_arg, MAXKARD) ~= EOF; i += 1) { if (last_arg (1) == '-'c && last_arg (2) == EOS) { if (getarg (i + 1, junk, 1) ~= EOF) # see if there's another arg reverse_video = YES } elif (last_arg (1) == '-'c && (last_arg (2) == 'c'c | last_arg (2) == 'C'c) && (last_arg (3) == EOS)) { if (getarg (i + 2, junk, 1) ~= EOF) { i += 1 if (getarg (i, junk, 2) == 1) c = junk (1) } } elif (getarg (i + 1, junk, 1) == EOF) break } call scopy (last_arg, 1, banner_text, 1) if (reverse_video == YES) { foreground_sym = ' 'c background_sym = c } else { foreground_sym = c background_sym = ' 'c } return end # output --- print a line on standard output subroutine output (line) integer line (ARB) integer l (134), i DB call print (ERROUT, "call output (line)*n.") do i = 1, 132 l (i) = line (i) l (133) = NEWLINE l (134) = EOS call putlin (l, STDOUT) return end # block data for banner program include "banner_data.r.i"