[Very, very] Simple Scripting Engine

The forum is locked. These are the original blitzbasic.com forums, kept so they can still be read. No new topics, replies or edits can be made here. To join in, head over to the Blitz3D+ forums.
Nilium
Picked it up again and made some changes. No more crap in the main program, variables, calls, and (binary) operators are handled differently, and the functions for parsing and such are being worked on now.
Open in online IDE
;; A simple scripting engine
;; Written by Noel R. Cower
;; This source code is public domain
;; You have the right to do whatever you want with it, regardless of how I feel about it
;; I'd like it if you added my name to your credits (and if anyone else modifies this, add theirs too, please)- but it's your decision, not mine

;#Region PUSH/POP DATA
	Global PoppedValue$
	Global PoppedClass%
	
	Type Stack
		Field F.StackObj
		Field L.StackObj
		Field Objects
	End Type
	
	Type StackObj
		Field Parent.Stack
		Field N.StackObj
		Field P.StackObj
		Field Value$
		Field Class%
	End Type
	
	Function CreateStack()
		s.Stack = New Stack
		Return Handle(s)
	End Function
	
	Function PushObject(Stack,Value$,Class%=V_INT,ToFront=1)
		s.Stack = Object.Stack(Stack)
		s\Objects = s\Objects + 1
		i.StackObj = New StackObj
		If Value = 0 And Class = 0 Then Stop
		i\Value = Value
		i\Class = Class
		i\Parent = s
		If ToFront = 0 Then
			If s\F = Null And s\L = Null Then
				s\F = i
				s\L = s\F
			Else
				i\P = s\L
				s\L\N = i
				s\L = i
			EndIf
		Else
			If s\F = Null And s\L = Null Then
				s\F = i
				s\L = s\F
			Else
				i\N = s\F
				s\F\P = i
				s\F = i
			EndIf
		EndIf
	End Function
	
	Function PopObject$(Stack,FromFront=0,RemoveData=1)
		s.Stack = Object.Stack(Stack)
		If RemoveData > 0 Then s\Objects = s\Objects - 1
		If FromFront = 0 Then
			i.StackObj = s\L
			If RemoveData > 0 Then
				s\L = i\P
				If S\L <> Null Then s\L\N = Null
			EndIf
		Else
			i.StackObj = s\F
			If RemoveData > 0 Then
				s\F = i\N
				If S\F <> Null Then s\F\P = Null
			EndIf
		EndIf
		
		If s\L = Null Then s\L = s\F
		If s\F = Null Then s\F = s\L
		
		PoppedClass = i\Class
		PoppedValue = i\Value
		v$ = i\Value
		If RemoveData > 0 Then Delete i
		Return V
	End Function
	
	Function Objects(Stack)
		s.Stack = Object.Stack(Stack)
		Return s\Objects
	End Function
	
	Function GetObject$(Stack,Index,RemoveData = 1)
		s.Stack = Object.Stack(Stack)
		i.StackObj = s\F
		Repeat
			If i = Null Then
				Return False
			ElseIf n = Index Then
				PoppedObject = i\Value
				PoppedClass = i\Class
				
				If RemoveData Then
					If i\P <> Null Then i\P\N = i\N
					If i\N <> Null Then i\N\P = i\P
					s\Objects = s\Objects - 1
					Delete i
				EndIf
				
				Return PoppedValue
			EndIf
			
			i = i\N
			n = n + 1
		Forever
	End Function
	
	Function InsertObject(Stack,Index,Value$="",Class%=V_INT)
		s.Stack = Object.Stack(Stack)
		
		i.StackObj = s\F
		o.StackObj = New StackObj
		o\Value$ = Value
		o\Class% = Class
		o\Parent = s
		
		Repeat
			If i\N = Null Or n = Index Then
				ne.StackObj = i\N
				pr.StackObj = i\P
				
				If ne <> Null Then ne\P =  o
				If pr <> Null Then pr\N = o
				
				If ne = Null Then s\L = o
				If pr = Null Then s\F = o
				
				o\N = ne
				o\P = pr
				
				Return True
			EndIf
			
			i = i\N
			n = n + 1
		Forever
	End Function
	
	Function FreeStack(Stack)
		s.Stack = Object.Stack(Stack)
		
		Delete s
		For i.StackObj = Each StackObj
			If i\Parent = Null Then Delete i
		Next
	End Function
;#End Region

;#Region VARIABLE
	Type Variable
		Field Name$
		Field Value$
		Field Class%
	End Type
	
	;; Datatype bytecodes
	Const V_FLOAT = %00000001
	Const V_INT = %00000010
	Const V_STRING = %00000100
	Const V_FLOATCONST = %00001000
	Const V_INTCONST = %00010000
	Const V_STRINGCONST = %00100000
	
	Function Variable$(Name$,Class%,Value$)
		Name$ = Lower(Trim(Name$))
		
		For v.Variable = Each Variable
			If v\Name = Name$ Then : v\Value = Value$ : v\Class = Class : Return Handle(v) : EndIf
		Next
		
		v.Variable = New Variable
		v\Name = Name
		v\Class = Class
		v\Value = Value
		Return Handle(v)
	End Function
	
	Function VarName$(ID)
		v.Variable = Object.Variable(ID)
		Return v\Name
	End Function
	
	Function VarValue$(ID)
		v.Variable = Object.Variable(ID)
		Return v\Value
	End Function
	
	Function VarClass%(ID)
		v.Variable = Object.Variable(ID)
		Return v\Class
	End Function
	
	Function GetVariable$(ID$,Class%)
		Select Class
			Case V_FLOAT,V_INT,V_STRING
				For v.Variable = Each Variable
					If v\Name = Lower(ID) Then
						Return v\Value
					EndIf
				Next
			Case T_CALL,T_OP
				ProcessCall(ID$,Class%)
				PopObject VarStack
				Return PoppedValue
		End Select
		
		Return ID$
	End Function
;#End Region

;#Region PARSE
	;; Spits out a string that is easily parsed
	Function Parse$(S$)
		For n = 1 To Len(S$)
			j$ = Mid(S$,n,1)
			
			For k = 1 To Len(j)
				If Asc(Mid(j,k,1)) = 34 Then StrOpen = Not StrOpen
			Next
			add=0
			If StrOpen = 0 Then
				If (Asc(Mid(j$,1,1)) <= 45) Or (Asc(Mid(j$,1,1)) >= 58 And Asc(Mid(j$,1,1)) <= 63) Or Asc(Mid(j,1,1)) = 124 Or Asc(Mid(j,1,1)) = 94 Or Asc(Mid(j,1,1)) = 34 Or Asc(Mid(j,1,1)) = 39  Then
					j = " "+j+" "
				EndIf
			EndIf
			
			t$ = t$ + j$
			
		Next
		S$ = t$
		
		StrOpen = 0
		For i = 1 To Len(S$)
			c$ = Mid(S$,i,1)
			
			If Asc(c$) = 34 Then StrOpen = Not StrOpen
			
			If c$ = " " And StrOpen = 0 Then
				For n = i To Len(S$)
					l$ = Mid(S$,n,1)
					If l <> " " Then Exit
				Next
				
				S$ = Left(S$,i-1)+" "+Right(S$,Len(S$)-(n-1))
			EndIf
		Next

		Return Trim(Replace(S$,"	"," "))
	End Function
;#End Region

;#Region TOKENIZE
	Function IsNumber(S$,IsNot=1)
		c = Asc(S)
		If c > 47 And c < 58 Then Return (Not IsNot)
		Return IsNot
	End Function
	
	Type Token
		Field Text$
		Field Sep%
	End Type
	
	Const S_WHITEPSPACE% = $3000
	Const S_DACCESS% = $3001
	Const S_NUMBER% = $3002
	Const S_STRING%= $3003
	
	Function Tokenize(S$)
		S$ = Parse(S$)
		
		For n = 1 To Len(S$)
			c$ = Mid(S$,n,1)
			If Asc(c) = 34 Then
				If StrOpen = 1 Then
					t.Token = New Token
					t\Text$ = Mid(S$,LString+1,n-LString-1)
					t\Sep = S_STRING
				Else
					LString = n
				EndIf
				StrOpen = Not StrOpen
			ElseIf c$ = " " Or n = 1 And StrOpen = 0 Then
				For i = n+1 To Len(S$)
					k$ = Mid(S$,i,1)
					If k$ = Chr(34) Then Exit
					If K$ = " " Or i = Len(S$) Then
						
						t.Token = New Token
						t\Text$ = Trim(Mid(S$,n,i-(n)+1))
						
						t\Sep = S_WHITESPACE
						count = count + 1
						Exit
					EndIf
				Next
			EndIf
		Next
		Return count
	End Function
	
	Function GetTok$()
		t.Token = First Token
		If t = Null Then Return
		tex$ =  t\Text
		If FreeData Then Delete t
		Return tex$
	End Function
;#End Region

;#Region SCRIPT ENGINE
	Type Module
		Field Script$
		Field Name$
		Field Stack
	End Type
	
	Global CallStack = CreateStack()		;; This is the stack that is processed at the start of the 'update'
	Global VarStack = CreateStack()		;; All variables that are added, used as arguments, etc. are pushed onto this
	Global InStack = CreateStack()		;; Instructions that made it through the call loop
	
	Function AddScript(ModuleName$,Script$)
		If FileType(Script) <> 1 Then Return 0
		Return 1
	End Function
	
	Function CallProcedure(Module$,Proc$)
		For m.Module = Each Module
			If m\Name = Module Or Module = "" Then
				For n = 0 To Objects(m\Stack)-1
					v$ = GetObject(m\Stack,n,0)
					c% = PoppedClass
					If c = T_PROCOPEN And v$ = Proc$ Then
						If ProcOpen = 1 Then RuntimeError v+"  "+c+Chr(10)+"Call to T_PROCOPEN when proc already open"
						ProcOpen = 1
					EndIf
					
					If c = T_PROCCLOSE Then
						If ProcOpen = 0 Then RuntimeError v+"  "+c+Chr(10)+"Call to T_PROCCLOSE found when no proc open"
						If ProcReturn = 0 Then PushObject VarStack,-1,V_INT
						Return
					EndIf
					
					If c = T_RETURN And ProcOpen = 1 Then
						
					ElseIf c = T_RETURN And ProcOpen = 0 Then
						RuntimeError v+"  "+c+Chr(10)+"Call to T_RETURN found when not inside proc"
					EndIf
					
					If ProcOpen Then ProcessCall(v,c)
				Next
				Return 1
			EndIf
		Next
		
		Return 0
	End Function
	
	Function ProcessCall(v$,c%)
		Select c%
			Case T_CALL
				Select v$
					Case T_PRINT
						Print GetVariable(PopObject(VarStack),PoppedClass)
					Case T_PLOT
						X# = GetVariable(PopObject(VarStack),PoppedClass)
						Y# = GetVariable(PopObject(VarStack),PoppedClass)
						R# = GetVariable(PopObject(VarStack),PoppedClass)
						G# = GetVariable(PopObject(VarStack),PoppedClass)
						B# = GetVariable(PopObject(VarStack),PoppedClass)
						Color R,G,B
						Plot X,Y
					Case T_INITGRAPHICS
						W# =  GetVariable(PopObject(VarStack),PoppedClass)
						H# =  GetVariable(PopObject(VarStack),PoppedClass)
						BPP% =  GetVariable(PopObject(VarStack),PoppedClass)
						WIN% =  GetVariable(PopObject(VarStack),PoppedClass)
						t3D% =  GetVariable(PopObject(VarStack),PoppedClass)
						If t3D > 0 Then
							Graphics3D W,H,BPP,WIN+1
						Else
							Graphics W,H,BPP,WIN+1
						EndIf
						
					Default
						CallProcedure("",v$)
				End Select
			Case T_OP
				Select v$
					Case T_ADD
						V1# = GetVariable(PopObject(VarStack),PoppedClass)
						V2# = GetVariable(PopObject(VarStack),PoppedClass)
						PushObject(VarStack,V2+V1,V_FLOATCONST,0)
					Case T_SUB
						V1# = GetVariable(PopObject(VarStack),PoppedClass)
						V2# = GetVariable(PopObject(VarStack),PoppedClass)
						PushObject(VarStack,V2-V1,V_FLOATCONST,0)
					Case T_MOD
						V1# = GetVariable(PopObject(VarStack),PoppedClass)
						V2# = GetVariable(PopObject(VarStack),PoppedClass)
						PushObject(VarStack,V2 Mod V1,V_FLOATCONST,0)
					Case T_DIV
						V1# = GetVariable(PopObject(VarStack),PoppedClass)
						V2# = GetVariable(PopObject(VarStack),PoppedClass)
						PushObject(VarStack,V2/V1,V_FLOATCONST,0)
					Case T_MUL
						V1# = GetVariable(PopObject(VarStack),PoppedClass)
						V2# = GetVariable(PopObject(VarStack),PoppedClass)
						PushObject(VarStack,V2*V1,V_FLOATCONST,0)
				End Select
		End Select
	End Function
	
	Function UpdateScript()
	End Function
;#End Region

;#Region TOKENS
	Const T_PRINT = $1000						;; Print
	Const T_LET = $1001							;; Let
	Const T_ADD = $1002							;; Add
	Const T_SUB = $1003							;; Sub
	Const T_MUL = $1004							;; Multiply
	Const T_DIV = $1005							;; Divide
	Const T_MOD = $1006							;; Mod
	Const T_STRING = $1007						;; String open/close
	Const T_PLOT = $1008							;; Plot
	Const T_UNID = $1009							;; Unidentified
	Const T_ARGOPEN = $100A					;; Open argument
	Const T_ARGCLOSE = $100B				;; Close argument
	Const T_SCOPEUP = $100C					;; Open scope
	Const T_SCOPEDOWN = $100D				;; Close scope
	Const T_PROCOPEN = $100E				;; Proc open
	Const T_PROCCLOSE = $100F				;; Proc close
	Const T_RETURN = $1010					;; Return proc
	Const T_CALL = $1011							;; Proc call
	Const T_OP = $1012							;; Operator
	Const T_INITGRAPHICS = $1013			;; Initialize graphics mode
;#End Region




Variable("GraphicsWidth",V_INT,800)	;; Little variable test

PushObject CallStack,T_INITGRAPHICS,T_CALL			;; Init graphics mode
PushObject VarStack,"GraphicsWidth",V_INT					;; Width
PushObject VarStack,600,V_INTCONST					;; Height
PushObject VarStack,32,V_INTCONST						;; BPP
PushObject VarStack,1,V_INTCONST						;; Windowed toggle
PushObject VarStack,0,V_INTCONST						;; 3D toggle

PushObject CallStack,T_PRINT,T_CALL
PushObject VarStack,"Weeble, my good sir, weeble",V_STRING

For x = 0 To 48
	For y = 24 To 48
		;; Push a call to Plot() onto the call stack
		PushObject CallStack,T_PLOT,T_CALL
		
		;; X- with various uneccessary operations
		PushObject VarStack,T_ADD,T_OP
		PushObject VarStack,T_ADD,T_OP
		PushObject VarStack,T_MUL,T_OP
		PushObject VarStack,3,V_INTCONST
		PushObject VarStack,x,V_INTCONST
		PushObject VarStack,24,V_INTCONST
		PushObject VarStack,y,V_INTCONST
		
		;; Y
		PushObject VarStack,T_MUL,T_OP
		PushObject VarStack,y,V_INTCONST
		PushObject VarStack,3,V_INTCONST
		
		;; RGB
		PushObject VarStack,255,V_INTCONST
		PushObject VarStack,255 * (Float(Y-24)/24),V_INTCONST
		PushObject VarStack,255 * (1.0 - Float(X)/48),V_INTCONST
	Next
Next

SetBuffer BackBuffer()

While Objects(CallStack)
	;; Pop the call
	PopObject(CallStack)
	
	;; And process it
	ProcessCall PoppedValue,PoppedClass
Wend

Flip()

WaitKey
Ultimately, this is turning into something I may end up using. It may even be possible to implement function calls.