Other Vintage Game

[LOUIS]

HOLA AMIGOS HMG

POR AQUÍ CON ESTE NUEVO JUEGO VINTAGE QUE QUIERO RESCATAR, PARA QUE LO JUEGUEN CHICOS y GRANDES ...
ESTE JUEGUITO ESTUVO PROGRAMADO EN QBASIC-BAJO D.O.S., EN LOS 80 ... SE LLAMA LA CULEBRITA.

A PESAR QUE EMPIEZA CON UNA PANTALLA HMG, LUEGO TUVE QUE PASAR A MODO REQUEST HB_GT_WIN_DEFAULT, PARA GUARDAR EL PARECIDO, ADEMÁS QUE EN MODO HMG NO SABRÍA CÓMO HACERLO

HAY UNAS DIFERENCIAS CON EL JUEGO ORIGINAL DE LOS 80 ... PERO CREO QUE NO ES DE MUCHA IMPORTANCIA ... SINEMBARGO ...

EL VINTAGE TIENE ...
--------------------------
- LOS NÚMEROS VAN SALIENDO A MEDIDA QUE SE "COME" EL QUE ESTÁ EN PANTALLA <--- IRRELEVANTE
- TIENE 5 VIDAS EL JUGADOR <--- IRRELEVANTE
- TIENE SONIDO AL MOMENTO QUE SE COME UN # <--- QUIZÁS NECESARIO
- SI PASA LA PRIMERA PANTALLA AVANZA A OTRO NIVEL DE DIFICULTAD <--- IRRELEVANTE
- GUARDA UN PUNTAJE ... <--- IRRELEVANTE
- SI PASA SOBRE SU PROPIO CUERPO (COLA) PIERDE <--- IMPORTANTE


EL QUE OS PRESENTO, TIENE ...
---------------------------------------
- EL MOVIMIENTO DE LAS 4 TECLAS DIRECCIONALES,
- EL CUERPO DE LA CULEBRA CRECE A MEDIDA QUE AVANZA
- EL TIEMPO DE INTÉRVALO EN MOVERSE LA CULEBRA ESTÁ EN EL PRG (.1) ES LO IDEAL
- PAUSA EL JUEGO CON ESC, PARA QUE EL JUGADOR REVISE SU ESTRATEGIA
- SI LA CULEBRA CHOCA CONTRA EL MARCO ROJO (LÍMITES), PIERDE !
- CONTROLA EL MOVIMIENTO EN CONTRA DE LA DIRECCIÓN QUE VA (TAL COMO EL ORIGINAL),
ES DECIR, SI VA A LA DERECHA Y PULSA HACIA LA IZQUIERDA O VICEVERSA, SE AUTO-ELIMINA
Y PIERDE EL JUEGO, O SI VA PARA ABAJO Y PULSA PARA ARRIBA O VICEVERSA, TAMBIÉN PIERDE.

EN ESTE, APARECEN TODOS LOS 9 NÚMEROS, POSICIONADOS EN FORMA ALEATORIA
EN UNA PANTALLA 25x80 Y LA CULEBRA NACE EN EL CENTRO AL IGUAL QUE EL VINTAGE,
PERO AQUÍ ESPERA A QUE EL JUGADOR PULSE LA PRIMERA TECLA DIRECCIONAL.

TENGO LA CAPTURA DE FILA Y COLUMNA DE CADA NÚMERO EN PANTALLA, EN 9 VARIABLES,
PORQUE CREO SE NECESITARÁ PARA SABER SI EL # FUE TAPADO POR LA CULEBRA,
Y EMITIR UN SONIDO EN ESE MOMENTO.


LO QUE FALTA POR HACER ES ...
---------------------------------------
- LA PANTALLA NEGRA INICIAL QUE NO APAREZCA, SINO CUANDO YA SE OCULTE WINDOW MAIN
- CENTRAR LA PANTALLA DEL JUEGO AUTOMÁTICAMENTE.
- CUANDO LA CULEBRA SE COMA UN # PITE UN SONIDO O APAREZCA ALGO Y DESAPAREZCA.
- SI EL JUGADOR PASA DEL #2 AL #5 o #7 Y NO AL QUE SIGUE, QUE ES EL #3, PIERDE EL JUEGO !
- SI LA CULEBRA PASA POR ENCIMA DE SU PROPIO CUERPO (COLA), PIERDE !
- CUANDO SE TAPE EL #9 DEBE SALIR UN MENSAJE QUE DIGA MSGINFO("LO HA LOGRADO, INTÉNTELO NUEVAMENTE !")
- SI LOGRA TAPAR HASTA EL #9 TAMBIÉN SE PODRÍA AÑADIR EL TIEMPO EN QUE LO HIZO


SI ALGUIEN DESEA AYUDARME, LE AGRADEZCO MUCHO ... ADEMÁS QUE ESTO ES PARA TODOS NOSOTROS

SALUDOS A TODOS
LOUIS

P.D.- LES ADJUNTO EL CÓDIGO ORIGINAL DE QBASIC, POR SI LO QUIEREN REVISAR.

[LOUIS]

Hola Amigos

Continué arreglando el programita de la culebrita y ya emite sonido al comerse los números (agregué un wab) y da el mensaje de despedida cuando el jugador ha terminado el juego, es decir, llegó hasta el número 9

Aún falta que se auto-elimine si se cruza sobre su propio cuerpo y que siga el orden numérico estricto

Alguien se anima a ayudarme a completar el código ?

Saludos a Todos

Louis

P.D.- Ah y también falta esconder la primera pantalla negra que sale al inicio

[LOUIS]

Hola Amigos

Por aquí con una nueva actualización, ya respeta el orden secuencial de los números y amplié un poquito la ventana para ir anotando los números que van siendo tapados.

Saludos
Louis

P.D.- Falta hacer que no aparezca la ventana negra del comienzo y que si la culebrita se cruza con su propio cuerpo se auto-elimine, creo que aquí si necesito de alguien que me dé una manito

[serge_girard]

thanks for sharing!

[edk]

Simplifiqué el código, agregué obstáculos adicionales (ladrillos), detección de colisiones de objetos, respetando el orden de los dígitos, ocultando/mostrando/cambiando el título de la ventana de la consola.

Code: Select all

******************************
*** COMPILADO EN HMG 3.4.0 ***
******************************

#include "hmg.ch"
#include "inkey.ch"

REQUEST HB_GT_WIN_DEFAULT

FUNCTION MAIN()

Public cons_hwnd:=GETCONSOLEWINDOW()
HideConsole(cons_hwnd)

SET CODEPAGE TO UNICODE
SET CURSOR OFF

DEFINE WINDOW SNAKE AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,139,139} MAIN

DRAW RECTANGLE IN WINDOW SNAKE AT 45,195 TO 105,1028 PENCOLOR GREEN PENWIDTH 5 FILLCOLOR {112,128,144}
@ 50,200 LABEL L1 VALUE "J U E G O      L A      C U L E B R I T A" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 36 FONTCOLOR WHITE BOLD UNDERLINE TRANSPARENT
@150,125 LABEL L2 VALUE "- CON LA CULEBRITA, PASA POR ENCIMA DE CADA NÚMERO QUE APARECE EN PANTALLA, EMPIEZA CON EL #1 HASTA LLEGAR AL #9  !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@200,125 LABEL L3 VALUE "- DEBES SEGUIR EXTRICTAMENTE EL ORDEN SECUENCIAL 1-2-3-4-5-6-7-8-9  !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@250,125 LABEL L4 VALUE "- LA CULEBRITA CADA VEZ QUE AVANZA IRÁ CRECIENDO SU CUERPO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@300,125 LABEL L5 VALUE "- PUEDES AVANZAR HACIA CUALQUIER LADO (ARRIBA-ABAJO-DERECHA-IZQUIERDA), UTILIZA LAS FLECHAS DIRECCIONALES," WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@350,125 LABEL L6 VALUE "- SI VAS EN DIRECCIÓN CONTRARIA A LA QUE VAS, TE ELIMINARÁS Y PERDERÁS EL JUEGO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@400,125 LABEL L7 VALUE "- SI CHOCAS CONTRA EL MARCO ROJO (LÍMITE DEL CAMPO DE JUEGO), PERDERÁS !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@450,125 LABEL L8 VALUE "- SI PASAS POR ENCIMA DE TU PROPIO CUERPO (COLA), PERDERÁS EL JUEGO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@500,125 LABEL L9 VALUE "- SI QUIERES PAUSAR EL JUEGO, PARA RECONSIDERAR UNA ESTRATEGIA, PULSA ESCAPE !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT

@575,600 BUTTON B1 CAPTION "J U G A R" FONT "ARIAL" SIZE 12 BOLD ONCLICK ENTRADA()


DEFINE PLAYER MUSIC
   ROW    0
   COL    0
   WIDTH  0
   HEIGHT 0
   FILE GetWindowsFolder() + "\Media\TOWN.MID"		// SONIDO DE FONDO PARA HACERLO AMIGABLE
END PLAYER

END WINDOW

SNAKE.MUSIC.PLAY()
SNAKE.MAXIMIZE
SNAKE.ACTIVATE
RETURN


*---------------
FUNCTION ENTRADA
Local i, aCoordinates, FnNum, CnNum, lFound, cBrick

SNAKE.HIDE

MessageBoxTimeout ("LA CULEBRITA NACE EN EL CENTRO DE LA PANTALLA Y ESPERA QUE TÚ LE DES MOVIMIENTO PARA CUALQUIER LADO")

ShowConsole(cons_hwnd)
SetConsoleTitle( "Snake" )

SETMODE(25,80)
CLEA

SET COLO TO W+/B+

SNAKE.MUSIC.STOP		// AQUÍ NO SÉ CÓMO DETENER EL SONIDO

SET COLO TO R/B
CLEA

DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "R/B" )

SET COLO TO W+/B

aCoordinates := { { 12, 40 } }		//snake's position
FOR i := 1 TO 9
     DO WHILE .T.
          FnNum := HB_RANDOMINT(1,23)
          CnNum := HB_RANDOMINT(1,78)
          IF Empty ( aCoordinates )
	       EXIT
          ELSE
               lFound := .F.
	       AEval ( aCoordinates, { | x | IF ( x [ 1 ] == FnNum .And. x [ 2 ] == CnNum, lFound := .T., Nil ) } ) 
               IF .Not. lFound
                    EXIT
               ENDIF
          ENDIF
      ENDDO
      AAdd ( aCoordinates, { FnNum, CnNum } )
      @ FnNum, CnNum SAY i PICT "9" COLO ("G+/N")	// MUESTRA LOS # ALEATORIAMENTE DENTRO DEL CUADRO

NEXT i

//some bricks
FOR i := 1 TO 9
     DO WHILE .T.
          FnNum := HB_RANDOMINT(1,23)
          CnNum := HB_RANDOMINT(1,78)
          lFound := .F.
	  AEval ( aCoordinates, { | x | IF ( x [ 1 ] == FnNum .And. x [ 2 ] == CnNum, lFound := .T., Nil ) } ) 
          IF .Not. lFound
               EXIT
          ENDIF
      ENDDO
      AAdd ( aCoordinates, { FnNum, CnNum } )
      IF i%1 = 0
          cBrick := "░"
      ENDIF
      IF i%2 = 0
          cBrick := "▓"
      ENDIF
      IF i%3 = 0
          cBrick := "▒"
      ENDIF
      @ FnNum, CnNum SAY cBrick COLO ("R+/N")	// Brick
NEXT i

DO JUGAR

RETURN

********************************
FUNCTION JUGAR
********************************
Local cScrChar, nNextGoal := 1, cMessage, F, C, cDirection := "", nSpeed

Keyboard CHR( 0 )

F := 12
C := 40

@ F,C SAY "☺"

X=0
INKEY(0)

DO WHILE .T.

DO CASE
   CASE lastkey() = K_RIGHT			// FLECHA A LA DERECHA

      DO CASE 
           CASE cDirection = "Up"				// PARA ARRIBA
               @ F,C SAY "╔"		//OK
           CASE cDirection = "Down"
               @ F,C SAY "╚"		//OK
      ENDCASE
      cDirection := "Right"
      C++
      nSpeed := 0.2

   CASE lastkey() = K_LEFT		// FLECHA A LA IZQUIERDA

      DO CASE 
           CASE cDirection = "Up"				// PARA ARRIBA
               @ F,C SAY "╗"		//OK
           CASE cDirection = "Down"
               @ F,C SAY "╝"		//OK
      ENDCASE
      cDirection := "Left"
      C--
      nSpeed := 0.2

   CASE lastkey() = K_UP			// FLECHA ARRIBA

      DO CASE 
           CASE cDirection = "Right"				// PARA ARRIBA
               @ F,C SAY "╝"		//OK
           CASE cDirection = "Left"
               @ F,C SAY "╚"		//OK
      ENDCASE
      cDirection := "Up"
      F--
      nSpeed := 0.35

   CASE lastkey() = K_DOWN		// FLECHA ABAJO

      DO CASE 
           CASE cDirection = "Right"				// PARA ARRIBA
               @ F,C SAY "╗"		//OK
           CASE cDirection = "Left"
               @ F,C SAY "╔"		//OK
      ENDCASE
      cDirection := "Down"
      F++
      nSpeed := 0.35

   CASE lastkey() = K_ESC		// PAUSA EL JUEGO
      @ 24,28 SAY "UD HA PAUSADO EL JUEGO !"
      INKEY(0)
      @ 24,28 SAY "CONTINÚE EL JUEGO .... !"
      LOOP

   CASE lastkey() != K_RIGHT .OR. lastkey() != K_LEFT .OR. lastkey() != K_UP .OR. lastkey() != K_DOWN
      EXIT

ENDCASE

cMessage := CheckCollision ( F /* nRow */ , C /* nCol */, @nNextGoal )
IF Empty ( cMessage )
     @ F,C SAY IF ( cDirection = "Right" .Or. cDirection = "Left", "═", "║" )
ELSE
     MessageBoxTimeout ( cMessage, "Snake" )
     EXIT
ENDIF

INKEY( nSpeed )				// VELOCIDAD DEL JUEGO
  
ENDDO

MessageBoxTimeout ("SALIENDO DE LA CULEBRITA !")
SNAKE.RELEASE
QUIT
RETURN

********************************************************
FUNCTION CheckCollision ( nRow, nCol, nNextGoal )
Local cScrChar := GetCharFromScreen( nRow, nCol ), i

DO CASE
     CASE isDigit ( cScrChar )
          IF Val ( cScrChar ) == nNextGoal
               IF nNextGoal = 9
		    PLAY WAVE GetWindowsFolder() + "\Media\tada.wav"
		    RETURN "LO HA LOGRADO ! ... INTÉNTELO DE NUEVO !!!"
               ENDIF
               PLAY WAVE GetWindowsFolder() + "\Media\ding.wav"
               nNextGoal ++
          ELSE
               PLAY WAVE GetWindowsFolder() + "\Media\notify.wav"
               RETURN "¡Orden equivocado!"
          ENDIF

      CASE cScrChar $ hb_utf8ToStr ( "☺═║╗╔╚╝", "EN" )
          PLAY WAVE GetWindowsFolder() + "\Media\chord.wav"
          SetColor ( "R+/B" )
          @nRow, nCol SAY "♦"
          RETURN "LO SIENTO UD SE HA SUICIDADO !"

      CASE cScrChar = hb_utf8ToStr ( "█", "EN" )
	  PLAY WAVE GetWindowsFolder() + "\Media\ringout.wav"
          FOR i := 1 TO 99
               DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "Y+/B" )
               DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "R/B" )
          NEXT i
          RETURN "SALIÓ DE LA PISTA DE JUEGO"+CHR(13)+CHR(13)+"HA PERDIDO !!!"
		
      CASE cScrChar <> " "
          PLAY WAVE GetWindowsFolder() + "\Media\chimes.wav"
          RETURN "Collision with " + hb_StrToUTF8 ( cScrChar, "EN" )
ENDCASE
RETURN ""
************************************************
FUNCTION GetCharFromScreen( nRow, nCol )
Local cChars
SET CODEPAGE TO ENGLISH
cChars := SaveScreen (nRow, nCol, nRow, nCol)
SET CODEPAGE TO UNICODE
RETURN Left ( cChars, 1 )


#pragma BEGINDUMP

#include "hbapi.h"
#include "hbapiitm.h"
#include <windows.h>

// doesn't work with win32 function GetConsoleWindow()
HWND GetConWin()
{
HWND hwnd;
AllocConsole();
hwnd = FindWindowA("ConsoleWindowClass",NULL);
return hwnd;
}

HB_FUNC( GETCONSOLEWINDOW )
{
hb_retnl ((LONG_PTR) GetConWin());
}

HB_FUNC(HIDECONSOLE )
{
HWND hwnd;
hwnd = (HWND) hb_parnl (1);

if (hwnd==NULL)
	hwnd = GetConWin();
ShowWindow(hwnd,SW_HIDE); // SW_HIDE
}

HB_FUNC(SHOWCONSOLE )
{
HWND hwnd;
hwnd = (HWND) hb_parnl (1);

if (hwnd ==NULL)
	hwnd = GetConWin();
ShowWindow(hwnd,SW_SHOW); // because 1'st time console stays minimized
ShowWindow(hwnd,SW_RESTORE); //SW_SHOW
SetFocus(hwnd);
SetForegroundWindow(hwnd);
}

HB_FUNC(SETCONSOLETITLE)
{ 
SetConsoleTitle( (char *) hb_parc(1) );
}

#pragma ENDDUMP

[LOUIS]

Muchas gracias Amigo Edward

Siempre Ud muy amable !

it turned out prettier

Saludos
Louis

[LOUIS]

Hola Amigos del HMGforum

Agradeciendo nuevamente la gentileza del Amigo Edward por su aporte al código, me permití hacer un pequeño arreglo
la pantalla a 90 para poder ir presentando los números que va cubriendo la culebrita y el sonido del x.wab que me parece
más fuerte y cool

Espero les agrade ...

Saludos
Louis

P.D.- Si alguien cree que puede agregar algo para hacerlo más cool, You can do it and don't forget to share with all of us !

Code: Select all

******************************
*** COMPILADO EN HMG 3.4.0 ***
******************************

#include "hmg.ch"
#include "inkey.ch"

REQUEST HB_GT_WIN_DEFAULT

FUNCTION MAIN()

Public cons_hwnd:=GETCONSOLEWINDOW()
HideConsole(cons_hwnd)

SET CODEPAGE TO UNICODE
SET CURSOR OFF

DEFINE WINDOW SNAKE AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,139,139} MAIN

DRAW RECTANGLE IN WINDOW SNAKE AT 45,195 TO 105,1028 PENCOLOR GREEN PENWIDTH 5 FILLCOLOR {112,128,144}
@ 50,200 LABEL L1 VALUE "J U E G O      L A      C U L E B R I T A" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 36 FONTCOLOR WHITE BOLD UNDERLINE TRANSPARENT
@150,125 LABEL L2 VALUE "- CON LA CULEBRITA, PASA POR ENCIMA DE CADA NÚMERO QUE APARECE EN PANTALLA, EMPIEZA CON EL #1 HASTA LLEGAR AL #9  !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@200,125 LABEL L3 VALUE "- DEBES SEGUIR EXTRICTAMENTE EL ORDEN SECUENCIAL 1-2-3-4-5-6-7-8-9  !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@250,125 LABEL L4 VALUE "- LA CULEBRITA CADA VEZ QUE AVANZA IRÁ CRECIENDO SU CUERPO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@300,125 LABEL L5 VALUE "- PUEDES AVANZAR HACIA CUALQUIER LADO (ARRIBA-ABAJO-DERECHA-IZQUIERDA), UTILIZA LAS FLECHAS DIRECCIONALES," WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@350,125 LABEL L6 VALUE "- SI VAS EN DIRECCIÓN CONTRARIA A LA QUE VAS, TE ELIMINARÁS Y PERDERÁS EL JUEGO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@400,125 LABEL L7 VALUE "- SI CHOCAS CONTRA EL MARCO ROJO (LÍMITE DEL CAMPO DE JUEGO), PERDERÁS !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@450,125 LABEL L8 VALUE "- SI PASAS POR ENCIMA DE TU PROPIO CUERPO (COLA), PERDERÁS EL JUEGO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@500,125 LABEL L9 VALUE "- SI QUIERES PAUSAR EL JUEGO, PARA RECONSIDERAR UNA ESTRATEGIA, PULSA ESCAPE !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT

@575,600 BUTTON B1 CAPTION "J U G A R" FONT "ARIAL" SIZE 12 BOLD ONCLICK ENTRADA()


DEFINE PLAYER MUSIC
   ROW    0
   COL    0
   WIDTH  0
   HEIGHT 0
   FILE GetWindowsFolder() + "\Media\TOWN.MID"		// SONIDO DE FONDO PARA HACERLO AMIGABLE
END PLAYER

END WINDOW

SNAKE.MUSIC.PLAY()
SNAKE.MAXIMIZE
SNAKE.ACTIVATE
RETURN


*---------------
FUNCTION ENTRADA
Local i, aCoordinates, FnNum, CnNum, lFound, cBrick

SNAKE.HIDE

MessageBoxTimeout ("LA CULEBRITA NACE EN EL CENTRO DE LA PANTALLA"+CHR(13)+CHR(13)+" Y ESPERA QUE TÚ LE DES MOVIMIENTO"+CHR(13)+"PARA CUALQUIER LADO ╬ ...")

ShowConsole(cons_hwnd)
SetConsoleTitle( "Snake" )

SETMODE(25,90)
CLEA

SET COLO TO W+/B+

SNAKE.MUSIC.STOP

SET COLO TO R/B
CLEA

DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "R/B" )

SET COLO TO W+/B

aCoordinates := { { 12, 40 } }		//snake's position
FOR i := 1 TO 9
     DO WHILE .T.
          FnNum := HB_RANDOMINT(1,23)
          CnNum := HB_RANDOMINT(1,78)
          IF Empty ( aCoordinates )
	       EXIT
          ELSE
               lFound := .F.
	       AEval ( aCoordinates, { | x | IF ( x [ 1 ] == FnNum .And. x [ 2 ] == CnNum, lFound := .T., Nil ) } ) 
               IF .Not. lFound
                    EXIT
               ENDIF
          ENDIF
      ENDDO
      AAdd ( aCoordinates, { FnNum, CnNum } )
      @ FnNum, CnNum SAY i PICT "9" COLO ("G+/N")	// MUESTRA LOS # ALEATORIAMENTE DENTRO DEL CUADRO
NEXT i

//nine bricks
FOR i := 1 TO 9
     DO WHILE .T.
          FnNum := HB_RANDOMINT(1,23)
          CnNum := HB_RANDOMINT(1,78)
          lFound := .F.
	  AEval ( aCoordinates, { | x | IF ( x [ 1 ] == FnNum .And. x [ 2 ] == CnNum, lFound := .T., Nil ) } ) 
          IF .Not. lFound
               EXIT
          ENDIF
      ENDDO
      AAdd ( aCoordinates, { FnNum, CnNum } )

      IF i%1 = 0 .OR. i%2 = 0 .OR. i%3 = 0
          cBrick := "◙"
      ENDIF

      @ FnNum, CnNum SAY cBrick COLO ("W+/B")	// Brick
NEXT i

DO JUGAR

RETURN

********************************
FUNCTION JUGAR
********************************
Local cScrChar, nNextGoal := 1, cMessage, F, C, cDirection := "", nSpeed

@ 6,82 SAY "NÚMEROS"
@ 7,82 SAY "TAPADOS"
@ 8,82 SAY "======="

Keyboard CHR( 0 )

F := 12
C := 40

@ F,C SAY "╬"

X=0
INKEY(0)

DO WHILE .T.

DO CASE
   CASE lastkey() = K_RIGHT			// FLECHA A LA DERECHA

      DO CASE 
           CASE cDirection = "Up"				// PARA ARRIBA
               @ F,C SAY "╔"		//OK
           CASE cDirection = "Down"
               @ F,C SAY "╚"		//OK
      ENDCASE
      cDirection := "Right"
      C++
      nSpeed := 0.2

   CASE lastkey() = K_LEFT		// FLECHA A LA IZQUIERDA

      DO CASE 
           CASE cDirection = "Up"				// PARA ARRIBA
               @ F,C SAY "╗"		//OK
           CASE cDirection = "Down"
               @ F,C SAY "╝"		//OK
      ENDCASE
      cDirection := "Left"
      C--
      nSpeed := 0.2

   CASE lastkey() = K_UP			// FLECHA ARRIBA

      DO CASE 
           CASE cDirection = "Right"				// PARA ARRIBA
               @ F,C SAY "╝"		//OK
           CASE cDirection = "Left"
               @ F,C SAY "╚"		//OK
      ENDCASE
      cDirection := "Up"
      F--
      nSpeed := 0.35

   CASE lastkey() = K_DOWN		// FLECHA ABAJO

      DO CASE 
           CASE cDirection = "Right"				// PARA ARRIBA
               @ F,C SAY "╗"		//OK
           CASE cDirection = "Left"
               @ F,C SAY "╔"		//OK
      ENDCASE
      cDirection := "Down"
      F++
      nSpeed := 0.35

   CASE lastkey() = K_ESC		// PAUSA EL JUEGO
      @ 24,28 SAY "UD HA PAUSADO EL JUEGO !"
      INKEY(0)
      @ 24,28 SAY "CONTINÚE EL JUEGO .... !"
      LOOP

   CASE lastkey() != K_RIGHT .OR. lastkey() != K_LEFT .OR. lastkey() != K_UP .OR. lastkey() != K_DOWN
      EXIT

ENDCASE

cMessage := CheckCollision ( F /* nRow */ , C /* nCol */, @nNextGoal )
IF Empty ( cMessage )
     @ F,C SAY IF ( cDirection = "Right" .Or. cDirection = "Left", "═", "║" )
ELSE
     MessageBoxTimeout ( cMessage, "Snake" )
     EXIT
ENDIF

INKEY( nSpeed )				// VELOCIDAD DEL JUEGO
  
ENDDO

MessageBoxTimeout ("SALIENDO DE LA CULEBRITA !")
SNAKE.RELEASE
QUIT
RETURN

********************************************************
FUNCTION CheckCollision ( nRow, nCol, nNextGoal )
Local cScrChar := GetCharFromScreen( nRow, nCol ), i

DO CASE
     CASE isDigit ( cScrChar )
          IF Val ( cScrChar ) == nNextGoal
               IF nNextGoal = 9
		    PLAY WAVE GetWindowsFolder() + "\Media\tada.wav"
                    @ nNextGoal+8,85 SAY ALLTRIM(STR(nNextGoal))
		    RETURN "LO HA LOGRADO ! ... INTÉNTELO DE NUEVO !!!"
               ENDIF
               PLAY WAVE "X.wav"
               //PLAY WAVE GetWindowsFolder() + "\Media\ding.wav"
               @ nNextGoal+8,85 SAY ALLTRIM(STR(nNextGoal))
               nNextGoal ++
          ELSE
               PLAY WAVE GetWindowsFolder() + "\Media\notify.wav"
               RETURN "¡ESE NÚMERO NO ERA EL QUE SEGUÍA!"
          ENDIF

      CASE cScrChar $ hb_utf8ToStr ( "☺═║╗╔╚╝", "EN" )
          PLAY WAVE GetWindowsFolder() + "\Media\chord.wav"
          SetColor ( "R+/B" )
          @nRow, nCol SAY "♦"
          RETURN "LO SIENTO UD SE HA SUICIDADO !"

      CASE cScrChar = hb_utf8ToStr ( "█", "EN" )
	  PLAY WAVE GetWindowsFolder() + "\Media\ringout.wav"
          FOR i := 1 TO 99
               DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "Y+/B" )
               DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "R/B" )
          NEXT i
          RETURN "SALIÓ DE LA PISTA DE JUEGO"+CHR(13)+CHR(13)+"HA PERDIDO !!!"
		
      CASE cScrChar <> " "
          PLAY WAVE GetWindowsFolder() + "\Media\chimes.wav"
          RETURN "Collision with " + hb_StrToUTF8 ( cScrChar, "EN" )
ENDCASE
RETURN ""


************************************************
FUNCTION GetCharFromScreen( nRow, nCol )
Local cChars
SET CODEPAGE TO ENGLISH
cChars := SaveScreen (nRow, nCol, nRow, nCol)
SET CODEPAGE TO UNICODE
RETURN Left ( cChars, 1 )


#pragma BEGINDUMP

#include "hbapi.h"
#include "hbapiitm.h"
#include <windows.h>

// doesn't work with win32 function GetConsoleWindow()
HWND GetConWin()
{
HWND hwnd;
AllocConsole();
hwnd = FindWindowA("ConsoleWindowClass",NULL);
return hwnd;
}

HB_FUNC( GETCONSOLEWINDOW )
{
hb_retnl ((LONG_PTR) GetConWin());
}

HB_FUNC(HIDECONSOLE )
{
HWND hwnd;
hwnd = (HWND) hb_parnl (1);

if (hwnd==NULL)
	hwnd = GetConWin();
ShowWindow(hwnd,SW_HIDE); // SW_HIDE
}

HB_FUNC(SHOWCONSOLE )
{
HWND hwnd;
hwnd = (HWND) hb_parnl (1);

if (hwnd ==NULL)
	hwnd = GetConWin();
ShowWindow(hwnd,SW_SHOW); // because 1'st time console stays minimized
ShowWindow(hwnd,SW_RESTORE); //SW_SHOW
SetFocus(hwnd);
SetForegroundWindow(hwnd);
}

HB_FUNC(SETCONSOLETITLE)
{ 
SetConsoleTitle( (char *) hb_parc(1) );
}

#pragma ENDDUMP

[edk]

Si ha cambiado el símbolo para el inicio de la serpiente, debe incluirlo también en la función que comprueba la colisión de objetos, de lo contrario este símbolo se detectará como un obstáculo extraño y no como parte de la serpiente.

Se agregó SplashScreen, pregunta de repetición, cabeza de serpiente, niveles de dificultad:

Code: Select all

******************************
*** COMPILADO EN HMG 3.4.0 ***
******************************

#include "hmg.ch"
#include "inkey.ch"

REQUEST HB_GT_WIN_DEFAULT

FUNCTION MAIN()

Public cons_hwnd:=GETCONSOLEWINDOW(), nLevel := 1, cEgg := "◌"

HideConsole(cons_hwnd)


SET WINDOW MAIN OFF
CreateScreenSplash ()
SET WINDOW MAIN ON

SET CODEPAGE TO UNICODE
SET CURSOR OFF

DEFINE WINDOW SNAKE AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,139,139} MAIN

DRAW RECTANGLE IN WINDOW SNAKE AT 45,195 TO 105,1028 PENCOLOR GREEN PENWIDTH 5 FILLCOLOR {112,128,144}
@ 50,200 LABEL L1 VALUE "J U E G O      L A      C U L E B R I T A" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 36 FONTCOLOR WHITE BOLD UNDERLINE TRANSPARENT
@150,125 LABEL L2 VALUE "- CON LA CULEBRITA, PASA POR ENCIMA DE CADA NÚMERO QUE APARECE EN PANTALLA, EMPIEZA CON EL #1 HASTA LLEGAR AL #9  !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@200,125 LABEL L3 VALUE "- DEBES SEGUIR EXTRICTAMENTE EL ORDEN SECUENCIAL 1-2-3-4-5-6-7-8-9  !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@250,125 LABEL L4 VALUE "- LA CULEBRITA CADA VEZ QUE AVANZA IRÁ CRECIENDO SU CUERPO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@300,125 LABEL L5 VALUE "- PUEDES AVANZAR HACIA CUALQUIER LADO (ARRIBA-ABAJO-DERECHA-IZQUIERDA), UTILIZA LAS FLECHAS DIRECCIONALES," WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@350,125 LABEL L6 VALUE "- SI VAS EN DIRECCIÓN CONTRARIA A LA QUE VAS, TE ELIMINARÁS Y PERDERÁS EL JUEGO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@400,125 LABEL L7 VALUE "- SI CHOCAS CONTRA EL MARCO ROJO (LÍMITE DEL CAMPO DE JUEGO), PERDERÁS !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@450,125 LABEL L8 VALUE "- SI PASAS POR ENCIMA DE TU PROPIO CUERPO (COLA), PERDERÁS EL JUEGO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@500,125 LABEL L9 VALUE "- SI QUIERES PAUSAR EL JUEGO, PARA RECONSIDERAR UNA ESTRATEGIA, PULSA ESCAPE !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT

@575,600 BUTTON B1 CAPTION "J U G A R" FONT "ARIAL" SIZE 12 BOLD ONCLICK ENTRADA()

DEFINE PLAYER MUSIC
   ROW    0
   COL    0
   WIDTH  0
   HEIGHT 0
   FILE GetWindowsFolder() + "\Media\TOWN.MID"		// SONIDO DE FONDO PARA HACERLO AMIGABLE
END PLAYER

END WINDOW

DoMethod ( "SplashScreen", "HIDE" )

SNAKE.MUSIC.PLAY()
SNAKE.MAXIMIZE
SNAKE.ACTIVATE
RETURN


*-------------------------------------------------------------------------------------------*
PROCEDURE CreateScreenSplash ()
*-------------------------------------------------------------------------------------------*

   DEFINE WINDOW SplashScreen;
         AT 0,0;  
         WIDTH 400;
         HEIGHT 200;
         BACKCOLOR WHITE; 
         NOSYSMENU;
         NOSIZE;
         NOMINIMIZE;
         NOMAXIMIZE; 
         NOCAPTION ;
         CHILD

         SET WINDOW SplashScreen TRANSPARENT TO COLOR WHITE

         @   0,   0 LABEL Frame_1 VALUE "" WIDTH 400 HEIGHT 200 BACKCOLOR NAVY
         @  15,  15 LABEL Frame_2 VALUE "" WIDTH 370 HEIGHT 170 BACKCOLOR WHITE
                 
         @  45,  20 LABEL Label_1 VALUE "S N A K E" WIDTH 360 HEIGHT 60 TRANSPARENT FONT "Times New Roman" SIZE 36 FONTCOLOR NAVY CENTERALIGN 
         @ 105,  20 LABEL Label_2 VALUE "Loading ..." WIDTH 360 HEIGHT 60 TRANSPARENT FONT "Times New Roman" SIZE 36 FONTCOLOR NAVY CENTERALIGN 
         
   END WINDOW

SplashScreen.CENTER
SplashScreen.SHOW

 
RETURN


*---------------
FUNCTION ENTRADA
Local i, aCoordinates, FnNum, CnNum, lFound, cBrick := "◙"

SNAKE.HIDE

MessageBoxTimeout ("LA CULEBRITA NACE EN EL CENTRO DE LA PANTALLA"+CHR(13)+CHR(13)+" Y ESPERA QUE TÚ LE DES MOVIMIENTO"+CHR(13)+"PARA CUALQUIER LADO " + cEgg + " ...")

SNAKE.MUSIC.STOP

ShowConsole(cons_hwnd)
SetConsoleTitle( "Snake" )

SETMODE(25,90)

SET COLO TO R/B
CLEA

DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "R/B" )

SET COLO TO W+/B

aCoordinates := { { 12, 40 } }		//snake egg position
FOR i := 1 TO 9
     DO WHILE .T.
          FnNum := HB_RANDOMINT(1,23)
          CnNum := HB_RANDOMINT(1,78)
          IF Empty ( aCoordinates )
	       EXIT
          ELSE
               lFound := .F.
	       AEval ( aCoordinates, { | x | IF ( x [ 1 ] == FnNum .And. x [ 2 ] == CnNum, lFound := .T., Nil ) } ) 
               IF .Not. lFound
                    EXIT
               ENDIF
          ENDIF
      ENDDO
      AAdd ( aCoordinates, { FnNum, CnNum } )
      @ FnNum, CnNum SAY i PICT "9" COLO ("G+/N")	// MUESTRA LOS # ALEATORIAMENTE DENTRO DEL CUADRO
NEXT i

//nine bricks
FOR i := 1 TO 9 + ( nLevel - 1 ) * 3
     DO WHILE .T.
          FnNum := HB_RANDOMINT(1,23)
          CnNum := HB_RANDOMINT(1,78)
          lFound := .F.
	  AEval ( aCoordinates, { | x | IF ( x [ 1 ] == FnNum .And. x [ 2 ] == CnNum, lFound := .T., Nil ) } ) 
          IF .Not. lFound
               EXIT
          ENDIF
      ENDDO
      AAdd ( aCoordinates, { FnNum, CnNum } )

      @ FnNum, CnNum SAY cBrick COLO ("W+/B")	// Brick

NEXT i

DO JUGAR

RETURN

********************************
FUNCTION JUGAR
********************************
Local cScrChar, nNextGoal := 1, cMessage, F, C, nDirection := 0, nSpeed
Local cHead := "", cUp_Head := "▲", cDown_Head := "▼", cRight_Head := "►", cLeft_Head := "◄"
Local nSpeed_X := 0.2, nSpeed_Y := 0.35

@ 3,82 SAY " LEVEL "
@ 4,82 SAY PADC (AllTrim (Str ( nLevel ) ), 7 )
@ 5,82 SAY "-------"

@ 6,82 SAY "NÚMEROS"
@ 7,82 SAY "TAPADOS"
@ 8,82 SAY "======="

DO WHILE NEXTKEY() # 0 .OR. LASTKEY() # 0   //Reset last and next key buffer
     KEYBOARD CHR(0)
     INKEY(0.1)
     DO EVENTS
ENDDO

F := 12
C := 40

@ F,C SAY cEgg

X=0
INKEY(0)

DO WHILE .T.

DO CASE
   CASE lastkey() = K_RIGHT			// FLECHA A LA DERECHA

      DO CASE 
           CASE nDirection = K_UP				// PARA ARRIBA
               @ F,C SAY "╔"		//OK
           CASE nDirection = K_DOWN
               @ F,C SAY "╚"		//OK
           OTHER
               @ F,C SAY "═"		//OK
      ENDCASE
      nDirection := K_RIGHT
      cHead := cRight_Head
      C++
      nSpeed := nSpeed_X

   CASE lastkey() = K_LEFT		// FLECHA A LA IZQUIERDA

      DO CASE 
           CASE nDirection = K_UP				// PARA ARRIBA
               @ F,C SAY "╗"		//OK
           CASE nDirection = K_DOWN
               @ F,C SAY "╝"		//OK
           OTHER
               @ F,C SAY "═"		//OK
      ENDCASE
      nDirection := K_LEFT
      cHead := cLeft_Head
      C--
      nSpeed := nSpeed_X

   CASE lastkey() = K_UP			// FLECHA ARRIBA

      DO CASE 
           CASE nDirection = K_RIGHT				// PARA ARRIBA
               @ F,C SAY "╝"		//OK
           CASE nDirection = K_LEFT
               @ F,C SAY "╚"		//OK
           OTHER
               @ F,C SAY "║"		//OK
      ENDCASE
      nDirection := K_UP
      cHead := cUp_Head
      F--
      nSpeed := nSpeed_Y

   CASE lastkey() = K_DOWN		// FLECHA ABAJO

      DO CASE 
           CASE nDirection = K_RIGHT				// PARA ARRIBA
               @ F,C SAY "╗"		//OK
           CASE nDirection = K_LEFT
               @ F,C SAY "╔"		//OK
           OTHER
               @ F,C SAY "║"		//OK
      ENDCASE
      nDirection := K_DOWN
      cHead := cDown_Head
      F++
      nSpeed := nSpeed_Y

   CASE lastkey() = K_ESC		// PAUSA EL JUEGO
      @ 24,28 SAY "UD HA PAUSADO EL JUEGO !"
      INKEY(0)
      @ 24,28 SAY "CONTINÚE EL JUEGO .... !"
      LOOP

   CASE lastkey() != K_RIGHT .OR. lastkey() != K_LEFT .OR. lastkey() != K_UP .OR. lastkey() != K_DOWN
      MsgStop ("SALIENDO DE LA CULEBRITA !")
      SNAKE.RELEASE
      QUIT

ENDCASE

cMessage := CheckCollision ( F /* nRow */ , C /* nCol */, @nNextGoal )

IF Empty ( cMessage )
     @ F,C SAY cHead
ELSE
     MessageBoxTimeout ( cMessage, "Snake" )
     EXIT
ENDIF

INKEY( Max ( nSpeed - (nLevel - 1) * .05, .03 ) )				// VELOCIDAD DEL JUEGO
  
ENDDO

IF MsgYesNo ( "¿Quieres jugar de nuevo?", "Snake" )
     ENTRADA()
ENDIF

SNAKE.RELEASE
QUIT

RETURN

********************************************************
FUNCTION CheckCollision ( nRow, nCol, nNextGoal )
Local cScrChar := GetCharFromScreen( nRow, nCol ), i

DO CASE
     CASE isDigit ( cScrChar )
          IF Val ( cScrChar ) == nNextGoal
               IF nNextGoal = 9
		    PLAY WAVE GetWindowsFolder() + "\Media\tada.wav"
                    @ nNextGoal+8,85 SAY ALLTRIM(STR(nNextGoal))
                    nLevel ++
		    RETURN "LO HA LOGRADO ! ... INTÉNTELO DE NUEVO !!!"
               ENDIF
               PLAY WAVE "X.wav"
               //PLAY WAVE GetWindowsFolder() + "\Media\ding.wav"
               @ nNextGoal+8,85 SAY ALLTRIM(STR(nNextGoal))
               nNextGoal ++
          ELSE
               PLAY WAVE GetWindowsFolder() + "\Media\notify.wav"
               RETURN "¡ESE NÚMERO NO ERA EL QUE SEGUÍA!"
          ENDIF

      CASE cScrChar $ hb_utf8ToStr ( cEgg + "═║╗╔╚╝", "EN" )
          PLAY WAVE GetWindowsFolder() + "\Media\chord.wav"
          @nRow, nCol SAY "♦" COLO ("R+/B")
          RETURN "LO SIENTO UD SE HA SUICIDADO !"

      CASE cScrChar = hb_utf8ToStr ( "█", "EN" )
	  PLAY WAVE GetWindowsFolder() + "\Media\ringout.wav"
          FOR i := 1 TO 99
               DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "Y+/B" )
               DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "R/B" )
          NEXT i
          RETURN "SALIÓ DE LA PISTA DE JUEGO"+CHR(13)+CHR(13)+"HA PERDIDO !!!"
		
      CASE cScrChar <> " "
          PLAY WAVE GetWindowsFolder() + "\Media\chimes.wav"
          RETURN "Oh, no, no te golpees la cabeza contra la pared."
ENDCASE
RETURN ""

************************************************
FUNCTION GetCharFromScreen( nRow, nCol )
Local cChars
SET CODEPAGE TO ENGLISH
cChars := SaveScreen (nRow, nCol, nRow, nCol)
SET CODEPAGE TO UNICODE
RETURN Left ( cChars, 1 )


#pragma BEGINDUMP

#include "hbapi.h"
#include "hbapiitm.h"
#include <windows.h>

// doesn't work with win32 function GetConsoleWindow()
HWND GetConWin()
{
HWND hwnd;
AllocConsole();
hwnd = FindWindowA("ConsoleWindowClass",NULL);
return hwnd;
}

HB_FUNC( GETCONSOLEWINDOW )
{
hb_retnl ((LONG_PTR) GetConWin());
}

HB_FUNC(HIDECONSOLE )
{
HWND hwnd;
hwnd = (HWND) hb_parnl (1);

if (hwnd==NULL)
	hwnd = GetConWin();
ShowWindow(hwnd,SW_HIDE); // SW_HIDE
}

HB_FUNC(SHOWCONSOLE )
{
HWND hwnd;
hwnd = (HWND) hb_parnl (1);

if (hwnd ==NULL)
	hwnd = GetConWin();
ShowWindow(hwnd,SW_SHOW); // because 1'st time console stays minimized
ShowWindow(hwnd,SW_RESTORE); //SW_SHOW
SetFocus(hwnd);
SetForegroundWindow(hwnd);
}

HB_FUNC(SETCONSOLETITLE)
{ 
SetConsoleTitle( (char *) hb_parc(1) );
}

#pragma ENDDUMP

[LOUIS]

Muchas Gracias Amigo Edward

Mejoró muchísimo más, está super cool con los niveles de dificultad !

Saludos
Louis

P.D.- Estoy luchando con el Nivel 4

[LOUIS]

Agradeciendo siempre la ayuda prestada del amigo Edward, hice un agregado para que sea más cool !

La ventana del juego ya aparece en el centro de la pantalla y le pregunta al jugador si desea oir la música de fondo mientras juega ...
La primera vez la música se detiene, pero si desea continuar jugando ahí le pregunta ...

Espero les guste a todos

Saludos
Louis