Anonymous user
$T.REX: Difference between revisions
m
added/changed whitespace and comments.
m (→$T.REX: elided a stray DOS cut-n-paste character (a section symbol).) |
m (added/changed whitespace and comments.) |
||
Line 290:
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
Line 524 ⟶ 529:
do abs(_) while _<99
do jt=1 for ?.t
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
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
/*──────────────────────────────────────────────────────────────────────────────────────*/
.a: call wn 'A',-99,99,sd()
?.ab= tb(?.ab, 'AB')
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
.b: call wn 'B',-99,99,sd()
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: 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: _= ?.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: 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=
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
.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: if ?.f\=='' then call er 61, '.F= .EF=' /*conflicting options.*/
?.f = ?.ef
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
.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: return x2c( b2x( translate( x2b( c2x( arg(1) ) ), 01, 10) ) )
/*──────────────────────────────────────────────────────────────────────────────────────*/
.j: upper ?.j
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: call wn 'KS', 0, 99, sw()
?.ksb = tb(?.ksb, 'KSB') /*blank lines between karate chop*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
.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: call wn 'O',-999,999,9999
if ?.o<0 then do
onlyo= -?.o
?.o= 9999
end
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
.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*/
Line 939 ⟶ 1,172:
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= _
Line 946 ⟶ 1,179:
if datatype(_, "N") then ?.z= _ / 1
if \datatype(_, left(t"W", 1) ) then call er 53, _ '.'z"="
if L\=='' then if _<L | _>H
return _
/*──────────────────────────────────────────────────────────────────────────────────────*/
wr: parse
if ?.f=='' then return /*Nothing to write? Then skip it.*/
if highL & ahics\=='' then wr= translate(wr, , ahics)
if !cms | !tso then 'EXECIO 1 DISKW' ?.f "(FINIS STRING" wr
Line 962 ⟶ 1,195:
/*══════════════════════════════════════════════════════════════════════════════════════*/
!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==
!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==
!var: call !fid; if !kexx then return space( dosenv(arg(1) ) ); return space( value(arg(1), , !env) )
$block: !call= '$BLOCK'; call
$mkdir: !call= '$MKDIR'; call
$scale: !call= '$SCALE'; call
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>
| |||