⚠️ Warning: This is a draft ⚠️

This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.

If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.

==$T.REX== This is the '''$T.REX''' (REXX) program which is used by many other REXX programs to display error or informational message(s),

some of the options are: ::* 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 (auto-fill) ::* 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 '''$BLOCK''' REXX program which is used to generate text to display text in (big) blocked letters (via '''$T''').

The '''$BLOCK''' REXX program is included here ──► [[$BLOCK.REX]].

The '''$T''' REXX program makes use of '''LINESIZE''' BIF which returns the terminals width (linesize).

Some REXXes don'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 don'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 don'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 don't have a '''SOUND''' BIF, so one is included here ──► [[SOUND.REX]].

REXX programs not included are '''$H''' which shows '''help''' and other documentation.

/*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
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/\'
#his=words(his)
                                       do jh=1  for #his
                                       hh.jh=substr(word(his,jh),2)
                                       end   /*jh*/

colorSupport=!pcrexx | !r4 | !roo      /*colors are supported by these. */

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

if colorSupport  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  /*do 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 #his
                      _=?.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(" ",_)
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 \colorSupport  then ?.c=            /*Most REXXes don't support color*/
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
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 0

/*═════════════════════════════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; if !crx then !env='DOS'; 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'; !crx=left(!sys,6)=='DOSCRX'; 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

[[Category:REXX library routines]]