Apagada docs

Aprendiendo a programar el pasado

Herramientas de usuario

Herramientas del sitio


es:basic:gwbasic:decgwba

decgwbas.bas y decgwba2.bas

Gwbasic permitía grabar los programas en dos formatos:

  • Un formato binario, que reflejaba el formato en que el programa era almacenado en memoria por el intérprete.
  • Un formato ascii, que permitía la edición posterior con un editor de texto o el uso de comandos como “Chain” y “Merge”.
SAVE "PROGRAMA.BAS" : REM Esto guarda el programa en formato binario
SAVE "PROGRAMA.BAS",A:REM Esto guarda el programa en formato ascii

Estos dos programas, compatibles con diversos dialectos de BASIC, permiten descomprimir programas grabados con GW-BASIC, sin necesidad de usar el propio GW-BASIC. Por razones de compatibilidad, se han mantenido los números de línea.

(Una sugerencia: puede usar QB64 para convertir este programa en un ejecutable compatible con Windows que le permita convertir sus viejos programas GWBASIC en listados legibles).

10 REM ******** DECGWBAS.BAS ********
15 REM Lee un archivo GWBASIC binario y produce un archivo
20 REM GWBASIC ascii
25 REM Util para leer archivos GWBASIC en QBASIC/QB64/FreeBasic
30 REM sin necesidad de tener una copia de GWBASIC.
35 REM (el último DOS que incluyó GWBASIC fue MS-DOS 4.01, 1989)
40 REM También podría funcionar para adaptar programas de GWBASIC
45 REM a otros BASIC basados en lineas como Chipmunk o Ubasic
50 REM ******** (c) José G Moya Y 2010 ********
55 REM Versi¢n RANDOM= Usa OPEN FOR RANDOM por compatibilidad con GWBASIC
60 REM KNOWN BUGS Listed at 20000
65 REM *****************************
70 FILES: PRINT "Por favor, introduzca el nombre de un archivo basic comprimido"
80 INPUT FileName$
90 PRINT "Introduzca el nombre del archivo de salida"
95 INPUT Outfile$
100 DEBUG = 0: REM Modo aprendizaje 0=Normal, 1=Debug
120 DIM COMAN$(1024): estado = 1
130 GOSUB 9000: CLS
135 REM NOMBRE DEL FICHERO QUE SE ABRIRA:
140 OPEN FileName$ FOR RANDOM AS #1 LEN = 1: FIELD 1, 1 AS CampoUno$
150 REM DEBUG: Lee una version ascii del archivo para
160 REM aprender nuevos comandos...
170 IF DEBUG >= 1 THEN OPEN "3ENRAYA.BAS" FOR INPUT AS #2
175 IF Outfile$ > "" THEN OPEN Outfile$ FOR OUTPUT AS #3
180 REM Leer "Magic signature" en byte 0
190 GET #1: I$ = CampoUno$
200 IF ASC(I$) <> 255 THEN PRINT "ARCHIVO INCORRECTO": END
210 WHILE SEEK(1) < LOF(1)
220    REM NO usamos "On... Gosub" por compatibilidad con
230    REM qbasic/freebasic/qb64
240    IF estado = 1 THEN GOSUB 1000
250    IF estado = 2 THEN GOSUB 2000
260    IF estado = 3 THEN GOSUB 3000
270    IF estado = 4 OR estado = 5 THEN GOSUB 4000
280    IF estado = 6 OR estado = 8 THEN GOSUB 4500
290    IF estado = 7 THEN GOSUB 5000
300    IF estado = 9 THEN GOSUB 5200
310    IF estado = 10 THEN GOSUB 5500
320    IF estado = 18 THEN GOSUB 6000
330    IF estado = 19 THEN GOSUB 6200
400    REM Salida de depuraci¢n...
410    IF DEBUG >= 2 THEN PRINT SALIDA$
420    REM Impresi¢n a disco...
430    IF (estado = 1) OR (estado = 99) THEN GOSUB 500
440    IF estado = 99 THEN PRINT "***THE*END***": END
450    IF DEBUG >= 3 THEN LOCATE CSRLIN, 1: PRINT "Press key"; : SLEEP 0: LOCATE CSRLIN, 1: PRINT SPACE$(9); : LOCATE CSRLIN, 1
460 WEND
500 REM ******* SALIDA A ARCHIVO *********
510 COLOR 15, 0
520 PRINT SALIDA$
530 IF Outfile$ > "" THEN PRINT #3, SALIDA$
540 COLOR 7, 0
550 sALIDA$=""
560 RETURN
1000 REM ******** ESTADO=1. INICIO LINEA ********
1010 REM en M$ hay un puntero que se incrementa en la longitud de la línea,
1020 REM pero no nos vale de nada hasta haber leído todas las líneas.
1030 GET #1: M$ = CampoUno$: GET #1: M$ = M$ + CampoUno$
1040 IF DEBUG >= 1 THEN PRINT "["; CVI(M$); "]"
1050 estado = 2: SHIFTED = 0
1060 IF CVI(M$) = 0 THEN estado = 99: RETURN
1070 IF DEBUG >= 1 THEN LINE INPUT #2, LINEA$
1080 RETURN
2000 REM ******** ESTADO=2. NUMERO LINEA ********
2010 GET #1: M$ = CampoUno$: GET #1: M$ = M$ + CampoUno$
2015 REM **** El numero de línea es un entero sin signo...
2020 SALIDA$ = SALIDA$ + STR$(ASC(LEFT$(M$, 1)) + 256! * ASC(RIGHT$(M$, 1))) + " "
2030 estado = 3
2050 RETURN
3000 REM ******** ESTADO=3. COMANDO ********
3010 GET #1: M$ = CampoUno$: LASTCMD = CMD: CMD = ASC(M$)
3020 IF CMD = 34 THEN estado = 18: REM don't return, wait until next line
3030 IF CMD >= 32 AND CMD <= 127 THEN SALIDA$ = SALIDA$ + M$: RETURN
3040 IF CMD = 11 THEN estado = 4: RETURN: REM OCT LITERAL
3050 IF CMD = 12 THEN estado = 5: RETURN: REM HEX LITERAL
3060 IF CMD = 14 THEN estado = 6: RETURN: REM VALOR NUMERICO Word
3070 IF CMD = 15 THEN estado = 7: RETURN: REM VALOR NUMERICO Byte
3080 IF (CMD >= 17) AND (CMD <= 27) THEN SALIDA$ = SALIDA$ + STR$(CMD - 17): RETURN: REM NUMERO
3090 IF CMD = 28 THEN estado = 8: RETURN: REM Entero=Word?
3100 IF CMD = 29 THEN estado = 9: RETURN: REM VALOR NUMERICO Simple
3110 IF CMD = 31 THEN estado = 10: RETURN: REM VALOR NUMERICO Doble
3120 IF CMD = 0 THEN estado = 1: RETURN
3130 IF CMD >= 253 THEN IF SHIFTED > 0 THEN PRINT "ERROR": GOTO 9500 ELSE SHIFTED = CMD - 252: RETURN
3145 IF (LASTCMD >= 128) AND (CMD >= 128) THEN SALIDA$ = SALIDA$ + " "
3140 IF COMAN$((CMD - 128) + 128 * SHIFTED) = "REM" THEN estado = 19: REM don't return, wait until next line
3150 IF COMAN$((CMD - 128) + 128 * SHIFTED) = "" THEN GOTO 9500 ELSE SALIDA$ = SALIDA$ + COMAN$((CMD - 128) + 128 * SHIFTED): SHIFTED = 0
'IF INSTR(salida$, "PRINT") > 0 THEN STOP
3200 RETURN
4000 REM ******** ESTADO=4/5 Oct literal/hex literal ********
4010 REM GWBASIC usa &O1 en lugar de &1 en sus archivos ascii
4020 IF estado = 4 THEN SALIDA$ = SALIDA$ + "&O" ELSE SALIDA$ = SALIDA$ + "&H"
4025 REM el valor es "unsigned". GWBASIC no acepta long, uso single.
4030 GET #1: VALORH! = ASC(CampoUno$)
4035 GET #1: VALORH! = VALORH! + 256! * ASC(CampoUno$)
4040 IF estado = 4 THEN SALIDA$ = SALIDA$ + OCT$(VALORH!) ELSE SALIDA$ = SALIDA$ + HEX$(VALORH!)
4050 estado = 3
4060 RETURN
4500 REM ******** ESTADO=6/8. NUMERO 2 Bytes ********
4505 REM Con estado=6, esperamos "Unsigned"
4510 GET #1: M$ = CampoUno$: GET #1: M$ = M$ + CampoUno$: Word! = 0
4515 IF estado = 6 THEN Word! = ASC(LEFT$(M$, 1)) + 256& * ASC(RIGHT$(M$, 1)) ELSE Word! = CVI(M$)
4520 SALIDA$ = SALIDA$ + STR$(Word!)
4530 estado = 3
4540 RETURN
5000 REM ******** ESTADO=7. NUMERO 1 Byte ********
5010 GET #1: M$ = CampoUno$
5020 SALIDA$ = SALIDA$ + STR$(ASC(M$))
5030 estado = 3
5040 RETURN
5200 REM ******** ESTADO=9. PRECISION SIMPLE ********
5210 M$ = "": FOR G = 1 TO 4: GET #1: M$ = M$ + CampoUno$: NEXT: SIMPLE% = 0
5220 REM Detectando GWBASIC/QBASIC:
5230 IF MKSMBF$(1) = "" THEN SIMPLE! = CVS(M$) ELSE SIMPLE! = CVSMBF(M$)
5240 REM Manteniendo precisi¢n en la salida
5250 REM Esto es especialmente necesario para n£meros aparentemente
5260 REM enteros (1% y similares)
5270 SALIDA$ = SALIDA$ + STR$(SIMPLE!)
5280 IF INT(SIMPLE!) = SIMPLE! THEN SALIDA$ = SALIDA$ + "!"
5290 estado = 3
5300 RETURN
5500 REM ******** ESTADO=10. PRECISION DOBLE ********
5510 M$ = "": FOR G = 1 TO 8: GET #1: M$ = M$ + CampoUno$: NEXT: largo# = 0
5520 REM Detectando GWBASIC/QBASIC:
5530 IF MKDMBF$(1) = "" THEN largo# = CVD(M$) ELSE largo# = CVDMBF(M$)
5540 REM Manteniendo precisi¢n en la salida
5550 REM Esto es especialmente necesario para n£meros aparentemente
5560 REM enteros (1# y similares)
5570 SALIDA$ = SALIDA$ + STR$(largo#) + "#"
5580 estado = 3
5590 RETURN
6000 REM ******** ESTADO=18. LITERAL HASTA COMILLAS ********
6010 GET #1: M$ = CampoUno$
6020 SALIDA$ = SALIDA$ + M$
6030 IF M$ = CHR$(34) THEN estado = 3
6040 REM En caso de comillas dobles (""), la rutina en estado=2 volver  a estado=6
6050 RETURN
6200 REM ******** ESTADO=19. LITERAL HASTA FIN DE LINEA (REM) ********
6210 GET #1: M$ = CampoUno$
6220 SALIDA$ = SALIDA$ + M$
6230 IF M$ = CHR$(0) THEN estado = 1
6240 RETURN
8999 END
9000 REM ******** INICIALIZAR COMANDOS ********
9010 RESTORE 10000
9020 CMDACT$ = "": CMD = 0
9030 WHILE CMDACT$ <> "***"
9040 READ CMDACT$, CMD
9050 IF CMD <> -1 THEN COMAN$(CMD - 128) = CMDACT$
9060 WEND
9070 RETURN
9500 REM ***** Comando no reconocido *****
9510 PRINT "Comando "; SHIFTED * 128 + ASC(M$); " no reconocido: "
9520 PRINT "(procesado>)"; SALIDA$;
9530 IF SHIFTED > 0 THEN PRINT "["; 252 + SHIFTED; "]";
9540 PRINT "["; ASC(M$); "]"
9550 PRINT SPC(LEN(SALIDA$) + 11);
9560 PRINT "^"
9570 REM En modo debug, se muestra la l¡nea ASCII para que se
9580 REM actualicen los DATAs
9590 IF DEBUG >= 1 THEN PRINT "(original >)"; LINEA$
9600 STOP: END
10000 REM ******** LISTA DE COMANDOS Y EQUIVALENTES ********
10010 REM 255=SHIFTED (NEXT =131, MID$=255.131)
10020 DATA "END",129
10030 DATA "FOR",130,"NEXT",131,"DATA",132,"INPUT",133,"DIM",134
10035 DATA "READ",135,"LET",136,"GOTO",137,"RUN",138,"IF",139
10040 DATA "RESTORE",140,"GOSUB",141,"RETURN",142,"REM",143,"STOP",144
10045 DATA "PRINT",145,"CLEAR",146,"LIST",147,"NEW",148,"ON",149
10050 DATA "WAIT",150,"DEF",151,"POKE",152,"CONT",153
10055 DATA "OUT",156,"LPRINT",157,"LLIST",158
10060 DATA "WIDTH",160,"ELSE",161,"TRON",162,"TROFF",163,"SWAP",164
10065 DATA "ERASE",165,"EDIT",166,"ERROR",167,"RESUME",168,"DELETE",169
10070 DATA "AUTO",170,"RENUM",171,"DEFSTR",172,"DEFINT",173,"DEFSNG",174
10075 DATA "DEFDBL",175,"LINE",176,"WHILE",177,"WEND",178,"CALL",179
10080 DATA "WRITE",183,"OPTION",184
10085 DATA "RANDOMIZE",185,"OPEN",186,"CLOSE",187,"LOAD",188,"MERGE",189
10090 DATA "SAVE",190,"COLOR",191,"CLS",192,"MOTOR",193,"BSAVE",194
10095 DATA "BLOAD",195,"SOUND",196,"BEEP",197,"PSET",198,"PRESET",199
10100 DATA "SCREEN",200,"KEY",201,"LOCATE",202,"TO",204
10105 DATA "THEN",205,"STEP",207,"USR",208,"FN",209
10110 DATA "SPC",210,"NOT",211,"ERL",212,"ERR",213,"STRING$",214
10115 DATA "USING",215,"INSTR",216,"VARPTR",218,"CSRLIN",219
10120 DATA "POINT",220,"OFF",221,"INKEY$",222
10130 DATA ">",230,"=",231,"<",232,"+",233,"-",234
10135 DATA "*",235,"/",236,"^",237,"AND",238,"OR",239
10140 DATA "XOR",240,"EQV",241,"IMP",242,"\",244,"MOD",243
10200 REM ******** SHIFTED 1 (+128) [253] [x] ********
10210 DATA "CVI",257,"CVS",258,"CVD",259
10220 DATA "MKI$",260,"MKS$",261,"MKD$",262
10300 REM ******** SHIFTED 2 (+256) [254] [X] ********
10315 DATA "FILES",385,"FIELD",386,"SYSTEM",387,"NAME",388,"LSET",389
10320 DATA "RSET",390,"KILL",391,"PUT",392,"GET",393,"RESET",394
10325 DATA "COMMON",395,"CHAIN",396,"DATE$",397,"TIME$",398,"PAINT",399
10340 DATA "COM",400,"CIRCLE",401,"DRAW",402,"PLAY",403,"TIMER",404
10345 DATA "ERDEV",405,"IOCTL",406,"CHDIR",407,"MKDIR",408,"RMDIR",409
10350 DATA "SHELL",410,"ENVIRON",411,"VIEW",412,"WINDOW",413,"PMAP",414
10355 DATA "PALETTE",415,"LCOPY",416,"CALLS",417
10360 DATA "PCOPY",421,"LOCK",423,"UNLOCK",424
10500 REM ******** SHIFTED 3 (+384) [255] [X] ********
10510 DATA "LEFT$",513,"RIGHT$",514
10515 DATA "MID$",515,"SGN",516,"INT",517,"ABS",518,"SQR",519
10520 DATA "RND",520,"SIN",521,"LOG",522,"EXP",523,"COS",524
10525 DATA "TAN",525,"ATN",526,"FRE",527,"INP",528,"POS",529
10530 DATA "LEN",530,"STR$",531,"VAL",532,"ASC",533,"CHR$",534
10535 DATA "PEEK",535,"SPACE$",536,"OCT$",537,"HEX$",538,"LPOS",539
10540 DATA "CINT",540,"CSNG",541,"CDBL",542,"FIX",543, "PEN",544
10545 DATA "STICK",545,"STRIG",546,"EOF",547,"LOC",548,"LOF",549
10900 DATA "[255] ",255,"[254]",254,"***",-1
11000 REM ---8<---------------- CUT HERE --------------------
11010 REM       any following procedure is for debug purposes only
11020 REM
11030 REM
12000 REM ***** DEBUG: Comprobar valores que faltan... *****
12005 PRINT "Todav¡a desconozco las siguientes instrucciones:";
12010 FOR SHFT = 0 TO 2
12020   IF SHFT = 0 THEN SHFTD$ = "" ELSE SHFTD$ = HEX$(252 + SHFT)
12030   FOR F = 128 TO 252
12040       IF COMAN$((F - 128) + (128 * SHFT)) = "" THEN PRINT SHFTD$ + HEX$(F); ", ";
12050   NEXT
12060 NEXT
12070 END
12500 REM **** Generar fichero falso para obtener valores ****
12505 REM WARNING: Puede no ser compatible
12510 DATA FF,7E,12,0A,00,91,20,41,3A,8F,20,39,31,78,78,78
12515 REM = "10 PRINT A:REM 91xxx", 16 bytes
12520 RESTORE 12500: CAMPO$ = "": SHFT = 2
12530 FOR F = 1 TO 16:
12540   READ X$: CMP$ = CMP$ + CHR$(VAL("&h" + X$))
12550 NEXT F
12560 RESET: OPEN "FAKE.BIN" FOR RANDOM AS #3 LEN = 16: FIELD 3, 16 AS CAMPO$
12565 RSET CAMPO$ = CMP$
12570 FOR F = 128 TO 252
12580   IF COMAN$((F - 128) + (128 * SHFT)) <> "" THEN GOTO 12800: REM NEXT
12590   REM INSERTA COMANDO EN LINEA
12600   IF SHFT = 0 THEN MID$(CAMPO$, 6, 1) = CHR$(F) ELSE MID$(CAMPO$, 6, 1) = CHR$(252 + SHFT): MID$(CAMPO$, 7, 1) = CHR$(F)
12610   MID$(CAMPO$, 12, 2) = RIGHT$("00" + HEX$(F), 2)
12620   PUT #3: PRINT SEEK(3)
12630 REM INCREMENTA BUFFER
12640   largo! = ASC(MID$(CAMPO$, 2, 1))
12650   largo! = largo! + 256! * ASC(MID$(CAMPO$, 3, 1))
12660   largo! = largo! + 16
12670   MID$(CAMPO$, 2, 1) = CHR$(largo! MOD 256)
12680   MID$(CAMPO$, 3, 1) = CHR$(INT(largo! / 256))
12690 REM INCREMENTA LINEA
12700   largo! = ASC(MID$(CAMPO$, 4, 1))
12710   largo! = largo! + 256! * ASC(MID$(CAMPO$, 5, 1))
12720   largo! = largo! + 10
12730   MID$(CAMPO$, 4, 1) = CHR$(largo! MOD 256)
12740   MID$(CAMPO$, 5, 1) = CHR$(INT(largo! / 256))
12750 REM LINEAS A PARTIR DE 1 LLEVAN 0
12760   MID$(CAMPO$, 1, 1) = CHR$(0)
12800 NEXT
12810 LSET CAMPO$ = STRING$(3, 0) + CHR$(&H1A) + STRING$(12, 0)
12820 PUT #3: CLOSE #1: END
20000 REM ***************************************
20010 REM Known bugs:
20020 REM 1) Extra spaces between symbols are inserted by STR$,
20030 REM    a routine to decide whether the space should be
20040 REM    inserted or not would be great.
20050 REM 2) Routine to insert extra spaces between command and
20060 REM    non-punctuators is buggy.
10 REM ******** DECGWBAS.BAS ********
15 REM Lee un archivo GWBASIC binario y produce un archivo
20 REM GWBASIC ascii
25 REM Util para leer archivos GWBASIC en QBASIC/QB64/FreeBasic
30 REM sin necesidad de tener una copia de GWBASIC.
35 REM (el último DOS que incluyó GWBASIC fue MS-DOS 4.01, 1989)
40 REM También podría funcionar para adaptar programas de GWBASIC
45 REM a otros BASIC basados en lineas como Chipmunk o Ubasic
50 ******** (c) José G Moya Y 2010 ********
55 REM Versi¢n BINARY= Usa OPEN FOR BINARY por compatibilidad con QB64
60 REM KNOWN BUGS Listed at 20000
65 REM *****************************
70 SHELL "DIR": PRINT "Por favor, introduzca el nombre de un archivo basic comprimido"
80 INPUT FileName$
90 PRINT "Introduzca el nombre del archivo de salida"
95 INPUT Outfile$
100 DEBUG = 0: REM Modo aprendizaje
120 DIM COMAN$(1024): estado = 1
130 GOSUB 9000: CLS
135 REM NOMBRE DEL FICHERO QUE SE ABRIRA:
140 OPEN FileName$ FOR BINARY AS #1
150 REM DEBUG: Lee una version ascii del archivo para
160 REM aprender nuevos comandos...
170 IF DEBUG >= 1 THEN OPEN "3ENRAYA.BAS" FOR INPUT AS #2
175 IF Outfile$ > "" THEN OPEN Outfile$ FOR OUTPUT AS #3
180 REM Leer "Magic signature" en byte 0
190 I$ = INPUT$(1, 1)
200 IF ASC(I$) <> 255 THEN PRINT "ARCHIVO INCORRECTO": END
210 WHILE SEEK(1) < LOF(1)
220    REM NO usamos "On... Gosub" por compatibilidad con
230    REM qbasic/freebasic/qb64
240    IF estado = 1 THEN GOSUB 1000
250    IF estado = 2 THEN GOSUB 2000
260    IF estado = 3 THEN GOSUB 3000
270    IF estado = 4 OR estado = 5 THEN GOSUB 4000
280    IF estado = 6 OR estado = 8 THEN GOSUB 4500
290    IF estado = 7 THEN GOSUB 5000
300    IF estado = 9 THEN GOSUB 5200
310    IF estado = 10 THEN GOSUB 5500
320    IF estado = 18 THEN GOSUB 6000
330    IF estado = 19 THEN GOSUB 6200
400    REM Salida de depuraci¢n...
410    IF DEBUG >= 2 THEN PRINT SALIDA$
420    REM Impresi¢n a disco...
430    IF (estado = 1) OR (estado = 99) THEN GOSUB 500
440    IF estado = 99 THEN PRINT "***THE*END***": END
450    IF DEBUG >= 3 THEN LOCATE CSRLIN, 1: PRINT "Press key"; : SLEEP 0: LOCATE CSRLIN, 1: PRINT SPACE$(9); : LOCATE CSRLIN, 1
460 WEND
500 REM ******* SALIDA A ARCHIVO *********
510 COLOR 15, 0
520 PRINT SALIDA$
530 IF Outfile$ > "" THEN PRINT #3, SALIDA$
540 COLOR 7, 0
550 SALIDA$ = ""
560 RETURN
1000 REM ******** ESTADO=1. INICIO LINEA ********
1010 REM en M$ hay un puntero que se incrementa en la longitud de la línea,
1020 REM pero no nos vale de nada hasta haber leído todas las líneas.
1030 M$ = INPUT$(2, 1)
1040 IF DEBUG >= 1 THEN PRINT "["; CVI(M$); "]"
1050 estado = 2: SHIFTED = 0
1060 IF CVI(M$) = 0 THEN estado = 99: RETURN
1070 IF DEBUG >= 1 THEN LINE INPUT #2, LINEA$
1080 RETURN
2000 REM ******** ESTADO=2. NUMERO LINEA ********
2010 M$ = INPUT$(2, 1)
2015 REM **** El numero de línea es un entero sin signo...
2020 SALIDA$ = SALIDA$ + STR$(ASC(LEFT$(M$, 1)) + 256! * ASC(RIGHT$(M$, 1))) + " "
2030 estado = 3
2050 RETURN
3000 REM ******** ESTADO=3. COMANDO ********
3010 M$ = INPUT$(1, 1): LASTCMD = CMD: CMD = ASC(M$)
3020 IF CMD = 34 THEN estado = 18: REM don't return, wait until next line
3030 IF CMD >= 32 AND CMD <= 127 THEN SALIDA$ = SALIDA$ + M$: RETURN
3040 IF CMD = 11 THEN estado = 4: RETURN: REM OCT LITERAL
3050 IF CMD = 12 THEN estado = 5: RETURN: REM HEX LITERAL
3060 IF CMD = 14 THEN estado = 6: RETURN: REM VALOR NUMERICO Word
3070 IF CMD = 15 THEN estado = 7: RETURN: REM VALOR NUMERICO Byte
3080 IF (CMD >= 17) AND (CMD <= 27) THEN SALIDA$ = SALIDA$ + STR$(CMD - 17): RETURN: REM NUMERO
3090 IF CMD = 28 THEN estado = 8: RETURN: REM Entero=Word?
3100 IF CMD = 29 THEN estado = 9: RETURN: REM VALOR NUMERICO Simple
3110 IF CMD = 31 THEN estado = 10: RETURN: REM VALOR NUMERICO Doble
3120 IF CMD = 0 THEN estado = 1: RETURN
3130 IF CMD >= 253 THEN IF SHIFTED > 0 THEN PRINT "ERROR": GOTO 9500 ELSE SHIFTED = CMD - 252: RETURN
3145 IF (LASTCMD >= 128) AND (CMD >= 128) THEN SALIDA$ = SALIDA$ + " "
3140 IF COMAN$((CMD - 128) + 128 * SHIFTED) = "REM" THEN estado = 19: REM don't return, wait until next line
3150 IF COMAN$((CMD - 128) + 128 * SHIFTED) = "" THEN GOTO 9500 ELSE SALIDA$ = SALIDA$ + COMAN$((CMD - 128) + 128 * SHIFTED): SHIFTED = 0
'IF INSTR(salida$, "PRINT") > 0 THEN STOP
3200 RETURN
4000 REM ******** ESTADO=4/5 Oct literal/hex literal ********
4010 REM GWBASIC usa &O1 en lugar de &1 en sus archivos ascii
4020 IF estado = 4 THEN SALIDA$ = SALIDA$ + "&O" ELSE SALIDA$ = SALIDA$ + "&H"
4025 REM el valor es "unsigned". GWBASIC no acepta long, uso single.
4030 VALORH! = ASC(INPUT$(1, 1)) + 256! * ASC(INPUT$(1, 1))
4040 IF estado = 4 THEN SALIDA$ = SALIDA$ + OCT$(VALORH!) ELSE SALIDA$ = SALIDA$ + HEX$(VALORH!)
4050 estado = 3
4060 RETURN
4500 REM ******** ESTADO=6/8. NUMERO 2 Bytes ********
4505 REM Con estado=6, esperamos "Unsigned"
4510 M$ = INPUT$(2, 1): WORD! = 0
4515 IF estado = 6 THEN WORD! = ASC(LEFT$(M$, 1)) + 256& * ASC(RIGHT$(M$, 1)) ELSE WORD! = CVI(M$)
4520 SALIDA$ = SALIDA$ + STR$(WORD!)
4530 estado = 3
4540 RETURN
5000 REM ******** ESTADO=7. NUMERO 1 Byte ********
5010 M$ = INPUT$(1, 1)
5020 SALIDA$ = SALIDA$ + STR$(ASC(M$))
5030 estado = 3
5040 RETURN
5200 REM ******** ESTADO=9. PRECISION SIMPLE ********
5210 M$ = INPUT$(4, 1): SIMPLE% = 0
5220 REM Detectando GWBASIC/QBASIC:
5230 IF MKSMBF$(1) = "" THEN SIMPLE! = CVS(M$) ELSE SIMPLE! = CVSMBF(M$)
5240 REM Manteniendo precisi¢n en la salida
5250 REM Esto es especialmente necesario para n£meros aparentemente
5260 REM enteros (1% y similares)
5270 SALIDA$ = SALIDA$ + STR$(SIMPLE!)
5280 IF INT(SIMPLE!) = SIMPLE! THEN SALIDA$ = SALIDA$ + "!"
5290 estado = 3
5300 RETURN
5500 REM ******** ESTADO=10. PRECISION DOBLE ********
5510 M$ = INPUT$(8, 1): largo# = 0
5520 REM Detectando GWBASIC/QBASIC:
5530 IF MKDMBF$(1) = "" THEN largo# = CVD(M$) ELSE largo# = CVDMBF(M$)
5540 REM Manteniendo precisi¢n en la salida
5550 REM Esto es especialmente necesario para n£meros aparentemente
5560 REM enteros (1# y similares)
5570 SALIDA$ = SALIDA$ + STR$(largo#) + "#"
5580 estado = 3
5590 RETURN
6000 REM ******** ESTADO=18. LITERAL HASTA COMILLAS ********
6010 M$ = INPUT$(1, 1)
6020 SALIDA$ = SALIDA$ + M$
6030 IF M$ = CHR$(34) THEN estado = 3
6040 REM En caso de comillas dobles (""), la rutina en estado=2 volver  a estado=6
6050 RETURN
6200 REM ******** ESTADO=19. LITERAL HASTA FIN DE LINEA (REM) ********
6210 M$ = INPUT$(1, 1)
6220 SALIDA$ = SALIDA$ + M$
6230 IF M$ = CHR$(0) THEN estado = 1
6240 RETURN
8999 END
9000 REM ******** INICIALIZAR COMANDOS ********
9010 RESTORE 10000
9020 CMDACT$ = "": CMD = 0
9030 WHILE CMDACT$ <> "***"
9040 READ CMDACT$, CMD
9050 IF CMD <> -1 THEN COMAN$(CMD - 128) = CMDACT$
9060 WEND
9070 RETURN
9500 REM ***** Comando no reconocido *****
9510 PRINT "Comando "; SHIFTED * 128 + ASC(M$); " no reconocido: "
9520 PRINT "(procesado>)"; SALIDA$;
9530 IF SHIFTED > 0 THEN PRINT "["; 252 + SHIFTED; "]";
9540 PRINT "["; ASC(M$); "]"
9550 PRINT SPC(LEN(SALIDA$) + 11);
9560 PRINT "^"
9570 REM En modo debug, se muestra la l¡nea ASCII para que se
9580 REM actualicen los DATAs
9590 IF DEBUG >= 1 THEN PRINT "(original >)"; LINEA$
9600  END
10000 REM ******** LISTA DE COMANDOS Y EQUIVALENTES ********
10010 REM 255=SHIFTED (NEXT =131, MID$=255.131)
10020 DATA "END",129
10030 DATA "FOR",130,"NEXT",131,"DATA",132,"INPUT",133,"DIM",134
10035 DATA "READ",135,"LET",136,"GOTO",137,"RUN",138,"IF",139
10040 DATA "RESTORE",140,"GOSUB",141,"RETURN",142,"REM",143,"STOP",144
10045 DATA "PRINT",145,"CLEAR",146,"LIST",147,"NEW",148,"ON",149
10050 DATA "WAIT",150,"DEF",151,"POKE",152,"CONT",153
10055 DATA "OUT",156,"LPRINT",157,"LLIST",158
10060 DATA "WIDTH",160,"ELSE",161,"TRON",162,"TROFF",163,"SWAP",164
10065 DATA "ERASE",165,"EDIT",166,"ERROR",167,"RESUME",168,"DELETE",169
10070 DATA "AUTO",170,"RENUM",171,"DEFSTR",172,"DEFINT",173,"DEFSNG",174
10075 DATA "DEFDBL",175,"LINE",176,"WHILE",177,"WEND",178,"CALL",179
10080 DATA "WRITE",183,"OPTION",184
10085 DATA "RANDOMIZE",185,"OPEN",186,"CLOSE",187,"LOAD",188,"MERGE",189
10090 DATA "SAVE",190,"COLOR",191,"CLS",192,"MOTOR",193,"BSAVE",194
10095 DATA "BLOAD",195,"SOUND",196,"BEEP",197,"PSET",198,"PRESET",199
10100 DATA "SCREEN",200,"KEY",201,"LOCATE",202,"TO",204
10105 DATA "THEN",205,"STEP",207,"USR",208,"FN",209
10110 DATA "SPC",210,"NOT",211,"ERL",212,"ERR",213,"STRING$",214
10115 DATA "USING",215,"INSTR",216,"VARPTR",218,"CSRLIN",219
10120 DATA "POINT",220,"OFF",221,"INKEY$",222
10130 DATA ">",230,"=",231,"<",232,"+",233,"-",234
10135 DATA "*",235,"/",236,"^",237,"AND",238,"OR",239
10140 DATA "XOR",240,"EQV",241,"IMP",242,"\",244,"MOD",243
10200 REM ******** SHIFTED 1 (+128) [253] [x] ********
10210 DATA "CVI",257,"CVS",258,"CVD",259
10220 DATA "MKI$",260,"MKS$",261,"MKD$",262
10300 REM ******** SHIFTED 2 (+256) [254] [X] ********
10315 DATA "FILES",385,"FIELD",386,"SYSTEM",387,"NAME",388,"LSET",389
10320 DATA "RSET",390,"KILL",391,"PUT",392,"GET",393,"RESET",394
10325 DATA "COMMON",395,"CHAIN",396,"DATE$",397,"TIME$",398,"PAINT",399
10340 DATA "COM",400,"CIRCLE",401,"DRAW",402,"PLAY",403,"TIMER",404
10345 DATA "ERDEV",405,"IOCTL",406,"CHDIR",407,"MKDIR",408,"RMDIR",409
10350 DATA "SHELL",410,"ENVIRON",411,"VIEW",412,"WINDOW",413,"PMAP",414
10355 DATA "PALETTE",415,"LCOPY",416,"CALLS",417
10360 DATA "PCOPY",421,"LOCK",423,"UNLOCK",424
10500 REM ******** SHIFTED 3 (+384) [255] [X] ********
10510 DATA "LEFT$",513,"RIGHT$",514
10515 DATA "MID$",515,"SGN",516,"INT",517,"ABS",518,"SQR",519
10520 DATA "RND",520,"SIN",521,"LOG",522,"EXP",523,"COS",524
10525 DATA "TAN",525,"ATN",526,"FRE",527,"INP",528,"POS",529
10530 DATA "LEN",530,"STR$",531,"VAL",532,"ASC",533,"CHR$",534
10535 DATA "PEEK",535,"SPACE$",536,"OCT$",537,"HEX$",538,"LPOS",539
10540 DATA "CINT",540,"CSNG",541,"CDBL",542,"FIX",543, "PEN",544
10545 DATA "STICK",545,"STRIG",546,"EOF",547,"LOC",548,"LOF",549
10900 DATA "[255] ",255,"[254]",254,"***",-1
11000 REM ---8<---------------- CUT HERE --------------------
11010 REM       any following procedure is for debug purposes only
11020 REM
11030 REM
12000 REM ***** DEBUG: Comprobar valores que faltan... *****
12005 PRINT "Todav¡a desconozco las siguientes instrucciones:";
12010 FOR SHFT = 0 TO 2
12020   IF SHFT = 0 THEN SHFTD$ = "" ELSE SHFTD$ = HEX$(252 + SHFT)
12030   FOR F = 128 TO 252
12040       IF COMAN$((F - 128) + (128 * SHFT)) = "" THEN PRINT SHFTD$ + HEX$(F); ", ";
12050   NEXT
12060 NEXT
12070 END
12500 REM **** Generar fichero falso para obtener valores ****
12505 REM WARNING: Puede no ser compatible
12510 DATA FF,7E,12,0A,00,91,20,41,3A,8F,20,39,31,78,78,78
12515 REM = "10 PRINT A:REM 91xxx", 16 bytes
12520 RESTORE 12500: CAMPO$ = "": SHFT = 2
12530 FOR F = 1 TO 16:
12540   READ X$: CMP$ = CMP$ + CHR$(VAL("&h" + X$))
12550 NEXT F
12560 RESET:OPEN "FAKE.BIN" FOR BINARY AS #3
12565 CAMPO$=SPACE$(16):RSET CAMPO$ = CMP$
12570 FOR F = 128 TO 252
12580   IF COMAN$((F - 128) + (128 * SHFT)) <> "" THEN GOTO 12800: REM NEXT
12590   REM INSERTA COMANDO EN LINEA
12600   IF SHFT = 0 THEN MID$(CAMPO$, 6, 1) = CHR$(F) ELSE MID$(CAMPO$, 6, 1) = CHR$(252 + SHFT): MID$(CAMPO$, 7, 1) = CHR$(F)
12610   MID$(CAMPO$, 12, 2) = RIGHT$("00" + HEX$(F), 2)
12620   PUT #3,,CAMPO$: PRINT SEEK(3)
12630 REM INCREMENTA BUFFER
12640   largo! = ASC(MID$(CAMPO$, 2, 1))
12650   largo! = largo! + 256! * ASC(MID$(CAMPO$, 3, 1))
12660   largo! = largo! + 16
12670   MID$(CAMPO$, 2, 1) = CHR$(largo! MOD 256)
12680   MID$(CAMPO$, 3, 1) = CHR$(INT(largo! / 256))
12690 REM INCREMENTA LINEA
12700   largo! = ASC(MID$(CAMPO$, 4, 1))
12710   largo! = largo! + 256! * ASC(MID$(CAMPO$, 5, 1))
12720   largo! = largo! + 10
12730   MID$(CAMPO$, 4, 1) = CHR$(largo! MOD 256)
12740   MID$(CAMPO$, 5, 1) = CHR$(INT(largo! / 256))
12750 REM LINEAS A PARTIR DE 1 LLEVAN 0
12760   MID$(CAMPO$, 1, 1) = CHR$(0)
12800 NEXT
12810 LSET CAMPO$ = STRING$(3, 0) + CHR$(&H1A) + STRING$(12, 0)
12820 PUT #3,,CAMPO$: CLOSE #1: END
20000 REM ***************************************
20010 REM Known bugs:
20020 REM 1) Extra spaces between symbols are inserted by STR$,
20030 REM    a routine to decide whether the space should be
20040 REM    inserted or not would be great.
20050 REM 2) Routine to insert extra spaces between command and
20060 REM    non-punctuators is buggy.
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/gwbasic/decgwba.txt · Última modificación: 2014/03/02 07:28 por nepenthes