I got a couple of requests for my all-REXX block letter routine, so here it
is. There should be no EBCDIC-ASCII problems; there are no strange
characters in here that I know of.
Right now this program just displays its output. Obviously it could be made
to return it to a caller. I leave it to the reader to work out how the
algorithm works. There are doubtless more elegant ways of doing this in REXX.
If you make useful changes, please post them.
Tony H.
/* REXX Block letters from a string */
/* This is a REXX version of the JES2 block letter algorithm. */
/* It uses the tables from the MVS 3.8 version of JES2 (which */
/* by a remarkable coincidence are identical to those in the */
/* current version of JES2). */
/* */
/* This program is in the public domain. */
/* */
/* The argument string consists of a signed number for the */
/* amount of slant the letters should have, followed by */
/* the text to be converted into block letters. In practice, */
/* sign values larger than 2 are not very useful. */
/* */
/* Examples: block 0 test Upright letters */
/* block 1 HELLO Right slanted letters */
/* block -2 test Steeply left slanted letters */
/* */
/* Case is not significant on input; only uppercase output */
/* is generated. Designing readable letter patterns is */
/* harder than it looks, but it is certainly possible to */
/* add patterns for new characters. Each block letter is */
/* made up of the letter itself, but this can be changed */
/* to use a single common character such as "@" by un- */
/* commenting one line. Generally the dense characters */
/* like @, #, * work well, while light ones like . and + */
/* make for very thin output. */
/* */
b. ='000000000000000000000000000000000000000000000000'
b.a='7FE0FFF0C030C030C030FFF0FFF0C030C030C030C030C030'
b.b='FFE0FFF0C030C030C060FFC0FFC0C060C030C030FFF0FFE0'
b.c='7FE0FFF0C030C000C000C000C000C000C000C030FFF07FE0'
b.d='FF80FFC0C060C030C030C030C030C030C030C060FFC0FF80'
b.e='FFF0FFF0C000C000C000FF00FF00C000C000C000FFF0FFF0'
b.f='FFF0FFF0C000C000C000FF00FF00C000C000C000C000C000'
b.g='7FE0FFF0C030C000C000C000C1F0C1F0C030C030FFF07FE0'
b.h='C030C030C030C030C030FFF0FFF0C030C030C030C030C030'
b.i='7FE07FE0060006000600060006000600060006007FE07FE0'
b.j='3FF03FF0030003000300030003000300C300C300FF007E00'
b.k='C030C060C0C0C180C300FE00FE00C300C180C0C0C060C030'
b.l='C000C000C000C000C000C000C000C000C000C000FFF0FFF0'
b.m='C030E070F0F0D9B0CF30C630C030C030C030C030C030C030'
b.n='C030E030F030D830CC30C630C330C1B0C0F0C070C030C010'
b.o='FFF0FFF0C030C030C030C030C030C030C030C030FFF0FFF0'
b.p='FFE0FFF0C030C030C030FFF0FFE0C000C000C000C000C000'
b.q='7FE0FFF0C030C030C030C030C030C330C1B0C0F0FFE07FB0'
b.r='FFE0FFF0C030C030C030FFF0FFE0C300C180C0C0C060C030'
b.$='06007FE0FFF0C630E6007FC03FE00670C630FFF07FE00600'
b.s='7FE0FFF0C030C000E0007FC03FE000700030C030FFF07FE0'
b.t='FFF0FFF00600060006000600060006000600060006000600'
b.u='C030C030C030C030C030C030C030C030C030C030FFF07FE0'
b.v='C030C030C030C030C030C030C030606030C019800F000600'
b.w='C030C030C030C030C030C030C630CF30D9B0F0F0E070C030'
b.x='C030C030606030C019800F000F00198030C06060C030C030'
b.y='C030C030606030C019800F00060006000600060006000600'
b.z='FFF0FFF0006000C001801FC01FC00C00180030007FF0FFF0'
b.0='3FC07FE0C0F0C1B0C330C630CC30D830F030E0307FE03FC0'
b.1='06000E001E0006000600060006000600060006007FE07FE0'
b.2='7FE0FFF0C0300030003000600180060018006000FFF0FFF0'
b.3='7FE0FFF0C0300030003001E001E000300030C030FFF07FE0'
b.4='038007800D80198031807FF0FFF001800180018001800180'
b.5='FFF0FFF0C000C000C000FF80FFC0006000300030FFF0FFE0'
b.6='7FE0FFF0C030C000C000FFE0FFF0C030C030C030FFF07FE0'
b.7='FFF0FFE0C0C0018003000600060006000600060006000600'
b.8='7FE0FFF0C030C03060603FC03FC06060C030C030FFF07FE0'
b.9='7FE0FFF0C030C030C030FFF0FFF000300030C030FFF07FE0'
b.#='30C030C0FFF0FFF030C030C030C030C0FFF0FFF030C030C0'
[EMAIL PROTECTED]'3FC07FE0C030003000301E303F306330C330C3307FE03FC0'
h.0 = '0000'
h.1 = '0001'
h.2 = '0010'
h.3 = '0011'
h.4 = '0100'
h.5 = '0101'
h.6 = '0110'
h.7 = '0111'
h.8 = '1000'
h.9 = '1001'
h.a = '1010'
h.b = '1011'
h.c = '1100'
h.d = '1101'
h.e = '1110'
h.f = '1111'
Parse Upper arg slant s
If \ Datatype(slant,'N') then
Do
Say "Error - slant value must be numeric."
Exit 8
end
posslant = Sign(slant) == 1
negslant = Sign(slant) == -1
slant = Abs(slant)
do line = 0 to 11
out = ''
do i = 1 to length(s)
char = substr(s,i,1)
mask = b.char
/* char = "@" */ /* Uncomment to use @ for all output characters */
mask1= substr(mask,line*4+1,1)
mask2= substr(mask,line*4+2,1)
mask3= substr(mask,line*4+3,1)
string1 = h.mask1
string2 = h.mask2
string3 = h.mask3
string = string1 || string2 || string3 || '0'
out = out || translate(string, ' ' || char, '01')
end
out = left(' ',slant*((11-line)*posslant + line*negslant)) || out
say out
end
Exit 0
/* End of REXX block letter routine */
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [EMAIL PROTECTED] with the message: GET IBM-MAIN INFO
Search the archives at http://bama.ua.edu/archives/ibm-main.html
