http://catseye.tc/projects/bef.html
http://en.wikipedia.org/wiki/Befunge
http://www.esolangs.org/wiki/Befunge
Code: Select all
' $lang: "qb"
'
' Befunge-93 interpreter in FreeBASIC 0.21.1
'
' Monday, January 3, 2011
'
' LICENSE/AUTHOR:
' = public domain, nenies proprajho, "!! Christus Rex !!"
' = rugxulo _AT_ gmail _DOT_ com
' HISTORY:
' = v1.0 -- semi tested to work fairly well but not fully
' = v1.1 -- fixed to (also) compile in lang qb
' BUGS:
' = still not fixed to work with real QBASIC 1.0 (yet)
' = ugh, much harder than I thought (why??) :-/
CONST xmax = 80, ymax = 25, stackmax = 1000
DIM SHARED ch AS STRING, chartemp AS STRING
DIM SHARED bspace(1 TO ymax) AS STRING * 80
DIM SHARED stack(1 TO stackmax) AS LONG
DIM SHARED a AS LONG, b AS LONG, c AS LONG
DIM SHARED x AS INTEGER, y AS INTEGER, strmode AS INTEGER
DIM SHARED xdelta AS INTEGER, ydelta AS INTEGER, sp AS INTEGER
FUNCTION pop() AS LONG
IF (sp < stackmax) THEN
sp = sp + 1 : pop = stack(sp)
ELSE
pop = 0
END IF
END FUNCTION 'pop
SUB nop()
a = 0
END SUB 'nop
SUB delta(xd AS INTEGER, yd AS INTEGER)
xdelta = xd : ydelta = yd
END SUB 'delta
SUB push(m AS LONG)
stack(sp) = m : IF (sp > 1) THEN sp = sp - 1
END SUB 'push
SUB ClearStack()
DIM s AS INTEGER
FOR s = 1 TO stackmax
stack(s) = 0
NEXT s
END SUB 'ClearStack
SUB ClearBspace()
DIM b AS INTEGER
FOR b = 1 TO ymax
bspace(b) = SPACE$(xmax)
NEXT b
END SUB 'ClearBspace
SUB ReadB93File()
DIM eg AS INTEGER, f AS INTEGER, z AS INTEGER, q AS INTEGER
DIM filename AS STRING
eg = FREEFILE : f = 1
filename = "example.bef"
' ************************************************
IF COMMAND$(1) <> "" THEN filename = COMMAND$(1)
' ************************************************
OPEN filename FOR INPUT AS #eg
IF ERR > 0 THEN
? "ERROR: Couldn't open " + """" + filename + """"
SYSTEM 255
END IF
DO UNTIL EOF(eg)
bspace(f) = SPACE$(xmax)
LINE INPUT #eg, bspace(f)
f = f + 1
LOOP
FOR z = 1 to f
q = INSTR(bspace(z),CHR$(0))-1
bspace(z) = MID$(bspace(z),1,q) + SPACE$(xmax-q)
NEXT z
CLOSE #eg
END SUB 'ReadB93File
' ==============================================================
SUB B93Debug()
DIM d AS INTEGER
? " x,y = " + LTRIM$(STR$(x)) + "," + RTRIM$(STR$(y));
IF (ch <> """") THEN
? " ch = """ + ch + """";
ELSE
? " ch = '" + ch + "'";
END IF
FOR d = 1 TO 4
IF ((sp+d) <= stackmax) THEN
? stack(sp+d);
END IF
NEXT d
IF (strmode) THEN
? " """""""""
ELSE
?
END IF
END SUB 'B93Debug
SUB ShowBspace()
DIM b AS INTEGER
FOR b = 1 TO ymax
? bspace(b)
NEXT b
SYSTEM
END SUB 'ShowBspace
' ==============================================================
' BEGIN bef93
x = -1 : y = 0 : delta(1,0) : sp = stackmax : strmode = 0
RANDOMIZE TIMER : ClearStack() : ClearBspace() : ReadB93File()
' ShowBspace()
DO ' main loop
x = x + xdelta : y = y + ydelta
' wrap if necessary
IF (x > xmax-1) THEN
x = 0
ELSEIF (y > ymax-1) THEN
y = 0
ELSEIF (x < 0) THEN
x = xmax-1
ELSEIF (y < 0) THEN
y = ymax-1
END IF
ch = MID$(bspace(y+1),x+1,1)
' B93Debug()
IF (strmode) AND (ch <> """") THEN
push(ASC(ch))
END IF
IF (ch = """") THEN
strmode = NOT strmode
END IF
IF NOT strmode THEN
SELECT CASE ch
CASE "?" : a = INT(RND * 4) + 1
SELECT CASE a
CASE 1 : delta(0,-1)
CASE 2 : delta(0,1)
CASE 3 : delta(-1,0)
CASE 4 : delta(1,0)
END SELECT
CASE "0" TO "9" : push(ASC(ch)-ASC("0"))
CASE "." : a=pop() : ? LTRIM$(STR$(a)) + " ";
CASE "," : a=pop() : IF (a = 10) THEN ? : ELSE ? CHR$(a);
CASE "v" : delta(0,1)
CASE "^" : delta(0,-1)
CASE "<" : delta(-1,0)
CASE ">" : delta(1,0)
CASE "#" : x = x + xdelta : y = y + ydelta
CASE "_"
a=pop() : IF (a <> 0) THEN delta(-1,0) : ELSE delta(1,0)
CASE "|"
a=pop() : IF (a <> 0) THEN delta(0,-1) : ELSE delta(0,1)
CASE "`"
b=pop() : a=pop() : IF (a > b) THEN push(1) ELSE push(0)
CASE "!" : a=pop() : IF (a = 0) THEN push(1) ELSE push(0)
CASE "\" : a=pop() : b=pop() : push(a) : push(b)
CASE ":" : a=pop() : push(a) : push(a)
CASE "$" : a=pop()
CASE "+" : b=pop() : a=pop() : push(a + b)
CASE "-" : b=pop() : a=pop() : push(a - b)
CASE "*" : b=pop() : a=pop() : push(a * b)
CASE "/" : b=pop() : a=pop() : push(a \ b) ' integer divide
CASE "%" : b=pop() : a=pop() : push(a MOD b)
CASE "~" : INPUT ; chartemp : push(ASC(chartemp))
CASE "&" : INPUT a : push(a)
CASE "g" : b=pop() : a=pop() : c = ASC(MID$(bspace(b+1),a+1,1))
push(c)
CASE "p" : b=pop() : a=pop() : c=pop()
MID$(bspace(b+1),a+1,1) = CHR$(c)
CASE "@" : SYSTEM
CASE ELSE : nop()
END SELECT
END IF ' NOT strmode
LOOP ' DO
' END bef93