Sudoku/REXX: Difference between revisions
Content added Content deleted
m (corrected two REXX names. -- ~~~~) |
m (→$SUDOKU.REX: added whitespace, changed and added comments, split multiple-statement lines, made more readable.) |
||
Line 6: | Line 6: | ||
<br><br>The '''$SUDOKU.REX''' REXX program makes use of '''$T.REX''' REXX program which is used to display text messages. |
<br><br>The '''$SUDOKU.REX''' REXX program makes use of '''$T.REX''' REXX program which is used to display text messages. |
||
<br>The '''$T.REX''' REXX program is included here ──► [[$T.REX]]. |
<br>The '''$T.REX''' REXX program is included here ──► [[$T.REX]]. |
||
<lang rexx>/**/trace |
<lang rexx>/*REXX*/ trace off |
||
parse arg ! |
|||
signal on halt; signal on novalue; signal on syntax |
|||
if !all(arg()) then exit |
|||
if !cms then address '' |
|||
signal on halt |
|||
signal on noValue |
|||
signal on syntax |
|||
ops=! /*remove extraneous blanks.*/ |
ops=! /*remove extraneous blanks.*/ |
||
Line 14: | Line 19: | ||
@.=' ' /*initialize grid to blanks*/ |
@.=' ' /*initialize grid to blanks*/ |
||
!.= /*nullify valid empty# list*/ |
!.= /*nullify valid empty# list*/ |
||
@abc='abcdefghijklmnopqrstuvwxyz' |
@abc='abcdefghijklmnopqrstuvwxyz' |
||
@abcU=@abc |
|||
upper @abcU |
|||
colors=!cms | !pcrexx | !r4 | !roo /*Are colors supported ? */ |
colors=!cms | !pcrexx | !r4 | !roo /*Are colors supported ? */ |
||
clear=1 /*option: clear the screen.*/ |
clear=1 /*option: clear the screen.*/ |
||
Line 58: | Line 65: | ||
do while ops\=='' /*parse any and all options*/ |
do while ops\=='' /*parse any and all options*/ |
||
parse var ops _1 2 1 _ . 1 _o ops |
parse var ops _1 2 1 _ . 1 _o ops |
||
upper _ |
|||
select |
select |
||
when _==',' then nop |
when _==',' then nop |
||
when _1=='.' & pos("=",_)\==0 then tops=tops _o |
when _1=='.' & pos("=",_)\==0 then tops=tops _o |
||
when left(_,4)=='PUZZ' then /*do PUZZ (whole) placement*/ |
when left(_,4)=='PUZZ' then /*do PUZZ (whole) placement*/ |
||
do |
do |
||
parse var _ '=' y |
parse var _ '=' y |
||
if y=='' then call er 35,'PUZZ'rc |
|||
if length(y)>81 then call er 30,y 'PUZZ 1--->81' |
if length(y)>81 then call er 30,y 'PUZZ 1--->81' |
||
do j=1 |
do j=1 |
||
q=substr(y,j,1) |
q=substr(y,j,1) |
||
if q==' ' then leave |
|||
if q=='.' then iterate |
if q=='.' then iterate |
||
call vern q,'PUZZLE_digit' |
call vern q,'PUZZLE_digit' |
||
c=j//9 |
c=j//9 |
||
if c==0 then c=9 |
if c==0 then c=9 |
||
r=(j-1)%9+1 |
r=(j-1)%9 + 1 |
||
@.r.c=q |
@.r.c=q |
||
end /*j*/ |
end /*j*/ |
||
end |
end |
||
when left(_,4)=='CELL' then /*do CELL (grid) placement.*/ |
when left(_,4)=='CELL' then /*do CELL (grid) placement.*/ |
||
do |
do |
||
parse var _ 'CELL' rc '=' y |
parse var _ 'CELL' rc '=' y |
||
if y=='' then call er 35,'CELL'rc |
|||
if length(rc)\==2 then call er 30,y 'CELL'rc 2 |
if length(rc)\==2 then call er 30,y 'CELL'rc 2 |
||
r=left |
r=left(rc,1) |
||
c=right(rc,1) |
|||
call vern r,'CELLrow' |
call vern r,'CELLrow' |
||
call vern c,'CELLcol' |
call vern c,'CELLcol' |
||
Line 88: | Line 103: | ||
@.r.c=y |
@.r.c=y |
||
end |
end |
||
when left(_,3)=='COL' then /*do COL (grid) placement. */ |
when left(_,3)=='COL' then /*do COL (grid) placement. */ |
||
do |
do |
||
parse var _ 'COL' n '=' y |
parse var _ 'COL' n '=' y |
||
if y=='' then call er 35,'COL'n |
|||
call vern n,'COL' |
call vern n,'COL' |
||
ly=length(y) |
ly=length(y) |
||
if ly>9 then call er 30,y 'COL'n '1--->8' |
|||
do j=1 |
do j=1 to ly |
||
x=substr(y,j,1) |
x=substr(y,j,1) |
||
if x=='' | x=="_" | x=='*' | x=="." then iterate |
if x=='' | x=="_" | x=='*' | x=="." then iterate |
||
Line 100: | Line 118: | ||
end /*j*/ |
end /*j*/ |
||
end |
end |
||
when left(_,3)=='ROW' then /*do ROW (grid) placement. */ |
when left(_,3)=='ROW' then /*do ROW (grid) placement. */ |
||
do |
do |
||
parse var _ 'ROW' n '=' y |
parse var _ 'ROW' n '=' y |
||
if y=='' then call er 35,'ROW'n |
|||
call vern n,'ROW' |
call vern n,'ROW' |
||
ly=length(y) |
ly=length(y) |
||
if ly>9 then call er 30,y 'ROW'n '1--->8' |
|||
do j=1 to ly |
do j=1 to ly |
||
Line 113: | Line 134: | ||
end /*j*/ |
end /*j*/ |
||
end |
end |
||
when abbn('CLearscreen') then clear=no() |
when abbn('CLearscreen') then clear=no() |
||
when abbn('HIGHLightsingles') then highlight=no() |
when abbn('HIGHLightsingles') then highlight=no() |
||
Line 134: | Line 156: | ||
when abbn('SHortgrid') then short=no() |
when abbn('SHortgrid') then short=no() |
||
when abbn('SOLvepuzzle') then solve=no() |
when abbn('SOLvepuzzle') then solve=no() |
||
otherwise call er 55,_o |
otherwise call er 55,_o |
||
end /*select*/ |
end /*select*/ |
||
Line 145: | Line 168: | ||
prunesing=1 |
prunesing=1 |
||
end |
end |
||
aprune = , /*is there a PRUNExxx on ? */ |
aprune = , /*is there a PRUNExxx on ? */ |
||
pruneexcl |, |
pruneexcl |, |
||
Line 155: | Line 179: | ||
hll='-' |
hll='-' |
||
hlr='-' |
hlr='-' |
||
if colors then do |
if colors then do |
||
hll='(' |
hll='(' |
||
Line 161: | Line 186: | ||
end |
end |
||
end |
end |
||
tops=space(tops) |
tops=space(tops) |
||
box.= |
box.= |
||
Line 169: | Line 195: | ||
boxr.j=rr |
boxr.j=rr |
||
boxc.j=cc |
boxc.j=cc |
||
do r=rr to rr+2 /*build boxes with cell #s.*/ |
do r=rr to rr+2 /*build boxes with cell #s.*/ |
||
do c=cc to cc+2 |
do c=cc to cc+2 |
||
Line 176: | Line 203: | ||
end /*c*/ |
end /*c*/ |
||
end /*r*/ |
end /*r*/ |
||
box.j=strip(box.j) |
box.j=strip(box.j) |
||
end /*j*/ |
end /*j*/ |
||
Line 222: | Line 250: | ||
call $T _ |
call $T _ |
||
end |
end |
||
if aprune |, |
if aprune |, |
||
showposs then do |
showposs then do |
||
Line 229: | Line 258: | ||
end |
end |
||
if combos==1 then call $t sod 'puzzle solved.' |
if combos==1 then call $t sod 'puzzle solved.' |
||
else if showcomb then call $t 'combinations='comma(combos) |
else if showcomb then call $t 'combinations='comma(combos) |
||
exit /*stick a fork in it, we're done.*/ |
exit /*stick a fork in it, we're done.*/ |
||
Line 289: | Line 318: | ||
do jb=1 while showbox\=='' |
do jb=1 while showbox\=='' |
||
b=substr(showbox,jb,1) |
b=substr(showbox,jb,1) |
||
if |
if b==' ' then leave |
||
⚫ | |||
end /*jb*/ |
end /*jb*/ |
||
Line 318: | Line 348: | ||
do r=1 for 9 /*step through each row. */ |
do r=1 for 9 /*step through each row. */ |
||
do c=1 for 9 /*step through each column.*/ |
do c=1 for 9 /*step through each column.*/ |
||
if @.r.c==' ' & !.r.c=='' then do /*no legal digit here. */ |
|||
if @.r.c==' ' & , |
|||
⚫ | |||
!.r.c=='' then do /*no legal digit here. */ |
|||
if arg(1)==1 then call $t sod "puzzle isn't valid !" |
|||
return 0 |
|||
end |
|||
end /*c*/ |
end /*c*/ |
||
end /*r*/ /*sub requires possibles. */ |
end /*r*/ /*sub requires possibles. */ |
||
Line 368: | Line 400: | ||
if kc\==c then y=y || @.r.kc /*build the rest of the row*/ |
if kc\==c then y=y || @.r.kc /*build the rest of the row*/ |
||
end /*kc*/ |
end /*kc*/ |
||
q=@.r.c /*get the digit at r,c */ |
q=@.r.c /*get the digit at r,c */ |
||
if pos(q,y)\==0 then return tem(r,c,'row') /*same number in same row ?*/ |
if pos(q,y)\==0 then return tem(r,c,'row') /*same number in same row ?*/ |
||
Line 375: | Line 408: | ||
end /*kr*/ |
end /*kr*/ |
||
if pos(q,y)\==0 then return tem(r,c,'col') |
if pos(q,y)\==0 then return tem(r,c,'col') /*same # in same column ?*/ |
||
y= /*the rest of the box. |
y= /*the rest of the box. */ |
||
b=box.rc |
b=box.rc |
||
Line 396: | Line 429: | ||
call $t !fn 'is starting prune pass #' prunes |
call $t !fn 'is starting prune pass #' prunes |
||
found=0 /*indicate no prunes so far*/ |
found=0 /*indicate no prunes so far*/ |
||
if prunesing then do /*prune puzzle for singles.*/ |
if prunesing then do /*prune puzzle for singles.*/ |
||
_=prunesing() /*find any singles ? */ |
_=prunesing() /*find any singles ? */ |
||
found=found | _ /*track if anything found. */ |
found=found | _ /*track if anything found. */ |
||
if _ then if showgrid then call showgrid /*show grid |
if _ then if showgrid then call showgrid /*show grid*/ |
||
end |
end |
||
if pruneexcl then do /*prune puzzle for singles.*/ |
if pruneexcl then do /*prune puzzle for singles.*/ |
||
_=pruneexcl() /*find any excluives ? */ |
_=pruneexcl() /*find any excluives ? */ |
||
found=found | _ /*track if anything found. */ |
found=found | _ /*track if anything found. */ |
||
if _ then if showgrid then call showgrid /*show grid |
if _ then if showgrid then call showgrid /*show grid*/ |
||
end |
end |
||
if pruneonly then do /*prune puzzle for onlys. */ |
if pruneonly then do /*prune puzzle for onlys. */ |
||
_=pruneonly() /*find any onlys ? */ |
_=pruneonly() /*find any onlys ? */ |
||
found=found | _ /*track if anything found. */ |
found=found | _ /*track if anything found. */ |
||
if _ then if showgrid then call showgrid /*show grid |
if _ then if showgrid then call showgrid /*show grid*/ |
||
end |
end |
||
if prunemats then do jpm=2 to 8 /*prune puzzle for matches.*/ |
if prunemats then do jpm=2 to 8 /*prune puzzle for matches.*/ |
||
_=prunemats(jpm) /*find any matches (len=j)?*/ |
_=prunemats(jpm) /*find any matches (len=j)?*/ |
||
found=found | _ /*track if anything found. */ |
found=found | _ /*track if anything found. */ |
||
if _ then if showgrid then call showgrid /*show grid |
if _ then if showgrid then call showgrid /*show grid*/ |
||
end |
end |
||
if pruneline then do /*prune puzzle for lines. */ |
if pruneline then do /*prune puzzle for lines. */ |
||
_=pruneline() /*find 2 or more on a line?*/ |
_=pruneline() /*find 2 or more on a line?*/ |
||
found=found | _ /*track if anything found. */ |
found=found | _ /*track if anything found. */ |
||
if _ then if showgrid then call showgrid /*show grid |
if _ then if showgrid then call showgrid /*show grid*/ |
||
end |
end |
||
if \found then leave /*nothing found this time ?*/ |
if \found then leave /*nothing found this time ?*/ |
||
end /*prunes*/ |
end /*prunes*/ |
||
Line 430: | Line 469: | ||
do r=1 for 9 |
do r=1 for 9 |
||
do c=1 for 9 |
do c=1 for 9 |
||
_=length(!.r.c) /*get length of possible. */ |
|||
if _==0 then iterate /*if null, then ignore it. */ |
if _==0 then iterate /*if null, then ignore it. */ |
||
if _\==1 then iterate /*if not one digit, ignore.*/ |
if _\==1 then iterate /*if not one digit, ignore.*/ |
||
Line 448: | Line 488: | ||
do exclusives=1 /*keep building possibles. */ |
do exclusives=1 /*keep building possibles. */ |
||
do r=1 for 9 |
do r=1 for 9 |
||
do c=1 for 9 |
do c=1 for 9 |
||
z=!.r.c |
|||
lz=length(z) /*get length of possible. */ |
lz=length(z) /*get length of possible. */ |
||
if lz==0 then iterate /*if null, then ignore it. */ |
if lz==0 then iterate /*if null, then ignore it. */ |
||
Line 454: | Line 495: | ||
rc=r || c |
rc=r || c |
||
b=box.rc |
b=box.rc |
||
do br=boxr.b to boxr.b+2 /*compare to #s of the box.*/ |
do br=boxr.b to boxr.b+2 /*compare to #s of the box.*/ |
||
do bc=boxc.b to boxc.b+2 /*build the rest of the box*/ |
do bc=boxc.b to boxc.b+2 /*build the rest of the box*/ |
||
Line 460: | Line 502: | ||
end /*bc*/ |
end /*bc*/ |
||
end /*br*/ |
end /*br*/ |
||
/*test for reduction. */ |
/*test for reduction. */ |
||
do t=1 for lz |
do t=1 for lz |
||
q=substr(z,t,1) |
|||
if pos(q,y)==0 then do |
if pos(q,y)==0 then do |
||
foundexcl=1 |
foundexcl=1 |
||
Line 486: | Line 531: | ||
do matches=1 |
do matches=1 |
||
do r=1 for 9 |
do r=1 for 9 |
||
do c=1 for 9 |
do c=1 for 9 |
||
_=length(!.r.c) /*get length of possible. */ |
|||
if _==0 then iterate /*if null, then ignore it. */ |
if _==0 then iterate /*if null, then ignore it. */ |
||
if _\==L then iterate /*not right length, ignore.*/ |
if _\==L then iterate /*not right length, ignore.*/ |
||
Line 503: | Line 549: | ||
!.r.pc=new /*store new value into old.*/ |
!.r.pc=new /*store new value into old.*/ |
||
foundmatch=1 /*indicate match was found.*/ |
foundmatch=1 /*indicate match was found.*/ |
||
call $t !fn 'is removing a' L "from" drc(r,pc,old), |
call $t !fn 'is removing a' L "from" drc(r,pc,old), |
||
'because of a match at' drc(r,c,qq) |
'because of a match at' drc(r,c,qq) |
||
if length(new)==1 then do /*reduce if L=1*/ |
if length(new)==1 then do /*reduce if L=1*/ |
||
@.r.pc=new /*store single.*/ |
@.r.pc=new /*store single.*/ |
||
Line 513: | Line 559: | ||
end /*pc*/ |
end /*pc*/ |
||
m=0 /*count of matches so far. */ |
m=0 /*count of matches so far. */ |
||
do _r=1 for 9 /*nother match in same col?*/ |
do _r=1 for 9 /*nother match in same col?*/ |
||
if qq==!._r.c then m=m+1 /*up count if it's a match.*/ |
if qq==!._r.c then m=m+1 /*up count if it's a match.*/ |
||
end /*_r*/ |
end /*_r*/ |
||
if m>=L then do pr=1 for 9 |
if m>=L then do pr=1 for 9 /*squish other possibles. */ |
||
old=!.pr.c /*save the "old" value. */ |
old=!.pr.c /*save the "old" value. */ |
||
if old==qq then iterate /*if match, then ignore it.*/ |
if old==qq then iterate /*if match, then ignore it.*/ |
||
Line 547: | Line 594: | ||
do findonlys=1 /*keep searching ... */ |
do findonlys=1 /*keep searching ... */ |
||
_row.= /*build str for each row . */ |
_row.= /*build str for each row . */ |
||
do r=1 for 9 |
do r=1 for 9 |
||
do c=1 for 9 |
do c=1 for 9 |
||
if !.r.c\=='' then _row.r=_row.r !.r.c |
|||
end /*c*/ |
end /*c*/ |
||
end /*r*/ |
end /*r*/ |
||
_col.= /*build str for each boxcol*/ |
_col.= /*build str for each boxcol*/ |
||
do c=1 for 9 |
do c=1 for 9 |
||
do r=1 for 9 |
do r=1 for 9 |
||
if !.r.c\=='' then _col.c=_col.c !.r.c |
|||
end /*r*/ |
end /*r*/ |
||
end /*c*/ |
end /*c*/ |
||
do r=1 for 9 |
do r=1 for 9 |
||
do c=1 for 9 |
do c=1 for 9 |
||
q=!.r.c |
|||
if q=='' then iterate /*if empty, then ignore it.*/ |
if q=='' then iterate /*if empty, then ignore it.*/ |
||
Line 571: | Line 624: | ||
o=squish(q,_) /*remove others*/ |
o=squish(q,_) /*remove others*/ |
||
!.r.c=o |
!.r.c=o |
||
call $t !fn 'removed part of an only', |
call $t !fn 'removed part of an only', |
||
_ "from cell" drc(r,c,q) |
_ "from cell" drc(r,c,q) |
||
if length(o)==1 then /*reduce if L=1*/ |
if length(o)==1 then /*reduce if L=1*/ |
||
do |
do |
||
Line 595: | Line 648: | ||
do findlines=1 /*keep searching ... */ |
do findlines=1 /*keep searching ... */ |
||
_boxr.= /*build str for each boxrow*/ |
_boxr.= /*build str for each boxrow*/ |
||
do r=1 for 9 |
do r=1 for 9 |
||
do c=1 for 9 |
do c=1 for 9 |
||
rc=r || c |
|||
b=box.rc |
|||
if !.r.c\=='' then _boxr.r.b=strip(_boxr.r.b !.r.c) |
if !.r.c\=='' then _boxr.r.b=strip(_boxr.r.b !.r.c) |
||
end /*c*/ |
end /*c*/ |
||
end /*r*/ |
end /*r*/ |
||
_boxc.= /*build str for each boxcol*/ |
_boxc.= /*build str for each boxcol*/ |
||
do c=1 for 9 |
do c=1 for 9 |
||
do r=1 for 9 |
do r=1 for 9 |
||
rc=r || c |
|||
b=box.rc |
|||
if !.r.c\=='' then _boxc.c.b=strip(_boxc.c.b !.r.c) |
if !.r.c\=='' then _boxc.c.b=strip(_boxc.c.b !.r.c) |
||
end /*r*/ |
end /*r*/ |
||
Line 608: | Line 668: | ||
do r=1 for 9 /*search all rows for twins*/ |
do r=1 for 9 /*search all rows for twins*/ |
||
do b=rowlb.r to rowhb.r /*for each row, search box.*/ |
do b=rowlb.r to rowhb.r /*for each row, search box.*/ |
||
aline=_boxr.r.b |
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*/ |
|||
do k=1 for 9 /*search for each digit. */ |
do k=1 for 9 /*search for each digit. */ |
||
f=pos(k,aline) /*pos of the 1st digit: k */ |
f=pos(k,aline) /*pos of the 1st digit: k */ |
||
if f==0 then iterate |
if f==0 then iterate /*no dig k, so keep looking*/ |
||
s=pos(k,aline,f+1) /*pos of the 2nd digit: k */ |
s=pos(k,aline,f+1) /*pos of the 2nd digit: k */ |
||
if s==0 then iterate |
if s==0 then iterate /*no 2nd k, so keep looking*/ |
||
do jr=rowlb.r to rowhb.r /*look at the other 2 rows.*/ |
do jr=rowlb.r to rowhb.r /*look at the other 2 rows.*/ |
||
if jr==r then iterate |
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*/ |
if pos(k,_boxr.jr.b)\==0 then iterate k /*if no digit K, ignore*/ |
||
end /*jr*/ |
end /*jr*/ |
||
/*found 2 Ks in row R box B*/ |
/*found 2 Ks in row R box B*/ |
||
do jb=rowlb.r to rowhb.r /*search boxes row R for K.*/ |
do jb=rowlb.r to rowhb.r /*search boxes row R for K.*/ |
||
if jb==b then iterate |
if jb==b then iterate /*ignore if in the same box*/ |
||
if pos(k,_boxr.r.jb)==0 then iterate |
if pos(k,_boxr.r.jb)==0 then iterate |
||
foundmatch=1 /*found a K in col C box JB*/ |
foundmatch=1 /*found a K in col C box JB*/ |
||
Line 631: | Line 694: | ||
rc=r || kc |
rc=r || kc |
||
if box.rc==b then iterate /*ignore if in the same box*/ |
if box.rc==b then iterate /*ignore if in the same box*/ |
||
_=!.r.kc |
_=!.r.kc |
||
if _=='' then iterate /*ignore if no possible. */ |
|||
if pos(k,_)==0 then iterate /*if no digit K, ignore. */ |
if pos(k,_)==0 then iterate /*if no digit K, ignore. */ |
||
call $t !fn 'is row-line pruning digit' k, |
call $t !fn 'is row-line pruning digit' k, |
||
'from cell' drc(r,kc,!.r.kc) |
'from cell' drc(r,kc,!.r.kc) |
||
!.r.kc=squish(_,k) /*remove mat's digs from X.*/ |
!.r.kc=squish(_,k) /*remove mat's digs from X.*/ |
||
if length(!.r.kc)==1 then do /*pruned down to one digit?*/ |
if length(!.r.kc)==1 then do /*pruned down to one digit?*/ |
||
Line 649: | Line 713: | ||
do c=1 for 9 /*search all cols for twins*/ |
do c=1 for 9 /*search all cols for twins*/ |
||
do b=collb.c to colhb.c by 3 /*for each col, search box.*/ |
do b=collb.c to colhb.c by 3 /*for each col, search box.*/ |
||
aline=_boxc.c.b |
aline=_boxc.c.b /*get a column in the box.*/ |
||
if aline=='' then iterate /*if empty, ignore line*/ |
|||
w=words(aline) |
|||
if w<2 then iterate /*if < 2 words, ignore line*/ |
|||
do k=1 for 9 /*search for each digit. */ |
do k=1 for 9 /*search for each digit. */ |
||
Line 672: | Line 739: | ||
rc=kr || c |
rc=kr || c |
||
if box.rc==b then iterate /*ignore if in the same box*/ |
if box.rc==b then iterate /*ignore if in the same box*/ |
||
_=!.kr.c |
_=!.kr.c |
||
if _=='' then iterate /*ignore if no possible. */ |
|||
if pos(k,_)==0 then iterate /*if no digit K, ignore. */ |
if pos(k,_)==0 then iterate /*if no digit K, ignore. */ |
||
call $t !fn 'is col-line pruning digit' k, |
call $t !fn 'is col-line pruning digit' k, |
||
'from cell' drc(kr,c,!.kr.c) |
'from cell' drc(kr,c,!.kr.c) |
||
!.kr.c=squish(_,k) /*remove mat's digs from X.*/ |
!.kr.c=squish(_,k) /*remove mat's digs from X.*/ |
||
if length(!.kr.c)==1 then do |
if length(!.kr.c)==1 then do /*pruned down to one digit?*/ |
||
@.kr.c=!.kr.c |
@.kr.c=!.kr.c /*make a true digit*/ |
||
!.kr.c= |
!.kr.c= /*erase possibility*/ |
||
call buildposs |
call buildposs /*rebuild possibles*/. |
||
iterate findlines |
iterate findlines |
||
end |
end |
||
end /*kr*/ |
end /*kr*/ |
||
end /*jb*/ |
end /*jb*/ |
||
Line 694: | Line 762: | ||
return foundmatch |
return foundmatch |
||
/*═════════════════════════════general 1-line subs══════════════════════*/ |
|||
/*═════════════════════════════general 1-line subs════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/ |
/*═════════════════════════════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 |
!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 then !env='OS2'!env;!ebcdic=1=='f0'x;return |
!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';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)) |
||
$fact!:procedure;parse arg x _ .;l=length(x);n=l-length(strip(x,'T',"!"));if n<=-n|_\==''|arg()\==1 then return x;z=left(x,l-n);if z<0|\isint(z) then return x;return $fact(z,n) |
$fact!: procedure;parse arg x _ .;l=length(x);n=l-length(strip(x,'T',"!"));if n<=-n|_\==''|arg()\==1 then return x;z=left(x,l-n);if z<0|\isint(z) then return x;return $fact(z,n) |
||
$fact:procedure;parse arg x _ .;arg ,n ! .;n=p(n 1);if \isint(n) then n=0;if x<-n|\isint(x)|n<1|_||!\==''|arg()>2 then return x||copies("!",max(1,n));!=1;s=x//n;if s==0 then s=n;do j=s to x by n;!=!*j;end;return ! |
$fact: procedure;parse arg x _ .;arg ,n ! .;n=p(n 1);if \isint(n) then n=0;if x<-n|\isint(x)|n<1|_||!\==''|arg()>2 then return x||copies("!",max(1,n));!=1;s=x//n;if s==0 then s=n;do j=s to x by n;!=!*j;end;return ! |
||
$sfxa:parse arg ,s,m;arg u,c;if pos(left(s,2),u)\==0 then do j=length(s) to compare(s,c)-1 by -1;if right(u,j)\==left(c,j) then iterate;_=left(u,length(u)-j);if isnum(_) then return m*_;leave;end;return arg(1) |
$sfxa: parse arg ,s,m;arg u,c;if pos(left(s,2),u)\==0 then do j=length(s) to compare(s,c)-1 by -1;if right(u,j)\==left(c,j) then iterate;_=left(u,length(u)-j);if isnum(_) then return m*_;leave;end;return arg(1) |
||
$sfxf:parse arg y;if right(y,1)=='!' then y=$fact!(y);if \isnum(y) then y=$sfxz();if isnum(y) then return y;return $sfxm(y) |
$sfxf: parse arg y;if right(y,1)=='!' then y=$fact!(y);if \isnum(y) then y=$sfxz();if isnum(y) then return y;return $sfxm(y) |
||
$sfxm:parse arg z;arg w;b=1000;if right(w,1)=='I' then do;z=shorten(z);w=z;upper w;b=1024;end;p=pos(right(w,1),'KMGTPEZYXWVU');if p==0 then return arg(1);n=shorten(z);r=num(n,f,1);if isnum(r) then return r*b**p;return arg(1) |
$sfxm: parse arg z;arg w;b=1000;if right(w,1)=='I' then do;z=shorten(z);w=z;upper w;b=1024;end;p=pos(right(w,1),'KMGTPEZYXWVU');if p==0 then return arg(1);n=shorten(z);r=num(n,f,1);if isnum(r) then return r*b**p;return arg(1) |
||
$sfxz:return $sfxa($sfxa($sfxa($sfxa($sfxa($sfxa(y,'PAIRs',2),'DOZens',12),'SCore',20),'GREATGRoss',1728),'GRoss',144),'GOOGOLs',1e100) |
$sfxz: return $sfxa($sfxa($sfxa($sfxa($sfxa($sfxa(y,'PAIRs',2),'DOZens',12),'SCore',20),'GREATGRoss',1728),'GRoss',144),'GOOGOLs',1e100) |
||
$t:if tops=='' then say arg(1);else do;!call=']$T';call "$T" tops arg(1);!call=;end;return |
$t: if tops=='' then say arg(1);else do;!call=']$T';call "$T" tops arg(1);!call=;end;return |
||
ab: arg ab,abl;return abbrev(ab,_,abl) |
ab: arg ab,abl;return abbrev(ab,_,abl) |
||
abb: arg abbu;parse arg abb;return abbrev(abbu,_,abbl(abb)) |
abb: arg abbu;parse arg abb;return abbrev(abbu,_,abbl(abb)) |
||
abbl: return verify(arg(1)'a',@abc,'M')-1 |
abbl: return verify(arg(1)'a',@abc,'M')-1 |
||
abbn: parse arg abbn;return abb(abbn)|abb('NO'abbn) |
abbn: parse arg abbn;return abb(abbn)|abb('NO'abbn) |
||
abn: arg ab,abl;return abbrev(ab,_,abl)|abbrev('NO'ab,_,abl+2) |
abn: arg ab,abl;return abbrev(ab,_,abl)|abbrev('NO'ab,_,abl+2) |
||
comma:procedure;parse arg _,c,p,t;c= |
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_() |
||
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 _ |
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 _ |
||
copies2: return copies(arg(1),2) |
copies2: return copies(arg(1),2) |
||
copies3: return copies(arg(1),3) |
copies3: return copies(arg(1),3) |
||
drc:procedure;parse arg r,c,p;_=r","c;if p\=='' then _=_ "("p')';return _ |
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 |
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 '' |
err: call er '-'arg(1),arg(2);return '' |
||
erx: call er '-'arg(1),arg(2);exit '' |
erx: call er '-'arg(1),arg(2);exit '' |
||
halt: call er .1 |
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 |
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') |
isint: return datatype(arg(1),'W') |
||
isnum: return datatype(arg(1),'N') |
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 |
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)) |
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 |
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) |
nai: return int(na(),_o) |
||
nail: return squish(int(translate(na(),0,','),_o)) |
nail: return squish(int(translate(na(),0,','),_o)) |
||
nan: return num(na(),_o) |
nan: return num(na(),_o) |
||
no: if arg(1)\=='' then call er 01,arg(2);return left(_,2)\=='NO' |
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 |
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) |
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))) |
shorten:procedure;parse arg a,n;return left(a,max(0,length(a)-p(n 1))) |
||
simple:return translate(arg(1),'.||--%<>AV'copies('+',25),"·│║─═☼◄►↑↓┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣") |
simple: return translate(arg(1),'.||--%<>AV'copies('+',25),"·│║─═☼◄►↑↓┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣") |
||
squish:return space(translate(arg(1),,word(arg(2) ',',1)),0) |
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) |
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 |
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> |
tg: arg tg; if simple then tg=simple(tg); call $t gridindent || tg; return</lang> |