aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2024-03-06 22:25:12 -08:00
parent ed705008a8
commit 0df55f9f24
2196 changed files with 32999 additions and 3075 deletions
Download patch file Download diff file Expand all files Collapse all files

80
Task/Flipping-bits-game/Forth/flipping-bits-game-1.fth Normal file
View file

@ -0,0 +1,80 @@
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
;

101
Task/Flipping-bits-game/Forth/flipping-bits-game-2.fth Normal file
View file

@ -0,0 +1,101 @@
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
;