/* 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:                           */

/*      .......                                                      */
/*      .......                                                      */
/*      .......                                                      */
/*      .......                                                      */
/*      .......                                                      */
/*      .......                                                      */
/*      .......                                                      */
/*      .......                                                      */
/*      .......                                                      */