Rosetta Code

Morpion solitaire: Difference between revisions

Page Discussion

Morpion solitaire (view source)

Revision as of 11:11, 4 January 2024

46,348 bytes added ,  4 months ago
→‎{{header|Wren}}: Minor tidy and fixed problem with 'mvprintw' now requiring a format specifier.
(→‎{{header|Java}}: I wanted to place this on a separate page, but I can't get past the captcha)
(→‎{{header|Wren}}: Minor tidy and fixed problem with 'mvprintw' now requiring a format specifier.)
 
(27 intermediate revisions by 12 users not shown)
Line 12:
There are several variations of the game, this task deals with the 5 point "touching" version also known as "5T".
 
MorpianMorpion solitaire is played on a (theoretically) infinite grid. It begins with 36 points marked in a Greek cross:
<pre>
...XXXX...
Line 56:
=={{header|C}}==
Console play with ncurses. Length and touching rules can be changed at the begining of source code. 'q' key to quit, space key to toggle auto move, anykey for next move. Play is random. I got nowhere near the record 177 moves, but did approach the worst-possible (20) quite often.
<langsyntaxhighlight Clang="c">#include <ncurses.h>
#include <stdlib.h>
#include <unistd.h>
Line 280:
endwin();
return 0;
}</langsyntaxhighlight>
 
=={{header|Icon}} and {{header|UniconGo}}==
{{libheader|goncurses}}
[[File:Morpion 5T92 unicon.PNG|thumb|right|Example of the longest random game produced by this program (92 moves) and displayed using the Pentasol player.]]
{{trans|C}}
<syntaxhighlight lang="go">package main
 
import (
The example provided goes beyond the basic requirement to play out a random game. It provides a flexible framework to explore the challenge of morpion solitaire.
gc "github.com/rthornton128/goncurses"
"log"
See [[Morpion_solitaire/Unicon]]
"math/rand"
"time"
)
 
// optional settings
const (
lineLen = 5
disjoint = 0
)
 
var (
=={{header|Java}}==
board [][]int
{{works with|Java|7}}
width int
Player vs computer. Click right-mouse button for hints. When multiple lines can be formed, click the green end point of the line you wish to select.
height int
)
 
const (
<lang java>import java.awt.*;
blank = 0
import java.awt.event.*;
occupied = 1 << (iota - 1)
import java.util.*;
dirNS
import java.util.List;
dirEW
import javax.swing.*;
dirNESW
dirNWSE
newlyAdded
current
)
 
var ofs = [4][3]int{
public class MorpionSolitaire extends JFrame {
{0, 1, dirNS},
{1, 0, dirEW},
{1, -1, dirNESW},
{1, 1, dirNWSE},
}
 
type move struct{ m, s, seq, x, y int }
MorpionSolitairePanel panel;
 
func btoi(b bool) int {
public static void main(String[] args) {
if b {
JFrame f = new MorpionSolitaire();
return 1
f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
f.setVisible(true);
}
return 0
}
 
func allocBoard(w, h int) [][]int {
public MorpionSolitaire() {
buf := make([][]int, h)
Container content = getContentPane();
for i := 0; i < h; i++ {
content.setLayout(new BorderLayout());
panelbuf[i] = new MorpionSolitairePanelmake([]int, w);
content.add(panel, BorderLayout.CENTER);
setTitle("MorpionSolitaire");
pack();
setLocationRelativeTo(null);
}
return buf
}
 
func boardSet(v, x0, y0, x1, y1 int) {
class MorpionSolitairePanel extends JPanel {
enumfor Statei := y0; i <= y1; i++ {
START,for HUMAN,j BOT,:= OVERx0; j <= x1; j++ {
board[i][j] = v
}
}
}
 
func initBoard() {
State gameState = State.START;
height = 3 * (lineLen - 1)
Grid grid;
width = height
String message = "Click to start a new game.";
board = allocBoard(width, height)
int playerScore, botScore;
Font scoreFont;
 
boardSet(occupied, lineLen-1, 1, 2*lineLen-3, height-2)
public MorpionSolitairePanel() {
boardSet(occupied, 1, lineLen-1, width-2, 2*lineLen-3)
setPreferredSize(new Dimension(1000, 750));
boardSet(blank, lineLen, 2, 2*lineLen-4, height-3)
setBackground(Color.white);
boardSet(blank, 2, lineLen, width-3, 2*lineLen-4)
}
 
// -1: expand low index end; 1: expand high index end
setFont(new Font("SansSerif", Font.BOLD, 20));
func expandBoard(dw, dh int) {
scoreFont = new Font("SansSerif", Font.BOLD, 12);
dw2, dh2 := 1, 1
if dw == 0 {
dw2 = 0
}
if dh == 0 {
dh2 = 0
}
nw, nh := width+dw2, height+dh2
nbuf := allocBoard(nw, nh)
dw, dh = -btoi(dw < 0), -btoi(dh < 0)
for i := 0; i < nh; i++ {
if i+dh < 0 || i+dh >= height {
continue
}
for j := 0; j < nw; j++ {
if j+dw < 0 || j+dw >= width {
continue
}
nbuf[i][j] = board[i+dh][j+dw]
}
}
board = nbuf
width, height = nw, nh
}
 
func showBoard(scr *gc.Window) {
grid = new Grid(35, 9);
for i := 0; i < height; i++ {
for j := 0; j < width; j++ {
var temp string
switch {
case (board[i][j] & current) != 0:
temp = "X "
case (board[i][j] & newlyAdded) != 0:
temp = "0 "
case (board[i][j] & occupied) != 0:
temp = "+ "
default:
temp = " "
}
scr.MovePrintf(i+1, j*2, temp)
}
}
scr.Refresh()
}
 
// test if a point can complete a line, or take that point
addMouseListener(new MouseAdapter() {
func testPosition(y, x int, rec *move) {
@Override
if (board[y][x] & occupied) != 0 {
public void mousePressed(MouseEvent e) {
switch (gameState) {return
}
case START:
for m := 0; m < 4; m++ { // 4 gameState = State.HUMAN;directions
dx message := "Your turn";ofs[m][0]
dy := ofs[m][1]
playerScore = botScore = 0;
dir := grid.newGame();ofs[m][2]
var k break;int
for s := 1 - lineLen; s <= 0; s++ { // caseoffset HUMAN:line
for k = 0; k < lineLen; k++ if (SwingUtilities.isRightMouseButton(e)){
if s+k == 0 grid.showHints();{
else {continue
}
Grid.Result res = grid.playerMove(e.getX(), e.getY());
xx := x + if dx*(res == Grid.Result.GOODs+k) {
yy := y + playerScore+dy*(s+;k)
if xx < 0 || xx >= width || yy < 0 || yy >= height {
break
}
 
// no piece at if (grid.possibleMoves().isEmpty())position
if (board[yy][xx] & occupied) == 0 gameState = State.OVER;{
else {break
gameState = State.BOT;
message = "Computer plays...";
}
}
}
break;
}
 
repaint();
// this direction taken
if (board[yy][xx] & dir) != 0 {
break
}
}
if k != lineLen {
continue
}
});
 
start(); // position ok
// rand.Intn to even each option's chance of being picked
rec.seq++
if rand.Intn(rec.seq) == 0 {
rec.m, rec.s, rec.x, rec.y = m, s, x, y
}
}
}
}
 
func addPiece(rec *move) {
public final void start() {
dx := ofs[rec.m][0]
new Thread(new Runnable() {
dy := @Overrideofs[rec.m][1]
dir := ofs[rec.m][2]
public void run() {
board[rec.y][rec.x] |= current | occupied
Random rand = new Random();
for k := 0; k < lineLen; while (true)k++ {
xx := rec.x + try {dx*(k+rec.s)
yy := rec.y + if dy*(gameState == Statek+rec.BOTs) {
board[yy][xx] |= newlyAdded
Thread.sleep(1500L);
if k >= disjoint || k < lineLen-disjoint {
board[yy][xx] |= dir
}
}
}
 
func nextMove() bool {
List<Point> moves = grid.possibleMoves();
var rec move
Point move = moves.get(rand.nextInt(moves.size()));
// wipe last iteration's new line markers
grid.computerMove(move.y, move.x);
for i := 0; i < height; botScorei++; {
for j := 0; j < width; j++ {
board[i][j] &^= newlyAdded | current
}
}
 
// randomly pick one of next legal moves
if (grid.possibleMoves().isEmpty()) {
for i := 0; i < height; i++ {
gameState = State.OVER;
for j := 0; j < width; } elsej++ {
testPosition(i, j, &rec)
gameState = State.HUMAN;
}
message = "Your turn";
}
repaint();
}
Thread.sleep(100L);
} catch (InterruptedException ignored) {
}
}
}
}).start();
}
 
// didn't find any move, game over
@Override
if rec.seq == 0 {
public void paintComponent(Graphics gg) {
super.paintComponent(gg);return false
}
Graphics2D g = (Graphics2D) gg;
g.setRenderingHint(RenderingHints.KEY_ANTIALIASING,
RenderingHints.VALUE_ANTIALIAS_ON);
 
addPiece(&rec)
grid.draw(g, getWidth(), getHeight());
 
if (gameStaterec.x == State.OVER)width-1 {
messagerec.x = "No more moves available. ";1
} else if rec.x != 0 {
if (playerScore > botScore)
rec.x message += "You win. ";0
} else if (botScore > playerScore){
rec.x message += "Computer wins. ";-1
else}
 
message += "It's a tie. ";
if rec.y == height-1 {
message += "Click to start a new game.";
gameStaterec.y = State.START;1
} else if rec.y != 0 {
rec.y = 0
} else {
rec.y = -1
}
 
if rec.x != 0 || rec.y != 0 {
expandBoard(rec.x, rec.y)
}
return true
}
 
func main() {
rand.Seed(time.Now().UnixNano())
initBoard()
scr, err := gc.Init()
if err != nil {
log.Fatal("init", err)
}
defer gc.End()
gc.Echo(false)
gc.CBreak(true)
ch := gc.Key(0)
move := 0
waitKey := true
for {
scr.MovePrintf(0, 0, "Move %d", move)
move++
showBoard(scr)
if !nextMove() {
nextMove()
showBoard(scr)
break
}
if !waitKey {
time.Sleep(100000 * time.Microsecond)
}
if ch = scr.GetChar(); ch == ' ' {
waitKey = !waitKey
if waitKey {
scr.Timeout(-1)
} else {
scr.Timeout(0)
}
}
if ch == 'q' {
break
}
}
scr.Timeout(-1)
gc.CBreak(false)
gc.Echo(true)
}</syntaxhighlight>
 
=={{header|Icon}} and {{header|Unicon}}==
g.setColor(Color.white);
[[File:Morpion 5T92 unicon.PNG|thumb|right|Example of the longest random game produced by this program (92 moves) and displayed using the Pentasol player.]]
g.fillRect(0, getHeight() - 50, getWidth(), getHeight() - 50);
 
The example provided goes beyond the basic requirement to play out a random game. It provides a flexible framework to explore the challenge of morpion solitaire.
g.setColor(Color.lightGray);
g.setStroke(new BasicStroke(1));
See [[Morpion_solitaire/Unicon]]
g.drawLine(0, getHeight() - 50, getWidth(), getHeight() - 50);
 
=={{header|J}}==
g.setColor(Color.darkGray);
With this program as the file m.ijs
<syntaxhighlight lang="j">
NB. turn will be a verb with GRID as y, returning GRID. Therefor:
NB. morpion is move to the power of infinity---convergence.
morpion =: turn ^: _
 
NB. Detail:
g.setFont(getFont());
g.drawString(message, 20, getHeight() - 18);
 
NB. bitwise manipulation definitions for bit masks.
g.setFont(scoreFont);
bit_and =: 2b10001 b.
String s1 = "Player " + String.valueOf(playerScore);
bit_or =: 2b10111 b.
g.drawString(s1, getWidth() - 180, getHeight() - 20);
 
assert 0 0 0 1 -: 0 0 1 1 bit_and 0 1 0 1
String s2 = "Computer " + String.valueOf(botScore);
assert 0 1 1 1 -: 0 0 1 1 bit_or 0 1 0 1
g.drawString(s2, getWidth() - 100, getHeight() - 20);
 
}
diagonal =: (<i.2)&|: NB. verb to extract the major diagonal of a matrix.
assert 0 3 -: diagonal i. 2 2
 
NB. choose to pack bits into groups of 3. 3 bits can store 0 through 5.
MASKS =: 'MARKED M000 M045 M090 M135'
(MASKS) =: 2b111 * 2b1000 ^ i. # ;: MASKS
 
bit_to_set =: 2&}.&.#:
 
MARK =: bit_to_set MARKED
 
GREEK_CROSS =: MARK * 10 10 $ 'x' = LF -.~ 0 :0
xxxx
x x
x x
xxxx xxxx
x x
x x
xxxx xxxx
x x
x x
xxxx
)
 
NB. frame pads the marked edges of the GRID
frame_top =: 0&,^:(0 ~: +/@:{.)
frame_bot =: frame_top&.:|.
frame_lef=:frame_top&.:|:
frame_rig=: frame_bot&.:|:
frame =: frame_top@:frame_bot@:frame_lef@:frame_rig
assert (-: frame) 1 1 $ 0
assert (3 3 $ _5 {. 1) (-: frame) 1 1 $ 1
 
odometer =: (4 $. $.)@:($&1) NB. http://www.jsoftware.com/jwiki/Essays/Odometer
index_matrix =: ($ <"1@:odometer)@:$ NB. the computations work with indexes
assert (1 1 ($ <) 0 0) (-: index_matrix) (i. 1 1)
 
Note 'adverb Line'
m is the directional bit mask.
produces the bitmask with a list of index vectors to make a new line.
use Line: (1,:1 5) M000 Line ;._3 index_matrix GRID
Line is a Boolean take of the result.
Cuts apply Line to each group of 5.
However I did not figure out how to make this work without a global variable.
)
 
NB. the middle 3 are not
NB. used in this direction and 4 are already marked
Line =: 1 :'((((0 = m bit_and +/@:}.@:}:) *. (4 = MARKED bit_and +/))@:,@:({&GRID))y){.<(bit_to_set m)(;,)y'
 
l000 =: (1,:1 5)&(M000 Line;._3)
l045 =: (1,:5 5) M045 Line@:diagonal;._3 |.
l090 =: (1,:5 1)&(M090 Line;._3)
l135 =: (1,:5 5)&(M135 Line@:diagonal;._3)
 
NB. find all possible moves
compute_marks =: (l135 , l090 , l045 , l000)@:index_matrix NB. compute_marks GRID
 
choose_randomly =: {~ ?@:#
apply =: (({~ }.)~ bit_or (MARK bit_or 0&{::@:[))`(}.@:[)`]}
save =: 4 : '(x) =: y'
move =: (apply~ 'CHOICE' save choose_randomly)~
 
turn =: 3 : 0
TURN =: >: TURN
FI =. GRID =: frame y
MOVES =: _6[\;compute_marks GRID
GRID =: MOVES move :: ] GRID
if. TURN e. OUTPUT do.
smoutput (":TURN),' TURN {'
smoutput ' choose among' ; < MOVES
smoutput ' selected' ; CHOICE
smoutput ' framed input & ouput' ; FI ; GRID
smoutput '}'
end.
GRID
)
 
NB. argument y is a vector of TURN numbers to report detailed output.
play =: 3 : 0
OUTPUT =: y
NB. save the random state to replay a fantastic game.
RANDOM_STATE =: '(9!:42 ; 9!:44 ; 9!:0)' ; (9!:42 ; 9!:44 ; 9!:0)''
if. 0 < # OUTPUT do.
smoutput 'line angle bit keys for MARK 000 045 090 135: ',":bit_to_set"0 MARKED,M000,M045,M090,M135
smoutput 'RANDOM_STATE begins as' ; RANDOM_STATE
end.
TURN =: _1 NB. count the number of plays. Convergence requires 1 extra attempt.
GRID =: morpion GREEK_CROSS NB. play the game
TURN
)
 
NB. example
smoutput play''
</syntaxhighlight>
load the file into a j session to play an initial game and report the number of turns. We can play a game providing a vector of move numbers at which to report the output.
<pre>
load'/tmp/m.ijs'
60
 
play 3
line angle bit keys for MARK 000 045 090 135: 1 8 64 512 4096
┌──────────────────────┬──────────────────────┬─┬───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────...
│RANDOM_STATE begins as│(9!:42 ; 9!:44 ; 9!:0)│2│┌─┬──┬─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────...
│ │ │ ││2│73│_1823777002250993298 _6838471509779976446 _8601563932981981704 _9084675764771521463 _513205540226054792 8272574653743672083 _9008275520901665952 542248839568947423 _149618965119662441 _7363052629138270...
│ │ │ │└─┴──┴─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────...
└──────────────────────┴──────────────────────┴─┴───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────...
3 TURN {
┌──────────────┬───────────────────────────────┐
│ choose among│┌────┬────┬────┬────┬────┬────┐│
│ ││4096│1 6 │2 7 │3 8 │4 9 │5 10││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││4096│3 7 │4 8 │5 9 │6 10│7 11││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││4096│6 1 │7 2 │8 3 │9 4 │10 5││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││4096│7 3 │8 4 │9 5 │10 6│11 7││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││512 │0 4 │1 4 │2 4 │3 4 │4 4 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││512 │0 7 │1 7 │2 7 │3 7 │4 7 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││512 │1 4 │2 4 │3 4 │4 4 │5 4 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││512 │1 7 │2 7 │3 7 │4 7 │5 7 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││512 │3 1 │4 1 │5 1 │6 1 │7 1 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││512 │3 10│4 10│5 10│6 10│7 10││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││512 │4 1 │5 1 │6 1 │7 1 │8 1 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││512 │4 10│5 10│6 10│7 10│8 10││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││512 │6 4 │7 4 │8 4 │9 4 │10 4││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││512 │7 4 │8 4 │9 4 │10 4│11 4││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││64 │10 6│9 7 │8 8 │7 9 │6 10││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││64 │5 1 │4 2 │3 3 │2 4 │1 5 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││8 │1 3 │1 4 │1 5 │1 6 │1 7 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││8 │1 4 │1 5 │1 6 │1 7 │1 8 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││8 │4 0 │4 1 │4 2 │4 3 │4 4 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││8 │4 1 │4 2 │4 3 │4 4 │4 5 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││8 │4 6 │4 7 │4 8 │4 9 │4 10││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││8 │4 7 │4 8 │4 9 │4 10│4 11││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││8 │7 0 │7 1 │7 2 │7 3 │7 4 ││
│ │├────┼────┼────┼────┼────┼────┤│
│ ││8 │7 1 │7 2 │7 3 │7 4 │7 5 ││
│ │└────┴────┴────┴────┴────┴────┘│
└──────────────┴───────────────────────────────┘
┌──────────┬───┬───┬───┬───┬───┬───┐
│ selected│512│1 4│2 4│3 4│4 4│5 4│
└──────────┴───┴───┴───┴───┴───┴───┘
┌──────────────────────┬───────────────────────────┬─────────────────────────────┐
│ framed input & ouput│0 0 0 0 0 0 0 0 0 0 0 0 0│0 0 0 0 0 0 0 0 0 0 0 0 0│
│ │0 0 0 0 1 1 1 1 0 0 0 0 0│0 0 0 0 513 1 1 1 0 0 0 0 0│
│ │0 0 0 0 1 0 0 1 0 0 0 0 0│0 0 0 0 513 0 0 1 0 0 0 0 0│
│ │0 0 0 0 1 0 0 1 0 0 0 0 0│0 0 0 0 513 0 0 1 0 0 0 0 0│
│ │0 1 1 1 1 0 0 1 1 1 1 0 0│0 1 1 1 513 0 0 1 1 1 1 0 0│
│ │0 1 0 0 0 0 0 0 0 0 1 0 0│0 1 0 0 513 0 0 0 0 0 1 0 0│
│ │0 1 0 0 0 0 0 0 0 0 1 0 0│0 1 0 0 0 0 0 0 0 0 1 0 0│
│ │0 1 1 1 1 0 0 521 9 9 9 9 0│0 1 1 1 1 0 0 521 9 9 9 9 0│
│ │0 0 0 0 1 0 0 513 0 0 0 0 0│0 0 0 0 1 0 0 513 0 0 0 0 0│
│ │0 0 0 0 1 0 0 513 0 0 0 0 0│0 0 0 0 1 0 0 513 0 0 0 0 0│
│ │0 0 0 0 9 9 9 521 9 0 0 0 0│0 0 0 0 9 9 9 521 9 0 0 0 0│
│ │0 0 0 0 0 0 0 513 0 0 0 0 0│0 0 0 0 0 0 0 513 0 0 0 0 0│
│ │0 0 0 0 0 0 0 0 0 0 0 0 0│0 0 0 0 0 0 0 0 0 0 0 0 0│
└──────────────────────┴───────────────────────────┴─────────────────────────────┘
}
62
</pre>
Explanation.
 
load'/tmp/m.ijs' Load the file played an initial game. This one played 60 moves.
class Grid {
enum Result {
GOOD, BAD, UGLY
}
 
play 3 Shows the state of the random generator at the start of the game, and then information about turn 3.
final int EMPTY = 0, POINT = 1, HORI = 2, VERT = 4, DIUP = 8, DIDO = 16,
The pseudo-random generator can be reconstructed from information in the RANDOM_STATE variable, hence one can replay with full output superior games.
HORI_END = 32, VERT_END = 64, DIUP_END = 128, DIDO_END = 256,
CAND = 512, ORIG = 1024, HINT = 2048;
 
Curly braces enclose output pertaining to the move transitioning from given state to the next.
final int[] basePoints = {120, 72, 72, 975, 513, 513, 975, 72, 72, 120};
<pre>3 TURN {
...
}
</pre>
A list of the possible moves follows, along with the selection. Let's decode the selected move.
Given the key from first output line the move 512 is a 90 degree (vertical) line. The list of index origin 0 row column coordinates indeed shows 5 constant column with sequential rows. From the framed input and output grids shown, near the top of the fifth column, the 1 1 1 1 0 became 513 513 513 513 513. 513 is the number corresponding to one bits of MARK and 90 degrees. On a prior move, the 521's shows that thes marked points were used for 0 and 90 degree lines, included in the (difficult to see) 9's and 513's in proper direction. The final 62 shows the length of the game. Display the value of final grid with the sentence GRID . GRID is a pronoun.
 
<pre>
int cellSize, pointSize, halfCell, centerX, centerY, origX, origY;
line angle bit keys for MARK 000 045 090 135: 1 8 64 512 4096
int minC, minR, maxC, maxR;
 
┌──────────┬───┬───┬───┬───┬───┬───┐
int[][] points;
│ selected│512│1 4│2 4│3 4│4 4│5 4│
List<Line> lines;
└──────────┴───┴───┴───┴───┴───┴───┘
Map<Point, Choice> choices;
┌──────────────────────┬───────────────────────────┬─────────────────────────────┐
List<Choice> candidates;
│ framed input & ouput│0 0 0 0 0 0 0 0 0 0 0 0 0│0 0 0 0 0 0 0 0 0 0 0 0 0│
│ │0 0 0 0 1 1 1 1 0 0 0 0 0│0 0 0 0 513 1 1 1 0 0 0 0 0│
│ │0 0 0 0 1 0 0 1 0 0 0 0 0│0 0 0 0 513 0 0 1 0 0 0 0 0│
│ │0 0 0 0 1 0 0 1 0 0 0 0 0│0 0 0 0 513 0 0 1 0 0 0 0 0│
│ │0 1 1 1 1 0 0 1 1 1 1 0 0│0 1 1 1 513 0 0 1 1 1 1 0 0│
│ │0 1 0 0 0 0 0 0 0 0 1 0 0│0 1 0 0 513 0 0 0 0 0 1 0 0│
│ │0 1 0 0 0 0 0 0 0 0 1 0 0│0 1 0 0 0 0 0 0 0 0 1 0 0│
│ │0 1 1 1 1 0 0 521 9 9 9 9 0│0 1 1 1 1 0 0 521 9 9 9 9 0│
│ │0 0 0 0 1 0 0 513 0 0 0 0 0│0 0 0 0 1 0 0 513 0 0 0 0 0│
│ │0 0 0 0 1 0 0 513 0 0 0 0 0│0 0 0 0 1 0 0 513 0 0 0 0 0│
│ │0 0 0 0 9 9 9 521 9 0 0 0 0│0 0 0 0 9 9 9 521 9 0 0 0 0│
│ │0 0 0 0 0 0 0 513 0 0 0 0 0│0 0 0 0 0 0 0 513 0 0 0 0 0│
│ │0 0 0 0 0 0 0 0 0 0 0 0 0│0 0 0 0 0 0 0 0 0 0 0 0 0│
└──────────────────────┴───────────────────────────┴─────────────────────────────┘
}
</pre>
The distribution of 4444 games is strongly bimodal with a narrow peak around 22 moves, and a broader peak of same count at 65 moves. The longest game scored 81, and 120 minimum 20 move games found.
 
=={{header|Java}}==
class Line {
See: [[Morpion solitaire/Java]]
final Point p1, p2;
 
Line(Point p1, Point p2) {
this.p1 = p1;
this.p2 = p2;
}
}
 
=={{header|Julia}}==
class Choice {
See:[[Morpion solitaire/Julia]]
int[] dir;
List<Point> points;
 
=={{header|Nim}}==
Choice(List<Point> p, int[] d) {
{{trans|Go}}
points = p;
{{libheader|nim-ncurses}}
dir = d;
}
}
 
<syntaxhighlight lang="nim">import os, random, sequtils
Grid(int cs, int ps) {
import ncurses
cellSize = cs;
pointSize = ps;
halfCell = cs / 2;
points = new int[50][50];
minC = minR = 0;
maxC = maxR = 50;
newGame();
}
 
const
final void newGame() {
LineLength = 5
for (int r = minR; r < maxR; r++)
Disjoint = 0
for (int c = minC; c < maxC; c++)
points[r][c] = EMPTY;
 
type
choices = new HashMap<>();
State {.pure.} = enum Blank, Occupied, DirNS, DirEW, DirNESW, DirNWSE, NewlyAdded, Current
candidates = new ArrayList();
States = set[State]
lines = new ArrayList<>();
Board = seq[seq[States]]
minC = minR = 18;
Move = tuple[m, s, seqnum, x, y: int]
maxC = maxR = 31;
 
const Ofs = [(0, 1, DirNS), (1, 0, DirEW), (1, -1, DirNESW), (1, 1, DirNWSE)]
// cross
for (int r = 0; r < 10; r++)
for (int c = 0; c < 10; c++)
if ((basePoints[r] & (1 << c)) != 0)
points[20 + r][20 + c] = POINT;
}
 
void draw(Graphics2D g, int w, int h) {
centerX = w / 2;
centerY = h / 2;
origX = centerX - halfCell - 24 * cellSize;
origY = centerY - halfCell - 24 * cellSize;
 
func set(board: var Board; value: State; x0, y0, x1, y1: int) =
// grid
for i in y0..y1:
g.setColor(Color.lightGray);
for j in x0..x1:
board[i][j] = {value}
 
int x = (centerX - halfCell) % cellSize;
int y = (centerY - halfCell) % cellSize;
 
func initBoard(): Board =
for (int i = 0; i <= w / cellSize; i++)
let height, width = 3 * (LineLength - 1)
g.drawLine(x + i * cellSize, 0, x + i * cellSize, h);
result = newSeqWith(height, newSeq[States](width))
result.set(Occupied, LineLength - 1, 1, 2 * LineLength - 3, height - 2)
result.set(Occupied, 1, LineLength - 1, width - 2, 2 * LineLength - 3)
result.set(Blank, LineLength, 2, 2 * LineLength - 4, height - 3)
result.set(Blank, 2, LineLength, width - 3, 2 * LineLength - 4)
 
for (int i = 0; i <= h / cellSize; i++)
g.drawLine(0, y + i * cellSize, w, y + i * cellSize);
 
func expand(board: var Board; dw, dh: int) =
// lines
g.setStroke(new BasicStroke(2));
for (int i = 0; i < lines.size(); i++) {
Line line = lines.get(i);
if (i == lines.size() - 1)
g.setColor(new Color(0x3399FF));
else
g.setColor(Color.orange);
int x1 = origX + line.p1.x * cellSize;
int y1 = origY + line.p1.y * cellSize;
int x2 = origX + line.p2.x * cellSize;
int y2 = origY + line.p2.y * cellSize;
g.drawLine(x1, y1, x2, y2);
}
 
# -1: expand low index end, +1: expand high index end.
// points
let
for (int r = minR; r < maxR; r++)
height = board.len
for (int c = minC; c < maxC; c++) {
int pwidth = points[r]board[c0];.len
nw = width + ord(dw != 0)
nh = height + ord(dh != 0)
 
var nboard = newSeqWith(nh, newSeq[States](nw))
if (p == EMPTY)
let dw = -ord(dw < 0)
continue;
let dh = -ord(dh < 0)
 
for i in 0..<nh:
if ((p & ORIG) != 0)
if i + dh notin 0..<height: continue
g.setColor(Color.red);
for j in 0..<nw:
if j + dw notin 0..<width: continue
nboard[i][j] = board[i + dh][j + dw]
 
board = move(nboard)
else if ((p & CAND) != 0)
g.setColor(Color.green);
 
else if ((p & HINT) != 0) {
g.setColor(Color.lightGray);
points[r][c] &= ~HINT;
} else
g.setColor(Color.darkGray);
 
proc show(board: Board) =
drawPoint(g, c, r);
for i, row in }board:
for j, cell in row:
}
let str = if Current in cell: "X "
elif NewlyAdded in cell: "0 "
elif Occupied in cell: "+ "
else: " "
mvprintw(cint(i + 1), cint(j + 2), str)
refresh()
 
private void drawPoint(Graphics2D g, int x, int y) {
x = origX + x * cellSize - (pointSize / 2);
y = origY + y * cellSize - (pointSize / 2);
g.fillOval(x, y, pointSize, pointSize);
}
 
proc testPosition(board: Board; y, x: int; rec: var Move) =
Result computerMove(int r, int c) {
let height = board.len
checkLines(r, c);
let width = board[0].len
if (candidates.size() > 0) {
if Occupied in board[y][x]: return
Choice choice = candidates.get(0);
addLine(choice.points, choice.dir);
return Result.GOOD;
}
return Result.BAD;
}
 
for m, (dx, dy, dir) in Ofs: # 4 directions.
Result playerMove(float x, float y) {
for s in (1 - LineLength)..0: # offset line.
int r = Math.round((y - origY) / cellSize);
var int ck = Math.round((x - origX) / cellSize);1
while k < LineLength:
inc k
if s + k == 0: continue
let xx = x + dx * (s + k)
let yy = y + dy * (s + k)
if xx < 0 or xx >= width or yy < 0 or yy >= height: break
if Occupied notin board[yy][xx]: break # No piece at position.
if dir in board[yy][xx]: break # This direction taken.
if k != LineLength: continue
 
# Position ok.
// see if inside active area
# Rand to even each option chance of being picked.
if (c < minC || c > maxC || r < minR || r > maxR)
if rand(rec.seqnum) == 0:
return Result.BAD;
rec.m = m; rec.s = s; rec.x = x; rec.y = y
inc rec.seqnum
 
// only process when mouse click is close enough to grid point
int diffX = (int) Math.abs(x - (origX + c * cellSize));
int diffY = (int) Math.abs(y - (origY + r * cellSize));
if (diffX > cellSize / 5 || diffY > cellSize / 5)
return Result.BAD;
 
proc addPiece(board: var Board; rec: Move) =
// did we have a choice in the previous turn
iflet ((points[r][c]dx, &dy, CANDdir) != 0) {Ofs[rec.m]
board[rec.y][rec.x] = board[rec.y][rec.x] + {Current, Occupied}
Choice choice = choices.get(new Point(c, r));
for k in 0..<LineLength:
addLine(choice.points, choice.dir);
let xx = rec.x + dx for* (Choicek ch+ : choicesrec.values(s)) {
let yy = rec.y + dy for* (Point pk :+ chrec.pointss)
board[yy][xx].incl NewlyAdded
points[p.y][p.x] &= ~(CAND | ORIG);
if k >= Disjoint or k < LineLength }- Disjoint:
board[yy][xx].incl dir
choices.clear();
return Result.GOOD;
}
 
if (points[r][c] != EMPTY || choices.size() > 0)
return Result.BAD;
 
proc nextMove(board: var Board): bool {.discardable.} =
checkLines(r, c);
var rec: Move
let maxi = board.high
let maxj = board[0].high
 
# Wipe last iteration new line markers.
if (candidates.size() == 1) {
for row in board.mitems:
Choice choice = candidates.get(0);
for cell in row.mitems:
addLine(choice.points, choice.dir);
cell = cell - {NewlyAdded, return Result.GOOD;Current}
} else if (candidates.size() > 1) {
// we can make more than one line
points[r][c] |= ORIG;
for (Choice ch : candidates) {
List<Point> cand = ch.points;
Point p = cand.get(cand.size() - 1);
if (p.equals(new Point(c, r)))
p = cand.get(0);
points[p.y][p.x] |= CAND;
choices.put(p, ch);
}
return Result.UGLY;
}
 
# Randomly pick one of next returnlegal Resultmove.BAD;
for i }in 0..maxi:
for j in 0..maxj:
board.testPosition(i, j, rec)
 
# Didn't find any move, game over.
void checkLine(int dir, int end, int r, int c, int rIncr, int cIncr) {
if rec.seqnum == 0: return false
List<Point> result = new ArrayList<>(5);
for (int i = -4; i < 1; i++) {
result.clear();
for (int j = 0; j < 5; j++) {
int y = r + rIncr * (i + j);
int x = c + cIncr * (i + j);
int p = points[y][x];
if (p != EMPTY && (p & dir) == 0 || (p & end) != 0 || i + j == 0)
result.add(new Point(x, y));
else
break;
}
if (result.size() == 5) {
candidates.add(new Choice(new ArrayList<>(result),
new int[]{dir, end}));
}
}
}
 
board.addPiece(rec)
void checkLines(int r, int c) {
candidates.clear();
checkLine(HORI, HORI_END, r, c, 0, 1);
checkLine(VERT, VERT_END, r, c, 1, 0);
checkLine(DIUP, DIUP_END, r, c, -1, 1);
checkLine(DIDO, DIDO_END, r, c, 1, 1);
}
 
rec.x = if rec.x == maxj: 1
void addLine(List<Point> line, int[] dir) {
Point p1 =elif linerec.get(x != 0: 0);
Point p2 = line.get(line.size()else: - 1);
rec.y = if rec.y == maxi: 1
elif rec.y != 0: 0
else: -1
 
if rec.x != 0 or rec.y != 0: board.expand(rec.x, rec.y)
// mark end points for 5T
result = true
points[p1.y][p1.x] |= dir[1];
points[p2.y][p2.x] |= dir[1];
 
lines.add(new Line(p1, p2));
 
proc play() =
for (Point p : line)
randomize()
points[p.y][p.x] |= dir[0];
var board = initBoard()
var waitKey = true
let win {.used.} = initscr()
noecho()
cbreak()
 
var move = 0
// growable active area
while true:
minC = Math.min(p1.x - 1, Math.min(p2.x - 1, minC));
mvprintw(0, 0, "Move %d", move)
maxC = Math.max(p1.x + 1, Math.max(p2.x + 1, maxC));
inc move
minR = Math.min(p1.y - 1, Math.min(p2.y - 1, minR));
board.show()
maxR = Math.max(p1.y + 1, Math.max(p2.y + 1, maxR));
if not board.nextMove():
}
board.nextMove()
board.show()
break
if not waitKey: sleep(100)
let ch = getch()
if ch == ord(' '):
waitKey = not waitKey
if waitKey: timeout(-1)
else: timeout(0)
elif ch == ord('q'):
break
 
timeout(-1)
List<Point> possibleMoves() {
getch()
List<Point> moves = new ArrayList<>();
nocbreak()
for (int r = minR; r < maxR; r++)
onecho()
for (int c = minC; c < maxC; c++) {
endwin()
if (points[r][c] == EMPTY) {
 
checkLines(r, c);
play()</syntaxhighlight>
if (candidates.size() > 0)
 
moves.add(new Point(c, r));
{{out}}
}
Intermediate state:
}
<pre>Move 20
return moves;
 
+
+++++
+ ++
+ ++ ++ +
+++++ +0+++
+ + 0 +
+ + X +
++++0+++++
+0 ++
++ +
+++++
+
</pre>
 
=={{header|Perl}}==
Picks a move at random from all possible moves at each step. A sample game is shown.
The largest score found so far (from just random play) is 92, also shown below.
<syntaxhighlight lang="perl">use strict;
use warnings;
use List::Util qw( none );
 
local $_ = <<END;
.............XXXX.............
.............X..X.............
.............X..X.............
..........XXXX..XXXX..........
..........X........X..........
..........X........X..........
..........XXXX..XXXX..........
.............X..X.............
.............X..X.............
.............XXXX.............
END
$_ = tr/X/ /r . $_ . tr/X/ /r; # expand to 30x30
tr/./ /; # and convert dots to spaces
 
my @moves;
my %used;
my $count = 0;
while( 1 )
{
# print s/\A(?: +\n)*|(?:^ +\n)*\z//gmr, "count $count\n"; # uncomment for each step
tr/O/X/;
my @try; # find valid moves
for my $i ( 0, 29 .. 31 )
{
my $gap = qr/.{$i}/s;
while( / (?=$gap(X)$gap(X)$gap(X)$gap(X))/g ) # add to top
{
my $cand = join ' ', map $-[$_], 0 .. 4;
none { $used{$_} } $cand =~ /(?=\b(\d+ \d+)\b)/g and push @try, $cand;
}
while( /X(?=$gap(.)$gap(.)$gap(.)$gap(.))/g ) # add inside/bottom downward
{
"$1$2$3$4" =~ tr/X// == 3 or next;
my $cand = join ' ', map $-[$_], 0 .. 4;
none { $used{$_} } $cand =~ /(?=\b(\d+ \d+)\b)/g and push @try, $cand;
}
}
@try ? $count++ : last;
my $pick = $try[rand @try]; #pick one valid move
push @moves, $pick;
for my $pos (split ' ', $pick)
{
substr $_, $pos, 1, 'O';
}
$used{$1} = 1 while $pick =~ /(?=\b(\d+ \d+)\b)/g;
}
print join(' ', map s/ .* /->/r =~ s!\d+! ($& % 31).','.int $& / 31 !ger, @moves)
=~ s/.{60}\K /\n/gr, "\n";
tr/O/X/;
print $_, "move count: $count\n";</syntaxhighlight>
This runs on a 30x30 grid (as advised by Talk page).
Each move is shown as the end points of a line, startcolumn,startrow->endcolumn,endrow where row and column numbers
are zero-based. To replay a game, just add all five points from each line to the grid. The final grid is also shown in full.
Uncommenting the early print will show each step with the latest line added as the 'O' character.
{{out}}
<pre>
10,15->14,19 13,16->13,20 10,13->10,17 15,16->19,16 15,10->19,14
12,10->16,10 19,12->19,16 16,16->16,20 9,16->13,16 12,16->16,20
16,13->20,13 10,13->14,13 13,9->13,13 16,9->16,13 16,9->12,13
13,19->17,19 14,10->10,14 19,15->15,19 20,13->16,17 13,9->17,13
13,11->17,11
X X
XXXXX
XXXXX
XX XX X
XXXXX XXXXX
X X
X XX
XXXXX XXXXX
X XX XX
XX X
XXXXX
X X
move count: 21
</pre>
<pre>
13,16->13,20 16,15->16,19 15,10->19,14 16,13->20,13 10,16->14,16
13,10->17,10 12,19->16,19 10,15->14,19 14,10->10,14 10,13->14,13
15,16->19,16 19,13->19,17 16,15->12,19 17,16->13,20 10,13->10,17
13,16->17,20 10,17->14,17 19,15->15,19 16,11->16,15 17,13->13,17
13,9->13,13 13,9->17,13 15,15->15,19 14,17->18,17 14,13->18,17
13,13->17,17 14,13->14,17 15,14->11,18 9,16->13,20 13,12->9,16
11,14->11,18 12,13->16,17 12,14->16,14 14,13->10,17 13,13->9,17
9,12->13,16 11,15->15,19 10,15->14,15 12,14->12,18 13,18->17,18
10,12->14,16 9,15->13,19 15,13->11,17 9,12->13,12 15,11->15,15
20,15->16,19 17,16->17,20 15,13->19,17 14,15->18,15 16,16->12,20
17,12->17,16 13,12->17,12 18,9->14,13 13,10->17,14 12,11->16,11
17,9->13,13 14,16->18,20 18,13->18,17 14,9->10,13 16,14->20,14
21,12->17,16 12,10->12,14 11,9->15,13 14,8->14,12 14,8->10,12
11,10->11,14 10,9->14,13 10,9->14,9 20,12->16,16 20,11->20,15
20,11->16,15 17,12->21,12 16,10->20,14 17,8->17,12 17,8->21,12
19,10->15,14 17,8->13,12 18,9->18,13 19,9->15,13 19,9->19,13
15,9->19,9 17,11->21,11 15,8->19,12 16,8->20,12 13,8->17,8 13,8->9,12 l
15,7->15,11 10,9->10,13 16,7->16,11 9,10->13,10 9,9->13,13 8,9->12,13
XX
XXXXX
XXXXXXXXXXXX
XXXXXXXXXXX
XXXXXXXXXXXX
XXXXXXXXXXXXX
XXXXXXXXXXX
XXXXXXXXXXX
XXXXXXXXXXXX
XXXXXXXXXXX
XXXXXXXXXXX
XXXXXXX
XXXXXX
XX XX
move count: 92
</pre>
 
A faster, shorter version without the single step display.
void showHints() {
Uses the same kind of block shift/or technology I used in "Forest fire" and have used
for (Point p : possibleMoves())
for Conway's Life.
points[p.y][p.x] |= HINT;
<syntaxhighlight lang="perl">use strict;
use warnings;
use feature 'bitwise';
use List::Util 'none';
 
local $_ = <<END;
.............XXXX.............
.............X..X.............
.............X..X.............
..........XXXX..XXXX..........
..........X........X..........
..........X........X..........
..........XXXX..XXXX..........
.............X..X.............
.............X..X.............
.............XXXX.............
END
$_ = tr/X./ /r . tr/./ /r . tr/X./ /r; # expand to 30x30 and spaces
 
my($count, @moves, %used) = 0;
while( 1 )
{
my @try; # valid moves
for my $i ( 1, 30 .. 32 ) # directions 1 - 30 / 31 | 32 \
{
my $combined = tr/X \n/A\0/r |.
(substr $_, $i) =~ tr/X \n/B\0/r |.
(substr $_, 2 * $i) =~ tr/X \n/D\0/r |.
(substr $_, 3 * $i) =~ tr/X \n/H\0/r |.
(substr $_, 4 * $i) =~ tr/X \n/P\0/r;
while( $combined =~ /[OW\[\]\^]/g ) # exactly four Xs and one space
{
my $cand = join ' ', map $-[0] + $_ * $i, 0 .. 4;
none { $used{$_} } $cand =~ /(?=\b(\d+ \d+)\b)/g and push @try, $cand;
}
}
@try ? $count++ : last;
}</lang>
my $pick = $try[rand @try]; #pick one valid move
push @moves, $pick;
for my $pos (split ' ', $pick)
{
substr $_, $pos, 1, 'X';
}
@used{ $pick =~ /(?=\b(\d+ \d+)\b)/g } = (1) x 4;
}
print join(' ', map s/ .* /->/r =~ s!\d+! ($& % 31).','.int $& / 31 !ger,
@moves) =~ s/.{60}\K /\n/gr, "\n";
print $_, "move count: $count\n";</syntaxhighlight>
 
=={{header|Phix}}==
Focuses on playing back the 178-record, see: [[Morpion solitaire/Phix]]
 
=={{header|Racket}}==
 
<syntaxhighlight lang="racket">#lang racket
(module rules racket/base
(require racket/match)
(provide game-cross
available-lines
add-line
line-dx.dy)
(define (add-points points# x y . more)
(define p+ (hash-set points# (cons x y) #t))
(if (null? more) p+ (apply add-points p+ more)))
;; original cross
(define (game-cross)
(let ((x1 (for/fold ((x (hash))) ((i (in-range 3 7)))
(add-points x 0 i i 0 9 i i 9))))
(for/fold ((x x1)) ((i (in-sequences (in-range 0 4) (in-range 6 10))))
(add-points x 3 i i 3 6 i i 6))))
;; add an edge
(define (make-edge points#)
(for*/hash ((k (in-hash-keys points#))
(dx (in-range -1 2))
(dy (in-range -1 2))
(x (in-value (+ (car k) dx)))
(y (in-value (+ (cdr k) dy)))
(e (in-value (cons x y)))
#:unless (hash-has-key? points# e))
(values e #t)))
(define (line-dx.dy d)
(values (match d ['w -1] ['nw -1] ['n 0] [ne 1])
(match d ['n -1] ['ne -1] ['nw -1] ['w 0])))
(define (line-points e d)
(define-values (dx dy) (line-dx.dy d))
(match-define (cons x y) e)
(for/list ((i (in-range 5)))
(cons (+ x (* dx i))
(+ y (* dy i)))))
(define (line-overlaps? lp d l#)
(for/first ((i (in-range 3))
(p (in-list (cdr lp)))
#:when (hash-has-key? l# (cons d p)))
#t))
(define (four-points? lp p#)
(= 4 (for/sum ((p (in-list lp)) #:when (hash-has-key? p# p)) 1)))
;; returns a list of lines that can be applied to the game
(define (available-lines p# l# (e# (make-edge p#)))
(for*/list ((ep (in-sequences (in-hash-keys e#) (in-hash-keys p#)))
(d (in-list '(n w ne nw)))
(lp (in-value (line-points ep d)))
#:unless (line-overlaps? lp d l#)
#:when (four-points? lp p#))
(define new-edge-point (for/first ((p (in-list lp)) #:when (hash-ref e# p #f)) p))
(list ep d lp new-edge-point)))
;; adds a new line to points# lines# returns (values [new points#] [new lines#])
(define (add-line line points# lines#)
(match-define (list _ dir ps _) line)
(for/fold ((p# points#) (l# lines#)) ((p (in-list ps)))
(values (hash-set p# p #t) (hash-set l# (cons dir p) #t)))))
 
(module player racket/base
(require racket/match
(submod ".." rules))
 
(provide play-game
random-line-chooser)
(define (random-line-chooser p# l# options)
(list-ref options (random (length options))))
;; line-chooser (points lines (Listof line) -> line)
(define (play-game line-chooser (o# (game-cross)))
(let loop ((points# o#)
(lines# (hash))
(rv null))
(match (available-lines points# lines#)
[(list) (values points# (reverse rv) o#)]
[options
(match-define (and chosen-one (list (cons x y) d _ new-edge-point))
(line-chooser points# lines# options))
(define-values (p# l#) (add-line chosen-one points# lines#))
(loop p# l# (cons (vector x y d new-edge-point) rv))]))))
 
;; [Render module code goes here]
 
(module main racket/base
(require (submod ".." render)
(submod ".." player)
pict
racket/class)
(define p (call-with-values (λ () (play-game random-line-chooser)) render-state))
p
(define bmp (pict->bitmap p))
(send bmp save-file "images/morpion.png" 'png))</syntaxhighlight>
 
 
'''Intermission:''' The <code>render</code> submodule just does drawing, and is not part of the solving. But the <code>main</code> module uses it, so we put it in here:
 
<syntaxhighlight lang="racket">(module render racket
(require racket/match
racket/draw
pict
(submod ".." rules))
(provide display-state
render-state)
(define (min/max-point-coords p#)
(for/fold ((min-x #f) (min-y #f) (max-x #f) (max-y #f))
((k (in-hash-keys p#)))
(match-define (cons x y) k)
(if min-x
(values (min min-x x) (min min-y y) (max max-x x) (max max-y y))
(values x y x y))))
(define (draw-text/centered dc x y t ->x ->y)
(define-values (w h b v) (send dc get-text-extent t))
(send dc draw-text t (- (->x x) (* w 1/2)) (- (->y y) (* h 1/2))))
 
(define ((with-stored-dc-context draw-fn) dc w h)
(define old-brush (send dc get-brush))
(define old-pen (send dc get-pen))
(define old-font (send dc get-font))
(draw-fn dc w h)
(send* dc (set-brush old-brush) (set-pen old-pen) (set-font old-font)))
 
(define red-brush (new brush% [style 'solid] [color "red"]))
(define white-brush (new brush% [style 'solid] [color "white"]))
(define cyan-brush (new brush% [style 'solid] [color "cyan"]))
(define cyan-pen (new pen% [color "cyan"]))
(define black-pen (new pen% [color "black"]))
(define green-pen (new pen% [color "green"] [width 3]))
(define black-brush (new brush% [style 'solid] [color "black"]))
(define (render-state p# ls (o# (hash)))
(define-values (min-x min-y max-x max-y) (min/max-point-coords p#))
(define C 24)
(define R 8)
(define D (* R 2))
(define Rp 4)
 
(define (draw dc w h)
(define (->x x) (* C (- x min-x -1/2)))
(define (->y y) (* C (- y min-y -1/2 )))
(send dc set-brush cyan-brush)
(send dc set-pen cyan-pen)
(send dc set-font (make-object font% R 'default))
(for ((y (in-range min-y (add1 max-y))))
(send dc draw-line (->x min-x) (->y y) (->x max-x) (->y y))
(for ((x (in-range min-x (add1 max-x))))
(send dc draw-line (->x x) (->y min-y) (->x x) (->y max-y))))
(send dc set-pen black-pen)
(for ((l (in-list ls)))
(match-define (vector x y d (cons ex ey)) l)
(define-values (dx dy) (line-dx.dy d))
(define x1 (+ x (* 4 dx)))
(define y1 (+ y (* 4 dy)))
(send* dc (draw-line (->x x) (->y y) (->x x1) (->y y1))))
(for* ((y (in-range min-y (add1 max-y)))
(x (in-range min-x (add1 max-x))))
(define k (cons x y))
(cond [(hash-has-key? o# k)
(send dc set-brush red-brush)
(send dc draw-ellipse (- (->x x) R) (- (->y y) R) D D)]
[(hash-has-key? p# k)
(send dc set-brush white-brush)
(send dc draw-ellipse (- (->x x) R) (- (->y y) R) D D)]))
(send dc set-brush black-brush)
(for ((l (in-list ls))
(i (in-naturals 1)))
(match-define (vector _ _ d (cons ex ey)) l)
(define-values (dx dy) (line-dx.dy d))
(define R.dx (* R dx 0.6))
(define R.dy (* R dy 0.6))
(send* dc
(set-pen green-pen)
(draw-line (- (->x ex) R.dx) (- (->y ey) R.dy) (+ (->x ex) R.dx) (+ (->y ey) R.dy))
(set-pen black-pen))
(draw-text/centered dc ex ey (~a i) ->x ->y)))
(define P (dc (with-stored-dc-context draw) (* C (- max-x min-x -1)) (* C (- max-y min-y -1))))
(printf "~s~%~a points ~a lines~%" ls (hash-count p#) (length ls))
P)
(define (display-state p# l (o# (hash)))
(define-values (min-x min-y max-x max-y) (min/max-point-coords p#))
(for ((y (in-range min-y (add1 max-y)))
#:when (unless (= y min-y) (newline))
(x (in-range min-x (add1 max-x))))
(define k (cons x y))
(write-char
(cond [(hash-has-key? o# k) #\+]
[(hash-has-key? p# k) #\.]
[else #\space])))
(printf "~s~%~a points ~a lines~%" l (hash-count p#) (length l))))</syntaxhighlight>
{{out}}
 
[[File:Morpion racket.png|thumb|right|The Racket rendition of the output solution]]
 
Here is the text output of one run, and if you're (I'm) lucky, there's a picture attached:
<pre>
(#(9 6 n (9 . 2)) #(4 3 w (4 . 3)) #(7 9 w (7 . 9)) #(8 3 w (5 . 3)) #(3 9 n (3 . 5))
#(0 7 n (0 . 7)) #(6 3 n (6 . -1)) #(7 0 w (7 . 0)) #(3 3 n (3 . -1)) #(4 6 w (4 . 6))
#(2 6 ne (4 . 4)) #(6 9 n (6 . 5)) #(0 4 ne (2 . 2)) #(9 4 nw (7 . 2)) #(8 6 w (5 . 6))
#(4 9 nw (2 . 7)) #(7 9 nw (5 . 7)) #(7 6 nw (5 . 4)) #(2 7 ne (4 . 5)) #(7 3 nw (5 . 1))
#(5 7 n (5 . 5)) #(7 5 w (7 . 5)) #(5 6 ne (7 . 4)) #(6 7 nw (3 . 4)) #(0 7 ne (2 . 5))
#(7 7 nw (7 . 7)) #(6 8 ne (10 . 4)) #(2 6 n (2 . 4)) #(5 7 ne (8 . 4)) #(5 4 w (1 . 4))
#(1 4 ne (4 . 1)) #(7 7 w (4 . 7)) #(4 9 n (4 . 8)) #(7 4 n (7 . 1)) #(7 4 nw (5 . 2))
#(11 4 w (11 . 4)) #(7 9 n (7 . 8)) #(5 3 n (5 . -1)) #(7 2 w (4 . 2)) #(8 6 nw (6 . 4))
#(7 8 w (5 . 8)) #(3 10 ne (3 . 10)) #(5 9 nw (1 . 5)) #(4 3 ne (8 . -1))
#(-1 7 ne (-1 . 7)) #(1 6 n (1 . 2)) #(6 1 w (2 . 1)) #(10 4 nw (8 . 2)) #(3 5 w (-1 . 5))
#(8 6 n (8 . 5)) #(-1 4 ne (-1 . 4)) #(5 5 ne (9 . 1)) #(3 6 nw (-1 . 2)) #(3 3 ne (7 . -1))
#(7 -1 w (4 . -1)) #(7 10 nw (7 . 10)) #(3 2 w (0 . 2)) #(3 5 nw (-1 . 1)) #(-1 5 n (-1 . 3))
#(3 7 w (1 . 7)) #(3 9 nw (2 . 8)) #(1 9 ne (1 . 9)) #(4 2 n (4 . -2)))
99 points 63 lines
</pre>
 
=={{header|REXX}}==
Line 716 ⟶ 1,437:
<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>
<syntaxhighlight 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,79,'─') /*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 /*forever*/
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 & > */</syntaxhighlight>
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('═',79)
else call t right('count of (above) wins =' wins,79,'═')
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>
'''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;overflow:scroll">
·╞···╔══╗···
·|···║··║···
·|···║··║···
·|╔══╝··╚══╗
·|║········║
·├║········║
·|╚══╗··╔══╝
·|···║··║···
·|···║··║···
·|···╚══╝···
─┼────┴────╨
·|··········
═══════════════════════════════════════════════════════════════════════════════
 
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
Line 951 ⟶ 1,682:
* number of wins = 47
</pre>
 
=={{header|Wren}}==
{{trans|C}}
{{libheader|ncurses}}
{{libheader|Wren-dynamic}}
{{libheader|Wren-fmt}}
An embedded program so we can use the ncurses library.
<syntaxhighlight lang="wren">/* Morpion_solitaire.wren */
 
import "random" for Random
import "./dynamic" for Flags, Struct
import "./fmt" for Conv
 
class Ncurses {
foreign static initscr()
 
foreign static cbreak()
foreign static nocbreak()
 
foreign static echo()
foreign static noecho()
 
foreign static refresh()
 
foreign static getch()
 
foreign static mvprintw(y, x, str)
 
foreign static timeout(delay)
 
foreign static endwin()
}
 
class C {
foreign static usleep(usec)
}
 
// optional settings
var lineLen = 5
var disjoint = 0
 
var fields = [
"blank", "occupied", "dirNS", "dirEW",
"dirNESW", "dirNWSE", "newlyAdded", "current"
]
var State = Flags.create("State", fields, true)
 
var ofs = [
[0, 1, State.dirNS],
[1, 0, State.dirEW],
[1, -1, State.dirNESW],
[1, 1, State.dirNWSE]
]
 
var Move = Struct.create("Move", ["m", "s", "seq", "x", "y"])
 
var rand = Random.new()
 
var board
var width
var height
 
var allocBoard = Fn.new { |w, h|
var buf = List.filled(h, null)
for (i in 0...h) buf[i] = List.filled(w, 0)
return buf
}
 
var boardSet = Fn.new { |v, x0, y0, x1, y1|
for (i in y0..y1) {
for (j in x0..x1) board[i][j] = v
}
}
 
var initBoard = Fn.new {
width = height = 3 * (lineLen - 1)
board = allocBoard.call(width, height)
 
boardSet.call(State.occupied, lineLen-1, 1, 2*lineLen-3, height-2)
boardSet.call(State.occupied, 1, lineLen-1, width-2, 2*lineLen-3)
boardSet.call(State.blank, lineLen, 2, 2*lineLen-4, height-3)
boardSet.call(State.blank, 2, lineLen, width-3, 2*lineLen-4)
}
 
// -1: expand low index end; 1: expand high index end
var expandBoard = Fn.new { |dw, dh|
var dw2 = (dw == 0) ? 0 : 1
var dh2 = (dh == 0) ? 0 : 1
var nw = width + dw2
var nh = height + dh2
var nbuf = allocBoard.call(nw, nh)
dw = -Conv.btoi(dw < 0)
dh = -Conv.btoi(dh < 0)
for (i in 0...nh) {
if (i + dh < 0 || i + dh >= height) continue
for (j in 0...nw) {
if (j + dw < 0 || j + dw >= width) continue
nbuf[i][j] = board[i+dh][j+dw]
}
}
board = nbuf
width = nw
height = nh
}
 
var showBoard = Fn.new {
for (i in 0...height) {
for (j in 0...width){
var temp
if (board[i][j] & State.current != 0) {
temp = "X "
} else if (board[i][j] & State.newlyAdded != 0) {
temp = "O "
} else if (board[i][j] & State.occupied != 0) {
temp = "+ "
} else {
temp = " "
}
Ncurses.mvprintw(i + 1, j * 2, temp)
}
}
Ncurses.refresh()
}
 
// test if a point can complete a line, or take that point
var testPosition = Fn.new { |y, x, rec|
if (board[y][x] & State.occupied != 0) return
for (m in 0..3) { // 4 directions
var dx = ofs[m][0]
var dy = ofs[m][1]
var dir = ofs[m][2]
var s = 1 - lineLen
while (s <= 0) { // offset line
var k = 0
while (k < lineLen) {
if (s + k == 0) {
k = k + 1
continue
}
var xx = x + dx * (s + k)
var yy = y + dy * (s + k)
if (xx < 0 || xx >= width || yy < 0 || yy >= height) break
 
// no piece at position
if (board[yy][xx] & State.occupied == 0) break
 
// this direction taken
if (board[yy][xx] & dir != 0) break
k = k + 1
}
if (k == lineLen) {
// position ok
// random integer to even each option's chance of being picked
rec.seq = rec.seq + 1
if (rand.int(rec.seq) == 0) {
rec.m = m
rec.s = s
rec.x = x
rec.y = y
}
}
s = s + 1
}
}
}
 
var addPiece = Fn.new { |rec|
var dx = ofs[rec.m][0]
var dy = ofs[rec.m][1]
var dir = ofs[rec.m][2]
board[rec.y][rec.x] = board[rec.y][rec.x] | (State.current | State.occupied)
for (k in 0...lineLen) {
var xx = rec.x + dx * (k + rec.s)
var yy = rec.y + dy * (k + rec.s)
board[yy][xx] = board[yy][xx] | State.newlyAdded
if (k >= disjoint || k < lineLen-disjoint) {
board[yy][xx] = board[yy][xx] | dir
}
}
}
 
var nextMove = Fn.new {
var rec = Move.new(0, 0, 0, 0, 0)
// wipe last iteration's new line markers
for (i in 0...height) {
for (j in 0...width) {
board[i][j] = board[i][j] & ~(State.newlyAdded | State.current)
}
}
// randomly pick one of next legal moves
for (i in 0...height) {
for (j in 0...width) testPosition.call(i, j, rec)
}
 
// didn't find any move, game over
if (rec.seq == 0) return false
addPiece.call(rec)
 
if (rec.x == width-1) {
rec.x = 1
} else if (rec.x != 0) {
rec.x = 0
} else {
rec.x = -1
}
 
if (rec.y == height-1) {
rec.y = 1
} else if (rec.y != 0) {
rec.y = 0
} else {
rec.y = -1
}
 
if (rec.x != 0 || rec.y != 0) expandBoard.call(rec.x, rec.y)
return true
}
 
initBoard.call()
Ncurses.initscr()
Ncurses.noecho()
Ncurses.cbreak()
var ch = 0
var move = 0
var waitKey = true
while (true) {
Ncurses.mvprintw(0, 0, "Move %(move)")
move = move + 1
showBoard.call()
if (!nextMove.call()) {
nextMove.call()
showBoard.call()
break
}
if (!waitKey) C.usleep(100000)
if ((ch = Ncurses.getch()) == 32) { // spacebar pressed
waitKey = !waitKey
if (waitKey) {
Ncurses.timeout(-1)
} else {
Ncurses.timeout(0)
}
}
if (ch == 113) break // 'q' pressed
}
Ncurses.timeout(-1)
Ncurses.nocbreak()
Ncurses.echo()
Ncurses.endwin()</syntaxhighlight>
<br>
We now embed the above script in the following C program, build and run it.
<syntaxhighlight lang="c">/* gcc Morpion_solitaire.c -o Morpion_solitaire -lncurses -lwren -lm */
 
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ncurses.h>
#include <unistd.h>
#include "wren.h"
 
/* C <=> Wren interface functions */
 
void C_initscr(WrenVM* vm) {
initscr();
}
 
void C_cbreak(WrenVM* vm) {
cbreak();
}
 
void C_nocbreak(WrenVM* vm) {
nocbreak();
}
 
void C_echo(WrenVM* vm) {
echo();
}
 
void C_noecho(WrenVM* vm) {
noecho();
}
 
void C_refresh(WrenVM* vm) {
refresh();
}
 
void C_getch(WrenVM* vm) {
int ch = getch();
wrenSetSlotDouble(vm, 0, (double)ch);
}
 
void C_mvprintw(WrenVM* vm) {
int y = (int)wrenGetSlotDouble(vm, 1);
int x = (int)wrenGetSlotDouble(vm, 2);
const char *str = wrenGetSlotString(vm, 3);
mvprintw(y, x, "%s", str);
}
 
void C_timeout(WrenVM* vm) {
int delay = (int)wrenGetSlotDouble(vm, 1);
timeout(delay);
}
 
void C_endwin(WrenVM* vm) {
endwin();
}
 
void C_usleep(WrenVM* vm) {
useconds_t usec = (useconds_t)wrenGetSlotDouble(vm, 1);
usleep(usec);
}
 
WrenForeignMethodFn bindForeignMethod(
WrenVM* vm,
const char* module,
const char* className,
bool isStatic,
const char* signature) {
if (strcmp(module, "main") == 0) {
if (strcmp(className, "Ncurses") == 0) {
if (isStatic && strcmp(signature, "initscr()") == 0) return C_initscr;
if (isStatic && strcmp(signature, "cbreak()") == 0) return C_cbreak;
if (isStatic && strcmp(signature, "noecho()") == 0) return C_noecho;
if (isStatic && strcmp(signature, "nocbreak()") == 0) return C_nocbreak;
if (isStatic && strcmp(signature, "echo()") == 0) return C_echo;
if (isStatic && strcmp(signature, "refresh()") == 0) return C_refresh;
if (isStatic && strcmp(signature, "getch()") == 0) return C_getch;
if (isStatic && strcmp(signature, "mvprintw(_,_,_)") == 0) return C_mvprintw;
if (isStatic && strcmp(signature, "timeout(_)") == 0) return C_timeout;
if (isStatic && strcmp(signature, "endwin()") == 0) return C_endwin;
} else if (strcmp(className, "C") == 0) {
if (isStatic && strcmp(signature, "usleep(_)") == 0) return C_usleep;
}
}
return NULL;
}
 
static void writeFn(WrenVM* vm, const char* text) {
printf("%s", text);
}
 
void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) {
switch (errorType) {
case WREN_ERROR_COMPILE:
printf("[%s line %d] [Error] %s\n", module, line, msg);
break;
case WREN_ERROR_STACK_TRACE:
printf("[%s line %d] in %s\n", module, line, msg);
break;
case WREN_ERROR_RUNTIME:
printf("[Runtime Error] %s\n", msg);
break;
}
}
 
char *readFile(const char *fileName) {
FILE *f = fopen(fileName, "r");
fseek(f, 0, SEEK_END);
long fsize = ftell(f);
rewind(f);
char *script = malloc(fsize + 1);
fread(script, 1, fsize, f);
fclose(f);
script[fsize] = 0;
return script;
}
 
static void loadModuleComplete(WrenVM* vm, const char* module, WrenLoadModuleResult result) {
if( result.source) free((void*)result.source);
}
 
WrenLoadModuleResult loadModule(WrenVM* vm, const char* name) {
WrenLoadModuleResult result = {0};
if (strcmp(name, "random") != 0 && strcmp(name, "meta") != 0) {
result.onComplete = loadModuleComplete;
char fullName[strlen(name) + 6];
strcpy(fullName, name);
strcat(fullName, ".wren");
result.source = readFile(fullName);
}
return result;
}
 
int main(int argc, char **argv) {
WrenConfiguration config;
wrenInitConfiguration(&config);
config.writeFn = &writeFn;
config.errorFn = &errorFn;
config.bindForeignMethodFn = &bindForeignMethod;
config.loadModuleFn = &loadModule;
WrenVM* vm = wrenNewVM(&config);
const char* module = "main";
const char* fileName = "Morpion_solitaire.wren";
char *script = readFile(fileName);
WrenInterpretResult result = wrenInterpret(vm, module, script);
switch (result) {
case WREN_RESULT_COMPILE_ERROR:
printf("Compile Error!\n");
break;
case WREN_RESULT_RUNTIME_ERROR:
printf("Runtime Error!\n");
usleep(10000000); // allow time to read it
timeout(-1);
nocbreak();
echo();
endwin();
break;
case WREN_RESULT_SUCCESS:
break;
}
wrenFreeVM(vm);
free(script);
return 0;
}</syntaxhighlight>
PureFox
9,476

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/187242...350847"