Rosetta Code

Morpion solitaire: Difference between revisions

Page Discussion

Morpion solitaire (view source)

Revision as of 01:39, 20 April 2020

4,204 bytes added ,  4 years ago
→‎{{header|REXX}}: reduce the program size, elided code to support boxing of the grid, added/changed comments, simplified code.
mNo edit summary
(→‎{{header|REXX}}: reduce the program size, elided code to support boxing of the grid, added/changed comments, simplified code.)
Line 1,046:
<br>This program allows the <tt> D </tt> or <tt> T </tt> forms of the game, and allows any board size (grid size) of three or higher.
<br>The default games is <tt> 5T </tt>
<lang rexx>/*REXX program plays Morpion solitaire (with grid output), the default is the 5T version*/
signal on syntax; signal on noValue /*handle possible REXX program errors. */
/* [↓] handle the user options (if any)*/
prompt= /*null string is used for ERR return.*/
quiet= 0 /*flag: suppresses output temporarily.*/
oFID= 'MORPION' /*filename of the game's output file. */
arg game player seed . /*see if a person wants to play. */
if game=='' | game=="," then game= '5T' /*Not specified? Then use the default.*/
if player=='' | player=="," then player= /* " " " " " " */
if isInt(seed) then call random ,,seed /*Is integer? Then use for RANDOM seed*/
TorD= 'T (touching) ───or─── D (disjoint).' /*the valid game types (T or D). */
sw= linesize() - 1 /*SW = screen width ─or─ linesize. */
gT= right(game, 1) /*T = touching ─or─ D = disjoint.*/
if \datatype(gT,'U') | verify(gT, "GT")\==0 then call err 'game not G or T' /*error?*/
gS= left( game, length(game) - 1) /*gS=Game Size (line length for a win)*/
if \isInt(gS) then call err "game size isn't an integer:" gS /*error?*/
gS= gS / 1 /*normalize the value of GS. */
if gS<3 then call err "grid size is too small for Morpion solitaire :" gS /*error? */
/*handle the defaults/configuration. */
indent= left('', max(0, sw - gS - 10) % 2) /*indentation used for board display. */
indent= ' '
empty= 'fa'x /*the empty grid point symbol (glyph). */
@.= empty /*the field (grid) is infinite in size*/
CBLF= player \== '' /*playing with a carbon─based lifeform?*/
if CBLF then oFID= player /*oFID: the fileID for the game LOG. */
oFID= oFID'.LOG' /*full name for the LOG's filename. */
prompt= 'enter X,Y point and an optional character for placing on board (or Quit):'
prompt= right(prompt, sw, '─') /*right justify the prompt message. */
call GreekX /*draw the (initial) Greek cross. */
 
do #=1 for 1500 /*───play a game of Morpion solitaire. */
<lang rexx>/*REXX program to play Morpion solitaire, the default is the 5T version.*/
if CBLF then do
signal on syntax; signal on novalue /*handle REXX program errors. */
if Gshots\=='' then do; parse var Gshots shot Gshots
quiet=0; oFID='MORPION'
arg game player . /*see if a person wants to play. */ parse var shot gx ',' gy
call mark gx,gy
if game=='' | game==',' then game='5T' /*Not specified? Then use default*/
prompt= /*null string is used for ERR ret*/ iterate
end
TorD='T (touching) ───or─── D (disjoint).' /*valid games types (T | D).*/
gT=right(game,1) if Gshots=='' then leave /*T = touching ─or─ D = disjoint.#*/
call t prompt; pull stuff; stuff= translate(stuff, , ',')
if \datatype(gT,'U') | verify(gT,gT)\==0 then call err 'game gT not' gT
stuff= space(stuff); parse var stuff px py p
gS=left(game,length(game)-1) /*gS=Game Size (line len for win)*/
_= px; upper _; if abbrev('QUIT', _, 1) then exit /*quitting? */
if \datatype(gS,'W') then call err "game size isn't numeric:" gS
if stuff=='' then do; call display; iterate
gS=gS/1
end
if gS<3 then call err "grid size is too small:" gS
call mark px,py,p
sw=linesize()-1
end /*if CBLF*/
indent=left('',max(0,sw-gS-10)%2) /*indentation used board display.*/
empty='fa'x else do; quiet= 1; /*the empty grid pointshot= symbol.translate( word(Gshots, turn), */, ',')
@.=empty if shot=='' then do /*field (grid) is infinite. */50
gC= xr= loX -1 + /*GreeKrandom(0, crosshiX character- orloX null.+ */2)
CBLF=player\=='' /*carbon-based lifeform ? */yr= loY -1 + random(0, hiY - loY + 2)
if CBLF then oFID=player /*oFID is used for the game log if @.xr.yr\==empty then */iterate
oFID=oFID'.LOG' /*fulltype for the LOG's filename*/ if \neighbor(xr, yr) then iterate
shot= xr yr
prompt='enter X,Y point and an optional character for placing on board',
end /*50*/
'(or Quit):'; prompt=right(prompt,sw,'─') /*right justify it.*/
call mark word(shot, 1), word(shot, 2)
call GreekCross
end /*else*/
jshots=Gshots
end /*#*/
 
call display
do turns=1 for 1000
call t '* number of wins =' wins
if CBLF then do
exit wins call t prompt; pull stuff; stuff=translate(stuff, /*stick a fork in it, we',')re all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
parse var stuff px py p
Gshot: if arg()==2 then Gshots= space(Gshots arg(1)','arg(2) ); return
_=px; upper _; if abbrev('QUIT',_,1) then exit
isInt: return datatype( arg(1), 'W') if stuff=='' then do; call display; iterate; /*is int? end*/
isNum: return datatype( arg(1), 'N') /*is num? */
call mark px,py
t: say arg(1); end /*if CBLF*/ call lineout oFID,arg(1); return
/*──────────────────────────────────────────────────────────────────────────────────────*/
else do; quiet=1
?win: arg z; L= length(z)
shot=translate(word(Gshots,turn),,',')
if L>gS then do; if shotgT=='D' then doreturn 0 /*longlines ¬ kosker for 50D*/
parse var xr=loX-1+random(0,hiX-loX+2) z z1 '?' z2 /*could be xxxxx?xxxx */
return length(z1)>=4 yr=loY-1+random| length(0,hiY-loY+2z2)>=4
if @.xr.yr\==empty then iterateend
return L==gS
if \neighbor(xr,yr) then iterate
/*──────────────────────────────────────────────────────────────────────────────────────*/
shot=xr yr
display: call t; do y=hiY to loY by -1; _c= /*start at a high end Y. */
do x=loX to hiX; != @.x.y; _c= _c || ! /*build an "X" grid line. */
call mark word(shot,1),word(shot,2)
end /*x*/
call t indent _c /*display a grid line. */
end /*turns*/
end /*y*/
 
if wins==0 then call t copies('═', sw)
call t '* number of wins =' wins
exit wins else call t right('(above) the board after' wins /*stick a fork in"turns.", itsw, we're done.*/═')
call t
/*───────────────────────────────error handling subroutines and others.─*/
err: if \quiet then do; call t; call treturn
/*──────────────────────────────────────────────────────────────────────────────────────*/
call t center(' error! ',max(40,linesize()%2),"*"); call t
err: if \quiet then do; j=1 for arg(); call t arg(j); call t; end; call t
end call t center(' error ', max(40, sw % 2), "*"); call t
do j=1 for arg(); call t arg(j); call t; end; call t
if prompt=='' then exit 13; return
end
if prompt=='' then exit 13; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
GreekX: wins= 0; loX= 1; hiX= 0; LB= gS - 1 /*Low cross Beam. */
turn= 1; loY= 1; hiY= 0; HT= 4 + 3*(LB-2) /*─ ─ */
Lintel= LB - 2; Gshots=; TB= HT - LB + 1 /*Top cross Beam. */
$= '0f'x; @@.= /*─ ─ */
do y=1 for HT; ToB= $ || copies($, Lintel) || $ /*ToB: Top Or Bot.*/
beam= $ || copies($, Lintel)$ || left('', Lintel)$ || copies($, Lintel) || $
select /*$: Greek cross glyph*/
when y==1 | y==HT then do x=1 for LB; call place x+LB-1,y,substr(ToB, x, 1)
end
when y==LB | y==TB then do x=1 for HT; if x>LB & x<TB then iterate
call place x,y,substr(beam, x, 1)
end
when y>LB & y<TB then do x=1 by HT-1 for 2; call place x,y,$; end
otherwise do x=LB by TB-LB for 2; call place x,y,$; end
end /*select*/
end /*y*/
 
@abc= 'abcdefghijklmnopqrstuvwxyz'; @chars= '1234567890'translate(@abc) || @abc
novalue: syntax: prompt=; quiet=0
@@.63= '@' ; @@.64= "æÆα"; @@.67= 'ß' ; @@.68= "¢" ; @@.69= '^'
call err 'REXX program' condition('C') "error",,
@@.70= 'Σ' ; @@.71= "ƒ" ; @@.72= 'ñÑπ'; @@.75= "σΘφ"; @@.78= '₧'
condition('D'),'REXX source statement (line' sigl"):",,
@@.79= '$δ'; sourceline(sigl) @@.81= "¥" ; @@.82= '#%&*=+\;'
do j=60 to 99; @chars= @chars || @@.j
end /*j*/
@chars= @chars'()[]{}<>«»' /*can't contain "empty", ?, blank.*/
call display
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
mark: parse arg xx,yy,pointChar /*place marker, check for errors. */
if pointChar=='' then pointChar= word( substr(@chars, turn, 1) "+", 1)
xxcyy= xx','yy; _.1= xx; _.2= yy
 
do j=1 for 2; XorY= substr('XY', j, 1) /*make sure X and Y are integers. */
t: say arg(1); call lineout oFID,arg(1); return
if _.j=='' then do; call err XorY "wasn't specified." ;return 0; end
Gshot: Gshots=Gshots arg(1)','arg(2); return
if \isNum(_.j) then do; call err XorY "isn't numeric:" _.j ; return 0; end
tranGC: if gC=='' then return arg(1); return translate(arg(1),copies(gC,12),'┌┐└┘│─╔╗╚╝║═')
if \isInt(_.j) then do; call err XorY "isn't an integer:" _.j; return 0; end
/*─────────────────────────────────────GREEKCROSS subroutine────────────*/
end /*j*/
GreekCross: wins=0; loX=-1; hiX=0; LB=gS-1 /*Low Bar*/
lintel=LB-2; turn=1; loY=-1; hiY=0; ht=4+3*(LB-2) /*─ ─ */
Gshots=; nook=gS-2; Hnook=ht-nook+1; TB=ht-LB+1 /*Top Bar*/
/*─ ─ */
do y=1 for ht; _top='╔'copies('═',lintel)'╗' ; _top=tranGC(_top)
_bot='╚'copies('═',lintel)'╝' ; _bot=tranGC(_bot)
_hib='╔'copies('═',lintel)'╝'left('',lintel)'╚'copies('═',lintel)'╗' ; _hib=tranGC(_hib)
_lob='╚'copies('═',lintel)'╗'left('',lintel)'╔'copies('═',lintel)'╝' ; _lob=tranGC(_lob)
_sid='║' ; _sid=tranGC(_sid)
select
when y==1 then do x=1 for LB; call place x+LB-1,y,substr(_bot,x,1); end
when y==ht then do x=1 for LB; call place x+LB-1,y,substr(_top,x,1); end
when y==LB then do x=1 for ht; if x>LB & x<TB then iterate; call place x,y,substr(_lob,x,1); end
when y==TB then do x=1 for ht; if x>LB & x<TB then iterate; call place x,y,substr(_hib,x,1); end
when y>LB & y<TB then do x=1 by ht-1 for 2; call place x,y,_sid; end
otherwise do x=LB by TB-LB for 2; call place x,y,_sid; end
end /*select*/
end /*y*/
 
xx= xx / 1; yy= yy / 1 /*normalize integers: + 7 or 5.0*/
@abc='abcdefghijklmnopqrstuvwxyz'; @chars='0123456789'translate(@abc)||@abc
if pointChar==empty |,
@chars=@chars'()[]{}<>«»' /*can't contain "empty", ?, blank*/
pointChar=='?' then do; call err 'illegal point character:' pointChar; return 0
end
if @.xx.yy\==empty then do; call err 'point' xxcyy "is already occupied."; return 0
end
if \neighbor(xx,yy) then do; call err "point" xxcyy "is a bad move." ; return 0
end
call place xx,yy,'?'
newWins= seeIfWin()
if newWins==0 then do; call err 'point' xxcyy "isn't a good move."
@.xx.yy= empty; return 0
end
call t "move" turn ' ('xx","yy') with "'pointChar'"'
wins= wins + newWins; @.xx.yy= pointChar
call display; turn= turn + 1
return 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
neighbor: parse arg a,b; am= a - 1; ap= a + 1; bm= b - 1; bp= b + 1
return @.am.b\==empty | @.am.bm\==empty | @.ap.b\==empty | @.am.bp \== empty |,
@.a.bm\==empty | @.ap.bm\==empty | @.a.bp\==empty | @.ap.bp\==empty
/*──────────────────────────────────────────────────────────────────────────────────────*/
noValue: syntax: prompt=; quiet= 0
call err 'REXX program' condition('C') "error", condition('D'), ,
"REXX source statement (line" sigl"):", sourceline(sigl)
/*──────────────────────────────────────────────────────────────────────────────────────*/
place: parse arg xxp,yyp /*place a marker (point) on grid.*/
loX= min(loX, xxp); hiX= max(hiX, xxp)
loY= min(loY, yyp); hiY= max(hiY, yyp); @.xxp.yyp= arg(3)
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
seeIfWin: y=yy; z= @.xx.yy /*count horizontal/vertical/diagonal wins.*/
do x=xx+1; if @.x.y==empty then leave; z= z||@.x.y; end
do x=xx-1 by -1; if @.x.y==empty then leave; z= @.x.y||z; end
if ?win(z) then return 1 /*────────count wins in horizontal line. */
x= xx; z= @.xx.yy
do y=yy+1; if @.x.y==empty then leave; z= z||@.x.y; end
do y=yy-1 by -1; if @.x.y==empty then leave; z= @.x.y||z; end
if ?win(z) then return 1 /*────────count wins in vertical line. */
x= xx; z= @.xx.yy
do y=yy+1; x= x + 1; if @.x.y==empty then leave; z= z||@.x.y; end
x= xx
do y=yy-1 by -1; x=x-1; if @.x.y==empty then leave; z= @.x.y||z; end
if ?win(z) then return 1 /*──────count diag wins: up & >, down & < */
x= xx; z= @.xx.yy
do y=yy+1; x= x - 1; if @.x.y==empty then leave; z= z||@.x.y; end
x= xx
do y=yy-1 by -1; x=x+1; if @.x.y==empty then leave; z= z||@.x.y; end
return ?win(z) /*──────count diag wins: up & <, down & > */</lang>
This REXX program makes use of &nbsp; '''LINESIZE''' &nbsp; REXX program (or BIF) which is used to determine the screen width (or linesize) of the terminal (console).
<br>The &nbsp; '''LINESIZE.REX''' &nbsp; REXX program is included here ──► [[LINESIZE.REX]].<br>
 
{{out|output|text=&nbsp; when running 1,500 trials, &nbsp; the highest win was a meager 47 (four games, all different), and one of them is shown below.}}
call display
<pre>
call Gshot nook , nook ; call Gshot nook , Hnook
···☼☼☼☼···
call Gshot Hnook , nook ; call Gshot Hnook , Hnook
call Gshot gS , LB ; call Gshot gS , TB ···☼··☼···
call Gshot ht-LB , LB ; call Gshot ht-LB , TB ···☼··☼···
call Gshot LB , gS ; call Gshot TB , gS ☼☼☼☼··☼☼☼☼
call Gshot LB , TB-1 ; call Gshot TB , TB-1 ☼········☼
call Gshot 1 , TB+1 ; call Gshot ht , TB+1 ☼········☼
call Gshot TB+1 , 1 ; call Gshot TB+1 , ht ☼☼☼☼··☼☼☼☼
···☼··☼···
return
···☼··☼···
/*─────────────────────────────────────DISPLAY subroutine───────────────*/
···☼☼☼☼···
display: call t; do y=hiY to loY by -1; _=indent /*start at a high Y.*/
═══════════════════════════════════════════════════════════════════════════════
do x=loX to hiX /*build an "X" line.*/
!=@.x.y; xo=x==0; yo=y==0
if !==empty then do /*grid transformation*/
if xo then !='|'
if xo & y//5 ==0 then !='├'
if xo & y//10==0 then !='╞'
if yo then !='─'
if yo & x//5 ==0 then !='┴'
if yo & x//10==0 then !='╨'
if xo & yo then !='┼'
end
_=_ || !
end /*x*/
call t _ /*...and display it.*/
end /*y*/
 
move 1 (11,4) with "1"
if wins==0 then call t copies('═',sw)
else call t right('count of (above) wins =' wins,sw,'═')
call t
return
/*─────────────────────────────────────PLACE subroutine─────────────────*/
place: parse arg xxp,yyp /*place a marker (point) on grid.*/
loX=min(loX,xxp); hiX=max(hiX,xxp)
loY=min(loY,yyp); hiY=max(hiY,yyp); @.xxp.yyp=arg(3)
return
/*─────────────────────────────────────MARK subroutine──────────────────*/
mark: parse arg xx,yy,pointChar /*place marker, check for errors.*/
if pointChar=='' then pointChar=word(substr(@chars,turn,1) '+',1)
xxcyy=xx','yy; _.1=xx; _.2=yy
 
···········
do j=1 for 2; XorY=substr('XY',j,1) /*make sure X and Y are integers.*/
if _.j=='' then do; call err XorY "wasn't specified." ; return 0; end ···☼☼☼☼····
···☼··☼····
if \datatype(_.j,'N') then do; call err XorY "isn't numeric:" _.j ; return 0; end
···☼··☼····
if \datatype(_.j,'W') then do; call err XorY "isn't an integer:" _.j; return 0; end
☼☼☼☼··☼☼☼☼·
end
☼········☼·
☼········☼·
☼☼☼☼··☼☼☼☼1
···☼··☼····
···☼··☼····
···☼☼☼☼····
═══════════════════════════════════════════════(above) the board after 1 turns.
 
move 2 (4,5) with "2"
xx=xx/1; yy=yy/1 /*normalize integers: + 7 or 5.0*/
 
···········
if pointChar==empty |,
···☼☼☼☼····
pointChar=='?' then do; call err 'illegal point character:' pointChar; return 0; end
···☼··☼····
if @.xx.yy\==empty then do; call err 'point' xxcyy 'is already occupied.'; return 0; end
···☼··☼····
if \neighbor(xx,yy) then do; call err "point" xxcyy "is a bad move." ; return 0; end
☼☼☼☼··☼☼☼☼·
call place xx,yy,'?'
☼········☼·
newWins=countWins()
☼··2·····☼·
if newWins==0 then do; call err "point" xxcyy "isn't a good move."
@.xx.yy=empty ☼☼☼☼··☼☼☼☼1
return 0 ···☼··☼····
end ···☼··☼····
···☼☼☼☼····
call t "move" turn ' ('xx","yy') with "'pointChar'"'
═══════════════════════════════════════════════(above) the board after 2 turns.
wins=wins+newWins; @.xx.yy=pointChar; call display; turn=turn+1
return 1
/*─────────────────────────────────────NEIGHBOR subroutine──────────────*/
neighbor: parse arg a,b; am=a-1; ap=a+1
bm=b-1; bp=b+1
return @.am.b \== empty | @.am.bm \== empty |,
@.ap.b \== empty | @.am.bp \== empty |,
@.a.bm \== empty | @.ap.bm \== empty |,
@.a.bp \== empty | @.ap.bp \== empty
/*─────────────────────────────────────COUNTALINE subroutine────────────*/
countAline: arg z ; L=length(z)
 
if L>gS then do; if gT=='D' then return 0 /*longlines ¬ kosker for D*/
parse var z z1 '?' z2 /*could be xxxxx?xxxx */
return length(z1)==4 | length(z2)==4
end
return L==gS
/*─────────────────────────────────────COUNTWINS subroutine─────────────*/
countWins: eureka=0; y=yy /*count horizontal/vertical/diagonal wins.*/
z=@.xx.yy
do x=xx+1; if @.x.y==empty then leave; z=z||@.x.y; end
do x=xx-1 by -1; if @.x.y==empty then leave; z=@.x.y||z; end
eureka=eureka+countAline(z) /*─────────count wins in horizontal line. */
 
x=xx
z=@.xx.yy
do y=yy+1; if @.x.y==empty then leave; z=z||@.x.y; end
do y=yy-1 by -1; if @.x.y==empty then leave; z=@.x.y||z; end
eureka=eureka+countAline(z) /*─────────count wins in vertical line. */
 
x=xx
z=@.xx.yy
do y=yy+1; x=x+1; if @.x.y==empty then leave; z=z||@.x.y; end
x=xx
do y=yy-1 by -1; x=x-1; if @.x.y==empty then leave; z=@.x.y||z; end
eureka=eureka+countAline(z) /*───────count diag wins: up&>, down&< */
 
x=xx
z=@.xx.yy
do y=yy+1; x=x-1; if @.x.y==empty then leave; z=z||@.x.y; end
x=xx
do y=yy-1 by -1; x=x+1; if @.x.y==empty then leave; z=z||@.x.y; end
return eureka+countAline(z) /*───────count diag wins: up&<, down&> */</lang>
This REXX program makes use of &nbsp; '''LINESIZE''' &nbsp; REXX program (or BIF) which is used to determine the screen width (or linesize) of the terminal (console).
<br>The &nbsp; '''LINESIZE.REX''' &nbsp; REXX program is included here ──► [[LINESIZE.REX]].<br>
 
'''output''' when running 1,500 trials, the highest win was a meager 44 (four games, all different), and
one of them is shown below.
<pre style="height:100ex">
·╞···╔══╗···
·|···║··║···
·|···║··║···
·|╔══╝··╚══╗
·|║········║
·├║········║
·|╚══╗··╔══╝
·|···║··║···
·|···║··║···
·|···╚══╝···
─┼────┴────╨
·|··········
═══════════════════════════════════════════════════════════════════════════════
 
move 1 (3,3) with "0"
... previous 46 moves elided ... above is the initial board (grid) ...
--- the next line means: 47th move, position=9,9 marked with an "k" ---
move 47 (9,9) with "k"
 
·|····· ···iQagP····
·|··iQagP·j·d☼☼☼☼F···
·╞j·d╔══╗F ··hO☼NL☼ck··
·|·hO║NL║ck··CZ1☼bK☼3MD·
·|CZ1║bK║3MD·· X☼☼☼☼57☼☼☼☼f
·X╔══╝57╚══╗f☼YHASGBJR☼·
·|║YHASGBJR║☼UT8I·9·e☼·
·├║UT8I·9·e║·☼☼☼☼46☼☼☼☼·
V··0☼W·☼2·|╚══╗46╔══╝··
·V··0║W·║2☼··☼····
·|···║··║··☼☼☼☼E···
·|···╚══╝E····
─┼────┴────╨──
·|············
═════════════════════════════════════════════════════ count of (above) wins = 47
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/187261"