$T.REX

This is the $T.REX (REXX) program which is used by other REXX programs to display error or informational message(s),
some of the options follow):

in color(s) (if supported)
highlights (in color) parts (up to 8 unique parts) of the text (if supported)
write text to a file
breaks the text into multiple lines
adds indentation
justifies the text: left/right/center/justify (autofill)
add blank lines before and/or after the displaying of text
boxing (around) the text
add spacing around the text inside the box
only showing specific lines of the text messages
suppressing specific lines of the text messages
translation of certain characters in the text
allowing other characters to be used for blanks
repeating a text
allows remarks in the text
writes the message, waits for a confirmation to proceed
delaying (waiting) after the text is displayed
showing a scale and/or a ruler above/below the text message(s)
supports hex/dec/bit strings
changing the case of the text
reverses the text
inverts the bits for certain characters
sounds alarm (beeps) after the text is displayed (if supported)
displays the text in reverse video (if supported)
displays the text in (big) block letters
clear the screen after or before the displaying of text
allows user-define option character, the default is . (period)
and many other options

The help for the $T REXX program is included here ──► $T.HEL.

The $T REXX program makes use of $ERR REXX program which is used to display error messages (via $T).
The $ERR REXX program is included here ──► $ERR.REX.

The $T REXX program makes use of LINESIZE BIF which returns the terminals width (linesize).
Some REXXes doen't have a LINESIZE BIF, so one is included here ──► LINESIZE.HEL.

The $T REXX program makes use of SCRSIZE BIF which returns the terminals width (linesize) and depth.
Some REXXes doen't have a SCRSIZE BIF, so one is included here ──► SCRSIZE.HEL.

The $T REXX program makes use of DELAY BIF which delays (sleeps) for a specified amount of seconds.
Some REXXes doen't have a DELAY BIF, so one is included here ──► DELAY.REX.

The $T REXX program makes use of SOUND BIF which produces sounds via the PC speaker.
Some REXXes doen't have a SOUND BIF, so one is included here ──► SOUND.REX.

REXX programs not included are $H which shows help and other documentation. <lang rexx>/**/ trace off /* There be many dragons below. */ parse arg ! if !all(0) then exit 0 /*help options and boilerplate.*/

zz = !! /*save a copy of original args. */ if !cms then address signal on halt /*be able to handle a HALT. */ signal on novalue /*catch REXX vars with noValue. */ signal on syntax /*catch REXX syntax errors. */ numeric digits 300 /*be able to handle some big 'uns*/

hues=space( 'BLACK 0;30', /*define some colors for DOS. */

           'BROWN     0;33',
           'DEFAULT   1;37',
           'GRAY      1;37',
           'BLUE      1;34',
           'GREEN     1;32',
           'TURQUOISE 1;36',
           'RED       1;31',
           'PINK      1;35',
           'YELLOW    1;33',
           'WHITE     1;37',
           'BRITE     1;37')          /*colors for  DOS  via  ANSI.SYS */

_= /*(below) set some vars ──> NULL */ parse var _ ?. @ color. colorC. ahics ehics hold lz more onlyo onlys,

           scr0 shics VMout VScolor VSdisp x1 x2

@abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU = @abc; upper @abcU

ms = 0

?.a = 0 ?.b = 0 ?.block = 0 ?.e = 0 ?.end = 0 ?.i = 0 ?.ks = 0 ?.L = 0 ?.p = 0 ?.q = 0 ?.r = 0 ?.ruler = 0 ?.s = 0 ?.scale = 0 ?.ts = 0 ?.x = 0 ?.z = 0 boxing = 0 highL = 0 LLd = 0 LLk = 0 LLx = 0 maxhic = 0

1. = 1

hue# = 1 minhic = 1 ?.t = 1

?.bd = .2 ?.bf = 800 ?.bs = 2 ?.o = 9999 ?.rulerb = ' ' ?.scaleb = ' ' ?.scaled = '.' ?.scalep = '+' ?.use = '.' esc = '1b'x"["

his='H() H{} H[] H<> H≤≥ H«» H/\"'

                                      do jh=1  for 7
                                      hh.jh=substr(word(his,jh),2)
                                      end   /*jh*/

                boxCH = '+-+|+-+|'    /*define some boxing characters. */

if !ebcdic then boxCH = 'acbfbcfabbbfabfa'x /*¼┐╝·╗┐½· <──single box.*/ if !dos then boxCH = 'c9cdbbbabccdc8ba'x /*╔═╗║╝═╚║ <──double box.*/

if !pcrexx| !r4 | !roo then do /*use pre-saved color values. */

                            _=translate(!var('SCREEN'), ,";,") /*envVar*/
                            if \datatype(space(_,0), "W")  then _='36 40'
                            scr0=esc || translate(0 _, ';', " ")'m'
                            colorC.0=scr0
                            colorC.1=esc"1;33m"
                            end
 do jz=1  while zz\==
 if ?.end==1 | pos('=',zz)==0 | pos(" "?.use,' 'zz)==0  then do
                                                             @=@ zz
                                                             leave
                                                             end
 if left(zz,1)==' '  then lz=lz" "
 parse var zz yy1 2 yy2 3 1 yy ' ' zz

 if yy1==?.use & pos('=',yy)\==0 & datatype(yy2,"U")  then
    do 1
    parse var yy 2 _ "=" dotv 2 _1 3
    if datatype(_,'U')  then
      do
      L1=length(_)==1
      if L1  then do
                  if _=='H'  then ?.hi.1=dotv
                             else ?._=dotv
                  iterate jz
                  end
             else select
                  when _=='BIN' then yy=valn("'"dotv"'B",'BIN',"B")
                  when _=='BOX' then do
                                     if dotv==""  then ?.BOX=boxCH
                                                  else ?.BOX=dotv
                                     iterate jz
                                     end
                  when _=='DEC' then yy=valn("'"dotv"'D",'DEC',"D")
                  when _=='INV' then yy=.inv(dotv)
                  when _=='HEX' then yy=valn("'"dotv"'X",'HEX',"X")
                  when _=='USE' then do
                                     dotv=tb(dotv,"USE",'.')
                                     iterate jz
                                     end
                  otherwise     ?._=dotv;    iterate jz
                  end   /*select*/
      end

    if _1=='H'  then do
                     _=wordpos(_,his)
                     if _\==0  then do
                                    ?.hi._=dotv
                                    iterate jz
                                    end
                     end
    end  /*1*/

 if @==  then @=lz || yy
           else @=@ yy
 lz=
 end     /*jz*/

if left(@,1)==' ' then @=substr(@,2) /*handle this special case. */

if ?.a\==0 then call .a if ?.a\==0 then call .b if ?.block\==0 then call .block if ?.c\== then call .c hue.1=colorC.0 if ?.d\== then call .d if ?.e\==0 then call wn 'E',0,99,sd() ?.eb=tb(?.eb,'EB') if ?.ef\== then call .ef if ?.f\== then call .f

                     do _j=1  for 7
                     _=?.hi._j
                     if _\== & \!regina  then do
                                                call colors _,"H"hh._j,_j
                                                highL=1
                                                end
                     end   /*_j*/

if ?.i\==0 then do; call wn 'I',0,sw(); ?.ib=tb(?.ib,'IB'); end if ?.j\== then call .j if ?.k\== then ?.k =valn(?.k,"K") if ?.kd\== then ?.kd=valn(?.kd,"KD") if ?.k\== then if ?.kd\=="" then call er 61, '.K= .KD=' if ?.ks\==0 then call .ks if ?.L\==0 then call .L if ?.o\==9999 then call .o if ?.p\==0 then do; call wn 'P',-99,99; ?.pb=tb(?.pb,'PB'); end if ?.q\==0 then call wn 'Q',0,1 if ?.r\==0 then call wn "R",0,99; ?.r=?.r+1 if ?.ruler\==0 then call .ruler if ?.s\==0 then call .s; ?.s=?.s+1 if ?.scale\==0 then call .scale if ?.t\==1 then call .t if ?.u\== then call .u ?.ub=tb(?.ub,'UB') if ?.ut\== then call .ut if ?.v\== then call .v ?.xb=tb(?.xb,'XB') if ?.z\==0 then call wn 'Z',0,99,,"N" if ?.box\== then call .box if highL then call highLight indent=copies(?.ib,?.i) if ?.x\==0 then call .x @=copies(@,?.r) ll=length(@) if ?.ub\==' ' then @=translate(@,?.ub," ") _=length(?.ut)%2 if _\==0 then @=translate(@,right(?.ut,_),left(?.ut,_)) tx.1=@ xk=?.k || ?.kd if xk\== then call .xk if LLk\==0 then LL=LLk

if ?.block\==0 then tLL=12+max(LL-1,0)*(12+?.bs)

                else tLL=LL

bline=strip(indent || x1 || copies(?.ab, tLL+4*boxing)x2, 'T')

if boxing then call ms bx.1 || copies(bx.2, LLx+tLL+2)bx.3 caLL VEReb ?.e,?.eb

 do jt=1  for ?.t
 if jt\==1  then  if jt\==?.t  then  call VEReb ?.ts,?.tsb

   do jj=1  for ##
   if jj\==1     then call VEReb ?.ks,?.ksb

   if boxing     then _=left(tx.jj,tLL)
                 else _=tx.jj

   if ?.v=='R'   then _=reverse(_)

   if ?.u\==   then select
                      when ?.u=='A'  then nop
                      when ?.u=='U'  then upper _
                      when ?.u=='L'  then _=lower(_)
                      when ?.u=='F'  then _=proper(_)
                      when ?.u=='W'  then do
                                        __=
                                                 do jw=1  for words(_)
                                                 __=__ proper(word(_,jw))
                                                 end   /*jw*/

                                        _=strip(__)
                                        end
                      end   /*select*/

   if ?.block==0 then call tellIt _
                 else call blocker
   end   /*jj*/
 end     /*jt*/

call VEReb ?.e,?.eb if boxing then call ms bx.7 || copies(bx.6,LLx+tLL+2)bx.5 call beeps ?.b call .p if ?.ruler<0 then call inches ?.ruler,0 if ?.scale<0 then call inches ?.scale,1

 select  /* <══════════════════════════where the rubber meets the road.*/
 when highL                                    then call sayHighlight
 when \highL & (?.c=='BRITE' | ?.c=="BRIGHT")  then call sayBright
 when ?.L\==0                                  then call sayAline
 otherwise                                          call sayNline
 end  /*select*/

if ?.c\== then call VMcolor VMout,space(VScolor VSdisp) if ?.b<0 then call call beeps ?.b if ?.z\==0 then call .z if ?.ruler>0 then call inches ?.ruler,0 if ?.scale>0 then call inches ?.scale,1 _=abs(?.a) if _==99 & \?.q then !cls

                 else do min(99,_)
                      call wit bline
                      end   /*min(...*/

if ?.w\== then call .w

if !pcrexx then if ?.q & LLd>79 then if LLd>sw() then say

                             /*(above)  PC-REXX bug: wrapped lines are */
                             /*            overwritten during cleanup. */

return 0

/*──────────────────────────────────.B subroutine───────────────────────*/ .b: call wn 'B',-99,99,sd() /*B is for beeps (sounds). */

if ?.bd\==.2 then do

                  _=translate(?.bd,,',')
                  __=_
                                 do  while __\==
                                 parse var __ ?.bd __
                                 call wn 'BD', .1, 9, ,"N"
                                 end   /*while*/
                  ?.bd=_
                  end

if ?.bf\==800 then do

                  _=translate(?.bf,,',')
                  __=_
                                 do while __\==
                                 parse var __ ?.bf __
                                 call wn 'BF', 1, 20000
                                 end   /*while*/
                  ?.bf=_
                  end

return

/*──────────────────────────────────.BLOCK subroutine───────────────────*/ .block: call wn 'BLOCK',-12,12

                               if ?.bs\==2   then call wn 'BS', -12, sw()
                               if ?.bc\==  then ?.bc = tb(?.bc, "BC")

?.bb=tb(?.bb,'BB') return

/*──────────────────────────────────.BOX subroutine─────────────────────*/ .box: _=?.box; upper _ if _=='*NONE*' then ?.box= boxing= ?.box\== if \boxing then return

if _=='SINGLELINE' then _=boxCH if length(_)>8 then call er 30, '.BOX='_ "boxcharacters 1 8" ?.box=left(_,8,right(_,1))

                                    do _=1  for 8
                                    bx._=substr(?.box,_,1)
                                    end   /*_*/

_=verify(@,' ')-1 if _>0 then @=@ || copies(" ",ldb) return

/*──────────────────────────────────.C subroutine───────────────────────*/ .c: call colors ?.c,'C',0

if !cms then do

             call cp 'QUERY SCREEN',1
             parse var cp.1 "VMOUT" VMout
             'QUERY VSCREEN CMS ALL(LIFO'
             if rc==0  then pull "(" . . VScolor VSdisp .
             if ?.c=='BRITE'  then call VMcolor "DEFAULT NONE"
                              else call VMcolor color.0 ?.d, color.0  ?.d
             end

if !regina then ?.c= /*Regina can't handle colors. */ return

/*──────────────────────────────────.D subroutine───────────────────────*/ .d: upper ?.d

    _ =   ?.d

if \(abbrev('BRITE',_,3) |,

    abbrev("BRIGHT",_,3)   |,
    abbrev('HIGHLIGHT',_)  |,
    abbrev("NONE",_,3)     |,
    abbrev('REVVIDEO',_,3) |,
    abbrev("UNDERLINE",_,3))      then call er 55, _ ".D="

if !regina then ?.d= /*Regina can't handle DISP's. */

           else  if  left(_,1)=='H'      then  highL=1

return

/*──────────────────────────────────.EF subroutine──────────────────────*/ ef: if ?.f\== then call er 61, '.F= .EF=' /*conflicting options.*/

       ?.f = ?.ef

return

/*──────────────────────────────────.F subroutine───────────────────────*/ .f: _=?.f /*File where the text is written.*/ if !cms then do

             _=translate(_, , '/,')   /*try to translate to CMS format.*/
             if words(_)>3  then call er 10, ?.f
             ?.f = _ word(subword(_,2)  !fn,1)  word(subword(_,3) 'A1',1)
             end

__=lastpos("\",_) if !dos & ?.ef== & __\==0 then call $mkdir left(_,__) return

/*──────────────────────────────────.INV subroutine─────────────────────*/ .inv: return x2c( b2x( translate( x2b( c2x( arg(1) ) ), 01, 10) ) )

/*──────────────────────────────────.J subroutine───────────────────────*/ .j: upper ?.j /*Justify (or not) the text. */

    if ?.j== then ?.j = 'N'         /*Justify  (or not)  the text.   */
               else ?.j=left(?.j,1)   /*just use the first letter of .J*/

if pos(?.j,"ACJLNR")==0 then call er 55, ?.j '.J=' if ?.j=='A' then ?.j= substr(copies('LRC',30),random(1,90),1)

?.jb=tb(?.jb,'JB') /*while we're here, handle JB. */ return

/*──────────────────────────────────.KS subroutine──────────────────────*/ .ks: call wn 'KS', 0, 99, sw()

    ?.ksb = tb(?.ksb, 'KSB')          /*blank lines between karate chop*/

return

/*──────────────────────────────────.L subroutine───────────────────────*/ .L: upper ?.L /*Line(s) for the text is shown. */

    if !cms then do
                 '$QWHAT DSC'
                 if rc==4  then ?.L=0
                 end

if ?.L=='CMSG' then ?.L="*" call wn 'L',-sd(),sd() if ?.L<0 then ?.L=sd()-?.L return

/*──────────────────────────────────.O subroutine───────────────────────*/ .o: call wn 'O',-999,999,9999

if ?.o<0 then do

              onlyo=-?.o
              ?.o=9999
              end

return

/*──────────────────────────────────.P subroutine───────────────────────*/ .p: if ?.q then return /*Post (writting) blank lines. */ _=?.p

if _>98 |,

  _<0  then do 1
            if !cms       & _>9998     then call CPmore
            !cls
            if \!cms                   then leave  /*1*/

            if _>9998     & more\==  then call CP 'TERMINAL MORE' more
            if _>99999998 & hold\==  then call CP 'TERMINAL HOLD' hold
            if _>99999998 & hold\==  then call CP 'TERMINAL HOLD' hold
            end   /*1*/

  do  abs(_)  while _<99
  call wit bline
  end   /*abs*/
                        do _=1  to -?.a
                        call wit  bline
                        end  /*_*/

return

/*──────────────────────────────────.RULER subroutine───────────────────*/ .ruler: call wn 'RULER', -sw(), sw() /*RULER draws a "ruler" line. */ ?.rulerb = tb(?.rulerb, 'RULERB') return

/*──────────────────────────────────.S subroutine───────────────────────*/ .s: call wn "S", -999, 999, 999 /*Skip (or suppress) line(s). */

if ?.s<0 then do

              if left(?.o,1)=='-' then  /*check for conflicting options*/
                    call er 61,"O="?.o 'S='?.s "(both can't be negative)"
              onlys = -?.s
              ?.s   = 0
              end

if left(?.o,1)=="-" & left(?.s,1)=='-' then

                    call er 61,"O="?.o 'S='?.s "(both can't be negative)"

return

/*──────────────────────────────────.SCALE subroutine───────────────────*/ .scale: call wn 'SCALE', -sw(), sw() /*SCALE draws a "scale" line. */

        ?.scaleb = tb(?.scaleb, 'SCALEB')
        ?.scaled = tb(?.scaled, 'SCALED', ".")
        ?.scalep = tb(?.scalep, 'SCALEP', "+")

return

/*──────────────────────────────────.T subroutine───────────────────────*/ .t: call wn 'T', 0, 99 /*Times the text is written. */ if ?.ts\==0 then call wn 'TS', 0, 99

                 ?.tsb = tb(?.tsb, 'TSB')

return

/*──────────────────────────────────.U subroutine───────────────────────*/ .u: upper ?.u /*handle uppercasing text parts. */

         ?.u = left(?.u, 1)
         if pos(?.u, " AFLUW")==0  then call er 55, ?.u  '.U='
         if ?.u==' ' | ?.u=='A'    then ?.u=

return

/*──────────────────────────────────.UT subroutine──────────────────────*/ .ut: call wn 'T', 0, 99 /*Times the text is written. */

         ?.ut=valn(?.ut, "UT")

         if length(?.ut)//2==1  then
                 call er 30,?.ut 'translate-characters an-even-number-of'

return

/*──────────────────────────────────.V subroutine───────────────────────*/ .v: upper ?.v /*video mode, Normal -or- Reverse*/

         ?.v=left(?.v, 1)
         if pos(?.v, " NR")==0   then call er 55, ?.v  '.V='
         if ?.v==' ' | ?.v=='N'  then ?.v=

return

/*──────────────────────────────────.W subroutine───────────────────────*/ .w: if ?.q then return

         if ?.wb\== then ?.wb=tb(?.wb, 'WB')

         ww=translate(?.w,,"_")
         if ww='dd'x  then ww = "press any key to continue ..."
         if ww='de'x  then ww = "press the  ENTER  key to continue ..."
                          call '$T' ".C=yel" translate(ww,?.wb,' ')
         if ww='dd'x  then call inkey
         if ww='de'x  then pull external

return

/*──────────────────────────────────.X subroutine───────────────────────*/ .x: call wn 'X', -sw(), sw()

         x2 = copies(?.xb, abs(?.x))
         if ?.x<0  then x1=x2
         LLx = length(x1 || x2)

return

/*──────────────────────────────────.XK subroutine──────────────────────*/ .xk: do ##=1

         parse var @ _ (xk) @
         if _==  &  @==""  then leave
         tx.## = _
         if @\==           then tx.## = tx.## || ?.k
         tx.## = strip(tx.##)
         LLk = max(LLk, length(tx.##))
         end    /*##*/

1. =##-1

return

/*──────────────────────────────────.Z subroutine───────────────────────*/ .z: _z=word(arg(1) ?.z, 1) /*snore subroutine: zzzzzz... */

         if _z=0  then return
         if !cms  then call cp 'SLEEP' _z "SEC"
         if !dos  then call delay _z

return

/*──────────────────────────────────BEEPS subroutine────────────────────*/ beeps: if \!dos & !pcrexx then return /*can this OS handle sounds? */

         do jb=1  for abs(arg(1))
         if jb\==1  then call delay .1

                  do jb_=1  for words(?.bf)
                  call sound word(?.bf, jb_),  word(word(?.bd,jb_) .2,1)
                  end  /*jb_*/

         end           /*jb */

return

/*──────────────────────────────────BLOCKER subroutine──────────────────*/ blocker: do jc=1 for LL /*process some blocked characters*/

                  chbit.jc = $block(substr(_, jc, 1))
                  end   /*jc*/

bcl = ?.block bcs = 1

if bcl<0 then do

                bcl=-bcl
                bcs=3*bcl-2
                end

if _== then _=' ' tbc = ?.bc if tbc== then tbc=_ tbc = left(copies(tbc,1+sw()%length(tbc)),sw())

 do jl=bcs  to 3*bcl  by 3
 _ = copies(?.bb, max(1, 12*LL+?.bs*LL-?.bs))
 bix = 1
                  do jo=1  for LL
                  _ = overlay(translate(x2b(substr(chbit.jo, jl, 3)),,
                                     substr(tbc, jo, 1)?.bb, 10), _, bix)
                  bix = max(1, bix+?.bs+12)
                  end   /*jo*/
 call tellIt _
 end     /*jl*/

return

/*──────────────────────────────────COLORS subroutine───────────────────*/ colors: arg hue,__,cc#,cc /*verify/handle synonymous colors*/ dark = left(hue,4)=='DARK' if dark then hue = substr(hue,5) if hue=='BRITE' | hue=="BRIGHT" then hue = 'WHITE' if left(hue,5)=='BRITE' then hue = substr(hue,6) if left(hue,6)=="BRIGHT" then hue = substr(hue,7) if abbrev('MAGENTA',hue,3) then hue = "PINK" if abbrev('CYAN' ,hue,3) then hue = "TURQUOIS" if hue=='GREY' then hue = "GRAY"

 do jj=1  to words(hues)  by 2
 ahue=word(hues,jj)
 if abbrev(ahue,hue,3)  then do
                             cc=word(hues,jj+1)
                             hue=ahue
                             leave
                             end
  end   /*jj*/

if cc== then call er 50, "color" '.'__"="hue if dark & left(cc,2)=='1;' then cc="0"substr(cc,2)

if !cms then do

            if hue='GRAY' | hue=="BLACK"  then hue='WHITE'
            if hue="BROWN"                then hue='YELLOW'
            end

color.cc# = hue colorC.cc# = esc || cc'm' return

/*──────────────────────────────────CPMORE subroutine───────────────────*/ cpMore: call cp 'QUERY TERM', 9 /*parse CP TERMINAL for MORE,HOLD*/

            __=
                     do jj=1  for cp.0
                     __=__ cp.jj
                     end   /*jj*/

            parse upper var __  'MORE'  more  ','  1  'HOLD'  hold  ','
            if _>9998     & more\==  then call  cp  'TERMINAL MORE 0 0'
            if _>99999998 & hold\==  then call  cp  'TERMINAL HOLD OFF'

return

/*──────────────────────────────────DSAY subroutine─────────────────────*/ dsay: if ?.q then return /*do SAY subroutine, write to scr*/

            dsay_ = strip(translate(arg(1), , '0'x), 'T')
            say  dsay_
            LLd = length(dsay_)       /*length of last line displayed. */

return

/*──────────────────────────────────HIGHLIGHT subroutine────────────────*/ highLight: do _=1 for 7

            hhl._  = color._\==
            hics._ = left(hh._,1)
            hice._ = right(hh._,1)

            if hhl._  then do
                           minhic= min(_,minhic);  shics= shics || hics._
                           maxhic= max(_,maxhic);  ehics= ehics || hice._
                           end
            end   /*_*/

ahics=shics || ehics return

/*──────────────────────────────────HUE subroutine──────────────────────*/ hue: hue#=max(1, hue#+arg(1))

            __=arg(2)
            if __\==  then hue.hue#=__
            _=

return

/*──────────────────────────────────INCHES Subroutine───────────────────*/ inches: /*handle RULER and SCALE stuff.*/ _ = kw('RULERB') kw('SCALEB') kw('SCALEP') kw('SCALED')

if arg(2) then _=$scale(?.scale _ 'Q')

          else _=$scale(?.ruler 'RULE' _ 'Q')

parse var _ _.1 '9'x _.2 '9'x _.3

            do jk=1  for 3
            _=_.jk
            if _\==  then call wit _
            end   /*jk*/

return

/*──────────────────────────────────MS subroutine───────────────────────*/ ms: #ms=#ms+1 /*justification and indentation. */ parse arg _i

 select
 when ?.j==             then nop
 when ?.N=='N'            then nop
 when length(_i)>=sw()-1  then nop
 when ?.j=='C'            then _i = centre(_i, sw()-1, ?.jb)
 when ?.j=='L'            then _i = strip(_i)
 when ?.j=='R'            then _i = right(strip(_i, "T"), sw()-1)
 when ?.j=='J'            then _i = justify(_i, sw()-1, ?.jb)
 end   /*select*/

mm.#ms=strip(indent || _i,'T') return

/*──────────────────────────────────SAYALINE subroutine──────────────────*/ sayAline:

 do jj=?.s  to #ms  for ?.o
 if skp()  then iterate

 if \?.q   then do
                if !cms then '$CLEAR .WL='?.L _mm
                if !dos then call dsay,
                           esc || (?.L-1) || ";0f"colorC.0 || _mm || scr0
                end
 call wr _mm
 ?.L=?.L+1
 if ?.L>sd()  then ?.L=1
 end   /*jj*/

return

/*──────────────────────────────────SAYBRITE subroutine─────────────────*/ sayBrite: do jj=?.s to #ms for ?.o

          if skp()  then iterate
          call wr _mm
          if ?.q   then iterate

          if !cms  then '$CLEAR .C=BRITE' _mm
                   else if !dos then call dsay colorC.0 || _mm || scr0
          end   /*jj*/

return

/*──────────────────────────────────SAYNLINE subroutine─────────────────*/ sayNline: do jj=?.s to #ms for ?.o

          if skp()  then iterate

          if !dos then do
                       if ?.c==  then call dsay _mm
                                   else call dsay colorC.0 || _mm || scr0
                       call wr _mm
                       end
                  else call wit _mm
          end   /*jj*/

return

/*──────────────────────────────────SAYHIGHLIGHT subroutine─────────────*/ sayHighlight:

 do jj=?.s  to #ms  for ?.o
 if skp()   then iterate

 if !cms    then do
                 if \?.q  then '$CLEAR .C=HIGHL' _mm
                 iterate
                 end

 lenmm=length(_mm)
 __=verify(_mm,ahics,'M')

 if __==0   then hc=lenmm+1
            else hc=__
 _xx=hue.1
 if hc>1    then _xx=_xx || left(_mm, hc-1)

   do jl=hc  to lenmm
   _=substr(_mm,jl,1)

     do jc=minhic  to maxhic
     if hhl.jc  then  if _==hics.jc  then call hue 1, colorC.jc
                                     else if _==hice.jc  then call hue -1
     end  /*jc*/

   if _==  then _xx=_xx" "
   __=verify(substr(_mm, jl+1), ahics, 'M')

   if __==0  then pl=lenmm-jl+1
             else pl=__

   if pl==1  then iterate
   _xx=_xx || hue.hue# || substr(_mm, jl+1, pl-1)
   jl=jl+pl-1
   end   /*jl*/

 if length(_xx)>sw()  then if lenmm<=sw()  then _xx = esc's'_xx || esc"u"
 call dsay _xx || scr0
 call wr _mm
 end   /*jj*/

return

/*──────────────────────────────────SKP subroutine──────────────────────*/ skp: if (onlyo\== & onlyo\==jj) |,

        (onlys\==""  &  onlys ==jj)   then return 1

_mm = mm.jj return 0

/*──────────────────────────────────TB subroutine───────────────────────*/ tb: tb=arg(1) /*test|verify Blank specification*/ if tb== then return left(arg(3), 1) if length(tb)==2 then return valn("'"tb"'X", arg(2), 'X') if length(tb)>1 then call er 30, tb "."arg(2)'=' 1 return tb

/*──────────────────────────────────TELLIT subroutine───────────────────*/ tellIt: ___=arg(1) /*tell it to the display terminal*/

               ___ = x1 || ___ || x2

if boxing then ___=bx.8 || ?.eb || ___ || ?.eb || bx.4

       call ms ___

return

/*──────────────────────────────────VALN subroutine─────────────────────*/ valn: procedure; parse arg x,n,k /*validate number (dec,bin,hex). */ _ = left(x, 1) v = "."n'=' if (_\=='"' & _\=="'") | ((right(x,2)\==_||k) & k\==) then return x arg ' ' -1 t x = substr(x,2,length(x)-3) _ = length(x)

if t=='X' then do

                         if \datatype(x, t)     then call er 40, x v
                         return x2c(x)
                         end

if t=='B' then do

                         if \datatype(x, t)     then call er 91, x v
                         return x2c(b2x(x))
                         end

if \datatype(x, 'W') then call er 53, x v return d2c(x)

/*──────────────────────────────────VEREB subroutine────────────────────*/ VEReb: if arg(1)==0 then return /*character for Extra Blank(s). */ eb_ = x1 || copies(?.eb,tLL)x2 if boxing then eb_ = bx.8 || ?.eb || eb_ || ?.eb || bx.4

                                   do jeb=1  for arg(1)
                                   call  ms  eb_
                                   end   /*jeb*/

return

/*──────────────────────────────────VMCOLOR subroutine──────────────────*/ VMcolor: if \!cms then return parse arg c1,c2

                if c1\==  then call cp "SCREEN VMOUT" c1
                if c2\==  then "SET VSCREEN CMS" c2

return

/*──────────────────────────────────WN subroutine───────────────────────*/ wn: procedure expose ?. /*normalize, validate N in range.*/ arg z, L, H, d, t _ = ?.z parse upper var _ f 2 m = pos(f,'MH')\==0

if m | ,

  f=='*' then do
              _ = (word(d H L sw(),1)) / word(1 2,m+1)substr(_,2)
              if \datatype(_,"N") then interpret '_='translate(_,"%",'/')
              ?.z = _
              end

if datatype(_,"N") then ?.z = _/1 if \datatype(_,left(t"W",1)) then call er 53, _ '.'z"=" if L\== then if _<L|_>H then call er 81,L H _ "value for option ."z'=' return _

/*──────────────────────────────────WR subroutine───────────────────────*/ wr: parse arg wr /*write [argument 1] ───> disk. */ if ?.f== then return /*Nothing to write? Then skip it.*/ if highL & ahics\== then wr=translate(wr,, ahics) /*has highlighting?*/

if !cms | !tso then 'EXECIO 1 DISKW' ?.f "(FINIS STRING" wr

                      else call lineout  ?.f, translate(wr, '10'x, "1a"x)
                                      /*(above) Handle E-O-F character.*/

call lineout ?.f /*close the file. */ return

/*═════════════════════════════general 1-line subs══════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/ !all:!!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1 !cal:if symbol('!CALL')\=="VAR" then !call=;return !call !env:!env='ENVIRONMENT';if !sys=='MSDOS'|!brexx|!r4|!roo then !env='SYSTEM';if !os2 then !env='OS2'!env;!ebcdic=1=='f0'x;return !fid:parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .;call !sys;if !dos then do;_=lastpos('\',!fn);!fm=left(!fn,_);!fn=substr(!fn,_+1);parse var !fn !fn '.' !ft;end;return word(0 !fn !ft !fm,1+('0'arg(1))) !rex:parse upper version !ver !vernum !verdate .;!brexx='BY'==!vernum;!kexx='KEXX'==!ver;!pcrexx='REXX/PERSONAL'==!ver|'REXX/PC'==!ver;!r4='REXX-R4'==!ver;!regina='REXX-REGINA'==left(!ver,11);!roo='REXX-ROO'==!ver;call !env;return !sys:!cms=!sys=='CMS';!os2=!sys=='OS2';!tso=!sys=='TSO'|!sys=='MVS';!vse=!sys=='VSE';!dos=pos('DOS',!sys)\==0|pos('WIN',!sys)\==0|!sys=='CMD';call !rex;return !var:call !fid;if !kexx then return space(dosenv(arg(1)));return space(value(arg(1),,!env)) .a: call wn 'A',-99,99,sd(); ?.ab=tb(?.ab,'AB'); return $block: !call='$BLOCK'; call '$BLOCK' arg(1); !call=; return result $mkdir: !call='$MKDIR'; call '$MKDIR' arg(1); !call=; return result $scale: !call='$SCALE'; call '$SCALE' arg(1); !call=; return result cp: 'EXECIO' '0'arg(2) "CP(STEM CP. STRING" arg(1); return rc er:parse arg _1,_2;call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2;if _1<0 then return _1;exit result p: return word(arg(1),1) halt: call er .1 kw: parse arg kw; return kw c2x(?.kw) lower: return translate(arg(1),@abc,@abcu) novalue:!sigl=sigl;call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl) proper: procedure; arg f 2;parse arg 2 r; return f || r sd: if ?.scrdepth== then parse value scrsize() with ?.scrdepth ?.linesize .;return ?.scrdepth sw: if ?.Linesize== then ?.Linesize=linesize(); return ?.Linesize syntax: !sigl=sigl;call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl) wit: call dsay arg(1); call wr arg(1); return</lang>