Apagada docs

Aprendiendo a programar el pasado

Herramientas de usuario

Herramientas del sitio


es:basic:xbasic

Xbasic

Durante cierto tiempo miré con entusiasmo este compilador de Basic, coetáneo de VisualBasic, como una solución para programar fácilmente en Windows. Sin embargo, me venció la pereza, dejé de usarlo, y cuando intenté volver descubrí que no era tan fácil como parecía…

xbcaballo

El siguiente programa genera los movimientos posibles del caballo de ajedrez. Uso XBasic para conseguir velocidad, y porque permite usar tipos que Qbasic no permite, como los BYTE, para ahorrar memoria. Estos movimientos pueden ser interpretados por un programa qbasic como PRSALC.BAS. Hice también un programa en javascript que presentaba problemas de saltos del caballo.

xbcaballo.x.txt
'
'
' ####################
' #####  PROLOG  #####
' ####################
'
PROGRAM	"xbCaballo"  ' 1-8 char program/file name without .x or any .extent
VERSION	"1.1000"    ' version number - increment before saving altered program
'
' You can stop the PDE from inserting the following PROLOG comment lines
' by removing them from the prolog.xxx file in your \xb\xxx directory.
'
' Programs contain:  1: PROLOG          - no executable code - see below
'                    2: Entry function  - start execution at 1st declared func
' * = optional       3: Other functions - everything else - all other functions
'
' The PROLOG contains (in this order):
' * 1. Program name statement             PROGRAM "progname"
' * 2. Version number statement           VERSION "0.0000"
' * 3. Import library statements          IMPORT  "libName"
' * 4. Composite type definitions         TYPE <typename> ... END TYPE
'   5. Internal function declarations     DECLARE/INTERNAL FUNCTION Func (args)
' * 6. External function declarations     EXTERNAL FUNCTION FuncName (args)
' * 7. Shared constant definitions        $$ConstantName = literal or constant
' * 8. Shared variable declarations       SHARED  variable
'
' ******  Comment libraries in/out as needed  *****
'
'	IMPORT	"xma"   ' Math library     : SIN/ASIN/SINH/ASINH/LOG/EXP/SQRT...
'	IMPORT	"xcm"   ' Complex library  : complex number library  (trig, etc)
	IMPORT	"xst"   ' Standard library : required by most programs
'	IMPORT	"xgr"   ' GraphicsDesigner : required by GuiDesigner programs
'	IMPORT	"xui"   ' GuiDesigner      : required by GuiDesigner programs
'
 
DECLARE FUNCTION  Entry ()
DECLARE FUNCTION  ProbarDirec ()
DECLARE FUNCTION  SBYTE Matriz (SSHORT X, SSHORT Y)
DECLARE FUNCTION  RecorrerInversoEImprimir (SSHORT X, SSHORT Y)
DECLARE FUNCTION  MostrarSolucion (S$)
DECLARE FUNCTION  SSHORT Cargarsolucion ()
 
SHARED SBYTE VengoDe[64]
'
'
' ######################
' #####  Entry ()  #####
' ######################
'
' Programs contain:
'   1. A PROLOG with type/function/constant declarations.
'   2. This Entry() function where execution begins.
'   3. Zero or more additional functions.
'
FUNCTION  Entry ()
SHARED SBYTE VengoDe[64]
SHARED SBYTE MovimientoX[7]
SHARED SBYTE MovimientoY[7]
AUTO SBYTE X
AUTO SBYTE Y
AUTO SBYTE NextX
AUTO SBYTE NextY
SHARED SBYTE Puntero
 
MovimientoY[0]=-2:MovimientoX[0]=1
MovimientoY[1]=-1:MovimientoX[1]=2
MovimientoY[2]=1:MovimientoX[2]=2
MovimientoY[3]=2:MovimientoX[3]=1
MovimientoY[4]=2:MovimientoX[4]=-1
MovimientoY[5]=1:MovimientoX[5]=-2
MovimientoY[6]=-1:MovimientoX[6]=-2
MovimientoY[7]=-2:MovimientoX[7]=-1
 
VengoDe[0]=-1
 
'Idea:
'Avanzar uno a uno las direcciones;
' Direccion=0
' Probar si las coordenadas para la Direccion estan en el mapa.
' Si se sale del mapa, saltar al final del bucle: Direccion=Direccion+1
' Probar si las coordenadas llevan a una casilla despejada (vengode=0)
' Si ocupada (>=0), saltar al final del bucle: Direccion=Direccion+1
' Si despejada (=-3),
'		X=X+DireccionX
'		Y=Y+DireccionY
'		VengoDe[X,Y]=direccion.
'   Avanzar el puntero de direcciones. Comprobar que sea < 64.
'   Si es 64, recorrer hacia atras e imprimir.
'		Volver al inicio del bucle, con direccion=0
'FIN DEL BUCLE (Direccion=Direccion+1)
' Si hemos llegado a 8
' Tomar VengoDe y Marcar casilla actual como libre
'Volver hacia atras usando (VengoDe+4 MOD 8)
'Reducir el puntero de direcciones.
 
'1-Marcar casillas como libres.
FOR F=0 TO 64
	VengoDe[F]=-3
NEXT F
 
 
'Recuperar soluciones antiguas--esto permite ejecutar el programa por lotes.
	SI$=INLINE$("Desea cargar soluciones antiguas desde fichero (S/N)?")
	RESP=0
	DO WHILE RESP=0
		IF (UCASE$(SI$)="S") OR (UCASE$(SI$)="Y") THEN RESP=1
		IF UCASE$(SI$)="N" THEN RESP=-1
	LOOP
	IF RESP=1 THEN
		R=Cargarsolucion()
		IF R<>-1 THEN
			X=R MOD 8
			Y=INT(R / 8)
			GOTO RecienCargado
		END IF
	END IF
 
'Inicializar variables
	Puntero=0
	X=0
	Y=0
 
'Bucle principal
DO
  NextX=X+MovimientoX[Direccion]
  NextY=Y+MovimientoY[Direccion]
  ' Probar si las coordenadas para la Direccion son validas
	' Si despejada (=-3),
  Mat=Matriz(NextX,NextY)
	'PRINT SPACE$(Puntero+1)+STRING$(Direccion)+"["+STRING$(Puntero)+"]"
	IF Mat=-3 THEN
		X=NextX
		Y=NextY
    VengoDe[Y*8+X]=Direccion
		Direccion=0
    Puntero=Puntero+1
'Tras cargar una solucion antigua venimos aqu
RecienCargado:
    IF Puntero=63 THEN
			RecorrerInversoEImprimir(X,Y)
			GOSUB Retroceso
		END IF
	ELSE
		Direccion=Direccion+1
		DO WHILE Direccion>=8
			GOSUB Retroceso
		LOOP
	END IF
LOOP
 
 
 
SUB Retroceso
			VengoDesde=Matriz(X,Y)
			VengoDe[Y*8+X]=-3
    	'Si vengodesde contiene un valor ilegal, probablemente hemos terminado.
	    IF VengoDesde<0 THEN EXIT FUNCTION
  	'Si puntero es -1, probablemente hemos terminado.
    	Puntero=Puntero-1
	    IF Puntero<0 THEN EXIT FUNCTION
    	X=X+MovimientoX[(VengoDesde+4) MOD 8]
		  Y=Y+MovimientoY[(VengoDesde+4) MOD 8]
			Direccion=VengoDesde+1
END SUB
 
 
 
 
END FUNCTION
'
'
' ############################
' #####  ProbarDirec ()  #####
' ############################
'
FUNCTION  ProbarDirec ()
SHARED SBYTE MovimientoX[]
SHARED SBYTE MovimientoY[]
FOR f=0 TO 7
	FOR g=-2 TO 2
    Q$="|"
		FOR h=-2 TO 2
	    IF (h=MovimientoX[f]) AND (g=MovimientoY[f]) THEN
				Q$=Q$+"*"
			ELSE
				IF (h=0) AND (g=0) THEN
					Q$=Q$+"X"
				ELSE
          IF (h=MovimientoX[(f+4) MOD 8]) AND (g=MovimientoY[(f+4) MOD 8]) THEN
						Q$=Q$+"@"
		      ELSE
						Q$=Q$+" "
					END IF
 				END IF
			END IF
			Q$=Q$+"|"
		NEXT h
    PRINT Q$
    Q$="-"
		FOR h=-2 TO 2
			Q$=Q$+"--"
    NEXT
    PRINT Q$
  NEXT g
	PRINT
	PRINT f
	X$=INLINE$(X$)
NEXT f
END FUNCTION
'
'
' #######################
' #####  Matriz ()  #####
' #######################
'
FUNCTION  SBYTE Matriz (SSHORT X, SSHORT Y)
SHARED SBYTE VengoDe[]
	IF X<0 THEN RETURN -2
  IF X>=8 THEN RETURN -2
  IF Y<0 THEN RETURN -2
  IF Y>=8 THEN RETURN -2
	'PRINT Y*8+X;"=>";
	'PRINT VengoDe[Y*8+X]
  RETURN (VengoDe[Y*8+X])
END FUNCTION
'
'
' #########################################
' #####  RecorrerInversoEImprimir ()  #####
' #########################################
'
FUNCTION  RecorrerInversoEImprimir (SSHORT X, SSHORT Y)
SHARED SBYTE MovimientoX[]
SHARED SBYTE MovimientoY[]
ofile=OPEN ("SALTOSCABALLO.TXT",$$RW)
SEEK (ofile,LOF(ofile))
P$=""
Direc=Matriz(X,Y)
DO WHILE Direc>=0
	P$=STR$(Direc)+P$
	X=X+MovimientoX[(Direc+4) MOD 8]
	Y=Y+MovimientoY[(Direc+4) MOD 8]
	Direc=Matriz(X,Y)
LOOP
PRINT P$
PRINT [ofile],P$
CLOSE (ofile)
' Des-comentar para mostrar la solucion en un tablero.
' MostrarSolucion(Solu1$)
 
END FUNCTION
'
'
' ################################
' #####  MostrarSolucion ()  #####
' ################################
'
FUNCTION  MostrarSolucion (S$)
SHARED SBYTE MovimientoX[]
SHARED SBYTE MovimientoY[]
SBYTE Mat[8,8]
SBYTE Dir
SBYTE X
SBYTE Y
UBYTE P
Tablero$=""
X=0:Y=0:P=0
	FOR f=1 TO LEN(S$) STEP 2
		Mat[X,Y]=P
		P=P+1
		Dir=SBYTE(MID$(S$,f,2))
		X=X+MovimientoX[Dir]
		Y=Y+MovimientoY[Dir]
	NEXT f
	Mat[X,Y]=P
	FOR X=0 TO 7
		L1$=""
		L2$=""
		FOR Y=0 TO 7
			L1$=L1$+RIGHT$(STR$(Mat[X,Y]),2)+"|"
      L2$=L2$+"---"
		NEXT Y
		Tablero$=Tablero$+L1$+"\n"+L2$+"\n"
	NEXT X
	PRINT Tablero$
END FUNCTION
'
'
' ###############################
' #####  Cargarsolucion ()  #####
' ###############################
'
FUNCTION USHORT   Cargarsolucion ()
SHARED SBYTE VengoDe[]
SHARED SBYTE MovimientoX[]
SHARED SBYTE MovimientoY[]
SBYTE Dir
SHARED SBYTE Puntero
AUTO SBYTE X
AUTO SBYTE Y
SSHORT ifile
 
	ifile=OPEN ("SALTOSCABALLO.TXT",$$RD)
	IF ifile=-1 THEN RETURN -1
 
	longitud=LOF(ifile)
	IF longitud=0 THEN
		CLOSE (ifile)
		XstDeleteFile("SALTOSCABALLO.TXT")
		RETURN -1
	END IF
 
	PRINT "RECUPERANDO ULTIMA POSICION DESDE FICHERO"
	Line1$=""
	DO
		Line2$=Line1$
		Line1$=INFILE$(ifile)
	LOOP WHILE NOT EOF(ifile)
 
 
	X=0:Y=0:Dir=0:Puntero=0
	FOR f=1 TO LEN(Line2$) STEP 2
		IF Matriz(X,Y)<>-3 THEN
			PRINT "ERROR -- FICHERO O DATOS INVALIDOS"
			GOSUB VaciaTablero
			RETURN -1
		END IF
		VengoDe[Y*8+X]=Dir
		Puntero=Puntero+1
		Dir=SBYTE(MID$(Line2$,f,2))
		X=X+MovimientoX[Dir]
		Y=Y+MovimientoY[Dir]
 
	NEXT f
	VengoDe[Y*8+X]=Dir
 
	PRINT "Datos cargados"
 
	RETURN Y*8+X
 
	SUB VaciaTablero
		FOR f=0 TO 63
			VengoDe[f]=-3
		NEXT f
	END SUB
 
END FUNCTION
END PROGRAM
prsalc.bas
'Probando el programa xbasic del salto del caballo.
Direcciones:
DATA 1,-2: '0 - a la una
DATA 2,-1: '1 - a las dos
DATA 2,1: '2 - a las cuatro
DATA 1,2: '3 - a las cinco
DATA -1,2: '4- a las siete
DATA -2,1: '5- a las ocho
DATA -2,-1: '6 - a las diez
DATA -1,-2: '7- A las 11
 
Saltos:
'Importados desde saltoscaballo.txt generado por xbasic
DATA 2,1,2,3,4,3,6,0: '
DATA 0,5,2,4,5,0,0,0: '
DATA 5,0,5,2,0,5,4,4: '
DATA 1,2,4,6,5,6,0,0: '
DATA 0,3,0,5,6,4,2,7: '
DATA 4,3,4,1,0,6,7,1: '
DATA 4,4,3,2,0,7,4,4: '
DATA 7,1,0,3,4,2,1: '
DIM movimientox(0 TO 7)
DIM movimientoy(0 TO 7)
RESTORE Direcciones
FOR f = 0 TO 7
    READ movimientox(f), movimientoy(f)
NEXT
CLS
FOR x = 0 TO 7
    FOR y = 0 TO 7
    LOCATE y * 2 + 1, x * 3 + 1
    PRINT "  |"
    LOCATE y * 2 + 2, x * 3 + 1
    PRINT "---"
    NEXT y
NEXT x
 
RESTORE Saltos
x = 0: y = 0
FOR f = 0 TO 63
    LOCATE y * 2 + 1, x * 3 + 1
    PRINT USING "##|"; f
    LOCATE y * 2 + 2, x * 3 + 1
    PRINT "---"
    IF f < 63 THEN READ salto
    x = x + movimientox(salto)
    y = y + movimientoy(salto)
    SLEEP 0
NEXT f
Este sitio web utiliza cookies. Al utilizar el sitio web, usted acepta almacenar cookies en su computadora. También reconoce que ha leído y entendido nuestra Política de privacidad. Si no está de acuerdo abandone el sitio web.Más información
es/basic/xbasic.txt · Última modificación: 2010/02/02 16:35 por nepenthes