Post by tsh73 on Nov 17, 2022 19:03:52 GMT
Console mode (mainwin).
Looks pretty solid to me.
Some code putting new piece on empty cell could be made shorter, but this one works as well.
I had really really hard time making [processB] to work (scaffolding removed in this version)
Give it a spin.
Whoever wants to make graphic version it's all yours ;)
Looks pretty solid to me.
Some code putting new piece on empty cell could be made shorter, but this one works as well.
I had really really hard time making [processB] to work (scaffolding removed in this version)
Give it a spin.
Whoever wants to make graphic version it's all yours ;)
'2048 game
'tsh73 Nov 2022
'mainwin program
'WASD controls
' pity ESC and arrows do not work
print "--------------------------"
print " 2048 mainwin clone"
print
print " use WASD keys for moving,"
print " Q quits"
print "--------------------------"
dim a(3,3)
gosub [makeA]
gosub [printA]
while 1
q$=input$(1)
needsPrint=1
select case q$
case "w"
print "^"; tab(21);using("######",score)
for c=0 to 3
'copy col to B
for i=0 to 3:b(i)=a(i,c):next
gosub [processB]
'copy back
for i=0 to 3:a(i, c)=b(i):next
next
case "a"
print "<-"; tab(21);using("######",score)
for r=0 to 3 'row to B
for j=0 to 3:b(j)=a(r,j):next
gosub [processB]
for j=0 to 3:a(r,j)=b(j):next
next
case "s"
print "v"; tab(21);using("######",score)
for c=0 to 3
for i=0 to 3:b(i)=a(3-i,c):next
gosub [processB]
'copy back
for i=0 to 3:a(3-i, c)=b(i):next
next
case "d"
print "->"; tab(21);using("######",score)
for r=0 to 3
for j=0 to 3:b(j)=a(r,3-j):next
gosub [processB]
for j=0 to 3:a(r,3-j)=b(j):next
next
case "q"
print "Bye then"
exit while
case else
needsPrint=0
end select
if not(addNew()) then
gosub [printA]
print "=========================="
print " Sorry, no more place"
print " --==** GAME OVER **==--"
exit while
end if
if needsPrint then gosub [printA]
wend
input "press Enter to quit";dummy$
end
[makeA]
redim a(3,3) 'clear
'2 pieces
r1=int(rnd(0)*16)
do
r2=int(rnd(0)*16)
loop while r1=r2
k=0
for i = 0 to 3
for j=0 to 3
if k=r1 or k=r2 then a(i,j)=2
k=k+1
next
next
return
[printA]
for i = 0 to 3
for j=0 to 3
print using("######", a(i,j));
next
print
next
print "--------------------------"
return
[processB]
minPos=0 'minimal possible pos to move
for toMove=1 to 3
if b(toMove)=0 then [skip] 'empty
for k=toMove-1 to minPos step -1
if k<minPos then exit for
if b(k)=0 then
b(k)=b(k+1):b(k+1)=0
else
if b(k)=b(k+1) then
score=score+b(k)
b(k)=2*b(k):b(k+1)=0
minPos=k+1
else
exit for 'got to end
end if
end if
next
[skip]
next
return
function addNew()
'adds new to empty place
'returns 1 for Ok, 0 in no empty place
nEmpty=0
k=0
dim empties(16) 'array from 1
for i = 0 to 3
for j=0 to 3
if a(i,j)=0 then
nEmpty=nEmpty+1
empties(nEmpty)=k
end if
k=k+1
next
next
addNew=nEmpty
if not(nEmpty) then exit function 'return 0
'put new
r=1+int(rnd(0)*nEmpty)
new=2: if rnd(0)<0.1 then new=4 '10% chance
k=0
for i = 0 to 3
for j=0 to 3
if k=empties(r) then a(i,j)=2
k=k+1
next
next
end function