Sudoku/REXX: Difference between revisions
Content added Content deleted
(Add collection) |
(→REXX Version 1 Messages: Copy error.) |
||
Line 1,538: | Line 1,538: | ||
=== REXX Version 1 Messages === |
=== REXX Version 1 Messages === |
||
This is the '''$ |
This is the '''$T.REX''' (REXX) program which is used by other REXX programs to display error or informational message(s), |
||
<br>some of the options follow): |
|||
<br><br>This REXX program was originally written to assist in sudoku puzzle solving (by giving strong hints), and not to solve the puzzle outright. |
|||
* in color(s) (if supported) |
|||
<br>The REXX program was written to give increasing better hints and also show the possibilities (of what is possible solution for any cell), |
|||
* highlights (in color) parts (up to 8 unique parts) of the text (if supported) |
|||
<br>and to partially solve the puzzle using distinct strategies (separately or in combination). One option is to solve the puzzle. |
|||
* write text to a file |
|||
<br><br>The help for the '''$SUDOKU''' REXX program is included here ──► [[$SUDOKU.HEL]]. |
|||
* breaks the text into multiple lines |
|||
<br>The '''$SUDOKU.REX''' REXX program makes use of '''$ERR.REX''' REXX program which is used to display error messages (via '''$T.REX'''). |
|||
* adds indentation |
|||
<br>The '''$ERR.REX''' REXX program is included here ──► [[$ERR.REX]]. |
|||
* justifies the text: left/right/center/justify (autofill) |
|||
<br>The '''$SUDOKU.REX''' REXX program makes use of '''$T.REX''' REXX program which is used to display text messages. |
|||
* add blank lines before and/or after the displaying of text |
|||
<br>The '''$T.REX''' REXX program is included here ──► [[$T.REX]]. |
|||
* boxing (around) the text |
|||
<br>Some older REXXes don't have a '''changestr''' BIF, so one is included here ──► [[CHANGESTR.REX]]. |
|||
* add spacing around the text inside the box |
|||
<br>REXX programs not included are '''$H''' which shows '''help''' and other documentation. |
|||
* only showing specific lines of the text messages |
|||
<lang rexx>/*REXX program displays, can give hints, and/or solve a sudoku puzzle. */ |
|||
* suppressing specific lines of the text messages |
|||
trace off |
|||
* 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 ! |
parse arg ! |
||
if !all( |
if !all(0) then exit 0 /*help options and boilerplate.*/ |
||
if !cms then address '' |
|||
signal on halt |
|||
signal on noValue |
|||
signal on syntax |
|||
zz = !! /*save a copy of original args. */ |
|||
if !cms then address '' |
|||
numeric digits 20 |
|||
signal on halt /*be able to handle a HALT. */ |
|||
combos=1 |
|||
signal on noValue /*catch REXX vars with noValue. */ |
|||
signal on syntax /*catch REXX syntax errors. */ |
|||
numeric digits 300 /*be able to handle some big 'uns*/ |
|||
@abc='abcdefghijklmnopqrstuvwxyz' |
|||
@abcU=@abc |
|||
upper @abcU |
|||
colors=!cms | !pcrexx | !r4 | !roo /*Are colors supported ? */ |
|||
clear=1 /*option: clear the screen.*/ |
|||
highLight=0 /*option: highlight singles*/ |
|||
pruneall=0 /*option: prune all. */ |
|||
prunemats=0 /*option: prune matches. */ |
|||
prunesing=0 /*option: prune singles. */ |
|||
pruneexcl=0 /*option: prune exclusives.*/ |
|||
pruneline=0 /*option: prune lines. */ |
|||
pruneonly=0 /*option: prune onlys. */ |
|||
simple=0 /*option: show simple boxes*/ |
|||
showoneline=0 /*option: show grid as1line*/ |
|||
showgrid=1 /*option: show the grid. */ |
|||
showinfo=1 /*option: show informatiion*/ |
|||
showposs=0 /*option: show possible val*/ |
|||
showcomb=0 /*option: show combinations*/ |
|||
showrow= /*option: SHOWPOSS for rowN*/ |
|||
showcol= /*option: SHOWPOSS for colN*/ |
|||
showbox= /*option: SHOWPOSS for boxN*/ |
|||
showcell= /*option: SHOWPOSS cellRC */ |
|||
short=0 |
|||
solve=0 /*option: solve the puzzle.*/ |
|||
sod=lower(translate(!fn,,'$')) /*name of the puzzle. */ |
|||
tellinvalid=1 /*tell err msg if invalid X*/ |
|||
tops= /*option: used for $T opts.*/ |
|||
hues=space( 'BLACK 0;30', /*define some colors for DOS. */ |
|||
'BROWN 0;33', |
|||
'DEFAULT 1;37', |
|||
gridwidth=7 /*grid cell interior width.*/ |
|||
'GRAY 1;37', |
|||
'BLUE 1;34', |
|||
'GREEN 1;32', |
|||
'TURQUOISE 1;36', |
|||
gridlb='c0'x /*grid cell left bottom. */ |
|||
'RED 1;31', |
|||
'PINK 1;35', |
|||
'YELLOW 1;33', |
|||
'WHITE 1;37', |
|||
'BRITE 1;37') /*colors for DOS via ANSI.SYS */ |
|||
griduj='c1'x /*grid cell up junction.*/ |
|||
gridlj='c3'x /*grid cell left junction.*/ |
|||
gridrj='b4'x /*grid cell right junction.*/ |
|||
gridcross='c5'x /*grid cell cross junction.*/ |
|||
_= /*(below) set some vars ──> NULL */ |
|||
parse var _ ?. @ color. colorC. ahics ehics hold lz more onlyo onlys, |
|||
scr0 shics VMout VScolor VSdisp x1 x2 |
|||
upper _ |
|||
@abc = 'abcdefghijklmnopqrstuvwxyz' |
|||
select |
|||
@abcU = @abc; upper @abcU |
|||
when _==',' then nop |
|||
when _1=='.' & pos("=",_)\==0 then tops=tops _o |
|||
#ms = 0 |
|||
when abb('PUZzle') then /*do PUZZ (whole) placement*/ |
|||
?.a = 0 |
|||
?.b = 0 |
|||
?.block = 0 |
|||
if length(puzz)>81 then call er 30,puzz 'PUZZLE 1───►81' |
|||
?.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 |
|||
do j=1 for length(puzz) |
|||
hue# = 1 |
|||
q=substr(puzz,j,1) |
|||
minhic = 1 |
|||
if q=='.' then iterate |
|||
?.t = 1 |
|||
call vern q,'PUZZLE_digit' |
|||
c=j//9 |
|||
if c==0 then c=9 |
|||
r=(j-1)%9 + 1 |
|||
@.r.c=q |
|||
end /*j*/ |
|||
end |
|||
?.bd = .2 |
|||
when _=='CELL' then /*do CELL (grid) placement.*/ |
|||
?.bf = 800 |
|||
?.bs = 2 |
|||
?.o = 9999 |
|||
if length(rc)\==2 then call er 30,y 'CELL'rc 2 |
|||
?.rulerb = ' ' |
|||
y=na() |
|||
?.scaleb = ' ' |
|||
if length(y)>1 then call er 30,y 'CELL'rc 1 |
|||
?.scaled = '.' |
|||
r=left(rc,1) |
|||
?.scalep = '+' |
|||
c=right(rc,1) |
|||
?.use = '.' |
|||
call vern r,'CELLrow' |
|||
esc = '1b'x"[" |
|||
call vern y,'CELLdigit' |
|||
@.r.c=y |
|||
end |
|||
his='H() H{} H[] H<> H≤≥ H«» H/\' |
|||
when abb('COLumn') then /*do ROW (grid) placement. */ |
|||
#his=words(his) |
|||
do |
|||
do jh=1 for #his |
|||
n=nai() |
|||
hh.jh=substr(word(his,jh),2) |
|||
y=na() |
|||
end /*jh*/ |
|||
call vern n,'column' |
|||
ly=length(y) |
|||
if ly>9 then call er 30,y 'column'n '1───>9' |
|||
colorSupport=!pcrexx | !r4 | !roo /*colors are supported by these. */ |
|||
do j=1 for ly |
|||
x=substr(y,j,1) |
|||
if x=='' | x=="_" | x=='*' | x=="." then iterate |
|||
if \isInt(x) then call er 92,x 'cell_for_column'n |
|||
@.j.n=x |
|||
end /*j*/ |
|||
end |
|||
boxCH = '+-+|+-+|' /*define some boxing characters. */ |
|||
if !ebcdic then boxCH = 'acbfbcfabbbfabfa'x /*¼┐╝·╗┐½· <──single box.*/ |
|||
do |
|||
if !dos then boxCH = 'c9cdbbbabccdc8ba'x /*╔═╗║╝═╚║ <──double box.*/ |
|||
n=nai() |
|||
y=na() |
|||
call vern n,'row' |
|||
ly=length(y) |
|||
if ly>9 then call er 30,y 'row'n '1───>9' |
|||
if colorSupport then do /*use pre-saved color values. */ |
|||
_=translate(!var('SCREEN'), ,";,") /*envVar.*/ |
|||
if \datatype(space(_,0), "W") then _='36 40' |
|||
scr0=esc || translate(0 _, ';', " ")'m' |
|||
colorC.0=scr0 |
|||
colorC.1=esc"1;33m" |
|||
end |
end |
||
do jz=1 while zz\=='' |
|||
when abbn('CLearscreen') then clear=no() |
|||
if ?.end==1 | pos('=',zz)==0 | pos(" "?.use,' 'zz)==0 then do |
|||
when abbn('HIGHLightsingles') then highLight=no() |
|||
@=@ zz |
|||
when abbn('PRUNEALL') then pruneall=no() |
|||
leave |
|||
when abbn('PRUNEONLYs') then pruneonly=no() |
|||
end |
|||
when abbn('PRUNEEXclusives') then pruneexcl=no() |
|||
if left(zz,1)==' ' then lz=lz" " |
|||
parse var zz yy1 2 yy2 3 1 yy ' ' zz |
|||
when abbn('PRUNEMATches') then prunemats=no() |
|||
when abbn('PRUNESINGles') then prunesing=no() |
|||
when abbn('SIMPle') then simple=no() |
|||
when abb('SHOWBOXes')|, |
|||
abb('SHOWBOXs') then showbox=nai() |
|||
when abb('SHOWCELLs') then showcell=translate(na(),,',') |
|||
when abb('SHOWCOLs') then showcol=nai() |
|||
when abbn('SHOWCOMBinations') then showcomb=no() |
|||
when abbn('SHOWGrid') then showgrid=no() |
|||
when abbn('SHOWINFOrmation') then showinfo=no() |
|||
when abbn('SHOWONELINE') then showoneline=no() |
|||
when abbn('SHOWPOSSibles') then showposs=no() |
|||
when abb('SHOWROWs') then showrow=nai() |
|||
when abbn('SHortgrid') then short=no() |
|||
when abbn('SOLvepuzzle') then solve=no() |
|||
if yy1==?.use & pos('=',yy)\==0 & datatype(yy2,"U") then |
|||
otherwise call er 55,_o |
|||
do 1 |
|||
parse var yy 2 _ "=" dotv 2 _1 3 |
|||
end /*while ops¬==''*/ |
|||
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 |
|||
if solve then pruneall=1 /*if solving, use PRUNEALL.*/ |
|||
_=wordpos(_,his) |
|||
if _\==0 then do |
|||
?.hi._=dotv |
|||
iterate jz |
|||
end |
|||
end |
|||
end /*do 1*/ |
|||
if @=='' then @=lz || yy |
|||
if pruneall then do /*if pruneAll, set ON other*/ |
|||
else @=@ yy |
|||
lz= |
|||
pruneonly=1 |
|||
end /*jz*/ |
|||
prunemats=1 |
|||
prunesing=1 |
|||
end |
|||
if left(@,1)==' ' then @=substr(@,2) /*handle this special case. */ |
|||
aprune = , /*is there a PRUNExxx on ? */ |
|||
pruneexcl |, |
|||
pruneonly |, |
|||
pruneline |, |
|||
prunemats |, |
|||
prunesing |
|||
if ?.a\==0 then call .a |
|||
if highLight then do /*HIGHLIGHTSINGLES opt on? */ |
|||
if ?.a\==0 then call .b |
|||
if ?.block\==0 then call .block |
|||
hLr='-' |
|||
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 |
|||
do _j=1 for #his |
|||
_=?.hi._j |
|||
if _\=='' & \!regina then do |
|||
call colors _,"H"hh._j,_j |
|||
highL=1 |
|||
end |
end |
||
end /*_j*/ |
|||
if ?.i\==0 then do |
|||
tops=space(tops) |
|||
call wn 'I',0,sw() |
|||
box.= |
|||
?.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) |
|||
do j=1 for 9 /*build the box bounds. */ |
|||
else tLL=LL |
|||
cc=(((j-1)//3)+1)*3-2 /*compute col lower bound. */ |
|||
boxr.j=rr |
|||
boxc.j=cc |
|||
bline=strip(indent || x1 || copies(?.ab, tLL+4*boxing)x2, 'T') |
|||
do r=rr to rr+2 /*build boxes with cell #s.*/ |
|||
do c=cc to cc+2 |
|||
rc=r || c |
|||
box.j=box.j rc |
|||
box.rc=j |
|||
end /*c*/ |
|||
end /*r*/ |
|||
if boxing then call ms bx.1 || copies(bx.2, LLx+tLL+2)bx.3 |
|||
box.j=strip(box.j) |
|||
caLL VEReb ?.e,?.eb |
|||
end /*j*/ |
|||
do jt=1 for ?.t |
|||
rowlb.=10 /*row R, low box number=b.*/ |
|||
if jt\==1 then if jt\==?.t then call VEReb ?.ts,?.tsb |
|||
collb.=10 /*col R, low box number=b.*/ |
|||
boxlr.=10 /*box B, low row number=r.*/ |
|||
boxlc.=10 /*box B, low col number=c.*/ |
|||
do jj=1 for ## |
|||
if jj\==1 then call VEReb ?.ks,?.ksb |
|||
rc=r || c |
|||
b=box.rc /*what box is this R,C in ?*/ |
|||
rowlb.r=min(rowlb.r,b) /*find min box # for row R.*/ |
|||
collb.c=min(collb.c,b) /*find min box # for col C.*/ |
|||
boxlr.b=min(boxlr.b,r) /*find min row # for box B.*/ |
|||
boxlc.b=min(boxlc.b,c) /*find min col # for box B.*/ |
|||
end /*c*/ |
|||
end /*r*/ |
|||
if boxing then _=left(tx.jj,tLL) |
|||
do j=1 to 9 /*for each box, row, col...*/ |
|||
else _=tx.jj |
|||
colhb.j=collb.j+6 /*compute col's high box #.*/ |
|||
boxhr.j=boxlr.j+2 /*compute box's high row #.*/ |
|||
boxhc.j=boxlc.j+6 /*compute box's high col #.*/ |
|||
end /*j*/ |
|||
if ?.v=='R' then _=reverse(_) |
|||
if showgrid then call showgrid 'the puzzle' /*show the grid to screen ?*/ |
|||
if \validall() then exit /*validate specified digits*/ |
|||
tellinvalid=0 /*don't tell err messages. */ |
|||
!.= /*nullify valid empty# list*/ |
|||
call buildposs /*build possible values. */ |
|||
if showposs then call showgrid 'puzzle possibles' /*show 1st possibles?*/ |
|||
if \validate(1) then exit /*validate the puzzle. */ |
|||
if ?.u\=='' then select |
|||
if showoneline then do /*show grid as line line ? */ |
|||
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*/ |
|||
end |
|||
if ?.block==0 then call tellIt _ |
|||
if aprune |, |
|||
else call blocker |
|||
showposs then do |
|||
end /*jj*/ |
|||
call pruneposs /*go build poss, then prune*/ |
|||
end /*jt*/ |
|||
if showposs then call showgrid 'possibles' /*show grid.*/ |
|||
if \validate(1) then exit /*validate the puzzle. */ |
|||
end |
|||
call VEReb ?.e,?.eb |
|||
if combos==1 then call $t sod 'puzzle solved.' |
|||
if boxing then call ms bx.7 || copies(bx.6,LLx+tLL+2)bx.5 |
|||
else if showcomb then call $t 'combinations='comma(combos) |
|||
call beeps ?.b |
|||
exit /*stick a fork in it, we're done.*/ |
|||
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.*/ |
|||
/*─────────────────────────────vern subroutine──────────────────────────*/ |
|||
when highL then call sayHighlight |
|||
when \highL & (?.c=='BRITE' | ?.c=="BRIGHT") then call sayBright |
|||
when ?.L\==0 then call sayAline |
|||
if \isInt(v) then call er 92,v w |
|||
otherwise call sayNline |
|||
if v<1 | v>9 then call er 81,1 9 v w |
|||
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 |
return |
||
/*──────────────────────────────────.BLOCK subroutine───────────────────*/ |
|||
/*─────────────────────────────buildposs subroutine─────────────────────*/ |
|||
.block: call wn 'BLOCK',-12,12 |
|||
buildposs: !.= /*nullify possibilities. */ |
|||
if ?.bs\==2 then call wn 'BS', -12, sw() |
|||
combos=1 |
|||
if ?.bc\=='' then ?.bc = tb(?.bc, "BC") |
|||
?.bb=tb(?.bb,'BB') |
|||
return |
|||
/*──────────────────────────────────.BOX subroutine─────────────────────*/ |
|||
do rp=1 for 9 /*build table of valid #s. */ |
|||
.box: _=?.box; upper _ |
|||
do cp=1 for 9 /*step through each column.*/ |
|||
if _=='*NONE*' then ?.box= |
|||
if @.rp.cp\==' ' then iterate /*not blank? Keep looking.*/ |
|||
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───────────────────────*/ |
|||
do jd=1 for 9 /*try each digit. */ |
|||
.c: call colors ?.c,'C',0 |
|||
@.rp.cp=jd |
|||
if validx(rp,cp) then !.rp.cp=!.rp.cp || jd |
|||
end /*jd*/ |
|||
if !cms then do |
|||
combos=combos*length(!.rp.cp) /*calculate # combinations.*/ |
|||
call cp 'QUERY SCREEN',1 |
|||
@.rp.cp=' ' /*restore the point (blank)*/ |
|||
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= /*Most REXXes don't support color*/ |
|||
return |
return |
||
/*──────────────────────────────────.D subroutine───────────────────────*/ |
|||
/*─────────────────────────────showgrid subroutine──────────────────────*/ |
|||
.d: upper ?.d |
|||
showgrid: parse arg title |
|||
_ = ?.d |
|||
if clear then !cls /*clear the screen ? */ |
|||
if title\=='' & showinfo then call $t !fn 'is showing' title |
|||
gtail=copies3(gridlb || gridlin || copies2(griduj || gridlin) || gridrb) |
|||
ghead=copies3(gridlt || gridlin || copies2(griddj || gridlin) || gridrt) |
|||
call tg ghead |
|||
gemp=copies3(copies3(gridbar || gridemp)gridbar) |
|||
grid=copies3(gridlj || gridlin || copies2(gridcross || gridlin)gridrj) |
|||
anyshow= \ ((showcell || showcol || showrow || showbox)\=='') |
|||
if \(abbrev('BRITE',_,3) |, |
|||
do jr=1 for 9 |
|||
abbrev("BRIGHT",_,3) |, |
|||
if \short then call tg gemp |
|||
abbrev('HIGHLIGHT',_) |, |
|||
gnum= |
|||
abbrev("NONE",_,3) |, |
|||
abbrev('REVVIDEO',_,3) |, |
|||
abbrev("UNDERLINE",_,3)) then call er 55, _ ".D=" |
|||
if !regina then ?.d= /*Regina can't handle DISP's. */ |
|||
do jc=1 for 9 |
|||
else if left(_,1)=='H' then highL=1 |
|||
_=@.jr.jc |
|||
return |
|||
if _\==' ' & highLight then _=hLl || _ || hLr |
|||
/*──────────────────────────────────.EF subroutine──────────────────────*/ |
|||
if _==' ' & , |
|||
ef: if ?.f\=='' then call er 61, '.F= .EF=' /*conflicting options.*/ |
|||
showposs then do |
|||
?.f = ?.ef |
|||
jrjc=jr || jc |
|||
return |
|||
showit=anyshow |
|||
if showcell\=='' then if wordpos(jrjc,showcell)\==0 then showit=1 |
|||
if showcol\=='' then if pos(jc,showcol)\==0 then showit=1 |
|||
if showrow\=='' then if pos(jr,showrow)\==0 then showit=1 |
|||
/*──────────────────────────────────.F subroutine───────────────────────*/ |
|||
do jb=1 while showbox\=='' |
|||
.f: _=?.f /*File where the text is written.*/ |
|||
if !cms then do |
|||
if b==' ' then leave |
|||
_=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 showit then _=strip(left(!.jr.jc,gridwidth),'T') |
|||
if !dos & ?.ef=='' & __\==0 then call $mkdir left(_,__) |
|||
return |
|||
/*──────────────────────────────────.INV subroutine─────────────────────*/ |
|||
gnum=gnum || gridbar || centre(_,gridwidth) |
|||
.inv: return x2c( b2x( translate( x2b( c2x( arg(1) ) ), 01, 10) ) ) |
|||
if jc//3==0 then gnum=gnum || gridbar |
|||
end /*jc*/ |
|||
/*──────────────────────────────────.J subroutine───────────────────────*/ |
|||
call tg gnum |
|||
.j: upper ?.j /*Justify (or not) the text. */ |
|||
if \short then call tg gemp |
|||
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───────────────────────*/ |
|||
if jr//3==0 then do |
|||
.L: upper ?.L /*Line(s) for the text is shown. */ |
|||
if !cms then do |
|||
'$QWHAT DSC' |
|||
if rc==4 then ?.L=0 |
|||
end |
end |
||
else call tg grid |
|||
end /*jr*/ |
|||
if ?.L=='CMSG' then ?.L="*" |
|||
call $t |
|||
call wn 'L',-sd(),sd() |
|||
if ?.L<0 then ?.L=sd()-?.L |
|||
return |
return |
||
/*──────────────────────────────────.O subroutine───────────────────────*/ |
|||
/*─────────────────────────────validate subroutine──────────────────────*/ |
|||
.o: call wn 'O',-999,999,9999 |
|||
validate: /*are all empties possible?*/ |
|||
if ?.o<0 then do |
|||
do r=1 for 9 /*step through each row. */ |
|||
onlyo=-?.o |
|||
?.o=9999 |
|||
end |
|||
return |
|||
/*──────────────────────────────────.P subroutine───────────────────────*/ |
|||
if @.r.c==' ' & , |
|||
.p: if ?.q then return /*Post (writting) blank lines. */ |
|||
_=?.p |
|||
if arg(1)==1 then call $t sod "puzzle isn't valid !" |
|||
return 0 |
|||
end |
|||
end /*c*/ |
|||
end /*r*/ /*sub requires possibles. */ |
|||
if _>98 |, |
|||
return 1 /*indicate puzzle is valid.*/ |
|||
_<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 |
|||
/*─────────────────────────────validall subroutine──────────────────────*/ |
|||
if _>99999998 & hold\=='' then call CP 'TERMINAL HOLD' hold |
|||
validall: /*validate all Q specified.*/ |
|||
if _>99999998 & hold\=='' then call CP 'TERMINAL HOLD' hold |
|||
end /*1*/ |
|||
do abs(_) while _<99 |
|||
do r=1 for 9 /*step through each row. */ |
|||
call wit bline |
|||
do c=1 for 9 /*step through each column.*/ |
|||
end /*abs*/ |
|||
if @.r.c==' ' then iterate /*if blank, then it's ok. */ |
|||
do _=1 to -?.a |
|||
call wit bline |
|||
rc=r||c |
|||
end /*_*/ |
|||
return |
|||
if kc\==c then y=y|| @.r.kc /*build the rest of the row*/ |
|||
end /*kc*/ |
|||
q=@.r.c |
|||
if pos(q,y)\==0 then return tem(r,c,'row') /*same # in same row?*/ |
|||
y= /*the rest of the column. */ |
|||
do kr=1 for 9 /*compare to #s in column. */ |
|||
if kr\==r then y=y || @.kr.c /*build the rest of the col*/ |
|||
end /*kr*/ |
|||
/*──────────────────────────────────.RULER subroutine───────────────────*/ |
|||
if pos(q,y)\==0 then return tem(r,c,'col') /*same # in same col?*/ |
|||
.ruler: call wn 'RULER', -sw(), sw() /*RULER draws a "ruler" line. */ |
|||
y= /*the rest of the box. */ |
|||
?.rulerb = tb(?.rulerb, 'RULERB') |
|||
b=box.rc |
|||
return |
|||
/*──────────────────────────────────.S subroutine───────────────────────*/ |
|||
do br=boxr.b to boxr.b+2 /*compare to #s of the box.*/ |
|||
.s: call wn "S", -999, 999, 999 /*Skip (or suppress) line(s). */ |
|||
if br\==r & bc\==c then y=y || @.br.bc |
|||
end /*bc*/ |
|||
end /*br*/ |
|||
if ?.s<0 then do |
|||
if pos(q,y)\==0 then return tem(r,c,'box') /*same # in same box?*/ |
|||
if left(?.o,1)=='-' then /*check for conflicting options*/ |
|||
end /*c*/ |
|||
call er 61,"O="?.o 'S='?.s "(both can't be negative)" |
|||
end /*r*/ |
|||
onlys = -?.s |
|||
?.s = 0 |
|||
end |
|||
if left(?.o,1)=="-" & left(?.s,1)=='-' then |
|||
return 1 /*indicate all are valid.*/ |
|||
call er 61,"O="?.o 'S='?.s "(both can't be negative)" |
|||
return |
|||
/*──────────────────────────────────.SCALE subroutine───────────────────*/ |
|||
/*─────────────────────────────validx subroutine────────────────────────*/ |
|||
.scale: call wn 'SCALE', -sw(), sw() /*SCALE draws a "scale" line. */ |
|||
validx: arg r,c |
|||
?.scaleb = tb(?.scaleb, 'SCALEB') |
|||
rc=r || c |
|||
?.scaled = tb(?.scaled, 'SCALED', ".") |
|||
y= /*the rest of the row. */ |
|||
?.scalep = tb(?.scalep, 'SCALEP', "+") |
|||
do kc=1 for 9 /*compare to #s in column. */ |
|||
return |
|||
if kc\==c then y=y || @.r.kc /*build the rest of the row*/ |
|||
end /*kc*/ |
|||
/*──────────────────────────────────.T subroutine───────────────────────*/ |
|||
q=@.r.c /*get the digit at r,c */ |
|||
.t: call wn 'T', 0, 99 /*Times the text is written. */ |
|||
if pos(q,y)\==0 then return tem(r,c,'row') /*same number in same row ?*/ |
|||
if ?.ts\==0 then call wn 'TS', 0, 99 |
|||
y= /*the rest of the column. */ |
|||
?.tsb = tb(?.tsb, 'TSB') |
|||
return |
|||
if kr\==r then y=y || @.kr.c /*build the rest of the col*/ |
|||
end /*kr*/ |
|||
/*──────────────────────────────────.U subroutine───────────────────────*/ |
|||
if pos(q,y)\==0 then return tem(r,c,'col') /*same # in same column ?*/ |
|||
.u: upper ?.u /*handle uppercasing text parts. */ |
|||
?.u = left(?.u, 1) |
|||
b=box.rc |
|||
if pos(?.u, " AFLUW")==0 then call er 55, ?.u '.U=' |
|||
if ?.u==' ' | ?.u=='A' then ?.u= |
|||
return |
|||
/*──────────────────────────────────.UT subroutine──────────────────────*/ |
|||
do br=boxr.b to boxr.b+2 /*compare to #s of the box.*/ |
|||
.ut: call wn 'T', 0, 99 /*Times the text is written. */ |
|||
?.ut=valn(?.ut, "UT") |
|||
y=y || @.br.bc |
|||
end /*br*/ |
|||
end /*bc*/ |
|||
if length(?.ut)//2==1 then |
|||
if pos(q,y)\==0 then return tem(r,c,'box') /*same # in same box ? */ |
|||
call er 30,?.ut 'translate-characters an-even-number-of' |
|||
return |
|||
/*──────────────────────────────────.V subroutine───────────────────────*/ |
|||
/*─────────────────────────────pruneposs subroutine─────────────────────*/ |
|||
.v: upper ?.v /*video mode, Normal -or- Reverse*/ |
|||
pruneposs: if \(prunesing | pruneexcl | prunemats | pruneline) then return |
|||
?.v=left(?.v, 1) |
|||
call buildposs |
|||
if pos(?.v, " NR")==0 then call er 55, ?.v '.V=' |
|||
if ?.v==' ' | ?.v=='N' then ?.v= |
|||
return |
|||
/*──────────────────────────────────.W subroutine───────────────────────*/ |
|||
do prunes=1 |
|||
.w: if ?.q then return |
|||
call $t !fn 'is starting prune pass #' prunes |
|||
if ?.wb\=='' then ?.wb=tb(?.wb, 'WB') |
|||
found=0 /*indicate no prunes so far*/ |
|||
ww=translate(?.w,,"_") |
|||
if prunesing then do /*prune puzzle for singles.*/ |
|||
if ww='dd'x then ww = "press any key to continue ..." |
|||
if ww='de'x then ww = "press the ENTER key to continue ..." |
|||
call '$T' ".C=yel" translate(ww,?.wb,' ') |
|||
if _ then if showgrid then call showgrid /*show grid*/ |
|||
if ww='dd'x then call inkey |
|||
if ww='de'x then pull external |
|||
return |
|||
/*──────────────────────────────────.X subroutine───────────────────────*/ |
|||
if pruneexcl then do /*prune puzzle for singles.*/ |
|||
.x: call wn 'X', -sw(), sw() |
|||
_=pruneexcl() /*find any excluives ? */ |
|||
x2 = copies(?.xb, abs(?.x)) |
|||
found=found | _ /*track if anything found. */ |
|||
if ?.x<0 then x1=x2 |
|||
LLx = length(x1 || x2) |
|||
return |
|||
/*──────────────────────────────────.XK subroutine──────────────────────*/ |
|||
if pruneonly then do /*prune puzzle for onlys. */ |
|||
.xk: do ##=1 |
|||
_=pruneonly() /*find any onlys ? */ |
|||
parse var @ _ (xk) @ |
|||
if _=='' & @=="" then leave |
|||
tx.## = _ |
|||
if @\=='' then tx.## = tx.## || ?.k |
|||
tx.## = strip(tx.##) |
|||
LLk = max(LLk, length(tx.##)) |
|||
end /*##*/ |
|||
##=##-1 |
|||
return |
|||
/*──────────────────────────────────.Z subroutine───────────────────────*/ |
|||
if prunemats then do jpm=2 to 8 /*prune puzzle for matches.*/ |
|||
.z: _z=word(arg(1) ?.z, 1) /*snore subroutine: zzzzzz... */ |
|||
if _z=0 then return |
|||
found=found | _ /*track if anything found. */ |
|||
if !cms then call cp 'SLEEP' _z "SEC" |
|||
if !dos then call delay _z |
|||
return |
|||
/*──────────────────────────────────BEEPS subroutine────────────────────*/ |
|||
if pruneline then do /*prune puzzle for lines. */ |
|||
beeps: if \!dos & !pcrexx then return /*can this OS handle sounds? */ |
|||
_=pruneline() /*find 2 or more on a line?*/ |
|||
found=found | _ /*track if anything found. */ |
|||
if _ then if showgrid then call showgrid /*show grid*/ |
|||
end |
|||
do jb=1 for abs(arg(1)) |
|||
if \found then leave /*nothing found this time ?*/ |
|||
if jb\==1 then call delay .1 |
|||
end /*prunes*/ |
|||
do jb_=1 for words(?.bf) |
|||
call sound word(?.bf, jb_), word(word(?.bd,jb_) .2,1) |
|||
end /*jb_*/ |
|||
end /*jb */ |
|||
return |
return |
||
/*──────────────────────────────────BLOCKER subroutine──────────────────*/ |
|||
/*─────────────────────────────prunesing subroutine─────────────────────*/ |
|||
blocker: do jc=1 for LL /*process some blocked characters*/ |
|||
prunesing: foundsing=0 |
|||
chbit.jc = $block(substr(_, jc, 1)) |
|||
end /*jc*/ |
|||
bcl = ?.block |
|||
bcs = 1 |
|||
if bcl<0 then do |
|||
do r=1 for 9 |
|||
bcl=-bcl |
|||
bcs=3*bcl-2 |
|||
end |
|||
if _\==1 then iterate /*if not one digit, ignore.*/ |
|||
@.r.c=!.r.c /*it's 1 digit, a solution.*/ |
|||
!.r.c= /*erase the old possible. */ |
|||
foundsing=1 |
|||
call $t !fn 'found a single digit at cell' drc(r,c,@.r.c) |
|||
end /*c*/ |
|||
end /*r*/ |
|||
if _=='' then _=' ' |
|||
if foundsing then call buildposs /*re-build the possibles. */ |
|||
tbc = ?.bc |
|||
return foundsing |
|||
if tbc=='' then tbc=_ |
|||
tbc = left(copies(tbc,1+sw()%length(tbc)),sw()) |
|||
do jl=bcs to 3*bcl by 3 |
|||
/*─────────────────────────────pruneexcl subroutine─────────────────────*/ |
|||
_ = copies(?.bb, max(1, 12*LL+?.bs*LL-?.bs)) |
|||
pruneexcl: foundexcl=0 |
|||
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 |
|||
do exclusives=1 /*keep building possibles. */ |
|||
do r=1 for 9 |
|||
do c=1 for 9 |
|||
z=!.r.c |
|||
lz=length(z) /*get length of possible. */ |
|||
if lz==0 then iterate /*if null, then ignore it. */ |
|||
y= |
|||
rc=r || c |
|||
b=box.rc |
|||
/*──────────────────────────────────COLORS subroutine───────────────────*/ |
|||
do br=boxr.b to boxr.b+2 /*compare to #s of the box.*/ |
|||
colors: arg hue,__,cc#,cc /*verify/handle synonymous colors*/ |
|||
dark = left(hue,4)=='DARK' |
|||
if br==r & bc==c then iterate |
|||
if dark then hue = substr(hue,5) |
|||
if hue=='BRITE' | hue=="BRIGHT" then hue = 'WHITE' |
|||
end /*bc*/ |
|||
if left(hue,5)=='BRITE' then hue = substr(hue,6) |
|||
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 |
|||
/*test for reduction. */ |
|||
ahue=word(hues,jj) |
|||
do t=1 for lz |
|||
if abbrev(ahue,hue,3) then do |
|||
q=substr(z,t,1) |
|||
cc=word(hues,jj+1) |
|||
hue=ahue |
|||
leave |
|||
end |
|||
end /*jj*/ |
|||
if cc=='' then call er 50, "color" '.'__"="hue |
|||
if pos(q,y)==0 then do |
|||
if dark & left(cc,2)=='1;' then cc="0"substr(cc,2) |
|||
foundexcl=1 |
|||
@.r.c=q /*it's a singularity, a sol*/ |
|||
!.r.c= /*erase old possibleity. */ |
|||
call $t !fn 'found the digit' q, |
|||
"by exclusiveness at cell" drc(r,c,z) |
|||
call buildposs /*re-build the possibles. */ |
|||
iterate exclusives |
|||
end |
|||
end /*t*/ |
|||
end /*c*/ |
|||
end /*r*/ |
|||
if !cms then do |
|||
leave |
|||
if hue='GRAY' | hue=="BLACK" then hue='WHITE' |
|||
end /*exclusives*/ |
|||
if hue="BROWN" then hue='YELLOW' |
|||
end |
|||
color.cc# = hue |
|||
return foundexcl |
|||
colorC.cc# = esc || cc'm' |
|||
return |
|||
/*──────────────────────────────────CPMORE subroutine───────────────────*/ |
|||
/*─────────────────────────────prunemats subroutine─────────────────────*/ |
|||
cpMore: call cp 'QUERY TERM', 9 /*parse CP TERMINAL for MORE,HOLD*/ |
|||
__= |
|||
parse arg L /*length of match, L=2,pair*/ |
|||
do jj=1 for cp.0 |
|||
__=__ cp.jj |
|||
end /*jj*/ |
|||
parse upper var __ 'MORE' more ',' 1 'HOLD' hold ',' |
|||
do matches=1 |
|||
if _>9998 & more\=='' then call cp 'TERMINAL MORE 0 0' |
|||
do r=1 for 9 |
|||
if _>99999998 & hold\=='' then call cp 'TERMINAL HOLD OFF' |
|||
do c=1 for 9 |
|||
return |
|||
_=length(!.r.c) /*get length of possible. */ |
|||
if _==0 then iterate /*if null, then ignore it. */ |
|||
if _\==L then iterate /*not right length, ignore.*/ |
|||
qq=!.r.c |
|||
m=0 /*count of matches so far. */ |
|||
do _c=1 for 9 /*nother match in same row?*/ |
|||
if qq==!.r._c then m=m+1 /*up count if it's a match.*/ |
|||
end /*_c*/ |
|||
/*──────────────────────────────────DSAY subroutine─────────────────────*/ |
|||
if m>=L then do pc=1 for 9 /*squish other possibles. */ |
|||
dsay: if ?.q then return /*do SAY subroutine, write to scr*/ |
|||
dsay_ = strip(translate(arg(1), , '0'x), 'T') |
|||
if old==qq then iterate /*if match, then ignore it.*/ |
|||
say dsay_ |
|||
if old=='' then iterate /*if null poss, then ignore*/ |
|||
LLd = length(dsay_) /*length of last line displayed. */ |
|||
return |
|||
if new==old then iterate /*if no change,keep looking*/ |
|||
!.r.pc=new /*store new value into old.*/ |
|||
foundmatch=1 /*indicate match was found.*/ |
|||
call $t !fn 'is removing a' old "from" drc(r,pc,old), |
|||
'because of a match at' drc(r,c,qq) |
|||
if length(new)==1 then do /*reduce if L=1*/ |
|||
@.r.pc=new /*store single.*/ |
|||
!.r.pc= /*delete poss. */ |
|||
call buildposs /*re-build poss*/ |
|||
iterate matches /*start over.*/ |
|||
end |
|||
end /*pc*/ |
|||
m=0 /*count of matches so far. */ |
|||
/*──────────────────────────────────HIGHLIGHT subroutine────────────────*/ |
|||
do _r=1 for 9 /*nother match in same col?*/ |
|||
highLight: do _=1 for 7 |
|||
if qq==!._r.c then m=m+1 /*up count if it's a match.*/ |
|||
hhl._ = color._\=='' |
|||
hics._ = left(hh._,1) |
|||
hice._ = right(hh._,1) |
|||
if hhl._ then do |
|||
minhic= min(_,minhic); shics= shics || hics._ |
|||
maxhic= max(_,maxhic); ehics= ehics || hice._ |
|||
end |
|||
end /*_*/ |
|||
if new==old then iterate /*if no change,keep looking*/ |
|||
!.pr.c=new /*store new value into old.*/ |
|||
foundmatch=1 /*indicate match was found.*/ |
|||
call $t !fn 'is removing a' old "from" drc(pr,c,old), |
|||
'because of a match at' drc(r,c,qq) |
|||
if length(new)==1 then do /*reduce if L=1*/ |
|||
@.pr.c=new /*store single.*/ |
|||
!.pr.c= /*delete poss. */ |
|||
call buildposs /*re-build poss*/ |
|||
iterate matches /*start over.*/ |
|||
end |
|||
end /*pr*/ |
|||
end /*c*/ |
|||
end /*r*/ |
|||
ahics=shics || ehics |
|||
leave |
|||
return |
|||
end /*matches*/ |
|||
/*──────────────────────────────────HUE subroutine──────────────────────*/ |
|||
return foundmatch |
|||
hue: hue#=max(1, hue#+arg(1)) |
|||
__=arg(2) |
|||
if __\=='' then hue.hue#=__ |
|||
_= |
|||
return |
|||
/*──────────────────────────────────INCHES Subroutine───────────────────*/ |
|||
/*─────────────────────────────pruneonly subroutine─────────────────────*/ |
|||
inches: /*handle RULER and SCALE stuff.*/ |
|||
_ = kw('RULERB') kw('SCALEB') kw('SCALEP') kw('SCALED') |
|||
if arg(2) then _=$scale(?.scale _ 'Q') |
|||
do findonlys=1 /*keep searching ... */ |
|||
else _=$scale(?.ruler 'RULE' _ 'Q') |
|||
_row.= /*build str for each row . */ |
|||
parse var _ _.1 '9'x _.2 '9'x _.3 |
|||
do c=1 for 9 |
|||
if !.r.c\=='' then _row.r=_row.r !.r.c |
|||
end /*c*/ |
|||
end /*r*/ |
|||
do jk=1 for 3 |
|||
_=_.jk |
|||
if _\=='' then call wit _ |
|||
end /*jk*/ |
|||
return |
|||
/*──────────────────────────────────MS subroutine───────────────────────*/ |
|||
do c=1 for 9 |
|||
ms: #ms=#ms+1 /*justification and indentation. */ |
|||
parse arg _i |
|||
if !.r.c\=='' then _col.c=_col.c !.r.c |
|||
end /*r*/ |
|||
end /*c*/ |
|||
select |
|||
do r=1 for 9 |
|||
when ?.j=='' then nop |
|||
when ?.N=='N' then nop |
|||
q=!.r.c |
|||
when length(_i)>=sw()-1 then nop |
|||
if q=='' then iterate /*if empty, then ignore it.*/ |
|||
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') |
|||
do j=1 to length(q) /*step through each digit. */ |
|||
return |
|||
k=substr(q,j,1) |
|||
/*──────────────────────────────────SAYALINE subroutine──────────────────*/ |
|||
if kount1(k,_row.r) |, /*is this the ONLY digit K?*/ |
|||
sayAline: |
|||
kount1(k,_col.c) then do i=1 to length(q) /*prune others.*/ |
|||
foundmatch=1 |
|||
_=substr(q,i,1) |
|||
if _==k then iterate /*if=K, ignore.*/ |
|||
o=squish(q,_) /*remove others*/ |
|||
!.r.c=o |
|||
call $t !fn 'removed part of an only', |
|||
_ "from cell" drc(r,c,q) |
|||
if length(o)==1 then /*reduce if L=1*/ |
|||
do |
|||
@.r.c=o /*store single.*/ |
|||
!.r.c= /*delete poss. */ |
|||
call buildposs /*re-build poss*/ |
|||
iterate findonlys /*start over. */ |
|||
end |
|||
end /*i*/ |
|||
end /*j*/ |
|||
end /*c*/ |
|||
end /*r*/ |
|||
do jj=?.s to #ms for ?.o |
|||
leave |
|||
if skp() then iterate |
|||
end /*findonlys*/ |
|||
if \?.q then do |
|||
return foundmatch |
|||
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 |
|||
/*─────────────────────────────pruneline subroutine─────────────────────*/ |
|||
pruneline: foundmatch=0 /*no matches found so far. */ |
|||
/*──────────────────────────────────SAYBRITE subroutine─────────────────*/ |
|||
do findlines=1 /*keep searching ... */ |
|||
sayBrite: do jj=?.s to #ms for ?.o |
|||
_boxr.= /*build str for each boxrow*/ |
|||
if skp() then iterate |
|||
call wr _mm |
|||
if ?.q then iterate |
|||
if !cms then '$CLEAR .C=BRITE' _mm |
|||
else if !dos then call dsay colorC.0 || _mm || scr0 |
|||
end /*jj*/ |
|||
return |
|||
b=box.rc |
|||
if !.r.c\=='' then _boxr.r.b=strip(_boxr.r.b !.r.c) |
|||
end /*c*/ |
|||
end /*r*/ |
|||
/*──────────────────────────────────SAYNLINE subroutine─────────────────*/ |
|||
_boxc.= /*build str for each boxcol*/ |
|||
sayNline: do jj=?.s to #ms for ?.o |
|||
if skp() then iterate |
|||
if !dos then do |
|||
if ?.c=='' then call dsay _mm |
|||
else call dsay colorC.0 || _mm || scr0 |
|||
call wr _mm |
|||
end |
|||
else call wit _mm |
|||
end |
end /*jj*/ |
||
return |
|||
/*──────────────────────────────────SAYHIGHLIGHT subroutine─────────────*/ |
|||
do r=1 for 9 /*search all rows for twins*/ |
|||
sayHighlight: |
|||
do jj=?.s to #ms for ?.o |
|||
if skp() then iterate |
|||
aline=_boxr.r.b /*get a row in the box. */ |
|||
if aline=='' then iterate /*if empty, ignore the line*/ |
|||
w=words(aline) /*W is # of words in aline*/ |
|||
if w<2 then iterate /*if < 2 words, ignore line*/ |
|||
if !cms then do |
|||
do k=1 for 9 /*search for each digit. */ |
|||
if \?.q then '$CLEAR .C=HIGHL' _mm |
|||
iterate |
|||
end |
|||
if s==0 then iterate /*no 2nd k, so keep looking*/ |
|||
lenmm=length(_mm) |
|||
do jr=rowlb.r to rowhb.r /*look at the other 2 rows.*/ |
|||
__=verify(_mm,ahics,'M') |
|||
if jr==r then iterate /*if the same row, ignore. */ |
|||
if pos(k,_boxr.jr.b)\==0 then iterate k /*if no digit K, ignore*/ |
|||
end /*jr*/ |
|||
/*found 2 Ks in row R box B*/ |
|||
do jb=rowlb.r to rowhb.r /*search boxes row R for K.*/ |
|||
if jb==b then iterate /*ignore if in the same box*/ |
|||
if pos(k,_boxr.r.jb)==0 then iterate |
|||
foundmatch=1 /*found a K in col C box JB*/ |
|||
if __==0 then hc=lenmm+1 |
|||
do kc=1 for 9 /*find which cell K is in.*/ |
|||
else hc=__ |
|||
_xx=hue.1 |
|||
if box.rc==b then iterate /*ignore if in the same box*/ |
|||
if hc>1 then _xx=_xx || left(_mm, hc-1) |
|||
if _=='' then iterate /*ignore if no possible. */ |
|||
if pos(k,_)==0 then iterate /*if no digit K, ignore. */ |
|||
call $t !fn 'is row-line pruning digit' k, |
|||
'from cell' drc(r,kc,!.r.kc) |
|||
!.r.kc=squish(_,k) /*remove mat's digs from X.*/ |
|||
if length(!.r.kc)==1 then do /*pruned down to one digit?*/ |
|||
@.r.kc=!.r.kc /*make a true digit*/ |
|||
!.r.kc= /*erase possibility*/ |
|||
call buildposs /*rebuild possibles*/. |
|||
iterate findlines |
|||
end |
|||
end /*kc*/ |
|||
end /*jb*/ |
|||
end /*k*/ |
|||
end /*b*/ |
|||
end /*r*/ |
|||
do jl=hc to lenmm |
|||
do c=1 for 9 /*search all cols for twins*/ |
|||
_=substr(_mm,jl,1) |
|||
do jc=minhic to maxhic |
|||
do b=collb.c to colhb.c by 3 /*for each col, search box.*/ |
|||
if hhl.jc then if _==hics.jc then call hue 1, colorC.jc |
|||
aline=_boxc.c.b /*get a column in the box.*/ |
|||
else if _==hice.jc then call hue -1 |
|||
end /*jc*/ |
|||
if w<2 then iterate /*if < 2 words, ignore line*/ |
|||
if _=='' then _xx=_xx" " |
|||
do k=1 for 9 /*search for each digit. */ |
|||
__=verify(substr(_mm, jl+1), ahics, 'M') |
|||
f=pos(k,aline) /*pos of the 1st digit: k */ |
|||
if f==0 then iterate /*no dig k, so keep looking*/ |
|||
s=pos(k,aline,f+1) /*pos of the 2nd digit: k */ |
|||
if s==0 then iterate /*no 2nd k, so keep looking*/ |
|||
if __==0 then pl=lenmm-jl+1 |
|||
do jc=boxlc.b to boxhc.b /*look at the other 2 cols.*/ |
|||
else pl=__ |
|||
if jc==c then iterate /*if the same col, ignore. */ |
|||
if pos(k,_boxc.jc.b)\==0 then iterate k /*if no digit K, ignore*/ |
|||
end /*jc*/ |
|||
/*found 2 Ks in col C box B*/ |
|||
do jb=collb.c to colhb.c by 3 /*search boxes col C for K.*/ |
|||
if jb==b then iterate /*ignore if in the same box*/ |
|||
if pos(k,_boxc.c.jb)==0 then iterate |
|||
foundmatch=1 /*found a K in col C box JB*/ |
|||
if pl==1 then iterate |
|||
do kr=1 for 9 /*find which cell K is in.*/ |
|||
_xx=_xx || hue.hue# || substr(_mm, jl+1, pl-1) |
|||
rc=kr || c |
|||
jl=jl+pl-1 |
|||
if box.rc==b then iterate /*ignore if in the same box*/ |
|||
end /*jl*/ |
|||
if _=='' then iterate /*ignore if no possible. */ |
|||
if pos(k,_)==0 then iterate /*if no digit K, ignore. */ |
|||
call $t !fn 'is col-line pruning digit' k, |
|||
'from cell' drc(kr,c,!.kr.c) |
|||
!.kr.c=squish(_,k) /*remove mat's digs from X.*/ |
|||
if length(!.kr.c)==1 then do /*pruned down to one digit?*/ |
|||
@.kr.c=!.kr.c /*make a true digit*/ |
|||
!.kr.c= /*erase possibility*/ |
|||
call buildposs /*rebuild possibles*/. |
|||
iterate findlines |
|||
end |
|||
end /*kr*/ |
|||
end /*jb*/ |
|||
end /*k*/ |
|||
end /*b*/ |
|||
end /*c*/ |
|||
if length(_xx)>sw() then if lenmm<=sw() then _xx = esc's'_xx || esc"u" |
|||
leave |
|||
call dsay _xx || scr0 |
|||
end /*findlines*/ |
|||
call wr _mm |
|||
end /*jj*/ |
|||
return |
return |
||
/*──────────────────────────────────SKP subroutine──────────────────────*/ |
|||
/*═════════════════════════════general 1-line subs════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/ |
|||
skp: if (onlyo\=='' & onlyo\==jj) |, |
|||
!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 |
|||
(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 |
!cal: if symbol('!CALL')\=="VAR" then !call=; return !call |
||
!env: !env='ENVIRONMENT'; if !sys=='MSDOS' | !brexx | !r4 | !roo then !env='SYSTEM'; if !os2 |
!env: !env='ENVIRONMENT'; if !sys=='MSDOS' | !brexx | !r4 | !roo then !env='SYSTEM'; if !os2 then !env='OS2'!env; !ebcdic=1=='f0'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=='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 |
!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)) |
||
.a: call wn 'A',-99,99,sd(); ?.ab=tb(?.ab,'AB'); return |
|||
$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) |
|||
$block: !call='$BLOCK'; call '$BLOCK' arg(1); !call=; return result |
|||
$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 ! |
|||
$mkdir: !call='$MKDIR'; call '$MKDIR' arg(1); !call=; return result |
|||
$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) |
|||
$scale: !call='$SCALE'; call '$SCALE' arg(1); !call=; return result |
|||
$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) |
|||
cp: "EXECIO" '0'arg(2) "CP(STEM CP. STRING" arg(1); return rc |
|||
$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) |
|||
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 |
|||
$sfxz: return $sfxa($sfxa($sfxa($sfxa($sfxa($sfxa(y,'PAIRs',2),'DOZens',12),'SCore',20),'GREATGRoss',1728),'GRoss',144),'GOOGOLs',1e100) |
|||
p: return word(arg(1),1) |
|||
$t: if tops=='' then say arg(1); else do; !call=']$T'; call "$T" tops arg(1); !call=; end; return |
|||
halt: call er .1 |
|||
ab: arg ab,abl; return abbrev(ab,_,abl) |
|||
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) |
|||
abbn: parse arg abbn; return abb(abbn) | abb('NO'abbn) |
|||
proper: procedure; arg f 2; parse arg 2 r; return f || r |
|||
sd: if ?.scrdepth=='' then parse value scrsize() with ?.scrdepth ?.linesize .; return ?.scrdepth |
|||
comma: procedure; parse arg _,c,p,t; c=pickBlank(c,","); o=p(p 3); p=abs(o); t=p(t 999999999); if \isInt(p) | \isInt(t) | p==0 | arg()>4 then return _; n=_'.9'; #=123456789; k=0; return comma_() |
|||
sw: if ?.linesize=='' then ?.linesize=linesize(); return ?.linesize |
|||
comma_: if o<0 then do; b=verify(_,' '); if b==0 then return _; e=length(_)-verify(reverse(_),' ')+1; end; else do; b=verify(n,#,"M"); e=verify(n,#'0',,verify(n,#"0.",'M'))-p-1; end; do j=e to b by -p while k<t; _=insert(c,_,j); k=k+1; end; return _ |
|||
syntax: !sigl=sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl) |
|||
copies2: return copies(arg(1),2) |
|||
wit: call dsay arg(1); call wr arg(1); return |
|||
copies3: return copies(arg(1),3) |
|||
drc: procedure; parse arg r,c,p; _=r","c; if p\=='' then _=_ "("p')'; return _ |
|||
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 '' |
|||
</lang> |
|||
erx: call er '-'arg(1),arg(2); exit '' |
|||
halt: call er .1 |
|||
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') |
|||
kount1: parse arg qd,string; k1=pos(qd,string); if k1==0 then return 0; return pos(qd,string,k1+1)==0 |
|||
lower: return translate(arg(1),@abc,translate(@abc)) |
|||
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) |
|||
nail: return squish(int(translate(na(),0,','),_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) |
|||
pickBlank: procedure; parse arg x,y; arg xu; if xu=='BLANK' then return ' '; return p(x y) |
|||
shorten:procedure; parse arg a,n; return left(a,max(0,length(a)-p(n 1))) |
|||
simple: return translate(arg(1),'.||--%<>AV'copies('+',25),"·│║─═☼◄►↑↓┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣") |
|||
squish: return space(translate(arg(1),,word(arg(2) ',',1)),0) |
|||
syntax: !sigl=sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl) |
|||
tem: parse arg r,c,w; if tellinvalid then say '***error!*** row' r", col" c '('@.r.c") is a duplicate of another in the same" w'.'; return 0 |
|||
tg: arg tg; if simple then tg=simple(tg); call $t gridindent || tg; return</lang> |
|||
=== REXX CHANGESTR function === |
=== REXX CHANGESTR function === |