2048: Difference between revisions

Line 9,868:

Faithful desktop gui reproduction of the above link (https://gabrielecirulli.github.io/2048/)

Now I just got figure out how to win...

<lang Phix>--

-- demo\rosetta\2048.exw

-- demo\rosetta\2048.exw

include pGUI.e

--

include pGUI.e

Ihandle canvas, dialog

cdCanvas cddbuffer, cdcanvas

Ihandle canvas, dialog

cdCanvas cddbuffer, cdcanvas

constant tile_colours = {#CCC0B4, -- blank

#EEE4DA, -- 2

constant tile_colours = {#CCC0B4, -- blank

#EDE0C8, -- 4

#EEE4DA, -- 2

#F2B179, -- 8

#EDE0C8, -- 4

#F59563, -- 16

#F2B179, -- 8

#F67C5F, -- 32

#F59563, -- 16

#F65E3B, -- 64

#F67C5F, -- 32

#EDCF72, -- 128

#F65E3B, -- 64

#EDCC61, -- 256

#EDCF72, -- 128

#EDC850, -- 512

#EDCC61, -- 256

#EDC53F, -- 1024

#EDC850, -- 512

#EDC22E} -- 2048

#EDC53F, -- 1024

#EDC22E} -- 2048

-- the 4x4 board.

-- note that values are [1..12] for [blank,2,4,8,..2048].

-- the 4x4 board.

-- (merging two eights is not 8+8->16 but 4+1->5, internally)

-- note that values are [1..12] for [blank,2,4,8,..2048].

sequence board

-- (merging two eights is not 8+8->16 but 4+1->5, internally)

sequence board

integer newgame = 1,

valid = 0,

integer newgame = 1

prev, nxt, bxy

procedure add_rand(integer count)

procedure add_rand(integer count)

-- (nb infinite loop if board is full)

-- (nb infinite loop if board is full)

integer x, y

integer x, y

while count do

while count do

x = rand(4)

x = rand(4)

y = rand(4)

y = rand(4)

if board[y][x]=1 then -- blank

if board[y][x]=1 then -- blank

board[y][x] = 2+(rand(10)=10)

board[y][x] = 2+(rand(10)=10)

count -= 1

count -= 1

end if

end if

end while

end while

end procedure

end procedure

integer valid = 0

procedure move_x(integer x, y, d)

integer prev, nxt, bxy

bxy = board[x][y]

if bxy!=1 then

procedure move_x(integer x, integer y, integer d)

if bxy=prev then

bxy = board[x][y]

board[x][y] = 1

if bxy!=1 then

bxy += 1

if bxy=prev then

board[x][nxt] = bxy

board[x][y] = 1

nxt += d

bxy += 1

prev = 13

board[x][nxt] = bxy

valid = 1

nxt += d

~~prev~~ = 13

else

if prev=1

valid = 1

or y!=nxt then

else

if prev!=1

if prev=1

and prev!=13 then

or y!=nxt then

nxt += d

if prev!=1

end if

and prev!=13 then

if y!=nxt then

nxt += d

board[x][y] = 1

end if

board[x][nxt] = bxy

if y!=nxt then

valid = 1

board[x][y] = 1

~~board[x][nxt]~~ = ~~bxy~~

end if

valid = 1

prev = bxy

end if

end if

end if

end if

prev = bxy

end procedure

end if

procedure move_y(integer x, y, d)

end procedure

bxy = board[x][y]

if bxy!=1 then

procedure move_y(integer x, integer y, integer d)

if bxy=prev then

bxy = board[x][y]

board[x][y] = 1

if bxy!=1 then

bxy += 1

if bxy=prev then

board[nxt][y] = bxy

board[x][y] = 1

nxt += d

bxy += 1

prev = 13

board[nxt][y] = bxy

valid = 1

nxt += d

~~prev~~ = 13

else

if prev=1

valid = 1

or x!=nxt then

else

if prev!=1

if prev=1

and prev!=13 then

or x!=nxt then

nxt += d

if prev!=1

end if

and prev!=13 then

if x!=nxt then

nxt += d

board[x][y] = 1

end if

board[nxt][y] = bxy

if x!=nxt then

valid = 1

board[x][y] = 1

~~board[nxt][y]~~ = ~~bxy~~

end if

valid = 1

prev = bxy

end if

end if

end if

end if

prev = bxy

end procedure

end if

function move(integer key)

end procedure

-- a non-zero result means it changed something.

valid = 0

function move(integer key)

if key=K_LEFT then

-- a non-zero result means it changed something.

for x=1 to 4 do

valid = 0

prev = 13

if key=K_LEFT then

nxt = 1

for x=1 to 4 do

for y=1 to 4 do

prev = 13

move_x(x,y,+1)

nxt = 1

end for

for y=1 to 4 do

end for

move_x(x,y,+1)

elsif key=K_UP then

end for

for y=1 to 4 do

end for

prev = 13

elsif key=K_UP then

nxt = 4

for y=1 to 4 do

for x=4 to 1 by -1 do

prev = 13

move_y(x,y,-1)

nxt = 4

end for

for x=4 to 1 by -1 do

end for

move_y(x,y,-1)

elsif key=K_RIGHT then

end for

for x=1 to 4 do

end for

prev = 13

elsif key=K_RIGHT then

nxt = 4

for x=1 to 4 do

for y=4 to 1 by -1 do

prev = 13

move_x(x,y,-1)

nxt = 4

end for

for y=4 to 1 by -1 do

end for

move_x(x,y,-1)

elsif key=K_DOWN then

end for

for y=1 to 4 do

end for

prev = 13

elsif key=K_DOWN then

nxt = 1

for y=1 to 4 do

for x=1 to 4 do

prev = 13

move_y(x,y,+1)

nxt = 1

end for

for x=1 to 4 do

end for

move_y(x,y,+1)

end if

end for

return valid

end for

end function

end if

return valid

function game_won()

end function

for i=1 to length(board) do

if find(12,board[i]) then return 1 end if

function game_won()

end for

for i=1 to length(board) do

return 0

if find(12,board[i]) then return 1 end if

end function

end for

return 0

constant valid_keys = {K_LEFT,K_DOWN,K_RIGHT,K_UP}

end function

function no_valid_moves()

constant valid_keys = {K_LEFT,K_DOWN,K_RIGHT,K_UP}

sequence saved_board = board

for i=1 to length(valid_keys) do

function no_valid_moves()

if move(valid_keys[i]) then

sequence saved_board = board

board = saved_board

for i=1 to length(valid_keys) do

return 0 -- OK

if move(valid_keys[i]) then

end if

board = saved_board

end for

return 0 -- OK

return 1 -- game over...

end if

end function

end for

return 1 -- game over...

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)

end function

integer tx, ty, bxy,

ox,oy, -- top right coords

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)

os,ts, -- overall and tile size

integer tx, ty, bxy,

ts2, -- half tile, for number positioning

ox,oy, -- top right coords

{dw,dh} = IupGetIntInt(canvas, "DRAWSIZE")

os,ts, -- overall and tile size

if dw>=dh then

ts2 -- half tile, for number positioning

ox = floor((dw-dh)/2)

integer {dw,dh} = IupGetIntInt(canvas, "DRAWSIZE")

oy = 0

if dw>=dh then

os = dh

ox = floor((dw-dh)/2)

else

oy = 0

ox = 0

os = dh

oy = floor((dh-dw)/2)

else

os = dw

ox = 0

end if

oy = floor((dh-dw)/2)

ts = floor((os-10)/4-7)

os = dw

ts2 = floor(ts/2+5)-10

end if

ts = floor((os-10)/4-7)

if newgame then

ts2 = floor(ts/2+5)-10

board = repeat(repeat(1,4),4)

add_rand(2)

if newgame then

newgame = 0

board = repeat(repeat(1,4),4)

end if

add_rand(2)

newgame = 0

cdCanvasActivate(cddbuffer)

end if

cdCanvasSetBackground(cddbuffer, #FAF8EF)

cdCanvasClear(cddbuffer)

cdCanvasActivate(cddbuffer)

cdCanvasSetForeground(cddbuffer, #BBADA0)

cdCanvasSetBackground(cddbuffer, #FAF8EF)

cdCanvasRoundedBox(cddbuffer, ox+5, ox+os-5, oy+5, oy+os-5, 10, 10)

cdCanvasClear(cddbuffer)

cdCanvasSetForeground(cddbuffer, #BBADA0)

tx = ox+15

cdCanvasRoundedBox(cddbuffer, ox+5, ox+os-5, oy+5, oy+os-5, 10, 10)

for y=1 to 4 do

ty = oy+15

tx = ox+15

for x=1 to 4 do

for y=1 to 4 do

bxy = board[x][y]

ty = oy+15

cdCanvasSetForeground(cddbuffer, tile_colours[bxy])

for x=1 to 4 do

cdCanvasRoundedBox(cddbuffer, tx, tx+ts-10, ty, ty+ts-10, 5, 5)

bxy = board[x][y]

if bxy>1 then

cdCanvasSetForeground(cddbuffer, tile_colours[bxy])

cdCanvasSetForeground(cddbuffer, iff(bxy<=3?#776E65:#F9F6F2))

cdCanvasRoundedBox(cddbuffer, tx, tx+ts-10, ty, ty+ts-10, 5, 5)

cdCanvasFont(cddbuffer, "Calibri", CD_BOLD, iff(bxy>10?32:40))

if bxy>1 then

cdCanvasText(cddbuffer, tx+ts2, ty+ts2-25-iff(bxy<11?7:0), sprint(power(2,bxy-1)))

cdCanvasSetForeground(cddbuffer, iff(bxy<=3?#776E65:#F9F6F2))

end if

cdCanvasFont(cddbuffer, "Calibri", CD_BOLD, iff(bxy>10?32:40))

ty += ts+5

cdCanvasText(cddbuffer, tx+ts2, ty+ts2-25-iff(bxy<11?7:0), sprint(power(2,bxy-1)))

end for

end if

tx += ts+5

ty += ts+5

end for

end for

cdCanvasFlush(cddbuffer)

tx += ts+5

return IUP_DEFAULT

end for

end function

cdCanvasFlush(cddbuffer)

return IUP_DEFAULT

function map_cb(Ihandle ih)

end function

cdcanvas = cdCreateCanvas(CD_IUP, ih)

cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)

function map_cb(Ihandle ih)

{} = cdCanvasTextAlignment(cddbuffer, CD_SOUTH)

cdcanvas = cdCreateCanvas(CD_IUP, ih)

return IUP_DEFAULT

cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)

end function

{} = cdCanvasTextAlignment(cddbuffer, CD_SOUTH)

return IUP_DEFAULT

function key_cb(Ihandle /*ih*/, atom c)

end function

if c=K_ESC then return IUP_CLOSE end if

if find(c,valid_keys) then

function key_cb(Ihandle /*ih*/, atom c)

if move(c) then

if c=K_ESC then return IUP_CLOSE end if

IupUpdate(canvas)

if find(c,valid_keys) then

string mbmsg = ""

if move(c) then

if game_won() then

IupUpdate(canvas)

mbmsg = "!!!YOU WON!!!\n\nAnother Go?"

string mbmsg = ""

if ~~game_won()~~ ~~then~~

else

add_rand(1)

mbmsg = "!!!YOU WON!!!\n\nAnother Go?"

-- repaintWindow(main)

else

IupUpdate(canvas)

add_rand(1)

if no_valid_moves() then

-- repaintWindow(main)

mbmsg = "You Lost.\n\nAnother Go?"

IupUpdate(canvas)

end if

if no_valid_moves() then

end if

mbmsg = "You Lost.\n\nAnother Go?"

if length(mbmsg) then

end if

if IupAlarm("Game Over",mbmsg,"Yes","No")=1 then

end if

newgame=1

if length(mbmsg) then

if ~~IupAlarm(~~"~~Game~~ ~~Over~~"~~,mbmsg,"Yes","No")=1 then~~

else

return IUP_CLOSE

newgame=1

end if

else

end if

return IUP_CLOSE

end if

end if

IupUpdate(canvas)

end if

end if

end if

return IUP_CONTINUE

IupUpdate(canvas)

end function

end if

return IUP_CONTINUE

procedure main()

end function

IupOpen()

procedure main()

canvas = IupCanvas("RASTERSIZE=520x540")

IupOpen()

IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))

IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))

canvas = IupCanvas("RASTERSIZE=520x540")

IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))

dialog = IupDialog(canvas,"MINSIZE=440x450")

IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))

IupSetAttribute(dialog,"TITLE","2048");

IupSetCallback(dialog, "K_ANY", Icallback("key_cb"));

dialog = IupDialog(canvas,"MINSIZE=440x450")

IupSetAttribute(dialog,"TITLE","2048");

IupShow(dialog)

IupSetCallback(dialog, "K_ANY", Icallback("key_cb"));

IupSetAttribute(canvas, "RASTERSIZE", NULL)

IupShow(dialog)

if platform()!=JS then

IupSetAttribute(canvas, "RASTERSIZE", NULL)

IupMainLoop()

IupClose()

IupMainLoop()

end if

IupClose()

end procedure

end procedure

main()

main()</lang>

=={{header|PHP}}==