====decgwbas.bas y decgwba2.bas====
Gwbasic allowed saving of program in two different formats:
* A binary format, similar to the format in wich the program was stored in memory.
* An ascii format, to allow user editing with a text editor. That format was required for using the "Chain" and "Merge" statements.
SAVE "PROGRAMA.BAS" : REM This saves program in binary format
SAVE "PROGRAMA.BAS",A:REM This saves program in ascii format
These programs, compatible with many BASIC dialects, allow decompression of programs saved in GWBASIC binary format, without the need of GWBASIC itself. For compatibility reasons, line numbers are used in this listing.
10 REM ******** DECGWBAS.BAS ********
15 REM Reads a binary GWBASIC file and produces
20 REM a GWBASIC ascii file
25 REM Useful to read GWBASIC files in QBASIC/QB64/FreeBasic
30 REM without using GWBASIC.
35 REM (the last DOS including GWBASIC was MS-DOS 4.01, 1989)
40 REM It could also be useful to adapt GWBASIC programs to
45 REM other line-based BASICs such as Chipmunk or Ubasic
50 REM ******** (c) José G Moya Y 2010 ********
55 REM RANDOM version: Uses OPEN FOR RANDOM for GWBASIC compatibility
60 REM KNOWN BUGS Listed at 20000
65 REM *****************************
70 FILES: PRINT "Please type the name of a gw-basic compressed file:"
80 INPUT FileName$
90 PRINT "Please type the name of output file:"
95 INPUT Outfile$
100 DEBUG = 0: REM Learning Mode
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: Reads a previously saved ASCII version of our file to
160 REM learn more keywords...
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 "WRONG FILE": END
210 WHILE SEEK(1) < LOF(1)
220 REM We won't use "On... Gosub" to allow
230 REM qbasic/freebasic/qb64 compatibility
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 Debug output...
410 IF DEBUG >= 2 THEN PRINT SALIDA$
420 REM File printing...
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 ******* FILE OUTPUT *********
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. LINE START ********
1010 REM M$ is a pointer increasing by line lenght, but
1020 REM we can't understand it before reading all lines.
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. LINE NUMBER ********
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. STATEMENT ********
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 uses &O1 instead of &1 when saving as ascii
4020 IF estado = 4 THEN SALIDA$ = SALIDA$ + "&O" ELSE SALIDA$ = SALIDA$ + "&H"
4025 REM Value is "unsigned". GWBASIC does not allow long.
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. 2 Bytes NUMBER********
4505 REM With estado=6, we expect "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. 1 Byte NUMBER********
5010 GET #1: M$ = CampoUno$
5020 SALIDA$ = SALIDA$ + STR$(ASC(M$))
5030 estado = 3
5040 RETURN
5200 REM ******** ESTADO=9. SINGLE PRECISION ********
5210 M$ = "": FOR G = 1 TO 4: GET #1: M$ = M$ + CampoUno$: NEXT: SIMPLE% = 0
5220 REM Detecting GWBASIC/QBASIC:
5230 IF MKSMBF$(1) = "" THEN SIMPLE! = CVS(M$) ELSE SIMPLE! = CVSMBF(M$)
5240 REM Keeping precision at output
5250 REM This is specially useful with numbers that seem to be
5260 REM INTEGER (1! and so on)
5270 SALIDA$ = SALIDA$ + STR$(SIMPLE!)
5280 IF INT(SIMPLE!) = SIMPLE! THEN SALIDA$ = SALIDA$ + "!"
5290 estado = 3
5300 RETURN
5500 REM ******** ESTADO=10. DOUBLE PRECISION ********
5510 M$ = "": FOR G = 1 TO 8: GET #1: M$ = M$ + CampoUno$: NEXT: largo# = 0
5520 REM Detecting GWBASIC/QBASIC:
5530 IF MKDMBF$(1) = "" THEN largo# = CVD(M$) ELSE largo# = CVDMBF(M$)
5540 REM Keeping precision at output
5550 REM This is specially useful with numbers that seem to be
5560 REM integer (1# and so on)
5570 SALIDA$ = SALIDA$ + STR$(largo#) + "#"
5580 estado = 3
5590 RETURN
6000 REM ******** ESTADO=18. LITERAL UNTIL QUOTES ********
6010 GET #1: M$ = CampoUno$
6020 SALIDA$ = SALIDA$ + M$
6030 IF M$ = CHR$(34) THEN estado = 3
6040 REM In case of double doublequotes (""), routine in estado=2 will return to estado=6
6050 RETURN
6200 REM ******** ESTADO=19. LITERAL UNTIL END OF LINE (REM) ********
6210 GET #1: M$ = CampoUno$
6220 SALIDA$ = SALIDA$ + M$
6230 IF M$ = CHR$(0) THEN estado = 1
6240 RETURN
8999 END
9000 REM ******** INITIALIZING STATEMENTS ********
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 ***** Unknown Statement *****
9510 PRINT "Comando "; SHIFTED * 128 + ASC(M$); " unknown: "
9520 PRINT "(processed>)"; SALIDA$;
9530 IF SHIFTED > 0 THEN PRINT "["; 252 + SHIFTED; "]";
9540 PRINT "["; ASC(M$); "]"
9550 PRINT SPC(LEN(SALIDA$) + 11);
9560 PRINT "^"
9570 REM In debug mode, line is shown to allow user
9580 REM upgrade DATAs
9590 IF DEBUG >= 1 THEN PRINT "(original >)"; LINEA$
9600 STOP: END
10000 REM ******** STATEMENT LIST ********
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: Check missing values... *****
12005 PRINT "I still need to learn the following statements:";
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 **** Generate fake file to get more statement values ****
12505 REM WARNING: This could cause some trouble.
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.