$T.REX: Difference between revisions
Content added Content deleted
m (→$T.REX: elided a stray DOS cut-n-paste character (a section symbol).) |
m (added/changed whitespace and comments.) |
||
Line 290: | Line 290: | ||
if ?.block\==0 then tLL= 12 + max(LL - 1, 0) * (12 + ?.bs) |
if ?.block\==0 then tLL= 12 + max(LL - 1, 0) * (12 + ?.bs) |
||
else tLL= LL |
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: | Line 529: | ||
do abs(_) while _<99 |
do abs(_) while _<99 |
||
bline= strip(indent || x1 || copies(?.ab, tLL+4*boxing)x2, 'T') |
|||
do jt=1 for ?.t |
|||
if boxing then call ms bx.1 || copies(bx.2, LLx + tLL + 2)bx.3 |
|||
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 |
|||
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 |
call wit bline |
||
end /*abs*/ |
end /*abs*/ |
||
Line 939: | Line 1,172: | ||
if m | f=='*' then do |
if m | f=='*' then do |
||
_= (word(d H L sw(), 1)) / word(1 2, m + 1)substr(_, 2) |
_= (word(d H L sw(), 1)) / word(1 2, m + 1)substr(_, 2) |
||
if \datatype(_,"N") then interpret '_=' translate(_,"%",'/') |
if \datatype(_,"N") then interpret '_=' translate(_,"%",'/') |
||
?.z= _ |
?.z= _ |
||
Line 946: | Line 1,179: | ||
if datatype(_, "N") then ?.z= _ / 1 |
if datatype(_, "N") then ?.z= _ / 1 |
||
if \datatype(_, left(t"W", 1) ) then call er 53, _ '.'z"=" |
if \datatype(_, left(t"W", 1) ) then call er 53, _ '.'z"=" |
||
if L\=='' then if _<L | _>H |
if L\=='' then if _<L | _>H then call er 81, L H _ "value for option ."z'=' |
||
return _ |
return _ |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
||
wr: parse |
wr: parse arg wr /*write [argument 1] ───> disk. */ |
||
if ?.f=='' then return /*Nothing to write? Then skip it.*/ |
if ?.f=='' then return /*Nothing to write? Then skip it.*/ |
||
if highL & ahics\=='' then wr= translate(wr,, ahics) |
if highL & ahics\=='' then wr= translate(wr, , ahics) /*has highlighting?*/ |
||
if !cms | !tso then 'EXECIO 1 DISKW' ?.f "(FINIS STRING" wr |
if !cms | !tso then 'EXECIO 1 DISKW' ?.f "(FINIS STRING" wr |
||
Line 962: | Line 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 |
!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 |
!cal: if symbol('!CALL')\=="VAR" then !call=; return !call |
||
!env: !env='ENVIRONMENT'; if !sys== |
!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))) |
!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 |
!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== |
!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)) |
!var: call !fid; if !kexx then return space( dosenv(arg(1) ) ); return space( value(arg(1), , !env) ) |
||
$block: !call='$BLOCK'; call |
$block: !call= '$BLOCK'; call "$BLOCK" arg(1); !call=; return result |
||
$mkdir: !call='$MKDIR'; call |
$mkdir: !call= '$MKDIR'; call "$MKDIR" arg(1); !call=; return result |
||
$scale: !call='$SCALE'; call |
$scale: !call= '$SCALE'; call "$SCALE" arg(1); !call=; return result |
||
cp: "EXECIO" '0'arg(2) "CP(STEM CP. STRING" arg(1); return rc |
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 |
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) |
p: return word( arg(1), 1) |
||
halt: call er .1 |
halt: call er .1 |
||
kw: parse arg kw; return kw c2x(?.kw) |
kw: parse arg kw; return kw c2x(?.kw) |
||
lower: return translate( arg(1), @abc, @abcu) |
lower: return translate( arg(1), @abc, @abcu) |
||
noValue: !sigl= sigl; call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl) |
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 |
proper: procedure; arg f 2; parse arg 2 r; return f || r |
||
sd: if ?.scrdepth=='' then parse value scrsize() with ?.scrdepth ?.linesize .; return ?.scrdepth |
sd: if ?.scrdepth=='' then parse value scrsize() with ?.scrdepth ?.linesize .; return ?.scrdepth |
||
sw: if ?.linesize=='' then ?.linesize= linesize(); return ?.linesize |
sw: if ?.linesize=='' then ?.linesize= linesize(); return ?.linesize |
||
syntax: !sigl= sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl) |
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> |
wit: call dsay arg(1); call wr arg(1); return</lang> |
||