View source for SCRSIZE.REX

The &nbsp; '''SCRSIZE.REX''' &nbsp; is a REXX program to emulate the &nbsp; '''scrsize''' &nbsp; BIF &nbsp; (which is available under some REXXes).
<br><br>The help for the &nbsp; '''SCRSIZE''' &nbsp; REXX program is included here ──► [[SCRSIZE.HEL]].
<lang rexx>/*REXX pgm finds the  SCRSIZE (screen size) of the console (terminal), returns 2 values.*/       

trace off

parse arg !
if !all(arg())  then exit
if !cms         then address ''

signal on halt
signal on noValue
signal on syntax


         /*┌────────────────────────────────────────────────────────────────────┐
         ┌─┘                                                                    └─┐
         │ The  SCRSIZE  function is used to return the screen size (depth and    │
         │ width)  for those REXX interpreters that don't support the  SCRSIZE   │
         │ built-in function (BIF).                                               │
         │                                                                        │
         │                                                                        │
         │ [PC/REXX,  PERSONAL REXX,  R4,  and  ROO   support the  SCRSIZE  BIF.] │
         │                                                                        │
         │ Method:  to save time, this program first attempts to find the DOS     │
         │ environmental variable  LINES  and  COLUMNS.                           │
         │                                                                        │
         │ Failing that  (in whole or in part),  it then parses the results from  │
         │ the   MODE CON   (DOS) command and scans for the  LINES  and  COLUMNS  │
         │ parameters.                                                            │
         └─┐                                                                    ┌─┘
           └────────────────────────────────────────────────────────────────────┘*/


if !cms  then do                                           /*if CMS, use $QWHAT program.*/
              '$QWHAT SCRDEPTH , 24';  sd= rc              /*get the sd,  default to 24.*/
              '$QWHAT SCRWIDTH , 80';  sw= rc              /*get the sw,  default to 80.*/
              return sd sw                                 /*return depth and width.    */
              end

if \!dos  then return 24 80                                /*not DOS?  Return default.  */

tfid=                                                      /*name of a temporary FID.   */
@abc= 'abcdefghijklmnopqrstuvwxyz'                         /*lowercase for options.     */

@erase    = 'ERASE'                                        /*point to DOS  ERASE command*/
@find     = 'FIND'                                         /*  "    "  "   FIND     "   */
@mode     = 'MODE'                                         /*  "    "  "   MODE     "   */

@pipe     = '|'                                            /*variable for pipe symbol.  */
@find_s   = '/i "s:"'                                      /*find record with   s:      */
                                                           /*the  /i  ignores the case. */

findCols= 1
findRows= 1
sd= 0
sw= 0

parse  var  !!  _  .  '('  ops  ')'  __
if _\=='' | __\==''  then call er 59
ops= space(ops)


  do  while  ops\==''
  parse  var  ops  _1  2  1  _  .  1  _o  ops
  upper _
            select
            when _==','                    then nop
            when _1==.  &  pos("=",_)\==0  then tops= tops _o
            when abbn('SCRWIDths' )  | ,
                 abbn('WIDths'    )  | ,
                 abbn('WIDes'     )  | ,
                 abbn('WIDs'      )  | ,
                 abbn('COLums'    )  | ,
                 abbn('COLs'      )        then findcols= no()
            when abbn('SCRWIDTHs' )  | ,
                 abbn('DEPTHs'    )  | ,
                 abbn('DEPs'      )  | ,
                 abbn('ROWs'      )  | ,
                 abbn('LINEs'     )  | ,
                 abbn('LINESizes' )        then findrows= no()
            otherwise                      call er 55,_o
            end   /*select*/
  end             /*while*/

if !regina  then call addr_with
            else call hard_way

return sd sw                                               /*return  depth  and  width. */


/*──────────────────────────────────────────────────────────────────────────────────────*/
hard_way:                                                  /*The  (DOS)  MODE   command */
                                                           /*  (writes to a temp file). */
            call gettfid, '$$$'                            /*get a TEMP id:   !fn  $$$  */
            @mode 'con: |' @find @find_s '>' tfid          /*find lines with   s:       */
            call linein tfid, 1, 0                         /*point to record 1.         */

                do  while  sd==0 | sw==0                   /*read file while sw|sw =0.  */
                if lines(tfid)==0   then leave             /*No lines left? We're done. */
                _= translate( linein(tfid), , '=:')        /*translate = : ──> blanks.  */
                parse  upper  var  _ yname yval .          /*parse with name value.     */
                if yname=='COLUMNS' & sw==0 then sw=yval   /*if  COLUMNS,  it's  width. */
                if yname=='LINES'   & sd==0 then sd=yval   /* "  LINES,      "   depth. */
                end    /*while*/

            call lineout tfid                              /*close the (now) input file.*/
            @erase tfid                                    /*erase the temporary file.  */

            if sd==0  then sd= 50                          /*just in case  MODE  failed.*/
            if sw==0  then sw= 80                          /*  "   "   "     "      "   */

            return


/*──────────────────────────────────────────────────────────────────────────────────────*/
addr_with: @.=                                             /*prepare stem, just in case.*/
           signal .                                        /*do an old fashioned  GO TO */
.:         where= sigL + 3                                 /*point to ADDRESS statement.*/
                                                           /*this blank line must exist.*/
           address system  @mode  'CON:'   @pipe  @find  @find_s   with   output  stem  @.

                                                 /*the above cmd only works with Regina.*/

           if rc\==0  then do                              /*did a DOS error happen?    */
                           parse source . . xfid           /*obtain the program's name. */
                           say
                           say '***error*** from: '  xfid  /*tell where/what this is.   */
                           say 'return code ' rc " from the REXX statement number "  where
                           say 'REXX statement:'
                           say copies('-', 77)
                           say strip ( sourceLine(where) ) /*show the source line of pgm*/
                           say copies('-', 77)
                           say
                           exit rc                         /*exit with the return code. */
                           end

           if @.0==''  then @.0= 0                         /*just in case MODE failed.  */

              do j=1  for @.0                              /*traipse through the output.*/
              _= translate( @.j, , '=:')                   /*translate  = :  ──> blanks.*/
              parse upper  var   _  yname  yval  .         /*parse with name value.     */
              if yname=='COLUMNS'  then sw= yval           /*if  COLUMNS,  it's width.  */
              if yname=='LINES'    then sd= yval           /*if  LINES,    it's depth.  */
              end   /*j*/

           if sd==0 | \datatype(sd, 'W')  then sd= 50      /*just in case  MODE  failed.*/
           if sw==0 | \datatype(sw, 'W')  then sw= 80      /*  "   "   "     "      "   */

           return


/*──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
!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= 3=='f3'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) )
$fact!:    procedure; parse arg x _ .; l= length(x);  n= l - length( strip(x, 'T', "!") ); if n<=-n|_\==''|arg()\==1 then return x; z=left(x,l-n); if z<0|\isInt(z) then return x; return $fact(z, n)
$fact:     procedure; parse arg x _ .; arg ,n ! .; n= p(n 1); if \isInt(n)  then n=0; if x<-n | \isInt(x) | n<1 | _ || !\=='' | arg()>2  then return x || copies("!", max(1,n)); !=1; s=x//n; if s==0  then s= n; do j=s  to x  by n; !=!*j; end; return !
$sfxa:     parse arg ,s,m;arg u,c;if pos(left(s,2),u)\==0 then do j=length(s) to compare(s,c)-1 by -1;if right(u,j)\==left(c,j) then iterate;_=left(u,length(u)-j);if isNum(_)  then return m*_; leave; end;   return arg(1)
$sfxf:     parse arg y;if right(y,1)=='!' then y=$fact!(y);  if \isNum(y)  then y= $sfxz();  if isNum(y)  then return y;   return $sfxm(y)
$sfxm:     parse arg z; arg w; b=1000; if right(w, 1)=='I' then do; z= shorten(z); w=z; upper w; b=1024; end; p= pos( right(w, 1), 'KMGTPEZYXWVU'); if p==0  then return arg(1); n=shorten(z); r=num(n,f,1); if isNum(r) then return r*b**p; return arg(1)
$sfxz:     return $sfxa( $sfxa( $sfxa( $sfxa( $sfxa( $sfxa(y,'PAIRs',2), 'DOZens', 12), 'SCore', 20), 'GREATGRoss', 1728), 'GRoss', 144), 'GOOGOLs', 1e100)
abb:       arg abbu; parse arg abb;    return abbrev( abbu, _, abbl(abb) )
abbl:      return verify( arg(1)'a', @abc, 'M')  -  1
abbn:      parse arg abbn;                             return abb(abbn) | abb('NO'abbn)
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
err:       call er '-'arg(1), arg(2);                  return ''
erx:       call er '-'arg(1), arg(2);                  exit ''
getdtfid:  tfid= p(!var("TMP") !var('TEMP') homedrive()"\");   if substr(tfid, 2, 1)==':' & substr(tfid, 3, 1)\=="\"  then tfid= insert('\', t, 2);    return strip(tfid, 'T', "\")'\'arg(1)'.'arg(2)
getTFID:   if symbol('TFID')=='LIT' then tfid=; if tfid\=='' then return tfid; gfn=word(arg(1) !fn,1); gft=word(arg(2) 'ANS',1); tfid='TEMP';if !tso then tfid=gfn'.'gft;if !cms then tfid=gfn','gft",A4";if !dos then tfid=getdTFID(gfn,gft); return tfid
halt:      call er .1
homedrive: if symbol('HOMEDRIVE')\=="VAR"  then homedrive= p(!var('HOMEDRIVE') 'C:');   return homedrive
int:       int= num(arg(1), arg(2)); if \isInt(int)  then call er 92, arg(1) arg(2);     return int/1
isInt:     return datatype( arg(1), 'W')
isNum:     return datatype( arg(1), 'N')
na:        if arg(1)\==''  then call er 01, arg(2); parse var ops na ops; if na==''  then call er 35,_o;   return na
nai:       return int(na(), _o)
nan:       return num(na(), _o)
no:        if arg(1)\==''  then call er 01,arg(2);     return left(_,2)\=='NO'
noValue:   !sigl= sigl;   call er 17,!fid(2)  !fid(3)  !sigl  condition('D')  sourceline(!sigl)
num:       procedure; parse arg x .,f,q; if x=='' then return x; if isNum(x) then return x/1; x=space(translate(x,,','),0); if \isNum(x) then x=$sfxf(x); if isNum(x) then return x/1; if q==1 then return x; if q=='' then call er 53,x f;call erx 53,x f
p:         return word( arg(1), 1)
s:         if arg(1)==1  then return arg(3);           return word( arg(2) 's', 1)
shorten:   procedure;  parse arg a,n;                  return left(a, max(0, length(a) - p(n 1) ) )
syntax:    !sigl= sigl;  call er 13,!fid(2)  !fid(3)  !sigl  !cal()  condition('D')  sourceline(!sigl)
</lang>

[[Category:REXX library routines]]