Flipping bits game: Difference between revisions

Added Forth entry.
m (→‎{{header|Wren}}: Minor tidy)
imported>CyD
(Added Forth entry.)
 
Line 2,174:
 
YOU WIN!</pre>
 
 
 
=={{header|Forth}}==
{{works with|gforth|0.7.3}}
 
===8x8 board in 64 bits Version===
Board size limited to 8x8, stored in only one cell (64 bits) variable.
<syntaxhighlight lang="Forth">
require random.fs
 
0 value board-size
variable target
variable board
variable moves
 
: moves-reset 0 moves ! ;
: moves+ 1 moves +! ;
: .moves ." You have made " moves @ . ." moves." ;
 
: target-gen ( -- ) rnd target ! ;
 
: row-flip ( n -- )
8 * 255 swap lshift
board @ xor board ! ;
 
: column-flip ( n -- )
1 swap lshift
8 0 do dup 8 lshift or loop
board @ xor board ! ;
 
: target>board ( -- ) target @ board ! ;
 
: board-shuffle ( -- )
board-size dup * 0 do
board-size random 2 random if row-flip else column-flip then
loop ;
 
: ask-move ( -- char )
cr ." choose row [0-" board-size [char] 0 + 1- emit
." ] or column [a-" board-size [char] a + 1- emit
." ]: "
key ;
 
: do-move ( char -- )
dup emit
dup [char] a dup board-size + within
if dup [char] a - column-flip
else
dup [char] 0 dup board-size + within
if dup [char] 0 - row-flip
else ." - this move is not permitted!"
then then
cr drop
;
 
: .header ( -- ) cr ." Target: " board-size 2 * spaces ." Board:" ;
: .column-header ( -- ) board-size 0 do i [char] a + emit space loop ;
: .row-header ( n -- ) . ." - " ;
: .row ( board@ n -- ) dup .row-header 8 * rshift board-size 0 do dup 1 and . 2/ loop drop ;
: .boards
.header cr
4 spaces .column-header 8 spaces .column-header cr
board-size 0 do
target @ i .row 4 spaces board @ i .row cr
loop
;
 
: ?win ( -- f )
0 board-size 0 do 2* 1+ loop
board-size 1 do dup 8 lshift or loop
dup target @ and
swap board @ and =
;
 
: game-loop
begin
.boards .moves
ask-move do-move moves+
?win until
." You win after " moves @ . ." moves!"
;
 
: flip-bit-game ( n -- )
to board-size
target-gen target>board board-shuffle
moves-reset
game-loop
;
</syntaxhighlight>
 
{{out}}
<pre>
3 flip-bit-game
Target: Board:
a b c a b c
0 - 0 0 1 0 - 1 0 0
1 - 1 0 1 1 - 1 1 1
2 - 1 0 0 2 - 0 0 1
You have made 0 moves.
choose row [0-2] or column [a-c]: 0
 
Target: Board:
a b c a b c
0 - 0 0 1 0 - 0 1 1
1 - 1 0 1 1 - 1 1 1
2 - 1 0 0 2 - 0 0 1
You have made 1 moves.
choose row [0-2] or column [a-c]: 2
 
Target: Board:
a b c a b c
0 - 0 0 1 0 - 0 1 1
1 - 1 0 1 1 - 1 1 1
2 - 1 0 0 2 - 1 1 0
You have made 2 moves.
choose row [0-2] or column [a-c]: b
You win after 3 moves! ok
</pre>
 
=== board in a cells array Version===
No size limitation. Board stored in a cells array (use of 64 bits for a bit...). Memory not freed.
 
<syntaxhighlight lang="Forth">
require random.fs
 
0 value board-size
0 value target
0 value board
variable moves
 
: moves-reset 0 moves ! ;
: moves+ 1 moves +! ;
: .moves ." You have made " moves @ . ." moves." ;
 
: allot-board ( -- addr ) here board-size dup * cells allot ;
 
: target-gen ( -- )
board-size dup * 0 do
2 random [char] 0 + target i cells + !
loop
;
 
: row-flip ( board n -- )
board-size * cells +
dup board-size cells + swap do
i dup @ 1 xor swap !
cell +loop
;
 
: column-flip ( board n -- )
cells +
dup board-size dup * cells + swap do
i dup @ 1 xor swap !
board-size cells +loop
;
 
: target>board ( -- )
board-size dup * cells 0 do
target i + @ board i + !
cell +loop
;
 
: board-shuffle ( -- )
board-size dup * 0 do
board board-size random 2 random if row-flip else column-flip then
loop
;
 
: ask-move ( -- char )
cr ." choose row [0-" board-size [char] 0 + 1- emit
." ] or column [a-" board-size [char] a + 1- emit
." ]: "
key ;
 
: do-move ( char -- )
dup emit
dup [char] a dup board-size + within
if dup board swap [char] a - column-flip
else
dup [char] 0 dup board-size + within
if dup board swap [char] 0 - row-flip
else ." - this move is not permitted!"
then then
cr drop
;
 
: .header ( -- ) cr ." Target: " board-size 2 * spaces ." Board:" ;
: .column-header ( -- ) board-size 0 do i [char] a + emit space loop ;
: .row-header ( n -- ) . ." - " ;
: .bit ( board row col -- ) board-size * + cells + @ emit space ;
: .row ( board n -- ) dup .row-header board-size 0 do 2dup i swap .bit loop 2drop ;
: .boards
.header cr
4 spaces .column-header 8 spaces .column-header cr
board-size 0 do
target i .row 4 spaces board i .row cr
loop
;
 
: ?win ( -- f )
board-size dup * 0 do
target i cells + @ board i cells + @
<> if false unloop exit then
loop true
;
 
: game-loop
begin
.boards .moves
ask-move do-move moves+
?win until
." You win after " moves @ . ." moves!"
;
 
: flip-bit-game ( n -- )
to board-size
allot-board to target
allot-board to board
target-gen
target>board
board-shuffle
moves-reset
game-loop
;
</syntaxhighlight>
{{out}}
<pre>
3 flip-bit-game
Target: Board:
a b c a b c
0 - 0 0 0 0 - 1 0 1
1 - 0 1 1 1 - 0 0 1
2 - 1 1 0 2 - 0 1 1
You have made 0 moves.
choose row [0-2] or column [a-c]: 0
 
Target: Board:
a b c a b c
0 - 0 0 0 0 - 0 1 0
1 - 0 1 1 1 - 0 0 1
2 - 1 1 0 2 - 0 1 1
You have made 1 moves.
choose row [0-2] or column [a-c]: b
 
Target: Board:
a b c a b c
0 - 0 0 0 0 - 0 0 0
1 - 0 1 1 1 - 0 1 1
2 - 1 1 0 2 - 0 0 1
You have made 2 moves.
choose row [0-2] or column [a-c]: 2
You win after 3 moves! ok
</pre>
 
 
 
 
 
=={{header|Fortran}}==
Anonymous user