Lorsque je suis tombé (aie !) par hasard sur ce source QBASIC "46K TINY BASIC INTERPRETER" j'ai tout de suite eu envie de le convertir en GFW
Le voici, avec quelques modifications. Il est limité à quelques instructions:
directes: QUIT, HELP, LIST, NEW, RUN, CLS
commandes: LET, PRINT, IF ... THEN, GOTO, INPUT, CLS
- Code: Tout sélectionner
' -------------------------------------------------------
' TINY BASIC GFW
' v1.00 (C)2010 FANTOMAS
' Original QBASIC version by GEMINO SMOTHERS
'
' -------------------------------------------------------
' : Changement de la commande 'BYE' en 'QUIT'
' : Modification de la commande 'LIST'
' : Modification de la commande 'HELP'
' : Ajout de la commande directe 'CLS'
' 30/09/10: Conversion QBASIC -> GFW
'
DIM l$(256)
DIM vn$(26)
DIM vv(26)
vars$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
FOR cv = 0 TO 25
vn$(cv) = MID$(vars$, cv + 1, 1)
NEXT cv
OPENW #1,(_X / 2) - 320,(_Y / 2) - 240,640,480,80
TITLEW #1," Tiny Basic v 1.00"
@fonte(16,12)
CLS
PRINT "-- * TINY BASIC * --"
PRINT "-- v1.00 --"
PRINT "-- GFW Code by FANTOMAS --"
ready:
PRINT
PRINT "READY"
cmdloop:
LINE INPUT in$
in$ = TRIM$(in$)
IF INSTR(in$, " ")
cmd$ = LEFT$(in$, INSTR(in$, " ") - 1)
param$ = MID$(in$, INSTR(in$, " ") + 1, LEN(in$))
ELSE
cmd$ = in$
param$ = ""
ENDIF
' ********************
' Commandes directes
' ********************
SELECT UPPER$(cmd$)
CASE "QUIT"
CLOSEW #1
END
CASE "HELP"
CLS
PRINT " Tiny Basic v1.00 commands"
PRINT "+---------------------------------------+"
PRINT "|QUIT |"
PRINT "|HELP |"
PRINT "|LIST (#) |"
PRINT "|NEW |"
PRINT "|RUN |"
PRINT "|LET <V>=<V OR #><OPERATOR><V OR #> |"
PRINT "|PRINT <$ OR V OR #> |"
PRINT "|IF <V OR #><OPERATOR><V OR #> THEN <#> |"
PRINT "|GOTO <#> |"
PRINT "|INPUT <V> |"
PRINT "|CLS |"
PRINT "+---------------------------------------+"
GOTO ready
' ------
' LIST
' ------
CASE "LIST"
IF param$ = ""
FOR cl = 0 TO 255
IF l$(cl) <> ""
PRINT cl + 1;" ";l$(cl)
ENDIF
NEXT cl
ELSE
IF l$(VAL(param$) - 1) <> ""
PRINT VAL(param$);" ";l$(VAL(param$) - 1)
ENDIF
ENDIF
GOTO ready
' -----
' NEW
' -----
CASE "NEW"
FOR cl = 0 TO 255
l$(cl) = ""
NEXT cl
GOTO ready
' -----
' RUN
' -----
CASE "RUN"
FOR cv = 0 TO 25
vv(cv) = 0
NEXT cv
@runcode
GOTO ready
' -----
' CLS
' -----
CASE "CLS"
CLS
GOTO ready
' --------------
' SYNTAX ERROR
' --------------
CASE ELSE
IF VAL(LEFT$(cmd$, 1))
IF param$ = ""
l$(VAL(cmd$) - 1) = ""
ELSE
l$(VAL(cmd$) - 1) = param$
ENDIF
ELSE
IF cmd$ <> ""
PRINT "SYNTAX ERROR: "; in$
GOTO ready
ENDIF
ENDIF
ENDSELECT
GOTO cmdloop
' *******************
' Execute programme
' *******************
PROCEDURE runcode
FOR cl = 0 TO 256
IF INSTR(l$(cl), " ") > 1
cmd$ = LEFT$(l$(cl), INSTR(l$(cl), " ") - 1)
param$ = MID$(l$(cl), INSTR(l$(cl), " ") + 1, LEN(l$(cl)))
ELSE
cmd$ = l$(cl)
param$ = ""
ENDIF
c$ = UPPER$(cmd$)
' ----
' IF
' ----
IF c$ = "IF"
op$ = ""
IF INSTR(param$, "<>")
op$ = "<>"
ol = 2
ELSE
IF INSTR(param$, "<=")
op$ = "<="
ol = 2
ELSE
IF INSTR(param$, "=")
op$ = "="
ol = 1
ELSE
IF INSTR(param$, ">=")
op$ = ">="
ol = 2
ELSE
IF INSTR(param$, "<")
op$ = "<"
ol = 1
ELSE
IF INSTR(param$, ">")
op$ = ">"
ol = 1
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
param$ = UPPER$(param$)
tmp1$ = TRIM$(LEFT$(param$, INSTR(param$, op$) - 1))
tmp2$ = TRIM$(MID$(param$, INSTR(param$, op$) + ol, INSTR(param$, "THEN") - INSTR(param$, op$) - ol))
tmp3$ = TRIM$(MID$(param$, INSTR(param$, "THEN") + 4, LEN(param$)))
FOR cv = 0 TO 26
IF cv = 26
v2 = VAL(tmp2$)
EXIT IF cv = 26
ENDIF
IF vn$(cv) = tmp1$
v1 = vv(cv)
EXIT IF vn$(cv) = tmp1$
ENDIF
NEXT cv
FOR cv = 0 TO 26
IF cv = 26
v2 = VAL(tmp2$)
EXIT IF cv = 26
ENDIF
IF vn$(cv) = tmp2$
v2 = vv(cv)
EXIT IF vn$(cv) = tmp2$
ENDIF
NEXT cv
IF op$ = "=" AND v1 = v2
cl = VAL(tmp3$) - 2
ENDIF
IF op$ = "<>" AND v1 <> v2
cl = VAL(tmp3$) - 2
ENDIF
IF op$ = "<" AND v1 < v2
cl = VAL(tmp3$) - 2
ENDIF
IF op$ = ">" AND v1 > v2
cl = VAL(tmp3$) - 2
ENDIF
IF op$ = "<=" AND v1 <= v2
cl = VAL(tmp3$) - 2
ENDIF
IF op$ = ">=" AND v1 >= v2
cl = VAL(tmp3$) - 2
ENDIF
ELSE
' -----
' LET
' -----
IF c$ = "LET"
op$ = ""
IF INSTR(param$, "+")
op$ = "+"
ELSE
IF INSTR(param$, "-")
op$ = "-"
ELSE
IF INSTR(param$, "*")
op$ = "*"
ELSE
IF INSTR(param$, "/")
op$ = "/"
ELSE
IF INSTR(param$, "^")
op$ = "^"
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
param$ = UPPER$(param$)
tmp1$ = TRIM$(LEFT$(param$, INSTR(param$, "=") - 1))
IF op$ = ""
tmp2$ = TRIM$(MID$(param$, INSTR(param$, "=") + 1, LEN(param$)))
tmp3$ = ""
ELSE
tmp2$ = TRIM$(MID$(param$, INSTR(param$, "=") + 1, INSTR(param$, op$) - INSTR(param$, "=") - 1))
tmp3$ = TRIM$(MID$(param$, INSTR(param$, op$) + 1, LEN(param$)))
ENDIF
FOR cv = 0 TO 26
IF cv = 26
v1 = VAL(tmp2$)
EXIT IF cv = 26
ENDIF
IF vn$(cv) = tmp2$
v1 = vv(cv)
EXIT IF vn$(cv) = tmp2$
ENDIF
NEXT cv
FOR cv = 0 TO 26
IF cv = 26
v2 = VAL(tmp3$)
EXIT IF cv = 26
ENDIF
IF vn$(cv) = tmp3$
v2 = vv(cv)
EXIT IF vn$(cv) = tmp3$
ENDIF
NEXT cv
FOR cv = 0 TO 25
EXIT IF vn$(cv) = tmp1$
NEXT cv
IF op$ = ""
vv(cv) = v1
ELSE
IF op$ = "+"
vv(cv) = v1 + v2
ELSE
IF op$ = "-"
vv(cv) = v1 - v2
ELSE
IF op$ = "*"
vv(cv) = v1 * v2
ELSE
IF op$ = "/"
LET vv(cv) = v1 / v2
ELSE
IF op$ = "^"
LET vv(cv) = v1 ^ v2
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ELSE
' -------
' PRINT
' -------
IF c$ = "PRINT"
param$ = TRIM$(param$)
IF INSTR(param$, CHR$(34))
PRINT MID$(param$, 2, LEN(param$) - 2)
ENDIF
IF VAL(param$)
PRINT VAL(param$)
ENDIF
cv = 0
FOR cv = 0 TO 25
IF vn$(cv) = UPPER$(param$)
PRINT vv(cv)
EXIT IF vn$(cv) = UPPER$(param$)
ENDIF
NEXT cv
ELSE
' -------
' INPUT
' -------
IF c$ = "INPUT"
FOR cv = 0 TO 25
IF vn$(cv) = TRIM$(UPPER$(param$))
INPUT vv(cv)
EXIT IF vn$(cv) = TRIM$(UPPER$(param$))
ENDIF
NEXT cv
ELSE
' ------
' GOTO
' ------
IF c$ = "GOTO"
cl = VAL(param$) - 2
ELSE
' -----
' CLS
' -----
IF c$ = "CLS"
CLS
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
NEXT cl
RETURN
'
PROCEDURE fonte(h&,w&)
fnt& = GetStockObject(OEM_FIXED_FONT)
FONT "Courier New",HEIGHT h&, WEIGHT w&
FONT TO fnt&
SETFONT fnt&
RETURN
Fantomas
