--!name Backgammon
--!icon game
--!category Games
local X={{},{}}for a=1,6 do X[1][a]=("acegik"):sub(a,a)X[2][a]=("bdfhjl"):sub(a,a)end local aR,aW="123456","789:;<"local b_={"NOP","QRS"}local p={{},{}}for b=1,2 do for a=0,25 do p[b][a]=0 end end local function bx(m)if m>=19 then return m-11,true elseif m>=13 then return m-12,true elseif m>=7 then return 13-m,false end return 14-m,false end local function ac(m,h)local l,am=bx(m)return(am and h or 14-h)*16+l+1 end local function bu(b,h)return(b==1 and 5-h or 9+h)*16+8 end local function bi(H)return H*16 end local w,bk={},("M"):rep(15).." "for H=1,15 do for l=0,15 do w[(H-1)*16+l+1]=(l==0 or l==7 or l==14)and"M"or" "end end for m=1,24 do local bc=m%2==1 and"ABCDEF"or"GHIJKL"for h=0,5 do w[ac(m,h)]=bc:sub(h+1,h+1)end end local bV=table.concat(w)local function aq(d)local a=25 while a>0 and d[a]==0 do a=a-1 end return a end local function aY(d,j,i,g,G)if d[i]==0 or(d[25]>0 and i~=25)then return false end local c=i-g if c>=1 then return j[25-c]<2 end return G<=6 and(c==0 or i==G)end local function aG(d,j,i,g)d[i]=d[i]-1 local c=i-g if c<1 then d[0]=d[0]+1 return false end d[c]=d[c]+1 if j[25-c]==1 then j[25-c]=0 j[25]=j[25]+1 return true end return false end local function aC(d,j,i,g,b4)d[i]=d[i]+1 local c=i-g if c<1 then d[0]=d[0]-1 return end d[c]=d[c]-1 if b4 then j[25-c]=1 j[25]=j[25]-1 end end local function a0(d,j,n,f)if f==0 then return 0 end local G,u=aq(d),0 local ah=d[25]>0 and 25 or 1 for h=1,f do local g=n[h]if h==1 or g~=n[1]then for i=G,ah,-1 do if d[i]>0 and aY(d,j,i,g,G)then local O=aG(d,j,i,g)n[h]=n[f];n[f]=g local e=1+a0(d,j,n,f-1)n[f]=n[h];n[h]=g aC(d,j,i,g,O)if e>u then u=e if e==f then return f end end end end end end return u end local v,A,N,F=1,{1,2},{},{}local function a3()local d,j,n=p[v],p[3-v],N local f=#n local a1=a0(d,j,n,f)local ai={}if a1==0 then return ai end local G,ao=aq(d),0 local ah=d[25]>0 and 25 or 1 for h=1,f do local g=n[h]if h==1 or g~=n[1]then for i=G,ah,-1 do if d[i]>0 and aY(d,j,i,g,G)then local O=aG(d,j,i,g)n[h]=n[f];n[f]=g local e=1+a0(d,j,n,f-1)n[f]=n[h];n[h]=g aC(d,j,i,g,O)if e==a1 then ai[#ai+1]=i*8+g if g>ao then ao=g end end end end end end if a1==1 and f==2 and n[1]~=n[2]then local a2={}for C,s in ipairs(ai)do if s%8==ao then a2[#a2+1]=s end end ai=a2 end return ai end local I,bW=0,4800 local bZ={11,12,14,15,15,17,6,6,5,3,2,3}local bY={1,1.5,2.5,4,5,4.5,3.5,2.5,1.5,1,0.5,0.3,0.3,0.2,0.2,0.2,0.3,1,2,3,2.5,1.5,1,0.8}local function b3(d,j,J)local a6,a9=25*d[25],25*j[25]local a5,a8=d[25]>0 and 25 or 0,j[25]>0 and 25 or 0 for a=1,24 do local s,as=d[a],j[a]if s>0 then a6=a6+s*a if a5<a then a5=a end end if as>0 then a9=a9+as*a if a8<a then a8=a end end end local e=a9-a6 if a5+a8<=25 then e=e+2*d[0]for a=1,6 do if d[a]>0 then e=e+0.3 end end return e end local aH,at=0,0 for a=1,6 do if d[a]>1 then aH=aH+1 end if j[a]>1 then at=at+1 end end e=e+j[25]*(3+aH*aH*0.5)-d[25]*at*at*0.5 local aw,u=0,0 for a=1,24 do local s=d[a]if s>1 then e=e+(J==1 and 1.5 or bY[a])aw=aw+1 if aw>u then u=aw end if s>3 then e=e-(s-3)*0.5 end else aw=0 if s==1 then if J==1 then e=e-3 else local b,ad=0,a<12 and a or 12 I=I+ad//2 for g=1,ad do local h=a-g if(h==0 and j[25]or j[25-h])>0 then b=b+bZ[g]end end if b>0 then e=e-(b>30 and 30 or b)/36*(29-a+2*at)end end end end end if u>2 then e=e+u*u*0.6 end return e end local bq,br,bm={},{},false do local a=0 for e in("257 -669 -1661 -2025 -2534 -161 -1117 -1067 -928 -1996 -1104 -808 99 -621 -1280 -592 -737 890 -389 -1598 ".."-1502 -610 1562 -474 -1804 -834 -977 -1414 245 110 -1365 -1056 1154 111 -383 -748 -592 811 -395 114 -732 -561 ".."1098 160 138 -1184 -434 1062 -213 48 -944 -230 1227 -131 -63 -759 -137 1784 304 368 -699 130 1231 409 -211 -641 ".."311 1596 657 254 -808 82 1790 543 412 -1062 79 2015 498 919 -908 59 1831 587 1288 -837 -332 2650 527 821 -589 ".."-1182 3358 620 574 -73 -362 4377 455 217 105 -620 3540 46 -181 632 -870 2477 -480 -1272 865 -1113 1246 -824 ".."-2771 1236 -1595 104 -1302 -4115 5626 -2758 0 -172 270 299 -85 0 -1404 -1051 72 -14 0 -1295 -2162 132 -1035 0 ".."-2298 -2346 173 83 0 -1273 -2874 -75 -342 0 -1346 -2466 -130 -16 0 274 600 483 252 0 395 682 53 93 0 249 -68 ".."-376 57 0 174 4 744 6 0 124 312 -910 -163 0 14 -108 -28 -880 0 1073 2004 1162 225 0 856 1063 1495 190 0 372 ".."-504 -148 120 0 137 140 1112 -127 0 -221 202 -63 -527 0 -136 -194 -93 -1261 0 3055 5169 1507 5350 0 2196 3854 ".."883 2301 0 923 1087 -117 -786 0 -98 -830 -1092 -4943 0 -1003 -3665 -2569 -9677 0 -2780 -7267 -3402 -12323 0 3420"):gmatch("%S+")do if a<122 then bq[a]=tonumber(e)/1000 else br[a-122]=tonumber(e)/1000 end a=a+1 end end local function ch(d,j)if d[0]==15 then return 1e7 end local Z=bm and br or bq local e=j[25]/2*Z[120]+d[0]/15*Z[121]for a=1,24 do local q,f=(24-a)*5,d[a]if f==0 then if j[25-a]==1 then e=e+Z[q]end elseif f==1 then e=e+Z[q+1]else e=e+Z[q+2]if f==3 then e=e+Z[q+3]elseif f>3 then e=e+Z[q+4]*(f-3)/2 end end end return e end local ck=function(d,j,J)if J==3 then return ch(d,j)end return b3(d,j,J)end local bo,bp,aV,aU,aT,bn=nil,nil,nil,false,{},nil local function bK(f,bj,bD)local d,j,n=bo,bp,aV if I>=bW then I=0;coroutine.yield()end local G=aq(d)local ah=d[25]>0 and 25 or 1 local am=G<bD and G or bD local bt=false I=I+3+(25-G)//5 for h=1,f do local g=n[h]if h==1 or g~=n[1]then I=I+(am-ah)//5 for i=am,ah,-1 do if d[i]>0 and aY(d,j,i,g,G)then bt=true I=I+3 local O=aG(d,j,i,g)aT[bj+1]=i*16+g+(O and 512 or 0)n[h]=n[f];n[f]=g bK(f-1,bj+1,aU and i or 25)n[f]=n[h];n[h]=g aC(d,j,i,g,O)end end end end if not bt then bn(bj)end end local bX={10,1,0}local function co(b,o,y,J)local d,j={},{}for a=0,25 do d[a]=p[b][a]j[a]=p[3-b][a]end bo,bp,aU=d,j,o==y aV=aU and{o,o,o,o}or{o,y}local ao=o>y and o or y bm=aq(d)+aq(j)<=25 local u,aD,a4={},nil,0 bn=function(f)if f<a4 or f==0 then return end if f>a4 then a4,aD,u=f,nil,{}end I=I+25 local e=ck(d,j,J)+math.random()*bX[J]if f==1 and aT[1]%16==ao then e=e+1e6 end if not aD or e>aD then aD=e for a=1,f do u[a]=aT[a]end end end bK(#aV,0,25)return u end local L,R,ap,al=1,2,false,false local Y={0,0,0,0,0,0,0,0,0,0,0,0}local U,Q,ag={},{0,0},"n"local E,z,r={},nil,"move"local S,K,t,x,az,ax="menu",1,nil,25,{},true local aA={"Easy","Medium","Hard"}local bl={""," a gammon"," a backgammon"}local function bB(b)return L==2 or b==1 end local function T(b)if L==1 then return b==1 and"You"or"Computer"end return b==1 and"White"or"Black"end local function bU(g)for a=1,#N do if N[a]==g then table.remove(N,a)return end end end local function bM()local o,y=A[1],A[2]N=o==y and{o,o,o,o}or{o,y}for C,l in ipairs(F)do bU(l%16)end end local function aZ()z=nil for b=1,2 do if p[b][0]==15 then local k,ba=p[3-b],1 if k[0]==0 then ba=2 for a=19,25 do if k[a]>0 then ba=3 end end end z={b,ba}end end return z end local function bP()if L~=1 or ap or not z then return end ap=true local q,aN=(R-1)*4,z[1]==1 Y[q+(aN and 1 or 2)]=Y[q+(aN and 1 or 2)]+1 Y[q+(aN and 3 or 4)]=Y[q+(aN and 3 or 4)]+z[2]end local function bO(k)local c={}for a,l in ipairs(k)do c[a]=string.char(64+l%512//16,(l>=512 and 96 or 48)+l%16)end return table.concat(c)end local function bN(b)local k={}for a=1,#b-1,2 do local ad=b:byte(a+1)k[#k+1]=(b:byte(a)-64)*16+(ad>=96 and ad-96+512 or ad-48)end return k end local function bI(cr)local c={}for b=1,2 do for a=0,25 do c[#c+1]=string.char(65+p[b][a])end end return table.concat(c)..v..A[1]..A[2]..ag..Q[1]..Q[2]..bO(U)..";"..(cr and bO(F)or"")end local function bH(H)if#H<59 then return false end local bQ,o,y,b8,cc,cd,cg,cp=H:sub(53):match("^([12])([1-6])([1-6])([omn])(%d)(%d)([^;]*);(.*)$")if not bQ then return false end local ay={{},{}}for b=1,2 do local f=0 for a=0,25 do local e=H:byte((b-1)*26+a+1)-65 if e<0 or e>15 then return false end ay[b][a]=e f=f+e end if f~=15 then return false end end for a=1,24 do if ay[1][a]>0 and ay[2][25-a]>0 then return false end end p=ay v,A,ag=tonumber(bQ),{tonumber(o),tonumber(y)},b8 Q,U,F={tonumber(cc),tonumber(cd)},bN(cg),bN(cp)bM()return true end local function ak()local c={"B1",L,R,ap and 1 or 0,"|",table.concat(Y,","),"|",bI(true)}for C,O in ipairs(E)do c[#c+1]="|"..O end snail.save(table.concat(c))end local function cj()local b=snail.load()if type(b)~="string"then return false end local aI,J,b2,cm,ci=b:match("^B1([12])([123])([01])|([%d,]+)|(.*)$")if not aI then return false end local aj={}for m in ci:gmatch("[^|]+")do aj[#aj+1]=m end if not aj[1]or not bH(aj[1])then return false end local a=0 for e in cm:gmatch("%d+")do a=a+1 if a<=12 then Y[a]=tonumber(e)end end L,R,ap=tonumber(aI),tonumber(J),b2=="1"E={}for ab=2,#aj do E[#E+1]=aj[ab]end return true end local function av()az=a3()if#az>0 then r="move"else r=#F==0 and"pass"or"done"end end local be,bg,ae local function bv(b,o,y)v,F,t=b,{},nil if not o then o,y=math.random(6),math.random(6)end A={o,y}bM()if bB(b)then E[#E+1]=bI(false)if#E>6 then table.remove(E,1)end av()ae()else be()end ak()end local function ca(aI)bg()L,al,ap,z=aI,true,false,nil for b=1,2 do for a=0,25 do p[b][a]=0 end p[b][24],p[b][13],p[b][8],p[b][6]=2,5,3,5 end E,U,ax,S={},{},true,"play"local B,q repeat B,q=math.random(6),math.random(6)until B~=q ag,Q="o",{B,q}bv(B>q and 1 or 2,B,q)end local function bf(i,g)local O=aG(p[v],p[3-v],i,g)F[#F+1]=i*16+g+(O and 512 or 0)bU(g)end local function bA()U,Q,ag,ax=F,A,"m",true bv(3-v)end local function ce(i,g)bf(i,g)ax,t=false,nil if aZ()then r="over"bP()else av()end ak()end local function cq()local l=table.remove(F)local g=l%16 aC(p[v],p[3-v],l%512//16,g,l>=512)N[#N+1]=g av()ak()end local V,aB,an=nil,0,nil bg=function()V,an=nil,nil snail.tick(0)end be=function()r,aB,an="ai",0,nil local b,o,y,J=v,A[1],A[2],R I=0 V=coroutine.create(function()return co(b,o,y,J)end)snail.tick(450)end local function bs()if not V then return end local cb,s=coroutine.resume(V)if coroutine.status(V)=="dead"then V=nil an=cb and s or false end end local function b0()snail.tick(0)local bL=an an,F=nil,{}if bL then for C,l in ipairs(bL)do bf(l%512//16,l%16)end else local k=a3()while#k>0 do bf(k[1]//8,k[1]%8)k=a3()end end if aZ()then r="over"bP()ak()else bA()end end function tick()if r~="ai"then snail.tick(0)return end aB=aB+1 if V then bs()if V then snail.after(bs)end elseif aB>=2 then b0()end end local function bT()local f=#E if r=="ai"or r=="over"then return f>0 and f or nil end return f>1 and f-1 or nil end local function cn()local a=bT()if not a then return end bg()local H=E[a]for ab=#E,a+1,-1 do E[ab]=nil end bH(H)z,ax,t,S=nil,true,nil,"play"av()ae()ak()end local function cl()local c,M={},{}for C,s in ipairs(az)do local i=s//8 if not M[i]then M[i]=true c[#c+1]=i end end return c end local function aM()local c,aa={},{}for C,s in ipairs(az)do if s//8==t then local g=s%8 local D=t-g if D<0 then D=0 end if not aa[D]then c[#c+1]=D aa[D]=g elseif g<aa[D]then aa[D]=g end end end return c,aa end local function aL()local c={}if r=="move"and not z then c=t and aM()or cl()if t then c[#c+1]=t end end local M={}for C,e in ipairs(c)do M[e]=true end return c,M end local function aP(k)if k==25 then return 7,v==1 and 4 or 12 end if k<=0 then return 15,v==1 and 10 or 6 end local l,am=bx(v==1 and k or 25-k)return l,am and 1 or 15 end ae=function()local c,M=aL()if#c==0 or M[x]then return end local aE,aF=aP(x)local u,_ for C,e in ipairs(c)do local aO,aQ=aP(e)local l=(aO-aE)^2+(aQ-aF)^2 if e~=t and(not _ or l<_)then u,_=e,l end end x=u or x end local function b6(by,bz)local c=aL()local aE,aF=aP(x)local u,_ for aJ=1,3 do for C,e in ipairs(c)do local aO,aQ=aP(e)local m=(aO-aE)*by+(aQ-aF)*bz local b=math.abs((aO-aE)*bz)+math.abs((aQ-aF)*by)if aJ==3 then m=-m end if e~=x and m>0 and(aJ~=1 or b<=m)then local l=aJ==1 and m*2+b or aJ==2 and m+b*3 or b-m*2 if not _ or l<_ then u,_=e,l end end end if u then break end end if u then x=u end end local function bE()local c={}if al then c[#c+1]={"Back to the game","resume"}end c[#c+1]={"New game against the computer","1"}c[#c+1]={"New game, two players","2"}c[#c+1]={"Computer level: "..aA[R],"lvl"}if al and bT()then c[#c+1]={"Take back a move","undo"}end return c end local aS={up={0,-1},down={0,1},left={-1,0},right={1,0}}function key(h)if S=="menu"then local P=bE()if K>#P then K=#P end if h=="up"then K=(K-2)%#P+1 elseif h=="down"then K=K%#P+1 elseif h=="ok"or((h=="left"or h=="right")and P[K][2]=="lvl")then local B=P[K][2]if B=="resume"then S="play"elseif B=="1"or B=="2"then ca(tonumber(B))elseif B=="lvl"then R=(R+(h=="left"and 1 or 0))%3+1 if al then ak()end elseif B=="undo"then cn()end end return end if h=="top"then if t then x,t=t,nil elseif(r=="move"or r=="done")and#F>0 then cq()ae()else S,K="menu",1 end return end if r=="over"then if h=="ok"then S,K="menu",L+1 end return end if r=="pass"or r=="done"then if h=="ok"then bA()end return end if r~="move"then return end if h=="ok"then local C,M=aL()if not t then if M[x]then t=x x=aM()[1]end elseif x==t then t=nil elseif M[x]then local C,aa=aM()local D=x ce(t,aa[D])if D>0 then x=D end ae()end elseif aS[h]then b6(aS[h][1],aS[h][2])end end local function bh(b,k)local f=p[b][k]local h=f>6 and 4 or f-1 if k==25 then return bu(b,h)end return ac(b==1 and k or 25-k,h)end local function bC(b,k)local f=p[b][k]return ac(b==1 and k or 25-k,f>5 and 5 or f)end local function bd(b,f,bw,B,q)for h=0,f>6 and 4 or f-1 do w[bw(B,h,q)]=X[b][1]end if f>6 then w[bw(B,5,q)]="{"..f.."}"end end local function b1()for a=1,240 do w[a]=bV:sub(a,a)end for m=1,24 do local W,q=p[1][m],p[2][25-m]if W>0 then bd(1,W,ac,m)elseif q>0 then bd(2,q,ac,m)end end for b=1,2 do bd(b,p[b][25],bu,b)local a7=p[b][0]for ab=0,4 do local s=a7-3*ab if s>0 then w[bi(b==1 and 15-ab or 1+ab)]=b_[b]:sub(s>3 and 3 or s,s>3 and 3 or s)end end if a7>0 then w[bi(b==1 and 9 or 7)]="{"..a7.."}"end end local b=v if ax and not z and#U>0 then local au,ar=3-b,{}for C,l in ipairs(U)do local i,c=l%512//16,l%512//16-l%16 if i<25 then ar[i]=(ar[i]or 0)-1 end if c>=1 then ar[c]=(ar[c]or 0)+1 end end for k,e in pairs(ar)do if e<0 and p[au][k]<6 then w[bC(au,k)]="u"elseif e>0 and p[au][k]>0 then w[bh(au,k)]=X[au][6]end end end if r~="over"then local o,y=A[1],A[2]local aX=7*16+(b==1 and 8 or 1)+1 if o==y then for a=1,4 do local bc=a<=4-#N and aW or aR w[aX+a]=bc:sub(o,o)end else local bR,bS=true,true for C,g in ipairs(N)do if g==o then bR=false elseif g==y then bS=false end end w[aX+2]=(bR and aW or aR):sub(o,o)w[aX+3]=(bS and aW or aR):sub(y,y)end end if r=="move"and S=="play"then if t then w[bh(b,t)]=X[b][x==t and 2 or 3]local as=3-b for C,k in ipairs((aM()))do local a_=k==x if k==0 then w[bi(b==1 and 10 or 6)]=a_ and"s"or"r"elseif p[as][25-k]==1 then w[ac(b==1 and k or 25-k,0)]=X[as][a_ and 5 or 4]else w[bC(b,k)]=a_ and"q"or"p"end end else local C,M=aL()if M[x]then w[bh(b,x)]=X[b][2]end end end local bb={bk}for H=0,14 do bb[H+2]=table.concat(w,"",H*16+1,H*16+16)end bb[17]=bk return table.concat(bb,"/")end local function aK(b)local d,f=p[b],0 for a=1,25 do f=f+d[a]*a end return f end local function bG(k)local c={}for a,l in ipairs(k)do local i=l%512//16 local D=i-l%16 c[a]=(i==25 and"bar"or i).."/"..(D<1 and"off"or D)..(l>=512 and"*"or"")end return table.concat(c," ")end local function bJ()local W,m=z[1],z[2]if L==1 then return(W==1 and"You win"or"Computer wins")..bl[m]..(W==1 and"!"or".")end return T(W).." wins"..bl[m].."!"end local function cf()if z then local m=z[2]return"Worth "..m..(m==1 and" point"or" points")..". OK for the menu."end if r=="ai"then return"Computer rolled "..A[1].."-"..A[2].."."end local bF=L==1 and""or T(v)..": "if r=="pass"then return bF.."No legal move. OK to pass."end if r=="done"then return bF.."Done. OK ends the turn."end if t then return"Choose where it goes."end return(L==1 and"You play "or T(v).." plays ")..table.concat(N,"-")..": pick a checker."end local function b7()if z then return T(v).." "..A[1].."-"..A[2]..": "..bG(F)end if ag=="o"then return"Opening roll: "..T(1).." "..Q[1]..", "..T(2).." "..Q[2]end if ag=="m"then return T(3-v).." "..Q[1].."-"..Q[2]..": "..(#U>0 and bG(U)or"no move")end end function draw()if S=="menu"then snail.title("Backgammon")local P=bE()local b9=K>#P and#P or K for a,b5 in ipairs(P)do snail.row(b5[1],a==b9)end snail.gap()if al then local W=L==2 and"Two players"or("You play White, "..aA[R])snail.small(W..(z and(". "..bJ())or(". Pips "..aK(1).."-"..aK(2)..".")))else snail.small("Bear off all 15 checkers first. No doubling cube: a gammon scores 2, a backgammon 3.")end local b=Y snail.small("Games won-lost (points) against the computer:")local c={}for af=1,3 do local q=(af-1)*4 c[af]=aA[af].." "..b[q+1].."-"..b[q+2].." ("..b[q+3].."-"..b[q+4]..")"end snail.small(table.concat(c,"  "))snail.hint("BACK leave OK choose UP/DN move")return end snail.title(L==1 and("Backgammon - "..aA[R])or"Backgammon - two players")snail.status("Pips: "..T(1).." "..aK(1)..", "..T(2).." "..aK(2)..(r=="ai"and" - thinking"or""))snail.text(cf())snail.board(b1(),nil,z and bJ()or nil)local af=b7()if af then snail.small(af)end if z then snail.hint("OK/BACK menu")elseif r=="ai"then snail.hint("BACK menu")elseif r=="pass"then snail.hint("BACK menu OK pass")elseif r=="done"then snail.hint("BACK undo OK end turn")elseif t then snail.hint("BACK cancel OK move here L/R choose")else snail.hint((#F>0 and"BACK undo"or"BACK menu").." OK pick L/R choose")end end function start()math.randomseed(os.time())if cj()then al=true if aZ()then r="over"else S="play"if bB(v)then av()ae()else be()end end end end
