Anonymous user
Flipping bits game: Difference between revisions
Added Forth entry.
SqrtNegInf (talk | contribs) m (→{{header|Perl}}: future-proof for 5.36, use new bitwise string operators) |
imported>CyD (Added Forth entry.) |
||
| (2 intermediate revisions by 2 users not shown) | |||
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}}==
Line 2,460 ⟶ 2,718:
</pre>
=={{header|
{{trans|QB64}}
<syntaxhighlight lang="vb">Dim Shared As Integer celdasXLado, contarMovs
Dim Shared As String movsValidos, inicioBS, actualBS, objetivoBS
Sub mostrarTablero (fila As Integer, columna As Integer, junto As String, titulo As String)
Dim As Integer i, j
Locate fila - 1, columna: Print titulo
For i = 1 To celdasXLado
Locate fila, columna + 2 * (i-1) + 3: Print Mid(movsValidos, i, 1);
Next i
Print
For i = 1 To celdasXLado
Locate fila + i, columna - 1: Print Str(i);
For j = 1 To celdasXLado
Locate fila + i, columna + 2 * j: Print " " + Mid(junto, (i-1) * celdasXLado + j, 1);
Next j
Print
Next i
End Sub
Sub mostrarEstado
Color 9: mostrarTablero 2, 2, actualBS, "Current:"
Color 12: mostrarTablero 2, 2 + 2 * celdasXLado + 6, objetivoBS, " Target:"
Color 13: Print !"\n Number of moves taken so far is " + Str(contarMovs)
Color 14
End Sub
Function Pistas() As String 'compare the currentB to targetB and suggest letter or digit or done
Dim As Integer i, j
Dim As Boolean flag = False
Dim As String r, actualBitS, objetivoBitS
For i = 1 To 2 * celdasXLado 'check cols first then rows as listed in movsValidos
r = Mid(movsValidos, i, 1)
If i <= celdasXLado Then
actualBitS = Mid(actualBS, i, 1): objetivoBitS = Mid(objetivoBS, i, 1)
If actualBitS <> objetivoBitS Then flag = False: Exit For
Else
j = i - celdasXLado
actualBitS = Mid(actualBS, (j - 1) * celdasXLado + 1, 1)
objetivoBitS = Mid(objetivoBS, (j - 1) * celdasXLado + 1, 1)
If actualBitS <> objetivoBitS Then flag = False: Exit For
End If
Next i
Pistas = Iif(flag, r, "Done?")
End Function
Sub Centrar (fila As Integer, texto As String) 'center print at fila
Locate fila, (80 - Len(texto)) / 2: Print texto;
End Sub
Sub vcls 'print the screen to file then clear it
Dim As String sc(23), scan
Dim As Integer lineas, t, final, i
For lineas = 1 To 23
For t = 1 To 80: scan &= Chr(Screen(lineas, t)): Next t
sc(lineas) = Rtrim(scan)
scan = ""
Next lineas
For final = 23 To 1 Step -1
If sc(final) <> "" Then Exit For
Next final
Print #3, ""
For i = 1 To final: Print #3, sc(i): Next i
Print #3, "": Print #3, String(80, "-"): Cls
End Sub
Function TeclaPulsada() As String 'just want printable characters
Dim As String KBD = ""
While Len(KBD) = 0
KBD = Inkey
If Len(KBD) Then 'press something so respond
If Len(KBD) = 2 Or Asc(KBD) > 126 Or Asc(KBD) < 32 Then KBD = "*"
End If
Wend
Return KBD
End Function
Function inicioTablero() As String
Dim As String r
For i As Integer = 1 To celdasXLado ^ 2
r &= Ltrim(Str(Int(Rnd * 2)))
Next i
Return r
End Function
Sub hacerMovim (moveS As String)
Dim As Uinteger ac = Asc(moveS)
Dim As Integer i, columna, fila
Dim As String bitS
If ac > 96 Then 'letter
columna = ac - 96
For i = 1 To celdasXLado
bitS = Mid(actualBS, (i - 1) * celdasXLado + columna, 1)
Mid(actualBS, (i-1) * celdasXLado + columna, 1) = Iif(bitS = "0", "1", "0")
Next
Else 'number
fila = ac - 48
For i = 1 To celdasXLado
bitS = Mid(actualBS, (fila-1) * celdasXLado + i, 1)
Mid(actualBS, (fila-1) * celdasXLado + i, 1) = Iif(bitS = "0", "1", "0")
Next i
End If
End Sub
Function hacerObjetivo() As String
While actualBS = inicioBS
For i As Integer = 1 To celdasXLado * celdasXLado
Dim As String mS = Mid(movsValidos, Int(Rnd * Len(movsValidos)) + 1, 1)
hacerMovim mS
Next i
Wend
Return actualBS
End Function
Sub Intro
Dim As Integer i
Dim As String inS
Close
Open "Copy Flipping Bits Game.txt" For Output As #3
celdasXLado = 0: movsValidos = "": contarMovs = 0
Color 9: Centrar 3, "Flipping Bits Game (with AI!) JHG 31/05/2023"
Color 5
Centrar 5, "You will be presented with a square board marked Current and"
Centrar 6, "another marked Target. The object of the game is to match"
Centrar 7, "the Current board to Target in the least amount of moves."
Centrar 9, "To make a move, enter a letter for a column to flip or"
Centrar 10, "a digit for a fila to flip. In a flip, all 1's are"
Centrar 11, "changed to 0's and all 0's changed to 1's."
Centrar 13, "You may enter 0 or q at any time to quit."
Centrar 14, "You may press ? when prompted for move to get a hint."
Centrar 15, "You may press ! to have the program solve the puzzle."
Color 14: Print: Print
While celdasXLado < 2 Or celdasXLado > 9
Locate Csrlin, 13: Print "Please press how many cells you want per side 2 to 9 > ";
inS = TeclaPulsada: Print inS : Sleep .4
If inS = "0" Or inS = "q" Then End Else celdasXLado = Val(inS)
Wend
vcls
For i = 1 To celdasXLado: movsValidos = movsValidos + Chr(96 + i) : Next i
For i = 1 To celdasXLado: movsValidos = movsValidos + Ltrim(Str(i)): Next i
inicioBS = inicioTablero
actualBS = inicioBS
objetivoBS = hacerObjetivo
actualBS = inicioBS
End Sub
Sub MenuPrincipal
Dim As String SiNo, mS, mvS
Dim As Boolean mostrarSolucion = False, salir = False
Do
mostrarEstado
If actualBS = objetivoBS Then 'game done!
Print !"\n Congratulations, done in"; contarMovs; " moves."
Print !"\n Press y for yes, if you want to start over > ";
SiNo = TeclaPulsada: Print SiNo: Sleep .4: vcls
If SiNo = "y" Then Intro Else salir = True
Else 'get next move
mS = " "
While Instr(movsValidos, mS) = 0
Print !"\n Press a lettered column or a numbered fila to flip (or 0,q,?,!) > ";
mS = TeclaPulsada: Print mS: Sleep .4
If mS = "!" Then
mostrarSolucion = True: mS = " ": Exit While
Elseif mS = "?" Then mS = " ": Centrar Csrlin, "Hint: " + Pistas
Elseif mS = "0" Or mS = "q" Then vcls: Close: End
Elseif mS = "" Then mS = " "
End If
Wend
If mostrarSolucion Then 'run the solution from hints function
mostrarSolucion = False: mvS = Pistas
Centrar Csrlin + 1, "For the next move, the AI has chosen: " + mvS
Centrar Csrlin + 1, "Running the solution with 4 sec screen sleeps..."
Sleep 4: vcls
While mvS <> "Done?"
contarMovs += 1
hacerMovim mvS
mostrarEstado
mvS = Pistas
Centrar Csrlin + 1, "For the next move, the AI has chosen: " + mvS
Centrar Csrlin + 1, "Running the solution with 4 sec screen sleeps..."
Sleep 4: vcls
Wend
mostrarEstado
Centrar Csrlin + 1, "Done! Current board matches Target"
Centrar Csrlin + 1, "Press y for yes, if you want to start over: > "
SiNo = TeclaPulsada: Print SiNo: Sleep .4: vcls
If SiNo = "y" Then Intro Else salir = True
Else
vcls
contarMovs += 1
hacerMovim mS
End If
End If
Loop Until salir
Close
End Sub
'--- Programa Principal ---
Randomize Timer
Intro
MenuPrincipal
End
'--------------------------</syntaxhighlight>
{{out}}
<pre>Similar to QB64 entry.</pre>
=={{header|Go}}==
<syntaxhighlight lang="go">package main
Line 6,624 ⟶ 7,096:
{{libheader|Wren-ioutil}}
{{libheader|Wren-str}}
<syntaxhighlight lang="
import "./ioutil" for Input
import "./str" for Str
var rand = Random.new()
| |||