Morpion solitaire/Phix
I focused on a half-decent gui and playing back the 178-record.
Gruntwork of searching 10^23 possible moves left as an exercise...
<lang Phix>-- demo\rosetta\Morpion_solitaire.exw
--
-- Download http://www.morpionsolitaire.com/Grid5T178Rosin.txt and
-- save it to the current directory, if you want this to replay it.
--
constant p178file = "Grid5T178Rosin.txt"
-- -- One point worth clarifying, suppose you have: -- -- ? -- ** -- * * -- * * -- * * -- -- Then placing a tile at 1,1/'?' makes //**either**// a | or a \, -- but *not* both. In fact, your next tile could then go at either -- 0,0 (if you made a |) or 1,0 (if you made a \), making the other -- one, and leaving one tile on row 5 unused (however both tiles on -- rows 2-4 become part of a 5-set). (Aside: the indexes just used -- are quite unlike the extending/double-spaced ones used below.) --
constant help_text = """ The game of Morpion Solitaire.
The aim is to make as many lines of 5 tiles as you can. Lines may cross and share endpoints, but not overlap. Valid places where a new tile may be placed are shown in orange.
The worst case game is 20 lines, the world record is 178. The play-178 button is disabled if it cannot open Grid5T178Rosin.txt in the current directory. Use +/- to speed up/slow down the playback. """
include pGUI.e
Ihandle dlg, canvas, hframe, history, play178, timer
sequence board -- -- board is {string}, with odd col&row as tiles, either even as spaces/lines, eg -- -- 123456789012345 -- {`...............`, 1 -- `...............`, 2 -- `..O-O-O.....O..`, 3 -- `..|\|X|..../...`, 4 -- `..O-O-O-O-O....`, 5 -- `..|.|\|\./.....`, 6 -- `..O-O-O-O-O....`, 7 -- `..|.|.|X.\.....`, 8 -- `..O-O-O-O-O....`, 9 -- `..|.|/|..\.\...`, 10 -- `..O-O-O-O-O.O..`, 11 -- `...............`, 12 -- `?..............`} 13 -- -- in other words if odd(col) and odd(row) then [r,c] must be one of ".O", else -- [r,c] must be one of ".-|\/X", for every single element/char of board[][]. -- (It turned out pretty easy to map that to a fairly nice gui, plus of course -- the above proved far easier to debug than (say) a bunch of bit-settings! -- Likewise for debugging '.' are somewhat easier to count/follow than ' '. ) -- -- There is a double-space border so that tiles can be placed (ie clicked on), -- at which point the board is automatically extended with a new double edge. -- For instance, playing a tile at the spot marked '?' means we must insert -- two spaces at the start of every line, add two new blank lines on the end, -- and run through the entire history/playback adding {2,0} to everything. At -- {1,1}, obviously, you have to add {2,2} to everything (and nowhere else).
sequence valid_moves = {} -- saved in redraw_cb(), for click testing in button_cb(): integer r = 0, r2 = 0 -- delay between moves in playback mode atom pause = 1
sequence played = {},
playback = {}
function redraw_cb(Ihandle ih, integer /*posx*/, integer /*posy*/)
integer {cw,ch} = IupGetIntInt(ih, "DRAWSIZE"),
bw = length(board[1]),
bh = length(board)
cdCanvas cddbuffer = IupGetAttributePtr(ih,"DBUFFER")
IupGLMakeCurrent(ih)
cdCanvasActivate(cddbuffer)
cdCanvasClear(cddbuffer)
integer mx = min(floor(cw/((bw+1)/2)),floor(ch/((bh+1)/2)))
r = floor(mx/2) -- save for button_cb()
mx = r*2 -- (prevent drift)
r2 = r*r
integer t = r+floor(r/3),
cy = ch-r, cx = r,
hr = floor(r/2)
-- draw grid
cdCanvasSetForeground(cddbuffer,CD_LIGHT_GREY)
while cx<cw or cy>0 do
cdCanvasLine(cddbuffer,cx,1,cx,ch)
cdCanvasLine(cddbuffer,1,cy,cw,cy)
cx += mx
cy -= mx
end while
-- draw lines
cdCanvasSetForeground(cddbuffer,CD_BLACK)
cy = ch-mx
for y=2 to bh do
cx = r
integer step = 1+and_bits(y,1)
for x=2 to bw by step do
integer c = board[y][x]
if c!='.' then
if c='-' then
cdCanvasLine(cddbuffer,cx,cy,cx+mx,cy)
elsif c='|' then
cdCanvasLine(cddbuffer,cx+r,cy-r,cx+r,cy+r)
elsif c='\\' then
cdCanvasLine(cddbuffer,cx,cy+r,cx+mx,cy-r)
elsif c='X' then
cdCanvasLine(cddbuffer,cx,cy+r,cx+mx,cy-r)
cdCanvasLine(cddbuffer,cx+mx,cy+r,cx,cy-r)
elsif c='/' then
cdCanvasLine(cddbuffer,cx,cy-r,cx+mx,cy+r)
end if
end if
cx += step*r
end for
cy -= r
end for
-- draw tiles
cy = ch-r
for y=1 to bh by 2 do
cx = r
for x=1 to bw by 2 do
if board[y][x]='O' then
cdCanvasSetForeground(cddbuffer,CD_GREY)
cdCanvasSector(cddbuffer, cx, cy, t, t, 0, 360)
cdCanvasSetForeground(cddbuffer,CD_DARK_GREY)
cdCanvasCircle(cddbuffer, cx, cy, t)
end if
cx += mx
end for
cy -= mx
end for
-- draw valid moves
cdCanvasSetForeground(cddbuffer,CD_ORANGE)
for i=1 to length(valid_moves) do
integer {x,y} = valid_moves[i]
if i>1 and {x,y}=valid_moves[i-1][1..2] then
cdCanvasSetForeground(cddbuffer,CD_DARK_RED)
else
cdCanvasSetForeground(cddbuffer,CD_ORANGE)
end if
cx = x*r
cy = ch-y*r
cdCanvasLine(cddbuffer,cx-hr,cy,cx+hr,cy)
cdCanvasLine(cddbuffer,cx,cy+hr,cx,cy-hr)
end for
cdCanvasFlush(cddbuffer)
return IUP_DEFAULT
end function
function map_cb(Ihandle ih)
IupGLMakeCurrent(ih)
atom res = IupGetDouble(NULL, "SCREENDPI")/25.4
cdCanvas cddbuffer = cdCreateCanvas(CD_GL, "10x10 %g", {res})
IupSetAttributePtr(ih,"DBUFFER",cddbuffer)
cdCanvasSetBackground(cddbuffer, CD_PARCHMENT)
return IUP_DEFAULT
end function
function canvas_resize_cb(Ihandle canvas)
cdCanvas cddbuffer = IupGetAttributePtr(canvas,"DBUFFER")
integer {canvas_width, canvas_height} = IupGetIntInt(canvas, "DRAWSIZE")
atom res = IupGetDouble(NULL, "SCREENDPI")/25.4
cdCanvasSetAttribute(cddbuffer, "SIZE", "%dx%d %g", {canvas_width, canvas_height, res})
return IUP_DEFAULT
end function
constant directions = {{-1,-1,'\\','/'},
{-1, 0,'|','.'},
{+1,-1,'/','\\'},
{ 0,-1,'-','.'}}
function scan_d(integer y, x, dx, dy, bh, bw, xc)
integer count = 0
for i=1 to 4 do
x += dx
y += dy
if x=0 or y=0 or x>bw or y>bh then exit end if
integer link = board[y,x]
if link!='.' and link!=xc then exit end if
x += dx
y += dy
integer tile = board[y,x]
if tile!='O' then exit end if
count += 1
end for
return count
end function
procedure find_valid_moves()
integer bh = length(board),
bw = length(board[1])
valid_moves = {}
for y=1 to bh by 2 do
for x=1 to bw by 2 do
if board[y][x]='.' then
for d=1 to length(directions) do
-- (obviously) this is what we're looking for:
-- OOOO. -2
-- OOO.O -1
-- OO.OO 0
-- O.OOO +1
-- .OOOO +2
-- with lc as count left of dot, and rc right,
-- the (only) "dirty trick" below is "2-lc".
integer {dy, dx, nc, xc} = directions[d]
integer lc = scan_d(y,x,+dx,+dy,bh,bw,xc),
rc = scan_d(y,x,-dx,-dy,bh,bw,xc)
while lc+rc>=4 do
if lc=-1 then ?9/0 end if -- sanity check
sequence move = {x,y,nc&"",2-lc}
if not find(move,valid_moves) then
valid_moves = append(valid_moves,move)
end if
lc -= 1
end while
end for
end if
end for
end for
valid_moves = sort(valid_moves) -- (entirely optional, helps debug)
end procedure
procedure redraw_all()
find_valid_moves() IupUpdate(canvas)
end procedure
procedure adjust_moves(integer dx, dy)
for i=1 to length(playback) do
playback[i][1] += dx
playback[i][2] += dy
end for
for i=1 to length(played) do
played[i][1] += dx
played[i][2] += dy
end for
end procedure
procedure make_move(integer i)
sequence vmi = valid_moves[i]
integer {x, y, {c}, d} = vmi
IupSetStrAttribute(history,"APPENDITEM","%v",{vmi})
played = append(played,vmi)
board[y][x] = 'O'
integer {dy, dx, l, nl} = directions[find(c,vslice(directions,3))],
{ul,dr} = {d*2-3,d*2+3}
-- "" are 1..7, -1..5, -3..3, -5..1, -7..-1
-- for d= +2 +1 0 -1 -2,
-- ie +2: .-O-O-O-O
-- +1: O-.-O-O-O
-- 0: O-O-.-O-O
-- -1: O-O-O-.-O
-- -2: O-O-O-O-.
for j=ul to dr by 2 do -- make lines/links
integer ly = y-j*dy,
lx = x-j*dx,
nc = board[ly][lx]
if nc='.' then
nc = l
elsif nc=nl then
nc = 'X'
else
?9/0
end if
board[ly][lx] = nc
end for
-- then extend board if rqd (maintain a double-space border)
if x=1 then
-- extend left
for i=1 to length(board) do
board[i] = ".."&board[i]
end for
adjust_moves(2,0)
elsif x=length(board[1]) then
-- extend right
for i=1 to length(board) do
board[i] &= ".."
end for
end if
-- (copy the undamaged lines from the other end...)
if y=1 then
-- extend up
board = board[$-1..$]&board
adjust_moves(0,2)
elsif y=length(board) then
-- extend down
board &= board[1..2]
end if
redraw_all()
end procedure
function button_cb(Ihandle /*canvas*/, integer button, pressed, x, y, atom /*pStatus*/)
if button=IUP_BUTTON1 and not pressed then -- (left button released)
sequence possible = {}
for i=1 to length(valid_moves) do
integer {cx,cy} = sq_sub(sq_mul(valid_moves[i][1..2],r),{x,y})
if (cx*cx+cy*cy)<=r2 then
possible &= i
end if
end for
if length(possible)>1 then
-- This needs some kind of popup... (IupPopup, IupMenu, IUP_MOUSEPOS...)
-- with menu entries such as:
-- | +2
-- - -2
-- / +1
-- \ 0
?"ambiguous... (tbc)"
end if
if length(possible)=1 then
integer i = possible[1]
make_move(i)
end if
end if
return IUP_CONTINUE
end function
procedure set_hframe_title()
string title = "History"
if IupGetInt(play178,"ACTIVE") and IupGetInt(play178,"RUNNING") then
string e = elapsed(pause)
e = e[1..find(',',e)-1]
e = e[1..match(" and ",e)-1]
title = sprintf("Playing world record (%s/move)",{e})
end if
IupSetStrAttribute(hframe,"TITLE",title)
end procedure
procedure fill_square(integer x1, x2, y1, y2, ch)
for x=x1 to x2 by 2 do
for y=y1 to y2 by 2 do
board[y][x] = ch
end for
end for
end procedure
procedure new_game()
board = repeat(repeat('.',23),23)
-- solid-fill a big '+'...
fill_square( 3,21, 9,15,'O')
fill_square( 9,15, 3,21,'O')
-- then vacate inner '+'
fill_square( 5,19,11,13,'.')
fill_square(11,13, 5,19,'.')
played = {}
IupSetAttribute(history,"REMOVEITEM","ALL")
IupSetInt(play178,"RUNNING",false)
find_valid_moves()
set_hframe_title()
end procedure
function new_game_cb(Ihandle /*ih*/)
new_game() redraw_all() return IUP_DEFAULT
end function
function exit_cb(Ihandle /*ih*/)
return IUP_CLOSE
end function
function help_cb(Ihandln /*ih*/)
IupMessage("Morpion Solitaire",help_text)
return IUP_DEFAULT
end function
function play178_cb(Ihandln /*ih*/)
sequence text = get_text(p178file,GT_LF_STRIPPED),
res = {}, r
integer dx, dy
bool first = true
for i=1 to length(text) do
string ti = text[i]
if ti[1]!='#' then
r = scanf(ti,iff(first?"(%d,%d)","(%d,%d) %c %d"))
if length(r)!=1 then
IupMessage("Error","Error processing line %d (%s) [%v]",{i,ti,r})
return IUP_DEFAULT
end if
r = r[1]
r[1..2] = sq_mul(r[1..2],2)
if first then
{dy,dx} = sq_sub(9,r)
first = false
else
r[1] += dy
r[2] += dx
res = append(res,r)
end if
end if
end for
new_game()
playback = res
IupSetInt(play178,"RUNNING",true)
set_hframe_title()
IupSetInt(timer,"RUN",true)
return IUP_DEFAULT
end function
function timer_cb(Ihandle /*ih*/)
if length(playback)=0 then
IupSetInt(timer,"RUN",false)
else
sequence move = playback[1]
integer p = find(move,valid_moves)
if p=0 then ?9/0 end if
playback = playback[2..$]
make_move(p)
end if
return IUP_DEFAULT
end function
function key_cb(Ihandle /*dlg*/, atom c)
if c=K_ESC then return IUP_CLOSE
elsif c=K_F1 then return help_cb(NULL)
elsif c='?' then ?valid_moves
elsif find(c,"+-") then
--(Initially 1s/move: you cannot actually stop it,
-- but 20+ makes it wait 6 days between moves,
-- and obviously 20- makes it finish in 0.0001s)
if c='+' and pause<250000000 then
pause *= 2
elsif c='-' and pause>0.01 then
pause /= 2
end if
set_hframe_title()
IupSetInt(timer,"TIME",round(pause*1000))
if IupGetInt(timer,"RUN") then
-- restart needed to apply new TIME
IupSetInt(timer,"RUN",false)
IupSetInt(timer,"RUN",true)
end if
end if
return IUP_CONTINUE
end function
procedure main()
IupOpen()
canvas = IupGLCanvas("RASTERSIZE=200x200")
history = IupList("VISIBLELINES=10, EXPAND=YES")
hframe = IupFrame(history,"TITLE=History, PADDING=5x4")
play178 = IupButton("Play 178",Icallback("play178_cb"),"PADDING=5x4")
IupSetInt(play178,"RUNNING",false)
Ihandle newgame = IupButton("New Game",Icallback("new_game_cb"),"PADDING=5x4"),
help = IupButton("Help (F1)",Icallback("help_cb"),"PADDING=5x4"),
quit = IupButton("E&xit",Icallback("exit_cb"),"PADDING=5x4"),
buttons = IupHbox({newgame,IupFill(),help,IupFill(),play178,IupFill(),quit}),
full = IupHbox({canvas,IupVbox({hframe,buttons})})
IupSetInt(play178,"ACTIVE",file_exists(p178file))
IupSetCallbacks({canvas}, {"ACTION", Icallback("redraw_cb"),
"MAP_CB", Icallback("map_cb"),
"RESIZE_CB", Icallback("canvas_resize_cb"),
"BUTTON_CB", Icallback("button_cb")})
dlg = IupDialog(IupHbox({full},"MARGIN=3x3"),"TITLE=\"Morpion Solitaire\"")
IupSetCallback(dlg, "K_ANY", Icallback("key_cb"))
new_game()
IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
IupSetAttribute(dlg, "RASTERSIZE", NULL)
IupSetStrAttribute(dlg, "MINSIZE", IupGetAttribute(dlg,"RASTERSIZE"))
timer = IupTimer(Icallback("timer_cb"), 1000, active:=false)
IupMainLoop()
IupClose()
end procedure
main()</lang>