CloudFlare suffered a massive security issue affecting all of its customers, including Rosetta Code. All passwords not changed since February 19th 2017 have been expired, and session cookie longevity will be reduced until late March.--Michael Mol (talk) 05:15, 25 February 2017 (UTC)

SCRSIZE.REX

From Rosetta Code

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. */
end
if \!dos then return 24 80 /*not DOS? Return default.*/
 
@abc='abcdefghijklmnopqrstuvwxyz'
@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". */
 
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
end
 
 
/*──────────────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.*/
end
 
 
/*──────────────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.*/
end
 
 
/*──────────────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. */
end
 
 
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)