/* 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 " say " " say " : 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: */ /* ....... */ /* ....... */ /* ....... */ /* ....... */ /* ....... */ /* ....... */ /* ....... */ /* ....... */ /* ....... */