Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
zlscript_compiler.bi
| Uploader: |  XOR |
| Datum/Zeit: | 06.01.2011 03:01:16 |
Function ZLCompileScriptfromFile(ByVal File As String) As TBefehl Ptr
Dim FF As Integer
Dim ScriptText As String
Dim Linie As String
FF = FreeFile
If Open(File,For Input, As #FF) <> 0 Then Return 0
Do
Line Input #FF, Linie
ScriptText += Linie + Chr(13,10)
Loop Until Eof(FF)
Close #FF
Return ZLCompileScript(ScriptText)
End Function
Function ZLCompileScript(ByVal Text As String) As TBefehl Ptr
Dim ScriptText As String
ScriptText = Script_Phase(Text)
Print ScriptText
return CompileScript(ScriptText)
End Function
Function CompileScript(ByVal Text As String) As TBefehl Ptr
Function = 0
Dim ScriptText As String
Dim Linie As String
Dim Befehl As String
Dim BefehlsArgumente As String
Dim BefehlsLenge As UInteger
Dim NumArgumente As UInteger
Dim pLastBefehl As TBefehl Ptr
Dim pBefehl As TBefehl Ptr
Dim Posi As TPosi
Dim Vari As TVari Ptr
Dim Arg As String
Dim First As Byte = 1
pLastBefehl = 0
ScriptText = Text
Print ScriptText
Posi.n = InStr(ScriptText,any ";{}")
Do
Linie = Mid(ScriptText,Posi.a+1,Posi.n-Posi.a-1)
BefehlsLenge = InStr(Linie,"(")
Befehl = Mid(Linie,1,BefehlsLenge-1)
BefehlsArgumente = Mid(Linie,BefehlsLenge+1,Len(Linie)-BefehlsLenge-1)
NumArgumente = GetNumArgumente(BefehlsArgumente)
If memres(@pBefehl,Len(TBefehl)) = 0 Then return 0
If First = 1 Then
Function = pBefehl
First = 0
Else
pLastBefehl->NextBefehl = pBefehl
EndIf
Select Case LCase(Befehl)
Case "byte"
NewVari(pBefehl,_Byte,BefehlsArgumente,NumArgumente)
Case "ubyte"
NewVari(pBefehl,_UByte,BefehlsArgumente,NumArgumente)
Case "short"
NewVari(pBefehl,_Short,BefehlsArgumente,NumArgumente)
Case "ushort"
NewVari(pBefehl,_UShort,BefehlsArgumente,NumArgumente)
Case "integer"
NewVari(pBefehl,_integer,BefehlsArgumente,NumArgumente)
Case "uinteger"
NewVari(pBefehl,_uinteger,BefehlsArgumente,NumArgumente)
Case "single"
NewVari(pBefehl,_single,BefehlsArgumente,NumArgumente)
Case "string"
NewVari(pBefehl,_string,BefehlsArgumente,NumArgumente)
Case "let"
Arg = GetArgument(BefehlsArgumente,1)
pBefehl->Befehl = _let
pBefehl->numArgumente = 2
If memres(@pBefehl->pArgument,Len(TArgument)*2) = 0 then Return 0
pBefehl->pArgument[0].Was = SucheVariType(Arg)
pBefehl->pArgument[0].Zeiger = SucheVariZeiger(Arg)
Arg = GetArgument(BefehlsArgumente,2)
If InStr(Arg,"(") <> 0 Then
pBefehl->pArgument[1].Was = _Befehl
pBefehl->pArgument[1].Zeiger = CompileScript(Arg)
Else
Select Case Mid(Arg,1,1)
Case Chr(34)
pBefehl->pArgument[1].Was = _Const_String
pBefehl->pArgument[1].Zeiger = Allocate(Len(Arg)-2)
*Cast(UByte Ptr,pBefehl->pArgument[1].Zeiger) = Mid(Arg,2,Len(Arg)-2)
Case "0" To "9"
If InStr(Arg,".") = 0 Then
pBefehl->pArgument[1].Was = _Const_Integer
Cast(Integer ptr,pBefehl->pArgument[1].Zeiger) = Allocate(Len(Integer))
*Cast(Integer ptr,pBefehl->pArgument[1].Zeiger) = Val(Arg)
Else
pBefehl->pArgument[1].Was = _Const_Single
Cast(Single Ptr,pBefehl->pArgument[1].Zeiger) = Allocate(Len(Single))
*Cast(Single Ptr,pBefehl->pArgument[1].Zeiger) = Val(Arg)
EndIf
Case Else
pBefehl->pArgument[1].Was = SucheVariType(Arg)
pBefehl->pArgument[1].Zeiger = SucheVariZeiger(Arg)
End Select
EndIf
Case "same"
pBefehl->Befehl = _same
Rechnung(pBefehl,BefehlsArgumente)
Case "bigger"
pBefehl->Befehl = _bigger
Rechnung(pBefehl,BefehlsArgumente)
Case "smaler"
pBefehl->Befehl = _smaler
Rechnung(pBefehl,BefehlsArgumente)
Case "biggerorsame"
pBefehl->Befehl = _biggersame
Rechnung(pBefehl,BefehlsArgumente)
Case "smalerorsame"
pBefehl->Befehl = _smalersame
Rechnung(pBefehl,BefehlsArgumente)
Case "notsame"
pBefehl->Befehl = _notsame
Rechnung(pBefehl,BefehlsArgumente)
Case "f_and"
pBefehl->Befehl = _and
Rechnung(pBefehl,BefehlsArgumente)
Case "f_or"
pBefehl->Befehl = _or
Rechnung(pBefehl,BefehlsArgumente)
Case "f_xor"
pBefehl->Befehl = _xor
Rechnung(pBefehl,BefehlsArgumente)
case "not"
pBefehl->Befehl = _not
Rechnung(pBefehl,BefehlsArgumente)
Case "add"
pBefehl->Befehl = _add
Rechnung(pBefehl,BefehlsArgumente)
Case "sub"
pBefehl->Befehl = _sub
Rechnung(pBefehl,BefehlsArgumente)
Case "mul"
pBefehl->Befehl = _mul
Rechnung(pBefehl,BefehlsArgumente)
Case "div"
pBefehl->Befehl = _div
Rechnung(pBefehl,BefehlsArgumente)
Case "pot"
pBefehl->Befehl = _pot
Rechnung(pBefehl,BefehlsArgumente)
Case "print"
pBefehl->Befehl = _print
pBefehl->numArgumente = NumArgumente
Arg = ""
For i As UInteger = 1 To NumArgumente
Arg += "%un "
Next
SetParameter(pBefehl,NumArgumente,BefehlsArgumente,Arg)
Case "screen"
pBefehl->Befehl = _screen
SetParameter(pBefehl,6,BefehlsArgumente,"%i %i %i8 %i1 %i0 %i0")
Case "cls"
pBefehl->Befehl = _cls
pBefehl->numArgumente = 0
Case "do"
Dim Hight As UByte
Dim Position As UInteger
pBefehl->Befehl = _do
SetParameter(pBefehl,2,BefehlsArgumente,"%b")
pBefehl->pArgument[1].Was = _Befehl
For i As UInteger = Posi.n+1 To Len(ScriptText)
If Mid(ScriptText,i,1) = "{" Then
Hight+=1
EndIf
If Mid(ScriptText,i,1) = "}" Then
If Hight = 0 Then
Position = i
Exit for
EndIf
Hight-=1
EndIf
Next
pBefehl->pArgument[1].Zeiger = CompileScript(Mid(ScriptText,Posi.n+1,Position-Posi.n-1)+";")
Posi.n = Position
Case "input"
pBefehl->Befehl = _input
SetParameter(pBefehl,2,BefehlsArgumente,"%st %i")
Case "sleep"
pBefehl->Befehl = _sleep
SetParameter(pBefehl,NumArgumente,BefehlsArgumente,"%i %i")
Case "inkey"
pBefehl->Befehl = _inkey
pBefehl->numArgumente = 0
Case "if"
Dim Hight As UByte
Dim Position As UInteger
pBefehl->Befehl = _if
SetParameter(pBefehl,2,BefehlsArgumente,"%b")
pBefehl->pArgument[1].Was = _Befehl
For i As UInteger = Posi.n+1 To Len(ScriptText)
If Mid(ScriptText,i,1) = "{" Then
Hight+=1
EndIf
If Mid(ScriptText,i,1) = "}" Then
If Hight = 0 Then
Position = i
Exit for
EndIf
Hight-=1
EndIf
Next
pBefehl->pArgument[1].Zeiger = CompileScript(Mid(ScriptText,Posi.n+1,Position-Posi.n-1)+";")
Posi.n = Position
Case "else"
Dim Hight As UByte
Dim Position As UInteger
pBefehl->Befehl = _else
pBefehl->numArgumente = 1
If memres(@pBefehl->pArgument,Len(TArgument)) = 0 then Return 0
pBefehl->pArgument[0].Was = _Befehl
For i As UInteger = Posi.n+1 To Len(ScriptText)
If Mid(ScriptText,i,1) = "{" Then
Hight+=1
EndIf
If Mid(ScriptText,i,1) = "}" Then
If Hight = 0 Then
Position = i
Exit for
EndIf
Hight-=1
EndIf
Next
pBefehl->pArgument[0].Zeiger = CompileScript(Mid(ScriptText,Posi.n+1,Position-Posi.n-1)+";")
Posi.n = Position
Case "elseif"
Dim Hight As UByte
Dim Position As UInteger
pBefehl->Befehl = _elseif
SetParameter(pBefehl,2,BefehlsArgumente,"%b")
pBefehl->pArgument[1].Was = _Befehl
For i As UInteger = Posi.n+1 To Len(ScriptText)
If Mid(ScriptText,i,1) = "{" Then
Hight+=1
EndIf
If Mid(ScriptText,i,1) = "}" Then
If Hight = 0 Then
Position = i
Exit for
EndIf
Hight-=1
EndIf
Next
pBefehl->pArgument[1].Zeiger = CompileScript(Mid(ScriptText,Posi.n+1,Position-Posi.n-1)+";")
Posi.n = Position
Case "locate"
pBefehl->Befehl = _locate
SetParameter(pBefehl,2,BefehlsArgumente,"%i %i")
Case "color"
pBefehl->Befehl = _Color
SetParameter(pBefehl,2,BefehlsArgumente,"%i %i0")
Case "rgb"
pBefehl->Befehl = _rgb
SetParameter(pBefehl,3,BefehlsArgumente,"%b %b %b")
Case "rgba"
pBefehl->Befehl = _rgba
SetParameter(pBefehl,4,BefehlsArgumente,"%b %b %b %b")
Case "chr"
pBefehl->Befehl = _chr
pBefehl->numArgumente = NumArgumente
Arg = ""
For i As UInteger = 1 To NumArgumente
Arg += "%ub "
Next
SetParameter(pBefehl,NumArgumente,BefehlsArgumente,Arg)
Case Else
memfree(@pBefehl)
pLastBefehl->NextBefehl=0
End Select
If pBefehl <> 0 then
pLastBefehl = pBefehl
EndIf
Posi.a = Posi.n
Posi.n = InStr(Posi.a+1,ScriptText,any ";{}")
Loop Until Posi.n = 0
End Function
Sub SetParameter(ByVal pBefehl As TBefehl ptr, ByVal NumPara As UInteger, ByVal ParameterListe As String, ByVal Liste As String)
If NumPara = 0 Then Exit sub
Dim Arg As String
Dim ListPos As UInteger
Dim LastListPos As UInteger
Dim i As UInteger
Dim Was As String
Dim Sonst As String
Dim Sonsterlaubt As Byte
pBefehl->numArgumente = NumPara
If memres(@pBefehl->pArgument,Len(TArgument)*NumPara) = 0 then Exit Sub
ListPos = InStr(Liste,"%")
Do
Sonsterlaubt = 0
Was = LCase(Mid(Liste,ListPos+1,1))
If Was = "s" Or Was = "u" Then
Was += LCase(Mid(Liste,ListPos+2,1))
If Mid(Liste,ListPos+3)>="0" And Mid(Liste,ListPos+3)<="9"Then
Sonsterlaubt = 1
Sonst = Mid(Liste,ListPos+3,InStr(ListPos+4,Liste,Any" %")-ListPos-3)
ElseIf Mid(Liste,ListPos+3)=Chr(34) Then
Sonst = Mid(Liste,ListPos+3,InStr(ListPos+4,Liste,Chr(34))-ListPos-3)
EndIf
Else
If Mid(Liste,ListPos+2)>="0" And Mid(Liste,ListPos+2)<="9"Then
Sonsterlaubt = 1
Sonst = Mid(Liste,ListPos+2,InStr(ListPos+4,Liste,Any" %")-ListPos-2)
ElseIf Mid(Liste,ListPos+3)=Chr(34) Then
Sonst = Mid(Liste,ListPos+2,InStr(ListPos+4,Liste,Chr(34))-ListPos-2)
EndIf
EndIf
Arg = GetArgument(ParameterListe,i+1)
If Arg = "" Then
If Sonsterlaubt = 1 Then
Arg = Sonst
Else
Print "Error"
EndIf
EndIf
If InStr(Arg,"(") <> 0 Then
pBefehl->pArgument[i].Was = _Befehl
pBefehl->pArgument[i].Zeiger = CompileScript(Arg)
Else
Select Case Mid(Arg,1,1)
Case Chr(34)
If Was = "st" Or Was = "un" Then
pBefehl->pArgument[i].Was = _Const_String
pBefehl->pArgument[i].Zeiger = Allocate(Len(Arg)-1)
*Cast(UByte Ptr,pBefehl->pArgument[i].Zeiger) = Mid(Arg,2,Len(Arg)-2)
EndIf
Case "0" To "9"
If Was <> "st" Then
If InStr(Arg,".") = 0 or (Was <> "si" And Was <> "un") Then
pBefehl->pArgument[i].Was = _Const_Integer
Cast(Integer ptr,pBefehl->pArgument[i].Zeiger) = Allocate(Len(Integer))
*Cast(Integer ptr,pBefehl->pArgument[i].Zeiger) = Val(Arg)
Else
pBefehl->pArgument[i].Was = _Const_Single
Cast(Single Ptr,pBefehl->pArgument[i].Zeiger) = Allocate(Len(Single))
*Cast(Single Ptr,pBefehl->pArgument[i].Zeiger) = Val(Arg)
EndIf
Else
Print "Error"
EndIf
Case Else
pBefehl->pArgument[i].Was = SucheVariType(Arg)
pBefehl->pArgument[i].Zeiger = SucheVariZeiger(Arg)
End Select
EndIf
LastListPos = ListPos
ListPos = InStr(LastListPos+1,Liste,"%")
i += 1
Loop Until LastListPos = 0 Or i >= NumPara
End Sub
Sub Rechnung(ByVal pBefehl As TBefehl Ptr, ByVal BefehlsArgumente As String)
Dim Arg As String
Dim Ok As Byte
Dim Posi As UInteger
pBefehl->numArgumente = 2
If memres(@pBefehl->pArgument,Len(TArgument)*2) = 0 then Exit sub
For i As UInteger = 0 To 1
Arg = GetArgument(BefehlsArgumente,i+1)
Ok = 0
Posi = 0
For j As UInteger = 1 To Len(Arg)
If Mid(Arg,j,1) = Chr(34) Then Ok = Not(OK)
If Ok = 0 Then
If Mid(Arg,j,1) = "(" Then
Posi = j
Exit For
EndIf
EndIf
Next
If Posi <> 0 then
pBefehl->pArgument[i].Was = _Befehl
pBefehl->pArgument[i].Zeiger = CompileScript(Arg)
Else
Select Case Mid(Arg,1,1)
Case Chr(34)
pBefehl->pArgument[i].Was = _Const_String
pBefehl->pArgument[i].Zeiger = Allocate(Len(Arg)-2)
*Cast(UByte Ptr,pBefehl->pArgument[i].Zeiger) = Mid(Arg,2,Len(Arg)-2)
Case "0" To "9"
If InStr(Arg,".") = 0 Then
pBefehl->pArgument[i].Was = _Const_Integer
Cast(Integer ptr,pBefehl->pArgument[i].Zeiger) = Allocate(Len(Integer))
*Cast(Integer ptr,pBefehl->pArgument[i].Zeiger) = Val(Arg)
Else
pBefehl->pArgument[i].Was = _Const_Single
Cast(Single Ptr,pBefehl->pArgument[i].Zeiger) = Allocate(Len(Single))
*Cast(Single Ptr,pBefehl->pArgument[i].Zeiger) = Val(Arg)
EndIf
Case Else
pBefehl->pArgument[i].Was = SucheVariType(Arg)
pBefehl->pArgument[i].Zeiger = SucheVariZeiger(Arg)
End Select
EndIf
Next
End Sub