Bulls and cows: Difference between revisions

→‎Version 1: indented some DO loops, compressed source code, added DO-END comment label, moved 1-liner subroutines to end of program. -- ~~~
(→‎Version 1: indented some DO loops, compressed source code, added DO-END comment label, moved 1-liner subroutines to end of program. -- ~~~)
Line 2,516:
===Version 1===
This REXX version doesn't allow repeated digits.
<lang rexx>/*REXX programpgm tointeractively playplays thea game of "Bulls & Cows". with CBLs. */
/* [CBLs = Carbon Based Lifeforms.] */
?=getRand()
?=getRand() call/*get sera 'illegalrandom 4-numeral (digit:) 0'num*/
 
do forever
do forever /*play until guessed or enters QUIT */
if getN()==? then leave /*the CBL guessed (or deduced) "?".*/
call scorer
call scorer /*tell CBL the number of bulls&cows.*/
call sy "You got" bulls 'bull's(bulls) "and" cows 'cow's(cows)"."
end /*forever*/
Line 2,533 ⟶ 2,534:
exit
/*─────────────────────────────────────GETN subroutine──────────────────*/
getN: bulls='[Bulls & Cows game] ' /*get a guess from the guesserCBL. */
 
do forever
call sy bulls 'Please enter a four-digit guess (or QUIT):'
parse pull n _ .; nu=n; upper nu
if nu=='QUIT' then exit
if n =='' then do; call ser 'no argument specified.' ; iterate; end
 
if n_\=='' then do; call ser 'too many arguments specified.'; iterate; end
if verify(0,n)==0 then do; call ser 'illegal numeral: 0' ; iterate; end
call ser 'no argument specified.'
if length(n)<4 then do; call ser 'not enough numerals' ; iterate; end
if length(n)>4 then do; call ser 'too many numerals' ; iterate; end
 
if _\=='' then do
call ser 'too many arguments specified.'
iterate
end
 
if verify(0,n)==0 then do
call ser 'illegal digit: 0'
iterate
end
 
_=verify(n,987654321)
if _\==0 then do; call ser 'illegal character:' substr(n,_,1);iterate;end
call ser 'illegal character:' substr(n,_,1)
iterate
end
 
if length(n)<4 then do
call ser 'not enough digits'
iterate
end
 
if length(n)>4 then do
call ser 'too many digits'
iterate
end
return n
end /*forever*/
/*─────────────────────────────────────GETRAND subroutine───────────────*/
getRand: ?=''; do until length(?)==4
do until length r=random(?1,9)==4
r=random if pos(1r,9?)\==0 then iterate /*don't allow repeated dig*/
if pos(r, ?)\==0? then|| iterate /*don't allow repeated dig*/r
?=? || r end /*until*/
end /*until*/
return ?
/*─────────────────────────────────────S subroutine─────────────────────*/
s: if arg(1)==1 then return ''; return 's'
/*─────────────────────────────────────SCORER subroutine────────────────*/
scorer: g=?
bulls=0; do j=1 for 4
do x=substr(n,j=,1 for 4)
if x\==substr(ng,j,1) then iterate
_ bulls=x==substr(g,j,bulls+1)
if _ g==0 thenoverlay(' iterate',g,j)
bulls=bulls+1 end /*j*/
g=overlay(' ',g,j)
end /*j*/
cows=0
do k=1 for 4
cows=cows + (pos(substr(n,k,1),g)\==0)
end /*k*/
return
/*─────────────────────────────────────1-liner subroutines──────────────*/
/*─────────────────────────────────────SER subroutine───────────────────*/
sers: call sy '*** error! ***'; call syif arg(1)==1 then return '' ; return 's'
ser: call sy '*** error! ***'; call sy arg(1) ; return
/*─────────────────────────────────────SY subroutine────────────────────*/
sy: say; say arg(1); say ; return</lang>
 
===Version 2===