Greed: Difference between revisions

22,345 bytes added ,  1 year ago
m
syntax highlighting fixup automation
m (syntax highlighting fixup automation)
 
(15 intermediate revisions by 9 users not shown)
Line 2:
This task is about making a clone of the game "GREED" by Matthew Day.
 
This game is played on a grid of   '''79'''   column by   '''22'''   rows of random numbers from   '''1'''   to 9. The player location is signified by the  '@''9''' symbol  (inclusive).
 
The player location is signified by the   '''@'''   symbol.
The object of Greed is to erase as much of the screen as possible by moving around (all 8 directions are allowed) in this grid. When you move in a direction, you erase N number of grid squares in that direction, N being the first number in that direction. Your score reflects the total number of squares eaten.
 
The object of Greed is to erase as much of the screen as possible by moving around   (all 8 directions are allowed in this grid).
 
When you move in a direction,   '''N'''   number of grid squares are erased ("eaten") in that direction,   '''N'''   being the first number in that direction.
 
Your score reflects the total number of squares "eaten".
 
You may not make a move that places you off the grid or over a previously eaten square.
Line 11 ⟶ 17:
 
[https://www.youtube.com/watch?v=XQHq6tdxylk&list=PLdvB7n7RN2UDkjHAWCmbQ8okmgSrjWcvE Video on YouTube]
<br><br>
 
 
=={{header|C++}}==
Windows console version.
[[File:newGreedCpp.png|200px|thumb|right]]
<langsyntaxhighlight lang="cpp">
#include <windows.h>
#include <iostream>
Line 137 ⟶ 143:
greed g; g.play(); return 0;
}
</syntaxhighlight>
</lang>
 
=={{header|Factor}}==
This uses Factor's own user interface vocabularies. Use hjkl-bnyu (vi-keys) to move.
<syntaxhighlight lang="factor">USING: accessors arrays colors combinators
combinators.short-circuit fry grouping io io.styles kernel lexer
literals make math math.matrices math.parser math.vectors random
sequences strings ui ui.commands ui.gadgets.panes
ui.gadgets.status-bar ui.gadgets.worlds ui.gestures
ui.pens.solid ;
IN: rosetta-code.greed
 
<<
SYNTAX: RGB: scan-token 2 cut 2 cut [ hex> 255 /f ] tri@ 1
<rgba> suffix! ;
>>
 
CONSTANT: cells-width 79
CONSTANT: cells-height 22
CONSTANT: size 24
CONSTANT: bg-color RGB: 000000
 
CONSTANT: player-format {
{ font-size $ size }
{ foreground RGB: 5990C8 }
{ background RGB: B96646 }
}
 
CONSTANT: normal-format { { font-size $ size } }
 
CONSTANT: colors {
RGB: 40B4A4
RGB: 40B3B7
RGB: 40A2B9
RGB: 408FBC
RGB: 407CBF
RGB: 4268C0
RGB: 4355C2
RGB: 4845C3
RGB: 5F46C4
}
 
CONSTANT: neighbors {
{ -1 -1 } { -1 0 } { -1 1 }
{ 0 -1 } { 0 1 }
{ 1 -1 } { 1 0 } { 1 1 }
}
 
TUPLE: greed < pane cells x y score ;
 
: set-player ( greed elt -- )
'[ y>> _ swap ] [ x>> 2array ] [ cells>> ] tri set-index ;
 
: place-player ( greed -- ) 0 set-player ;
 
: remove-player ( greed -- ) f set-player ;
 
: make-cells ( -- cells )
cells-width cells-height * [ 9 random 1 + ] replicate
cells-width group ;
 
: write-number ( n/f -- )
[ >digit 1string normal-format first foreground ]
[ 1 - colors nth 2array ] bi 2array format ;
 
: write-cell ( n/f -- )
{
{ f [ " " normal-format format ] }
{ 0 [ "@" player-format format ] }
[ write-number ]
} case ;
 
: write-cells ( cells -- ) [ [ write-cell ] each nl ] each ;
 
: update-cells ( greed -- )
dup cells>> [ write-cells ] curry with-pane ;
 
: init-greed ( greed -- greed' )
make-cells >>cells cells-width random >>x cells-height
random >>y 0 >>score dup place-player dup update-cells dup
"Score: 0" swap show-status ;
 
: <greed> ( -- greed )
f greed new-pane bg-color <solid> >>interior init-greed ;
 
: ?r,c ( r c matrix -- elt/f ) swapd ?nth ?nth ;
: ?r,cths ( seq matrix -- newseq )
[ [ first2 ] dip ?r,c ] curry map ;
 
: (ray) ( start-loc dir length -- seq )
1 + [ [ [ v+ ] keep over , ] times ] { } make 2nip ;
 
: ray ( start-loc dir length -- seq/f )
dup [ (ray) ] [ 2nip ] if ;
 
: ?r,c-dir ( r c dir matrix -- n )
[ 2array ] [ v+ first2 ] [ ?r,c ] tri* ;
 
: move-length ( greed dir -- n )
[ [ y>> ] [ x>> ] [ ] tri ] dip swap cells>> ?r,c-dir ;
 
: y,x>loc ( greed -- loc ) [ y>> ] [ x>> ] bi 2array ;
 
: ray-dir ( greed dir -- seq )
[ [ y,x>loc ] dip ] [ move-length ] 2bi ray ;
 
: in-bounds? ( dim loc -- ? )
{ [ nip [ 0 >= ] all? ] [ v- [ 0 > ] all? ] } 2&& ;
 
: endpoint-in-bounds? ( greed dir -- ? )
ray-dir dup [
last ${ cells-height cells-width } swap in-bounds?
] when ;
 
: gapless? ( greed dir -- ? )
[ ray-dir ] [ drop cells>> ?r,cths ] 2bi [ integer? ] all? ;
 
: can-move? ( greed dir -- ? )
{ [ endpoint-in-bounds? ] [ gapless? ] } 2&& ;
 
: can-move-any? ( greed -- ? )
neighbors [ can-move? ] with map [ t = ] any? ;
 
: setup-move ( greed dir -- seq ) over remove-player ray-dir ;
 
: update-score ( greed dir -- greed dir )
2dup move-length pick swap [ + ] curry change-score dup
score>> number>string "Score: " prepend swap show-status ;
 
: (move) ( greed dir -- )
update-score [ drop f ] [ setup-move dup last ]
[ drop cells>> swap [ set-indices ] dip ] 2tri first2
[ >>y ] dip >>x place-player ;
 
: game-over ( greed -- )
[
score>> number>string "Game over! Final score: "
prepend " Press <space> for new game." append
] [ show-status ] bi ;
 
: ?game-over ( greed -- )
dup can-move-any? [ drop ] [ game-over ] if ;
 
: move ( greed dir -- )
dupd 2dup can-move? [ (move) ] [ 2drop ] if
[ update-cells ] [ ?game-over ] bi ;
 
: ?new-game ( greed -- )
dup can-move-any? [ drop ] [ init-greed drop ] if ;
 
: e ( greed -- ) { 0 1 } move ;
: se ( greed -- ) { 1 1 } move ;
: s ( greed -- ) { 1 0 } move ;
: sw ( greed -- ) { 1 -1 } move ;
: w ( greed -- ) { 0 -1 } move ;
: nw ( greed -- ) { -1 -1 } move ;
: n ( greed -- ) { -1 0 } move ;
: ne ( greed -- ) { -1 1 } move ;
 
greed "gestures" f {
{ T{ key-down { sym "l" } } e }
{ T{ key-down { sym "n" } } se }
{ T{ key-down { sym "j" } } s }
{ T{ key-down { sym "b" } } sw }
{ T{ key-down { sym "h" } } w }
{ T{ key-down { sym "y" } } nw }
{ T{ key-down { sym "k" } } n }
{ T{ key-down { sym "u" } } ne }
{ T{ key-down { sym " " } } ?new-game }
} define-command-map
 
: greed-window ( -- )
[
<greed> <world-attributes> "Greed" >>title
open-status-window
] with-ui ;
 
MAIN: greed-window</syntaxhighlight>
{{out}}
[https://i.imgur.com/3IEo8cC.png Screenshot of the game after a loss]
 
=={{header|Go}}==
{{trans|C++}}
{{libheader|termbox-go}}
{{works with|Ubuntu 16.04}}
<br>
This hasn't been tested on Windows 10 but should work.
 
Note that this version uses the Z key (rather than the Y key) to move diagonally downwards to the left. A leave key, L, has also been added in case one wants to end the game prematurely.
<syntaxhighlight lang="go">package main
 
import (
"fmt"
"github.com/nsf/termbox-go"
"log"
"math/rand"
"strconv"
"time"
)
 
type coord struct{ x, y int }
 
const (
width = 79
height = 22
nCount = float64(width * height)
)
 
var (
board [width * height]int
score = 0
bold = termbox.AttrBold
cursor coord
)
 
var colors = [10]termbox.Attribute{
termbox.ColorDefault,
termbox.ColorWhite,
termbox.ColorBlack | bold,
termbox.ColorBlue | bold,
termbox.ColorGreen | bold,
termbox.ColorCyan | bold,
termbox.ColorRed | bold,
termbox.ColorMagenta | bold,
termbox.ColorYellow | bold,
termbox.ColorWhite | bold,
}
 
func printAt(x, y int, s string, fg, bg termbox.Attribute) {
for _, r := range s {
termbox.SetCell(x, y, r, fg, bg)
x++
}
}
 
func createBoard() {
for y := 0; y < height; y++ {
for x := 0; x < width; x++ {
board[x+width*y] = rand.Intn(9) + 1
}
}
cursor = coord{rand.Intn(width), rand.Intn(height)}
board[cursor.x+width*cursor.y] = 0
score = 0
printScore()
}
 
func displayBoard() {
termbox.SetCursor(0, 0)
bg := colors[0]
for y := 0; y < height; y++ {
for x := 0; x < width; x++ {
i := board[x+width*y]
fg := colors[i]
s := " "
if i > 0 {
s = strconv.Itoa(i)
}
printAt(x, y, s, fg, bg)
}
}
fg := colors[9]
termbox.SetCursor(cursor.x, cursor.y)
printAt(cursor.x, cursor.y, "@", fg, bg)
termbox.Flush()
}
 
func printScore() {
termbox.SetCursor(0, 24)
fg := colors[4]
bg := termbox.ColorGreen
s := fmt.Sprintf(" SCORE: %d : %.3f%% ", score, float64(score)*100.0/nCount)
printAt(0, 24, s, fg, bg)
termbox.Flush()
}
 
func execute(x, y int) {
i := board[cursor.x+x+width*(cursor.y+y)]
if countSteps(i, x, y) {
score += i
for i != 0 {
i--
cursor.x += x
cursor.y += y
board[cursor.x+width*cursor.y] = 0
}
}
}
 
func countSteps(i, x, y int) bool {
t := cursor
for i != 0 {
i--
t.x += x
t.y += y
if t.x < 0 || t.y < 0 || t.x >= width || t.y >= height || board[t.x+width*t.y] == 0 {
return false
}
}
return true
}
 
func existsMoves() bool {
for y := -1; y < 2; y++ {
for x := -1; x < 2; x++ {
if x == 0 && y == 0 {
continue
}
ix := cursor.x + x + width*(cursor.y+y)
i := 0
if ix >= 0 && ix < len(board) {
i = board[ix]
}
if i > 0 && countSteps(i, x, y) {
return true
}
}
}
return false
}
 
func check(err error) {
if err != nil {
log.Fatal(err)
}
}
 
func main() {
rand.Seed(time.Now().UnixNano())
err := termbox.Init()
check(err)
defer termbox.Close()
 
eventQueue := make(chan termbox.Event)
go func() {
for {
eventQueue <- termbox.PollEvent()
}
}()
 
for {
termbox.HideCursor()
createBoard()
for {
displayBoard()
select {
case ev := <-eventQueue:
if ev.Type == termbox.EventKey {
switch ev.Ch {
case 'q', 'Q':
if cursor.x > 0 && cursor.y > 0 {
execute(-1, -1)
}
case 'w', 'W':
if cursor.y > 0 {
execute(0, -1)
}
case 'e', 'E':
if cursor.x < width-1 && cursor.y > 0 {
execute(1, -1)
}
case 'a', 'A':
if cursor.x > 0 {
execute(-1, 0)
}
case 'd', 'D':
if cursor.x < width-1 {
execute(1, 0)
}
case 'z', 'Z':
if cursor.x > 0 && cursor.y < height-1 {
execute(-1, 1)
}
case 'x', 'X':
if cursor.y < height-1 {
execute(0, 1)
}
case 'c', 'C':
if cursor.x < width-1 && cursor.y < height-1 {
execute(1, 1)
}
case 'l', 'L': // leave key
return
}
} else if ev.Type == termbox.EventResize {
termbox.Flush()
}
}
printScore()
if !existsMoves() {
break
}
}
displayBoard()
fg := colors[7]
bg := colors[0]
printAt(19, 8, "+----------------------------------------+", fg, bg)
printAt(19, 9, "| GAME OVER |", fg, bg)
printAt(19, 10, "| PLAY AGAIN(Y/N)? |", fg, bg)
printAt(19, 11, "+----------------------------------------+", fg, bg)
termbox.SetCursor(48, 10)
termbox.Flush()
select {
case ev := <-eventQueue:
if ev.Type == termbox.EventKey {
if ev.Ch == 'y' || ev.Ch == 'Y' {
break
} else {
return
}
}
}
}
}</syntaxhighlight>
 
=={{header|Kotlin}}==
Line 143 ⟶ 563:
{{works with|Windows 10}}
Note that this version uses the Z key (rather than the Y key) to move diagonally downwards to the left.
<langsyntaxhighlight lang="scala">// Kotlin Native v0.5
 
import kotlinx.cinterop.*
Line 340 ⟶ 760:
srand(time(null).toInt())
Greed().play()
}</langsyntaxhighlight>
 
=={{header|Java}}==
Line 349 ⟶ 769:
 
=={{header|Julia}}==
GUI version. Click a square adjacent to the "@" symbol to move.
<lang julia>using Gtk
<syntaxhighlight lang="julia">using Gtk
 
struct BState
Line 388 ⟶ 809:
pastboardstates = Vector{BState}()
score = 0
gameover = false
condition = Condition()
won = ""
myrow, mycol = 1, 1
 
function update!()
for i in 1:rows, j in 1:cols
Line 399 ⟶ 818:
end
set_gtk_property!(buttons[myrow, mycol], :label, "@")
won = all(iszero, board) ? "WINNING" : ""
set_gtk_property!(win, :title, "$won Greed Game (Score: $score)")
end
Line 423 ⟶ 843:
won = ""
possiblevals = collect(1:9)
gameover = false
for i in 1:rows, j in 1:cols
board[i, j] = rand(possiblevals)
Line 435 ⟶ 854:
end
function undo!(w)
if !gameoverwon == "" && length(pastboardstates) > 0
bst = pop!(pastboardstates)
board, myrow, mycol = bst.board, bst.row, bst.col
Line 452 ⟶ 871:
# greedapp(22, 79) # This would be per task, though a smaller game board is nicer
greedapp(12, 29)
</syntaxhighlight>
</lang>
 
=={{header|Nim}}==
{{trans|Julia}}
{{libheader|gintro}}
 
This is a translation of the Julia solution with some modifications. The most important is the way the new position is computed after choosing a direction. Rather than moving to the neighbor tile, we move to the farthest tile in the chosen direction as shown in the video.
 
There is of course a lot of differences due to the way <code>gintro</code> library works which is quite different of Julia GTK API.
 
And we also added a score field to the BState object in order to restore the correct score when undoing a move.
 
<syntaxhighlight lang="nim">import random, strutils
import gintro/[gobject, glib, gtk, gio]
 
const Rows = 22
const Cols = 79
 
type
 
Board = array[Rows, array[Cols, int]]
 
 
BState = object
board: Board
score: Natural
row, col: int
 
 
Game = ref object
window: Window
score: Natural
won: string
board: Board
buttons: array[Rows, array[Cols, Button]]
myRow, myCol: Natural
pastBoardStates: seq[BState]
 
 
proc update(game: Game) =
## Update game state.
var won = true
for i in 0..<Rows:
for j in 0..<Cols:
let val = game.board[i][j]
won = won and val == 0
game.buttons[i][j].setLabel(if val > 0: $val else: "")
 
game.buttons[game.myRow][game.myCol].setLabel("@")
game.won = if won: "WINNING " else: ""
game.window.setTitle(game.won & "Greed game (score: $#)".format(game.score))
 
 
proc eraseFromTile(game: Game; moveRow, moveCol: Natural) =
## Erase tile values from the given tile.
let xdir = moveRow - game.myRow
let ydir = moveCol - game.myCol
if abs(xdir) > 1 or abs(ydir) > 1 or xdir == 0 and ydir == 0 or game.board[moveRow][moveCol] == 0:
return
game.pastBoardStates.add BState(board: game.board, score: game.score,
row: game.myRow, col: game.myCol)
let count = game.board[moveRow][moveCol]
var x: int = game.myRow
var y: int = game.myCol
for i in 1..count:
inc x, xdir
inc y, ydir
if x in 0..<Rows and y in 0..<Cols:
game.board[x][y] = 0
inc game.score
else:
# Restore to last valid position.
dec x, xdir
dec y, ydir
game.board[game.myRow][game.myCol] = 0
game.myRow = x
game.myCol = y
game.update()
 
 
proc clicked(b: Button; game: Game) =
## Callback tp process a click in the grid.
var row, col = -1
for i in 0..<Rows:
for j in 0..<Cols:
if game.buttons[i][j] == b:
(row, col) = (i, j)
break
if row < 0: return
game.eraseFromTile(row, col)
 
 
proc undo(b: ToolButton; game: Game) =
## Callback to undo last move.
if game.won.len == 0 and game.pastBoardStates.len > 0:
let bst = game.pastBoardStates.pop()
game.board = bst.board
game.score = bst.score
game.myRow = bst.row
game.myCol = bst.col
game.update()
 
 
proc initialize(game: Game) =
## Initialize the game.
const PossibleVals = {1..9}
game.score = 0
game.won = ""
for i in 0..<Rows:
for j in 0..<Cols:
game.board[i][j] = PossibleVals.sample()
game.buttons[i][j].connect("clicked", clicked, game)
game.myRow = rand(Rows - 1)
game.myCol = rand(Cols - 1)
game.update()
 
 
proc initGame(b: ToolButton; game: Game) =
## Callback to start a new game.
game.initialize()
 
 
proc activate(app: Application) =
## Activate the application.
 
let game = new(Game)
let window = app.newApplicationWindow()
window.setSizeRequest(1600, 800)
window.setTitle("Greed game")
game.window = window
 
let box = newBox(Orientation.vertical, 0)
window.add box
let toolbar = newToolbar()
box.add toolbar
let newGame = newToolButton(label = "New game")
let undoMove = newToolButton(label = "Undo move")
toolbar.add(newGame)
toolbar.add(undoMove)
 
let srcWindow = newScrolledWindow()
box.packEnd(srcWindow, true, true, 0)
let grid = newGrid()
srcWindow.add grid
 
for i in 0..<Rows:
for j in 0..<Cols:
let b = newButton()
game.buttons[i][j] = b
grid.attach(b, j, i, 1, 1)
 
game.initialize()
newGame.connect("clicked", initGame, game)
undoMove.connect("clicked", undo, game)
game.window.showAll()
 
 
randomize()
let app = newApplication(Application, "Rosetta.greed")
discard app.connect("activate", activate)
discard app.run()</syntaxhighlight>
 
=={{header|Perl}}==
{{trans|Raku}}
<syntaxhighlight lang="perl">use strict;
use warnings;
use feature 'say';
 
my @board;
my $w = 79;
my $h = 22;
for (1..$h) {
my @row;
push @row, int 1 + rand 9 for 1..$w;
push @board, [@row];
}
my $X = int 0.5 + rand $w;
my $Y = int 0.5 + rand $h;
$board[$Y][$X] = '@';
 
my $score = 0;
 
sub execute {
my($y,$x) = @_;
my $i = $board[$Y+$y][$X+$x];
if (countSteps($i, $x, $y)) {
$score += $i;
$board[ $Y + $y*$_ ][ $X + $x*$_ ] = ' ' for 0..$i;
$board[ $Y += $y*$i ][ $X += $x*$i ] = '@';
}
}
 
sub countSteps {
my($i, $x, $y) = @_;
my $tX = $X;
my $tY = $Y;
for (0..$i) {
$tX += $x;
$tY += $y;
return 0 if $tX < 0 or $tY < 0 or $tX >= $w or $tY >= $h or $board[$tY][$tX] eq ' '
}
return 1
}
 
sub existsMoves {
for ([-1,-1], [-1,0], [-1,1], [0,-1], [0,0], [0,1], [1,-1], [1,0], [1,1]) {
my($x,$y) = @$_;
next if $x == 0 and $y == 0;
next if $X+$x < 0 or $X+$x > $w or $Y+$y < 0 or $Y+$y > $h ;
my $i = $board[$Y+$y][$X+$x];
return 1 if ( $i ne ' ' and countSteps($i, $x, $y) )
}
return 0;
}
 
while () {
say join '', @$_ for @board;
say "Game over." and last unless existsMoves();
print "Current score : " . $score . "\n";
my $c = <> ; chomp $c;
if ($c eq 'q') { say "So long." and last}
if ($c eq 'e') { execute(-1,-1) if $X > 0 and $Y > 0 } # North-West
if ($c eq 'r') { execute(-1, 0) if $Y > 0 } # North
if ($c eq 't') { execute(-1, 1) if $X < $w and $Y > 0 } # North-East
if ($c eq 'd') { execute( 0,-1) if $X > 0 } # West
if ($c eq 'g') { execute( 0, 1) if $X < $w } # East
if ($c eq 'x') { execute( 1,-1) if $X > 0 and $Y < $h } # South-West
if ($c eq 'c') { execute( 1, 0) if $Y < $h } # South
if ($c eq 'v') { execute( 1, 1) if $X < $w and $Y < $h } # South-East
}</syntaxhighlight>
 
=={{header|Phix}}==
{{trans|C++}}
<langsyntaxhighlight Phixlang="phix">constant W = 79, H = 22, NCOUNT = W*H
 
sequence board
Line 561 ⟶ 1,209:
end while
end procedure
play()</langsyntaxhighlight>
 
=={{header|PicoLisp}}==
Computer play by selecting random road. [https://asciinema.org/a/369181 Demo] is here.
<syntaxhighlight lang="picolisp">
(load "@lib/simul.l")
(seed (in "/dev/urandom" (rd 8)))
(scl 6)
# N - number
# C - Color
# F - flag to draw candidates
# A - @ mark
(de display ()
(let P 0
(wait 500)
(prin "^[[2J")
(for L G
(for This L
# count cleared cells
(and (lt0 (: N)) (inc 'P))
(prin
"^[[0;"
(if (or (: A) (: F)) 100 (: C))
"m"
(cond
((: A) "@")
((lt0 (: N)) " ")
(T (: N)) )
"^[[0m" ) )
(prinl) )
(prinl
"Score: "
S
" "
(round (*/ P 1.0 100.0 1738.0) 2)
"%" ) ) )
(de roads (Lst Flg)
(mapc
'((L)
(with C
(do (car L)
(setq This ((cadr L) This))
(=: F Flg) ) ) )
Lst )
(display) )
(let
(Colors (simul~shuffle (31 32 33 35 91 92 93 94 96))
G (simul~grid 22 79)
C NIL
S 0 )
# set random grid
(for L G
(for This L
(let X (rand 1 9)
(=: N X)
(=: C (get Colors X)) ) ) )
# set random startpoint
(with (get G (rand 1 22) (rand 1 79))
(setq C This)
(=: A 0) )
(display)
(loop
(NIL
(setq Z
(extract
'((D)
(with C
(let? S (with (D This) (: N))
(and
(do S
(NIL (setq This (D This)))
(NIL (gt0 (: N)))
'next )
(list S D This) ) ) ) )
'(simul~west
simul~east
simul~south
simul~north
((X) (simul~south (simul~west X)))
((X) (simul~north (simul~west X)))
((X) (simul~south (simul~east X)))
((X) (simul~north (simul~east X))) ) ) ) )
# XXX
(roads Z T)
(roads Z)
# select road randomly
(let L (get Z (rand 1 (length Z)))
(with C
(inc 'S (: N))
# clear value of "old" Center
(=: N -1)
(=: A)
# clear selected road
(do (car L)
(inc 'S (: N))
(=: N -1)
(setq This ((cadr L) This)) ) )
# set new Center
(with (caddr L)
(setq C This)
(=: A 0) ) )
(display) ) )
(bye)</syntaxhighlight>
 
=={{header|Raku}}==
{{trans|Phix}}
<syntaxhighlight lang="raku" line># 20200913 added Raku programming solution
 
srand 123456;
 
my @board = [ (1..9).roll xx my \w = 79 ] xx my \h = 22 ;
my \X = $ = w.rand.Int ; my \Y = $ = h.rand.Int;
@board[Y;X] = '@';
my \score = $ = 0;
 
sub execute (\y,\x) {
my \i = $ = @board[Y+y;X+x];
if countSteps(i, x, y) {
score += i;
@board[ Y + y*$_ ; X + x*$_ ] = ' ' for ^i;
@board[ Y += y*i ; X += x*i ] = '@';
}
}
 
sub countSteps(\i, \x, \y) {
my \tX = $ = X ; my \tY = $ = Y;
for ^i {
tX += x; tY += y;
return False if tX < 0 or tY < 0 or tX ≥ w or tY ≥ h or @board[tY;tX] eq ' '
}
return True;
}
 
sub existsMoves {
for (-1 .. 1) X (-1 .. 1) -> (\x,\y) {
next if x == 0 and y == 0;
next if X+x < 0 or X+x > w or Y+y < 0 or Y+y > h ;
my \i = @board[Y+y;X+x];
return True if ( i ne ' ' and countSteps(i, x, y) )
}
return False;
}
 
loop {
for @board { .join.print ; print "\r\n" } ;
{ say "Game over." and last } unless existsMoves();
print "Current score : ", score, "\r\n";
given my $c = $*IN.getc {
when 'q' { say "So long." and last}
when 'e' { execute(-1,-1) if X > 0 and Y > 0 } # North-West
when 'r' { execute(-1, 0) if Y > 0 } # North
when 't' { execute(-1, 1) if X < w and Y > 0 } # North-East
when 'd' { execute( 0,-1) if X > 0 } # West
when 'g' { execute( 0, 1) if X < w } # East
when 'x' { execute( 1,-1) if X > 0 and Y < h } # South-West
when 'c' { execute( 1, 0) if Y < h } # South
when 'v' { execute( 1, 1) if X < w and Y < h } # South-East
}
}</syntaxhighlight>
 
=={{header|REXX}}==
Line 569 ⟶ 1,375:
 
Pointers (above and to the right of) the grid are included to help identify where the current location is.
<langsyntaxhighlight lang="rexx">/*REXX program lets a user play the game of GREED (by Matthew Day) from the console. */
parse arg sw sd @ b ?r . /*obtain optional argumenst from the CL*/
if sw=='' | sw=="," then sw=79 79 /*cols specified? Then use the default*/
if sd=='' | sd=="," then sd=22 22 /*rows " " " " " */
if @=='' | @=="," then @= '@' /*here " " " " " */
if b=='' | b=="," then b= ' ' /*blank " " " " " */
Line 578 ⟶ 1,384:
if length(@)==2 & datatype(@,'X') then @=x2c(@) /*maybe use @ char for current pos. */
if length(b)==2 & datatype(b,'X') then b=x2c(b) /* " " B char for background. */
signal on halt /*handle pressing of Ctrl-Break key. */
call init /* [↓] CLR is reset if there's an err*/
clr=1; do until # == sw*sd; ??= /*keep playing until the grid is blank.*/
call show clr /*show the playing field (grid) to term*/
call ask; clr=1 1 /*obtain user's move, validate, or quit*/
if \move() then do; clr=0 0 /*perform the user's move per @ loc.*/
if ??==@. then say ____ "invalid move: moving out of bounds."
if ??==b then say ____ "invalid move: moving into a blank."
Line 598 ⟶ 1,405:
say ____
say ____ 'enter a move ──or── QUIT (the score is: ' #")"
parse pull z 2 1 what . 1 oz; upper z what
if abbrev('QUIT', what, 2) | abbrev('"QQUIT'", what, 2) then leave
if length( space(oz) )==1 & pos(z, 'QWEADZXC')\==0 then return
say ____ '***error*** invalid direction for a move:' space(oz); say
Line 605 ⟶ 1,412:
halt: say; say ____ 'quitting.'; exit 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
init: @.= 'ff'x; $.=.; ____= copies('"'", 8) /*out─of─bounds literal; fence for SAYs*/
signal on halt /*handle pressing of Ctrl-Break key. */
do r=1 for sd
do c=1 for sw; @.r.c= random(1, 9) /*assign grid area to random digs (1►9)*/
end /*c*/
end /*r*/
!r= random(1, sd); !c= random(1, sw); @.!r.!c= @; return /*assign 1st position*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
move: @.!r.!c= '≤'; $r= !r; $c= !c; ??= /*blank out this "start" position. */
@@=. /*nullify the count of move positions. */
do until @@==0; select
when z== 'Q' then do; !r= !r - 1; !c= !c - 1; end
when z== 'W' then !r= !r - 1
when z== 'E' then do; !r= !r - 1; !c= !c + 1; end
when z== 'A' then !c= !c - 1
when z== 'D' then !c= !c + 1
when z== 'Z' then do; !r= !r + 1; !c= !c - 1; end
when z== 'X' then !r= !r + 1
when z== 'C' then do; !r= !r + 1; !c= !c + 1; end
end /*select*/
?= @.!r.!c; if ?==@. | ?==b then do; !r= $r; !c= $c; ??= ?; return 0
 
?=@.!r.!c; if ?==@. | ?==b then do; !r=$r; !c=$c; ??=?; return 0; end /*err*/ end
if @@==. then @@=?; if datatype(@@, 'W') then @@= @@ - 1 /*diminish cnt.*/
@.!r.!c= '±' /*nullify (later, a blank) position. */
end /*until*/
@.!r.!c= @; return 1 /*signify current grid position with @ */
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: arg tell; #=0; if tell then do; ' "CLS'"; say left('', !c)"↓"; end
do r=1 for sd; _= ' ' /* [↑] DOS cmd CLS clears the screen*/
do c=1 for sw /*construct row of the grid for display*/
if @.r.c=='"±'" & ??\=='' then @.r.c= $.r.c /*Is this a temp blank? Restore*/
if @.r.c=='"±'" & ?? =='' then @.r.c=b b /*Is this a temp blank? Blank. */
if @.r.c=='"'" & ??\=='' then @.r.c= $.r.c /*Is this a temp a @ ? Restore*/
if @.r.c=='"'" & ?? =='' then @.r.c=b b /*Is this a temp a @ ? Blank. */
?= @.r.c; _= _ || ? /*construct a line of the grid for term*/
if ?==b | ?==@ then #= # + 1 /*Position==b ─or─ @? Then bump score.*/
if tell then $.r.c= @.r.c /*create a backup grid for re─instating*/
end /*c*/
if r==!r then _= _ '◄' /*indicate row of current position. */
if tell then say _ /*display a row of grid to screen. */
end /*r*/; say; return # return # /*SHOW also counts # of blanks (score).*/</langsyntaxhighlight>
A note on the OUTPUT sections: &nbsp; each (cleared) screen displayed is shown below as a separate OUTPUT section.
 
Line 694 ⟶ 1,500:
──────── quitting.
</pre>
 
 
=={{header|Wren}}==
 
See [[Greed/Wren]].
 
=={{header|Z80 Assembly}}==
 
See [[Greed/Z80 Assembly]].
<br><br>
10,327

edits