/* REXX BLOX create block letters from an input string.
for each of eight lines
for each letter in string
get pattern for letter
get sub-pattern for this line
build slug
attach to line
write the line
Written by Frank Clarke, Oldsmar, FL
*/
address TSO
signal on syntax
tv="" ; odsn="" /* ensure values */
sav = ""
parse upper arg instr "((" parms /* get parameters */
if instr="" & parms="" then call HELP /* no parms at all */
parms = Strip(parms,T,")") /* clip trailing paren */
parse value KEYWD("TRACE") "O" with tv .
odsn = KEYWD("OUTPUT") /* output to file ? */
if Pos("(",odsn) > 0 then, /* has a left banana */
if Pos(")",odsn) = 0 then, /* but no right banana */
odsn = Space(odsn")",0) /* add one */
prompt = \SWITCH("NOPROMPT")
diagnose = SWITCH("DIAGNOSE")
instr = Strip(instr) /* clean the input */
rc = Trace(tv)
if odsn <> "" then do /* was a value */
"ALLOC FI(BLOXDD) DA("odsn") SHR REU"
if rc > 0 then do /* doesn't exist ? */
"ALLOC FI(BLOXDD) DA("odsn") NEW REU SPACE(1) TRACKS",
" RECFM(V B) LRECL(121) BLKSIZE(1210) UNIT(SYSDA)"
if rc > 0 then do /* ...and couldn't create it! */
say "Allocation failed for "odsn"."
exit
end /* alloc NEW */
end /* alloc SHR */
end /* alloc dataset */
else "ALLOC FI(BLOXDD) DA(*) SHR REU" /* to the terminal */
call SET_PATN /* -*/
if tv = "O" then "CLEAR" /* clear screen */
if instr = "" then do /* no input ? */
say ":" /* initial prompt */
"NEWSTACK"
pull instr
"DELSTACK"
end
do forever
do while instr <> ""
if length(instr) > 8 then do /* too long */
parse var instr instr 9 sav /* save the excess */
end
do i = 1 to 7 /* for 7 lines */
outline="" /* clear it */
do j = 1 to Length(instr) /* for each letter */
ltr = Substr(instr,j,1) /* isolate it */
ltrpos = Pos(ltr,choices) /* where in the array ? */
if ltrpos = 0 then ltrpos = 47 /* set to blank */
byte = Substr(patn.ltrpos,i*2-1,2)
if diagnose then say ltr byte X2B(byte)
slug = X2B(byte) /* character-to-binary */
slug = Translate(slug," ","0") /* off -> blank */
slug = Translate(slug,ltr,"1") /* on -> letter */
outline = outline slug /* splice to the line */
end /* j for length(instr) */
queue outline /* into the queue */
end /* i for 7 lines */
instr = ""
queue " " /* blank line */
queue " " /* blank line */
rc = Trace("O")
rc = Trace(tv)
if sav <> "" then do /* was there excess ? */
instr = sav /* restore it */
sav = "" /* indicate "no excess" */
end
end /* while instr filled */
if prompt then,
if instr = "" then do /* no more input ? */
say ":" /* prompt for more */
"NEWSTACK"
pull instr
"DELSTACK"
end
if instr = "" then leave /* prompt was refused */
end /* forever */
rc = Trace("O") ; rc = Trace(tv)
"EXECIO" queued() "DISKW BLOXDD (FINIS" /* flush to output */
"FREE FI(BLOXDD)"
exit
/*
. ----------------------------------------------------------------- */
SET_PATN: /*@ */
patn.="" /* storage for patterns */
patn.1 = "081422417F4141" /* A */
patn.2 = "7E41417E41417E" /* B */
patn.3 = "3E41404040413E" /* C */
patn.4 = "7C42414141427C" /* D */
patn.5 = "7F40407C40407F" /* E */
patn.6 = "7F40407C404040" /* F */
patn.7 = "7E41404047417E" /* G */
patn.8 = "4141417F414141" /* H */
patn.9 = "1C08080808081C" /* I */
patn.10 = "7F02020202423C" /* J */
patn.11 = "41424478444241" /* K */
patn.12 = "4040404040407F" /* L */
patn.13 = "41635549414141" /* M */
patn.14 = "41615149454341" /* N */
patn.15 = "3E41414141413E" /* O */
patn.16 = "7E41417E404040" /* P */
patn.17 = "3E41414145423D" /* Q */
patn.18 = "7E41417E444241" /* R */
patn.19 = "3E41403E01413E" /* S */
patn.20 = "7F080808080808" /* T */
patn.21 = "4141414141413E" /* U */
patn.22 = "41414141221408" /* V */
patn.23 = "41414141494936" /* W */
patn.24 = "41221408142241" /* X */
patn.25 = "41221408080808" /* Y */
patn.26 = "7F02040810207F" /* Z */
patn.27 = "3E43454951613E" /* 0 */
patn.28 = "0818080808083E" /* 1 */
patn.29 = "3E41020408103E" /* 2 */
patn.30 = "7F020C0201413E" /* 3 */
patn.31 = "2040487F080808" /* 4 */
patn.32 = "7F40407E01017E" /* 5 */
patn.33 = "0408103E41413E" /* 6 */
patn.34 = "7F020408080808" /* 7 */
patn.35 = "3E41413E41413E" /* 8 */
patn.36 = "3E41413E040810" /* 9 */
patn.37 = "22227F227F2222" /* # */
patn.38 = "143E403E013E14" /* $ */
patn.39 = "21522408122542" /* % */
patn.40 = "0018241825423D" /* & */
patn.41 = "0022143E142200" /* * */
patn.42 = "04081010100804" /* ( */
patn.43 = "10080404040810" /* ) */
patn.44 = "0000003E000000" /* - */
patn.45 = "00181800181800" /* : */
patn.46 = "00000000000000" /*blank */
patn.47 = "00181800181808" /* ; */
patn.48 = "3E410104080008" /* ? */
choices ="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789#$%&*()-: ;?"
return /*@ SET_PATN */
/*
. ----------------------------------------------------------------- */
HELP: /*@ */
"CLEAR" /* clear screen */
say " "
say " BLOX is a REXX routine which will build 8x7 block letters "
say " from text you specify. "
say " "
say " BLOX can handle strings to length=8 and will write either to "
say " the screen-face or to a file you name. Syntax for BLOX is: "
say " BLOX <string> <options> "
say " "
say " <options>: OUTPUT output-dsname "
say " "
exit /*@ HELP */
/*-------------------------------------------------------------------*/
KEYWD: Procedure expose, /*@ */
kw parms
arg kw .
if Wordpos(kw,parms) = 0 then,
kw_val = ""
else,
if Wordpos(kw,parms) = 1 then,
kwa = kw" "
else kwa = " "kw" "
parse var parms . value(kwa) kw_val .
if kw_val <> "" then parms = Delword(parms,Wordpos(value(kw),parms),2)
return kw_val /*@ KEYWD */
/*-------------------------------------------------------------------*/
SWITCH: /*@ */
arg kw .
sw_val = Wordpos(value(kw),parms) > 0
if sw_val then parms = Delword(parms,Wordpos(value(kw),parms),1)
return sw_val /*@ SWITCH */
/*-------------------------------------------------------------------*/
SYNTAX: /*@ */
errormsg = "REXX error" rc "in line" sigl":" errortext(rc)
say errormsg
say sourceline(sigl)
Trace "?R"
nop
exit /*@ SYNTAX */
/* Work area for creating new patterns: */
/* ....... */
/* ....... */
/* ....... */
/* ....... */
/* ....... */
/* ....... */
/* ....... */
/* ....... */
/* ....... */