Anonymous user
Sudoku/REXX: Difference between revisions
→REXX Version 1 Messages: Copy error.
(Add collection) |
(→REXX Version 1 Messages: Copy error.) |
||
Line 1,538:
=== REXX Version 1 Messages ===
This is the '''$
<br>some of the options follow):
* in color(s) (if supported)
* highlights (in color) parts (up to 8 unique parts) of the text (if supported)
* write text to a file
* breaks the text into multiple lines
* adds indentation
* justifies the text: left/right/center/justify (autofill)
* add blank lines before and/or after the displaying of text
* boxing (around) the text
* add spacing around the text inside the box
* only showing specific lines of the text messages
* suppressing specific lines of the text messages
* translation of certain characters in the text
* allowing other characters to be used for blanks
* repeating a text
* allows remarks in the text
* writes the message, waits for a confirmation to proceed
* delaying (waiting) after the text is displayed
* showing a scale and/or a ruler above/below the text message(s)
* supports hex/dec/bit strings
* changing the case of the text
* reverses the text
* inverts the bits for certain characters
* sounds alarm (beeps) after the text is displayed (if supported)
* displays the text in reverse video (if supported)
* displays the text in (big) block letters
* clear the screen after or before the displaying of text
* allows user-define option character, the default is '''.''' (period)
* and many other options
<br>The help for the '''$T''' REXX program is included here ──► [[$T.HEL]].
<br><br>The '''$T''' REXX program makes use of '''$ERR''' REXX program which is used to display error messages (via '''$T''').
<br>The '''$ERR''' REXX program is included here ──► [[$ERR.REX]].
<br><br>The '''$T''' REXX program makes use of '''LINESIZE''' BIF which returns the terminals width (linesize).
<br>Some REXXes doen't have a '''LINESIZE''' BIF, so one is included here ──► [[LINESIZE.HEL]].
<br><br>The '''$T''' REXX program makes use of '''SCRSIZE''' BIF which returns the terminals width (linesize) and depth.
<br>Some REXXes doen't have a '''SCRSIZE''' BIF, so one is included here ──► [[SCRSIZE.HEL]].
<br><br>The '''$T''' REXX program makes use of '''DELAY''' BIF which delays (sleeps) for a specified amount of seconds.
<br>Some REXXes doen't have a '''DELAY''' BIF, so one is included here ──► [[DELAY.REX]].
<br><br>The '''$T''' REXX program makes use of '''SOUND''' BIF which produces sounds via the PC speaker.
<br>Some REXXes doen't have a '''SOUND''' BIF, so one is included here ──► [[SOUND.REX]].
<br><br>REXX programs not included are '''$H''' which shows '''help''' and other documentation.
<lang rexx>/*REXX*/ trace off /* There be many dragons below. */
parse arg !
if !all(
if !cms then address ''
signal on halt /*be able to handle a HALT. */
numeric digits 300 /*be able to handle some big 'uns*/
'DEFAULT 1;37',
'TURQUOISE 1;36',
_=
scr0 shics VMout VScolor VSdisp x1 x2
@abc = 'abcdefghijklmnopqrstuvwxyz'
@abcU = @abc; upper @abcU
#ms = 0
?.a =
?.b =
?.block = 0
?.e = 0
?.end = 0
?.i = 0
?.ks = 0
?.L = 0
?.p = 0
?.q = 0
?.r = 0
?.ruler = 0
?.s = 0
?.scale = 0
?.ts = 0
?.x = 0
?.z = 0
boxing = 0
highL = 0
LLd = 0
LLk = 0
LLx = 0
maxhic = 0
## = 1
hue# = 1
minhic = 1
?.t = 1
?.bd = .2
?.bf =
?.bs =
?.o = 9999
?.rulerb = ' '
?.scaleb = ' '
?.scaled = '.'
?.scalep = '+'
?.use = '.'
esc =
his='H() H{} H[] H<> H≤≥ H«» H/\'
#his=words(his)
do jh=1 for #his
hh.jh=substr(word(his,jh),2)
end /*jh*/
colorSupport=!pcrexx | !r4 | !roo /*colors are supported by these. */
if !ebcdic then boxCH = 'acbfbcfabbbfabfa'x /*¼┐╝·╗┐½· <──single box.*/
if !dos then boxCH = 'c9cdbbbabccdc8ba'x /*╔═╗║╝═╚║ <──double box.*/
if colorSupport then do /*use pre-saved color values.
scr0=esc ||
end
do jz=1 while zz\==''
if ?.end==1 | pos('=',zz)==0 | pos(" "?.use,' 'zz)==0 then do
@=@ zz
leave
end
if
parse var zz yy1 2 yy2 3 1 yy ' ' zz
if yy1==?.use & pos('=',yy)\==0 & datatype(yy2,"U") then
parse var yy 2 _ "=" dotv 2 _1 3
if datatype(_,'U') then
do
L1=length(_)==1
if L1 then do
if _=='H' then ?.hi.1=dotv
else ?._=dotv
iterate jz
end
else select
when _=='BIN' then yy=valn("'"dotv"'B",'BIN',"B")
when _=='BOX' then do
if dotv=="" then ?.BOX=boxCH
else ?.BOX=dotv
iterate jz
end
when _=='DEC' then yy=valn("'"dotv"'D",'DEC',"D")
when _=='INV' then yy=.inv(dotv)
when _=='HEX' then yy=valn("'"dotv"'X",'HEX',"X")
when _=='USE' then do
dotv=tb(dotv,"USE",'.')
iterate jz
end
otherwise ?._=dotv; iterate jz
end /*select*/
end
if _1=='H' then do
_=wordpos(_,his)
if _\==0 then do
?.hi._=dotv
iterate jz
end
end
end /*do 1*/
if @=='' then @=lz || yy
else @=@
lz=
end
if left(@,1)==' ' then @=substr(@,2) /*handle this special case. */
if ?.a\==0 then call .a
if ?.a\==0 then call
if ?.block\==0 then call .block
if ?.c\=='' then call .c
hue.1=colorC.0
if ?.d\=='' then call .d
if ?.e\==0 then call wn 'E',0,99,sd()
?.eb=tb(?.eb,'EB')
if ?.ef\=='' then call .ef
if ?.f\=='' then call .f
if _\=='' & \!regina then
end
end /*_j*/
if ?.i\==0 then do
call wn 'I',0,sw()
?.ib=tb(?.ib,'IB')
end
if ?.j\=='' then call .j
if ?.k\=='' then ?.k =valn(?.k,"K")
if ?.kd\=='' then ?.kd=valn(?.kd,"KD")
if ?.k\=='' then if ?.kd\=="" then call er 61, '.K= .KD='
if ?.ks\==0 then call .ks
if ?.L\==0 then call .L
if ?.o\==9999 then call .o
if ?.p\==0 then do; call wn 'P',-99,99; ?.pb=tb(?.pb,'PB'); end
if ?.q\==0 then call wn 'Q',0,1
if ?.r\==0 then call wn "R",0,99; ?.r=?.r+1
if ?.ruler\==0 then call .ruler
if ?.s\==0 then call .s; ?.s=?.s+1
if ?.scale\==0 then call .scale
if ?.t\==1 then call .t
if ?.u\=='' then call .u
?.ub=tb(?.ub,'UB')
if ?.ut\=='' then call .ut
if ?.v\=='' then call .v
?.xb=tb(?.xb,'XB')
if ?.z\==0 then call wn 'Z',0,99,,"N"
if ?.box\=='' then call .box
if highL then call highLight
indent=copies(?.ib,?.i)
if ?.x\==0 then call .x
@=copies(@,?.r)
ll=length(@)
if ?.ub\==' ' then @=translate(@,?.ub," ")
_=length(?.ut)%2
if _\==0 then @=translate(@,right(?.ut,_),left(?.ut,_))
tx.1=@
xk=?.k || ?.kd
if xk\=='' then call .xk
if LLk\==0 then LL=LLk
if ?.block\==0 then tLL=12+max(LL-1,0)*(12+?.bs)
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
do jt=1 for ?.t
if jt\==1 then if jt\==?.t then call VEReb ?.ts,?.tsb
if boxing then _=left(tx.jj,tLL)
if ?.v=='R' then _=reverse(_)
if ?.u\=='' then select
when ?.u=='U' then
when ?.u=='L' then
when ?.u=='F'
when ?.u=='W' then
do jw=1 for words(_)
__=__ proper(word(_,jw))
end /*jw*/
_=
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 /* <══════════════════════════where the rubber meets the road.*/
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
/*──────────────────────────────────.B subroutine───────────────────────*/
.b: call wn 'B',-99,99,sd() /*B is for beeps (sounds). */
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 subroutine───────────────────*/
.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 subroutine─────────────────────*/
.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 subroutine───────────────────────*/
.c: call colors ?.c,'C',0
if !cms then do
call cp 'QUERY SCREEN',1
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= /*Most REXXes don't support color*/
return
/*──────────────────────────────────.D subroutine───────────────────────*/
.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 subroutine──────────────────────*/
ef: if ?.f\=='' then call er 61, '.F= .EF=' /*conflicting options.*/
?.f = ?.ef
return
/*──────────────────────────────────.F subroutine───────────────────────*/
.f: _=?.f
if !cms then do
_=translate(_, , '/,') /*try to translate to CMS
if words(_)>3 then call er 10,
?.f = _ word(subword(_,2) !fn,1) word(subword(_,3) 'A1',1)
end
__=lastpos("\",_)
if !dos & ?.ef=='' & __\==0 then call $mkdir
return
/*──────────────────────────────────.INV subroutine─────────────────────*/
.inv: return x2c( b2x( translate( x2b( c2x( arg(1) ) ), 01, 10) ) )
/*──────────────────────────────────.J subroutine───────────────────────*/
.j: upper ?.j /*Justify (or not) the text. */
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 subroutine──────────────────────*/
.ks: call wn 'KS', 0, 99, sw()
?.ksb = tb(?.ksb, 'KSB') /*blank lines between karate chop*/
return
/*──────────────────────────────────.L subroutine───────────────────────*/
.L: upper ?.L
'$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 subroutine───────────────────────*/
.o: call wn 'O',-999,999,9999
if ?.o<0 then do
?.o=9999
end
return
/*──────────────────────────────────.P subroutine───────────────────────*/
.p: if
_=?.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*/
call wit bline
return
/*──────────────────────────────────.RULER subroutine───────────────────*/
.ruler: call wn 'RULER', -sw(), sw() /*RULER draws a "ruler" line. */
?.rulerb = tb(?.rulerb, 'RULERB')
return
/*──────────────────────────────────.S subroutine───────────────────────*/
if ?.s<0 then do
if left(?.o,1)=='-' then /*check for conflicting options*/
call er 61,"O="?.o 'S='?.s "(both can't be negative)"
onlys = -?.s
?.s = 0
end
if left(?.o,1)=="-" & left(?.s,1)=='-' then
call er 61,"O="?.o 'S='?.s "(both can't be negative)"
return
/*──────────────────────────────────.SCALE subroutine───────────────────*/
.scale: call wn 'SCALE', -sw(), sw() /*SCALE draws a "scale" line. */
?.scaleb = tb(?.scaleb, 'SCALEB')
?.scaled = tb(?.scaled, 'SCALED', ".")
?.scalep = tb(?.scalep, 'SCALEP', "+")
return
/*──────────────────────────────────.T subroutine───────────────────────*/
.t: call wn 'T', 0, 99 /*Times the text is written. */
if ?.ts\==0 then call wn 'TS', 0, 99
return
/*──────────────────────────────────.U subroutine───────────────────────*/
?.u = left(?.u, 1)
if pos(?.u, " AFLUW")==0 then call er 55, ?.u '.U='
if ?.u==' ' | ?.u=='A' then ?.u=
return
/*──────────────────────────────────.UT subroutine──────────────────────*/
.ut: call wn 'T', 0, 99
if length(?.ut)//2==1 then
return
/*──────────────────────────────────.V subroutine───────────────────────*/
.v: upper ?.v /*video mode, Normal -or- Reverse*/
?.v=left(?.v, 1)
if pos(?.v, " NR")==0 then call er 55, ?.v '.V='
if ?.v==' ' | ?.v=='N' then ?.v=
return
/*──────────────────────────────────.W subroutine───────────────────────*/
.w: if ?.q then return
if ?.wb\=='' then ?.wb=tb(?.wb, 'WB')
ww=translate(?.w,,"_")
if ww='dd'x then ww
if ww='de'x then ww
call '$T' ".C=yel" translate(ww,?.wb,' ')
if ww='dd'x then call
if ww='de'x then pull external
return
/*──────────────────────────────────.X subroutine───────────────────────*/
.x: call wn 'X', -sw(), sw()
x2 = copies(?.xb, abs(?.x))
LLx = length(x1 ||
return
/*──────────────────────────────────.XK subroutine──────────────────────*/
.xk: do ##=1
parse var @
tx.## =
if @\=='' then tx.## = tx.## || ?.k
tx.## = strip(tx.##)
LLk = max(LLk, length(tx.##))
end /*##*/
##=##-1
return
/*──────────────────────────────────.Z subroutine───────────────────────*/
.z:
if _z=0 then return
if !dos then call delay
return
/*──────────────────────────────────BEEPS subroutine────────────────────*/
beeps: if \!dos & !pcrexx then return /*can this OS handle sounds? */
do jb=1 for abs(arg(1))
if jb\==1 then call delay .1
do jb_=1 for words(?.bf)
call sound word(?.bf, jb_), word(word(?.bd,jb_) .2,1)
end /*jb_*/
end /*jb */
return
/*──────────────────────────────────BLOCKER subroutine──────────────────*/
blocker: do jc=1 for LL /*process some blocked characters*/
chbit.jc = $block(substr(_, jc, 1))
end /*jc*/
bcl = ?.block
bcs = 1
if bcl<0 then do
if _=='' then _=' '
tbc = ?.bc
if tbc=='' then tbc=_
tbc = left(copies(tbc,1+sw()%length(tbc)),sw())
do jl=bcs to 3*bcl by 3
_ = copies(?.bb, max(1, 12*LL+?.bs*LL-?.bs))
bix = 1
do jo=1 for LL
_ = overlay(translate(x2b(substr(chbit.jo, jl, 3)),,
substr(tbc, jo, 1)?.bb, 10), _, bix)
bix = max(1, bix+?.bs+12)
end /*jo*/
call tellIt _
end /*jl*/
return
/*──────────────────────────────────COLORS subroutine───────────────────*/
colors: arg hue,__,cc#,cc
dark = left(hue,4)=='DARK'
if dark
if hue=='BRITE' | hue=="BRIGHT" then hue = 'WHITE'
if left(hue,5)=='BRITE' then hue =
if left(hue,6)=="BRIGHT" then hue = substr(hue,7)
if abbrev('MAGENTA',hue,3) then hue = "PINK"
if abbrev('CYAN' ,hue,3) then hue = "TURQUOIS"
if hue=='GREY' then hue = "GRAY"
do jj=1 to words(hues) by 2
ahue=word(hues,jj)
if abbrev(ahue,hue,3) then do
cc=word(hues,jj+1)
hue=ahue
leave
end
end /*jj*/
if cc=='' then call er 50, "color" '.'__"="hue
if dark & left(cc,2)=='1;' then cc="0"substr(cc,2)
if !cms then do
if hue='GRAY' | hue=="BLACK" then hue='WHITE'
if hue="BROWN" then hue='YELLOW'
end
color.cc# = hue
colorC.cc# = esc || cc'm'
return
/*──────────────────────────────────CPMORE subroutine───────────────────*/
__=
do jj=1 for cp.0
__=__ cp.jj
end /*jj*/
parse upper var __ 'MORE' more ',' 1 'HOLD' hold ','
if _>9998 & more\=='' then call cp 'TERMINAL MORE 0 0'
if _>99999998 & hold\=='' then call cp 'TERMINAL HOLD OFF'
return
/*──────────────────────────────────DSAY subroutine─────────────────────*/
dsay: if
dsay_ = strip(translate(arg(1), , '0'x), 'T')
say dsay_
LLd =
return
/*──────────────────────────────────HIGHLIGHT subroutine────────────────*/
highLight: do _=1 for 7
hics._ = left(hh._,1)
hice._ = right(hh._,1)
ahics=shics || ehics
return
/*──────────────────────────────────HUE subroutine──────────────────────*/
hue: hue#=max(1, hue#+arg(1))
__=arg(2)
if __\=='' then hue.hue#=__
_=
return
/*──────────────────────────────────INCHES Subroutine───────────────────*/
_ = kw('RULERB') kw('SCALEB') kw('SCALEP') kw('SCALED')
if arg(2) then _=$scale(?.scale _ 'Q')
else _=$scale(?.ruler 'RULE' _ 'Q')
parse var _
_=_.jk
if _\=='' then call wit _
end /*jk*/
return
/*──────────────────────────────────MS subroutine───────────────────────*/
ms: #ms=#ms+1
parse arg _i
select
when ?.j==''
when ?.N=='N' then nop
when length(_i)>=sw()-1 then nop
when ?.j=='C' then _i = centre(_i, sw()-1, ?.jb)
when ?.j=='L' then _i = strip(_i)
when ?.j=='R' then _i = right(strip(_i, "T"), sw()-1)
when ?.j=='J' then _i = justify(_i, sw()-1, ?.jb)
end /*select*/
mm.#ms=strip(indent || _i,'T')
return
/*──────────────────────────────────SAYALINE subroutine──────────────────*/
sayAline:
do jj=?.s to #ms for ?.o
if skp() then iterate
if \?.q then do
if !cms then '$CLEAR .WL='?.L _mm
if !dos then call dsay,
esc || (?.L-1) || ";0f"colorC.0 || _mm || scr0
end
call wr _mm
?.L=?.L+1
if ?.L>sd() then ?.L=1
end /*jj*/
return
/*──────────────────────────────────SAYBRITE subroutine─────────────────*/
sayBrite: do jj=?.s to #ms for ?.o
if skp() then iterate
call wr _mm
if ?.q then iterate
end
return
/*──────────────────────────────────SAYNLINE subroutine─────────────────*/
sayNline: do jj=?.s to #ms for ?.o
if skp() then iterate
end
return
/*──────────────────────────────────SAYHIGHLIGHT subroutine─────────────*/
sayHighlight:
if skp() then iterate
if !cms then do
lenmm=length(_mm)
__=verify(_mm,ahics,'M')
if __==0 then hc=lenmm+1
_xx=hue.1
if hc>1 then _xx=_xx || left(_mm,
do jl=hc to lenmm
_=substr(_mm,jl,1)
do jc=minhic to maxhic
if hhl.jc then if _==hics.jc then call hue 1, colorC.jc
if _=='' then _xx=_xx" "
__=verify(substr(_mm, jl+1), ahics, 'M')
if __==0 then pl=lenmm-jl+1
else pl=__
if pl==1 then iterate
_xx=_xx || hue.hue# || substr(_mm, jl+1, pl-1)
jl=jl+pl-1
end
if length(_xx)>sw() then if lenmm<=sw() then _xx = esc's'_xx || esc"u"
call dsay _xx || scr0
call wr _mm
end /*jj*/
return
/*──────────────────────────────────SKP subroutine──────────────────────*/
skp: if (onlyo\=='' & onlyo\==jj) |,
(onlys\=="" & onlys ==jj) then return 1
_mm = mm.jj
return 0
/*──────────────────────────────────TB subroutine───────────────────────*/
tb: tb=arg(1) /*test|verify Blank specification*/
if tb=='' then return left(arg(3), 1)
if length(tb)==2 then return valn("'"tb"'X", arg(2), 'X')
if length(tb)>1 then call er 30, tb "."arg(2)'=' 1
return tb
/*──────────────────────────────────TELLIT subroutine───────────────────*/
tellIt: ___=arg(1) /*tell it to the display terminal*/
___ = x1 || ___ || x2
if boxing then ___=bx.8 || ?.eb || ___ || ?.eb || bx.4
call ms ___
return
/*──────────────────────────────────VALN subroutine─────────────────────*/
valn: procedure; parse arg x,n,k /*validate number (dec,bin,hex). */
_ = left(x, 1)
v = "."n'='
if (_\=='"' & _\=="'") | ((right(x,2)\==_||k) & k\=='') then return x
arg ' ' -1 t
x = substr(x,2,length(x)-3)
_ = length(x)
if t=='X' then do
if \datatype(x, t) then call er 40, x v
return x2c(x)
end
if t=='B' then do
if \datatype(x, t) then call er 91, x v
return x2c(b2x(x))
end
if \datatype(x, 'W') then call er 53, x v
return d2c(x)
/*──────────────────────────────────VEREB subroutine────────────────────*/
VEReb: if arg(1)==0 then return /*character for Extra Blank(s). */
eb_ = x1 || copies(?.eb,tLL)x2
if boxing then eb_ = bx.8 || ?.eb || eb_ || ?.eb || bx.4
do jeb=1 for arg(1)
call ms eb_
end /*jeb*/
return
/*──────────────────────────────────VMCOLOR subroutine──────────────────*/
VMcolor: if \!cms then return
parse arg c1,c2
if c1\=='' then call cp "SCREEN VMOUT" c1
if c2\=='' then "SET VSCREEN CMS" c2
return
/*──────────────────────────────────WN subroutine───────────────────────*/
wn: procedure expose ?. /*normalize, validate N in range.*/
arg z, L, H, d, t
_ = ?.z
parse upper var _ f 2
m = pos(f,'MH')\==0
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 = _
end
if datatype(_,"N") then ?.z = _/1
if \datatype(_,left(t"W",1)) then call er 53, _ '.'z"="
if L\=='' then if _<L | _>H then call er 81,L H _ "value for option ."z'='
return _
/*──────────────────────────────────WR subroutine───────────────────────*/
wr: parse arg wr /*write [argument 1] ───> disk. */
if ?.f=='' then return /*Nothing to write? Then skip it.*/
if highL & ahics\=='' then wr=translate(wr,, ahics) /*has highlighting?*/
if !cms | !tso then 'EXECIO 1 DISKW' ?.f "(FINIS STRING" wr
else call lineout ?.f, translate(wr, '10'x, "1a"x)
/*(above) Handle E-O-F character.*/
call lineout ?.f /*close the file. */
return 0
/*═════════════════════════════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
!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))
.a: call wn 'A',-99,99,sd(); ?.ab=tb(?.ab,'AB'); return
$block: !call='$BLOCK'; call '$BLOCK' arg(1); !call=; return result
$mkdir: !call='$MKDIR'; call '$MKDIR' arg(1); !call=; return result
$scale: !call='$SCALE'; call '$SCALE' arg(1); !call=; return result
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
noValue: !sigl=sigl; call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
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>
=== REXX CHANGESTR function ===
|