This makes box letters out of a text string of up to 6 words but width
of box letter is just 1 letter.
I tweaked it a little, Frank was the mastermind.
/* REXX ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
/* */
/* */
/* Name: NAME OF REXX */
/* Type: TSO exec */
/* Author: Frank Clarke, Oldsmar, FL. */
/* Requires: - */
/* Description: */
/* */
/* Invocation : TSO BLOX 'what you want in box letters' */
/* trace Ir */
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
arg p1 p2 p3 p4 p5 p6 p7 p8
instr = p1 p2 p3 p4 p5 p6 p7 p8
Signal On Failure
Signal On Syntax
Signal On Novalue
Signal On Error
Signal On Halt
Call Main_Routine
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
/* Normal Finish */
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
Signal Off Failure
Signal Off Syntax
Signal Off Novalue
Signal Off Error
Signal Off Halt
"DELSTACK"
Exit RC
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
/* Error handling */
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
Failure: Say "Command failed on line" Sigl; Call Cleanup; Exit(12);
Syntax: Say "Syntax error on line" Sigl; Call Cleanup; Exit(12);
Novalue: Say "Novalue used on line" Sigl; Call Cleanup; Exit(12);
Error: Say "Command error on line" Sigl; Call Cleanup; Exit(12);
Halt: Say "User terminated on line" Sigl; Call Cleanup; Exit(12);
Cleanup:
Say '*** 'SYSVAR('SYSICMD')' failed'
Return
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
/* Driver */
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
Main_Routine:
If instr='' then Do
Say 'enter TSO BLOX then up to 6 words(character strings) to box'
End
DSN = USERID()"."SYSVAR('SYSICMD')".FORMAT"
SC = LISTDSI("'"DSN"'")
If SC = 0 Then
"DELETE '"DSN"'"
Address TSO "ALLOC F(BLOXDD) DA('"DSN"')
NEW CATALOG UNIT(3390)
RECFM(F B) LRECL(480) BLKSIZE(24000)"
/* "ALLOC FI(BLOXDD) DA(*) SHR REU" to the terminal */
/* "FREE FILE(BLOXDD)" */
If rc > 0 then do
say "Allocation failed for "DSN"."
Signal Halt
End
call SET_PATN
"DELSTACK"
"NEWSTACK"
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)
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
end /* i for 7 lines */
/*"CLEAR" /* clear screen */
SAY '::::::::::::::::::::::::::::::::::::::::::::::::::::::: '
SAY '::::::::::::::::::::::::::::::::::::::::::::::::::::::: ' */
"EXECIO" queued() "DISKW BLOXDD (FINIS"
"FREE FI(BLOXDD)"
Return
SET_PATN:
patn.=""
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 */
-----Original Message-----
From: IBM Mainframe Discussion List [mailto:[EMAIL PROTECTED] On
Behalf Of John P Donnelly
Sent: Friday, May 09, 2008 8:17 AM
To: IBM-MAIN@BAMA.UA.EDU
Subject: Re: absurd programs that used to be everywhere ...
.got one...
//GOTHIC EXEC PGM=GOTHIC,PARM='X '
//SYSPRINT DD SYSOUT=*
//*
//* PARM=FOREGROUND BLANK BACKGROUND
//* PARM='X ' OR PARM='. MW*'
//* X CREATES WHITE BACKGROUND WITH PRINTED LETTERS.
//* . MW CREATES DARK BACKGROUND WITH BLANK LETTERS.
//*
//* DATA CARDS
//* TWO BLANKS TERMINATE CARD
//* DEFAULT IS LOWER CASE. USE _LETTER FOR UPPER CASE.
//*
//SYSIN DD *
1970 _MOI
/*
...provide an address and preferred method of shipping...
...executes on our z/OS V1R7, but you gotta have the printers...
-----Original Message-----
From: F. J. Kelley [mailto:[EMAIL PROTECTED]
Sent: Friday, May 09, 2008 6:21 AM
To: IBM-MAIN@BAMA.UA.EDU
Subject: absurd programs that used to be everywhere ...
(Sincere apologies, I already hate myself for even asking this, but ...)
Our computer center is having its 50th anniversary and digging up all
kinds of stuff from the "old days". The 3330 disk I had has already
been grabbed.
I am the last mf support person on the academic side (we still have a
robust administrative side that uses the mainframe), but it is thought I
have all sorts of programs from the 70's and 80's on hand.
(well, I do still have the startrek load module, but that's something of
an accident)
Anyway, I've been asked if I can provide banners ... sheesh ...
The kind printed on fanfold (ie greenbar) paper.
(I'd settle for giving them a snoopy calendar, though they really want
the banners) I remember SAS Proc GSLIDE was often used for this kind
of stuff, but not on an impact printer. Anyone still have one of those
programs?
thanks and apologies for burdening the list with this silliness (but now
I can say "i asked").
-- Joe Kelley
[EMAIL PROTECTED]
----------------------------------------------------------------------
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
----------------------------------------------------------------------
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
----------------------------------------------------------------------
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
