⚠️ 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.

The '''SCRSIZE.REX''' is a REXX program to emulate the '''scrsize''' bif (which is available under some REXXes) for some REXX programs.

The help for the '''SCRSIZE''' REXX program is included here ──► [[SCRSIZE.HEL]].

/**/trace o;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 interpereters that don't support the  SCRSIZE   │
│ built-in function (BIF).                                               │
│                                                                        │
│                                                                        │
│ [PC/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 pgm.  */
             '$QWHAT SCRDEPTH , 24';sd=rc    /*get sd,  default to 24.  */
             '$QWHAT SCRWIDTH , 80';sw=rc    /*get sw,  default to 80.  */
             return sd sw                    /*return depth and width.  */
if \!dos then return 24 80                   /*not DOS?  Return default.*/

@erase    ='ERASE'                           /*point to dos ERASE    cmd*/
@find     ='FIND'                            /*point to the dos FIND cmd*/
@MODE     ='MODE'                            /*point to the dos MODE cmd*/
tfid=                                        /*name of a temporary FID. */

                                             /*Note:   /i = ignore case.*/
@find_s   ='/i "s"'                          /*find line with an  "s".  */
@find_l   ='/i "l"'                          /*find line with an  "l".  */


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

  do while ops\==''; parse var ops _1 2 1 _ . 1 _o ops; upper _
    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

/*──────────────attempt to use the DOS environmental variable: COLUMNS. */
if findcols then do
                 sw=p(!var('COLUMNS'))       /*pick off the first word. */
                 if \isint(sw) then sw=0     /*if not whole #,  then 0. */
                 sw=sw/1                     /*decimal point ?   remove.*/

/*──────────────attempt to use the DOS environmental variable: LINES.   */
if findrows then do
                 sd=p(!var('LINES'))         /*pick off the first word. */
                 if \isint(sd) then sd=0     /*if not whole #,  then 0. */
                 sd=sd/1                     /*decimal point ?   remove.*/

/*──────────────if not defined, then use (DOS) MODE (writes to a file). */
if sd==0 | sw==0 then                        /*not defined?  use MODE.  */
   do                                        /*first, find temp. disk.  */
   call gettfid ,'$$$'                       /*get a TEMP id:  !fn $$$  */

   @mode 'con',                              /*issue  MODE CON, then:   */
         '|' @find @find_s,                  /*find lines with an  "s", */
         '|' @find @find_l '>' tfid          /*find lines with an  "l". */

   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  /*if LINES,   it's depth.*/
     end    /*do while*/

   @erase tfid                               /*erase the temp. file.    */

if sd==0 then sd=50                          /*just in case MODE failed.*/
if sw==0 then sw=80                          /*just in case MODE failed.*/
                                             /*use positive values.     */
return abs(sd) abs(sw)                       /*return depth and width.  */

/*═════════════════════════════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))
$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 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)

[[Category:REXX library routines]]