15 puzzle game: Difference between revisions

Content added Content deleted
m (Automated syntax highlighting fixup (second round - minor fixes))
No edit summary
Line 1,849: Line 1,849:


For other puzzles, one must just the single line with the package instantiation. E.g., for an 8-puzzle, we would write the following. <syntaxhighlight lang="ada"> package Puzzle is new Generic_Puzzle(Rows => 3, Cols => 3, Name => Image);</syntaxhighlight>
For other puzzles, one must just the single line with the package instantiation. E.g., for an 8-puzzle, we would write the following. <syntaxhighlight lang="ada"> package Puzzle is new Generic_Puzzle(Rows => 3, Cols => 3, Name => Image);</syntaxhighlight>

=={{header|Amazing Hopper}}==
<syntaxhighlight lang="Amazing Hopper">
#include <jambo.h>

#define FILATABLA 5
#define COLUMNATABLA 10
#define Imprimelamatriz Gosub 'Pone la matriz'
#define Imprimelascasillas Gosub 'Pone las casillas'
#define Imprimeelíndiceen(_X_,_Y_) Set '_X_,_Y_', Gosub 'Pone el índice'

Main
Set break

Void (casilla, índice, números)
Link gosub( Crea una casilla, Crea el índice, Crea la matriz de números )
Cls
x=4, y=4, Tok sep '""', Gosub 'Imprime escenario'
/* INICIA EL JUEGO */
SW = 1, GANADOR = 0
c=0, cero x=4, cero y=4
Loop
Let ( c:=Getch )
Switch ( c )
Case 'KRIGHT' { #( y < 4 ) do{ ++y }, Exit }
Case 'KDOWN' { #( x < 4 ) do{ ++x }, Exit }
Case 'KLEFT' { #( y > 1 ) do{ --y }, Exit }
Case 'KUP' { #( x > 1 ) do{ --x }, Exit }
Case 'KRETURN' { If ( Gosub 'Chequear si movimiento es válido' )
Gosub 'Mover las casillas'
End If
Exit
}
Case 'KESCAPE' { SW=0 }
End switch
Gosub 'Imprime escenario'
Break if ( Gosub 'Verificar puzzle resuelto' --- Backup to 'GANADOR' )
Back if 'SW' is not zero

/* FIN DEL JUEGO */
If ( GANADOR )
Locate (18,15), Printnl("LO RESOLVISTE!")
End If
Locate (19,1), Prnl
End

Subrutines

/* CHEQUEO DE MOVIMIENTO */

Define ( Verificar puzzle resuelto )
ret = 0
Clr all marks
Tnúmeros=números
Redim (Tnúmeros,0), N = 0, Let ( N := Length(Tnúmeros) Minus (1))
i=1
Iterator ( ++i, Less equal ( i, N ) And( Not(ret) ), \
Let ( ret := Bit xor(i, [i] Get 'Tnúmeros') ) )
Clr all marks
Clear 'Tnúmeros'

Return 'Not (ret); And( Equals(i, Plus one(N)) ) '

Define ( Chequear si movimiento es válido )
Return 'Only one ( Equals (x, cero x), Equals(y, cero y ) )'

Define ( Mover las casillas )
If ( Equals (y, cero y) )
If ( Less (x, cero x) ) // mueve hacia abajo
Loop for ( i = cero x, #( i >= x ) , --i )
If ( Greater ( i, 1 ) )
[{i} Minus(1), y] Get 'números', [i,y] Put 'números'
Else
[{i} Plus(1), y] Get 'números', [i,y] Put 'números'
End If
Next
Else // por defecto: mueve hacia arriba
Loop for ( i = cero x, #( i <= x ) , ++i )
If ( Less ( i, 4 ) )
[{i} Plus(1), y] Get 'números', [i,y] Put 'números'
Else
[i,y] Get 'números', [{i} Minus(1),y] Put 'números'
End If
Next
End If
[x,y] Set '0', Put 'números'
Set 'x', Move to 'cero x'
Else // por defecto: está en la misma fila
If ( Less ( y, cero y ) ) // mueve hacia la derecha
Loop for ( i = cero y, #( i >= y ) , --i )
If ( Greater ( i, 1) )
[x, {i} Minus(1)] Get 'números', [x,i] Put 'números'
Else
[x, y] Get 'números', [x, {i} Plus(1)] Put 'números'
End If
Next
Else // por defecto: mueve hacia la izquierda
Loop for ( i = cero y, #( i <= y ) , ++i )
If ( Less ( i, 4 ) )
[x, {i} Plus(1)] Get 'números', [x,i] Put 'números'
Else
[x,i] Get 'números', [x,{i} Minus(1)] Put 'números'
End If
Next
End If
[x,y] Set '0', Put 'números'
Set 'y', Move to 'cero y'
End If
Clr all marks
Return

/* DESPLIEGUE DE CUADRITOS Y NUMEROS */

Define ( Imprime escenario )
Imprime las casillas
Imprime el índice en 'x,y'
Imprime la matriz
Return

Define ( Pone la matriz )
i=4, col = COLUMNA TABLA, celda=""
Clr all marks
py=1
Loop
j=4, fil = FILA TABLA, px=1
Loop
Locate 'Plus one(fil), Plus two (col)'
Printnl( Get if ([px,py] Get 'números' ---Backup to (celda)---, celda, " ") )
fil += 3
--j, ++px
Back if (j) is not zero
col += 6, --i, ++py
Back if (i) is not zero
Return

Define ( Pone las casillas )
i=4, col = COLUMNA TABLA
Clr all marks
Loop
j=4, fil = FILA TABLA
Loop
Set 'fil, col', Gosub 'Pone un cuadrito'
fil += 3, --j
Back if (j) is not zero
col += 6, --i
Back if (i) is not zero
Return

Define (Pone un cuadrito, fil, col)
Locate 'fil, col', Print table 'casilla'
Return

Define ( Pone el índice, fil, col )
/* 5+(fil-1)*3 fila
10+(col-1)*6 col */
Clr all marks
Locate 'Minus one(fil) Mul by (3) Plus (FILA TABLA), Minus one(col) Mulby(6) Plus(COLUMNA TABLA)'
Print table 'índice'
Return

/* CONFIGURACION DEL JUEGO */

Define ( Crea la matriz de números )
Sequence ( 0, 1, 16, números )
Gosub 'Barajar el array'
Redim ( números, 4,4 )
Return

/* algoritmo de Fisher-Yates */
Define ( Barajar el array )
N = 0, Let ( N := Length(números) )
R = 0, aux = 0
Loop
Let (R := Ceil(Rand(N)))
Let (aux := [R] Get 'números' )
[N] Get 'números', [R] Put 'números'
Set 'aux', [N] Put 'números'
--N
Back if 'N' is positive
If ( [16] Get 'números' ---Backup to 'aux'---, Not (Is zero?) )
[aScan(1,0,números)] Set 'aux', Put 'números'
[16] Set '0', Put 'números'
End If
Return

Define ( Crea una casilla )
Set 'Utf8(Chr(218)),Utf8(Chr(196)),Utf8(Chr(196)),Utf8(Chr(196)),Utf8(Chr(196)),Utf8(Chr(191))', Apnd row 'casilla'
Set 'Utf8(Chr(179))," "," "," "," ",Utf8(Chr(179))', Apnd row 'casilla'
Set 'Utf8(Chr(192)),Utf8(Chr(196)),Utf8(Chr(196)),Utf8(Chr(196)),Utf8(Chr(196)),Utf8(Chr(217))', Apnd row 'casilla'
Return

Define ( Crea el índice )
Set 'Utf8(Chr(220)),Utf8(Chr(220)),Utf8(Chr(220)),Utf8(Chr(220)),Utf8(Chr(220)),Utf8(Chr(220))', Apnd row 'índice'
Set 'Utf8(Chr(219))," "," "," "," ",Utf8(Chr(219))', Apnd row 'índice'
Set 'Utf8(Chr(223)),Utf8(Chr(223)),Utf8(Chr(223)),Utf8(Chr(223)),Utf8(Chr(223)),Utf8(Chr(223))', Apnd row 'índice'
Return

</syntaxhighlight>
{{out}}
<pre>
$ hopper jm/puzzle.jambo

┌────┐┌────┐┌────┐┌────┐
│ 7 ││ 10 ││ 14 ││ 12 │
└────┘└────┘└────┘└────┘
┌────┐┌────┐┌────┐┌────┐
│ 15 ││ ││ 4 ││ 2 │
└────┘└────┘└────┘└────┘
┌────┐▄▄▄▄▄▄┌────┐┌────┐
│ 1 │█ 8 █│ 6 ││ 11 │
└────┘▀▀▀▀▀▀└────┘└────┘
┌────┐┌────┐┌────┐┌────┐
│ 3 ││ 13 ││ 5 ││ 9 │
└────┘└────┘└────┘└────┘

....

┌────┐┌────┐┌────┐┌────┐
│ 1 ││ 2 ││ 3 ││ 4 │
└────┘└────┘└────┘└────┘
┌────┐┌────┐┌────┐┌────┐
│ 5 ││ 6 ││ 7 ││ 8 │
└────┘└────┘└────┘└────┘
┌────┐┌────┐┌────┐┌────┐
│ 9 ││ 10 ││ 11 ││ 12 │
└────┘└────┘└────┘└────┘
┌────┐┌────┐┌────┐▄▄▄▄▄▄
│ 13 ││ 14 ││ 15 │█ █
└────┘└────┘└────┘▀▀▀▀▀▀

LO RESOLVISTE!
</pre>


=={{header|APL}}==
=={{header|APL}}==
Retrieved from "https://rosettacode.org/wiki/15_puzzle_game"