Greed: Difference between revisions

3,177 bytes added ,  5 years ago
m (→‎{{header|REXX}}: changed wording in the output section.)
Line 346:
See [[Greed/Java]].
<br><br>
 
=={{header|Phix}}==
{{trans|C++}}
<lang Phix>constant W = 79, H = 22, NCOUNT = W*H
 
sequence board
integer X, Y, score
 
procedure printScore()
position(25,1); bk_color(2); text_color(10)
printf(1," SCORE: %d : %f%% ",{score,score*100/NCOUNT});
end procedure
 
procedure createBoard()
board = repeat(repeat('0',W),H)
for y=1 to H do
for x=1 to W do
board[y,x] = '0'+rand(9)
end for
end for
X = rand(W); Y = rand(H);
board[Y,X] = '0'; score = 0;
printScore();
end procedure
 
procedure displayBoard()
position(1,1)
bk_color(2)
for y=1 to H do
for x=1 to W do
integer ch = board[y,x];
text_color(iff(ch=' '?6:6+ch-'0'))
puts(1,ch)
end for
puts(1,"\n")
end for
bk_color(4); text_color(15); position(Y,X); puts(1,"@")
end procedure
 
function countSteps(integer i, x, y)
integer tX = X, tY = Y
while i do
i -= 1; tX += x; tY += y;
if tX<1 or tY<1 or tX>W or tY>H or board[tY,tX]=' ' then return false end if
end while
return true;
end function
 
procedure execute(integer x, y)
integer ch = board[Y+y,X+x],
i = iff(ch=' '?0:ch-'0')
if countSteps(i, x, y) then
score += i
while i do
i -= 1; X += x; Y += y;
board[Y,X] = ' ';
end while
end if
end procedure
 
procedure getInput()
while true do
integer k = upper(wait_key())
if k='Q' and X > 1 and Y > 1 then execute(-1,-1) exit
elsif k='W' and Y > 1 then execute( 0,-1) exit
elsif k='E' and X < W and Y > 1 then execute( 1,-1) exit
elsif k='A' and X > 1 then execute(-1, 0) exit
elsif k='D' and X < W then execute( 1, 0) exit
elsif k='Z' and X > 1 and Y < H then execute(-1, 1) exit
elsif k='X' and Y < H then execute( 0, 1) exit
elsif k='C' and X < W and Y < H then execute( 1, 1) exit
end if
end while
printScore();
end procedure
 
function existsMoves()
for y=-1 to +1 do
for x=-1 to +1 do
if (x or y)
and X+x>=1 and X+x<=W
and Y+y>=1 and Y+y<=H then
integer ch = board[Y+y,X+x];
if ch!=' ' and countSteps(ch-'0', x, y) then
return true
end if
end if
end for
end for
return false;
end function
 
procedure play()
while true do
cursor(NO_CURSOR); createBoard();
while true do
displayBoard(); getInput()
if not existsMoves() then exit end if
end while
displayBoard(); text_color(7);
position( 8,19); puts(1,"+----------------------------------------+");
position( 9,19); puts(1,"| GAME OVER |");
position(10,19); puts(1,"| PLAY AGAIN(Y/N)? |");
position(11,19); puts(1,"+----------------------------------------+");
position(10,48); cursor(BLOCK_CURSOR);
if upper(wait_key())!='Y' then return end if
end while
end procedure
play()</lang>
 
=={{header|REXX}}==
7,820

edits