Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
zlscript_interpreter.bi
| Uploader: |  XOR |
| Datum/Zeit: | 06.01.2011 03:02:02 |
Sub ZLRunScript(ByVal Script As TBefehl Ptr)
Dim Ret As TRet
Ret = RunScript(Script)
End Sub
Function RunScript(ByVal Script As TBefehl Ptr)As TRet
Dim Zurueck As TRet
Dim Lastif As Byte
Zurueck.Was = _Single
Dim pBefehl As TBefehl Ptr
pBefehl = Script
Do
Select Case pBefehl->Befehl
Case _Byte
For i As UInteger = 0 To pBefehl->numArgumente-1
memres(@Cast(Any Ptr,Cast(TVari Ptr,pBefehl->pArgument[i].Zeiger)->Zeiger),Len(Byte))
Next
Case _UByte
For i As UInteger = 0 To pBefehl->numArgumente-1
memres(@Cast(Any Ptr,Cast(TVari Ptr,pBefehl->pArgument[i].Zeiger)->Zeiger),Len(UByte))
Next
Case _Short
For i As UInteger = 0 To pBefehl->numArgumente-1
memres(@Cast(Any Ptr,Cast(TVari Ptr,pBefehl->pArgument[i].Zeiger)->Zeiger),Len(Short))
Next
Case _UShort
For i As UInteger = 0 To pBefehl->numArgumente-1
memres(@Cast(Any Ptr,Cast(TVari Ptr,pBefehl->pArgument[i].Zeiger)->Zeiger),Len(UShort))
Next
Case _Integer
For i As UInteger = 0 To pBefehl->numArgumente-1
memres(@Cast(Any Ptr,Cast(TVari Ptr,pBefehl->pArgument[i].Zeiger)->Zeiger),Len(Integer))
Next
Case _UInteger
For i As UInteger = 0 To pBefehl->numArgumente-1
memres(@Cast(Any Ptr,Cast(TVari Ptr,pBefehl->pArgument[i].Zeiger)->Zeiger),Len(UInteger))
Next
Case _Single
For i As UInteger = 0 To pBefehl->numArgumente-1
memres(@Cast(Any Ptr,Cast(TVari Ptr,pBefehl->pArgument[i].Zeiger)->Zeiger),Len(Single))
Next
Case _String
For i As UInteger = 0 To pBefehl->numArgumente-1
memres(@Cast(Any Ptr,Cast(TVari Ptr,pBefehl->pArgument[i].Zeiger)->Zeiger),Len(UByte))
Next
Case _let
Dim Vari(0) As TRet
Vari(0) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If pBefehl->pArgument[0].Was <> _String Then
SetZahl(@pBefehl->pArgument[0],Vari(0).Zahl)
Else
SetString(@pBefehl->pArgument[0],Vari(0).Stri)
EndIf
Case _same
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl=Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Stri=Vari(1).Stri
EndIf
Return Zurueck
Case _bigger
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl>Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Stri>Vari(1).Stri
EndIf
Return Zurueck
Case _smaler
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl<Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Stri<Vari(1).Stri
EndIf
Return Zurueck
Case _biggersame
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl>=Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Stri>=Vari(1).Stri
EndIf
Return Zurueck
Case _smalersame
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl<=Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Stri<=Vari(1).Stri
EndIf
Return Zurueck
Case _Notsame
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl<>Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Stri<>Vari(1).Stri
EndIf
Return Zurueck
Case _and
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl And Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = 0
EndIf
Return Zurueck
Case _or
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl Or Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = 0
EndIf
Return Zurueck
Case _xor
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl Xor Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = 0
EndIf
Return Zurueck
Case _not
Dim Vari(0) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Not(Vari(0).Zahl)
Else
Zurueck.Was = _Single
Zurueck.Zahl = 0
EndIf
Return Zurueck
Case _add
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl+Vari(1).Zahl
Else
Zurueck.Was = _String
Zurueck.Stri = Vari(0).Stri+Vari(1).Stri
EndIf
Return Zurueck
Case _sub
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl-Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = 0
EndIf
Return Zurueck
Case _mul
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl*Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = 0
EndIf
Return Zurueck
Case _div
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl/Vari(1).Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = 0
EndIf
Return Zurueck
Case _pot
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
If Vari(0).Was <> _String Then
Print "pot"
Print Vari(0).Zahl
Print Vari(1).Zahl
Zurueck.Was = _Single
Zurueck.Zahl = Vari(0).Zahl^Vari(1).Zahl
Print Zurueck.Zahl
Else
Zurueck.Was = _Single
Zurueck.Zahl = 0
EndIf
Return Zurueck
Case _print
Dim Vari(0) As TRet
For i As Integer = 0 To pBefehl->numArgumente-1
Vari(0) = GetVari(pBefehl->pArgument[i].Was,pBefehl->pArgument[i].Zeiger)
If Vari(0).Was <> _String Then
Print Vari(0).Zahl;
Else
Print Vari(0).Stri;
EndIf
Print " ";
Next
Print
Case _screen
Dim Vari(5) As TRet
For i As Integer = 0 To 5
Vari(i) = GetVari(pBefehl->pArgument[i].Was,pBefehl->pArgument[i].Zeiger)
Next
ScreenRes Vari(0).Zahl,Vari(1).Zahl,Vari(2).Zahl,Vari(3).Zahl,Vari(4).Zahl,Vari(5).Zahl
Case _cls
Cls
Case _do
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Do
Vari(1) = RunScript(pBefehl->pArgument[1].Zeiger)
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Loop Until Vari(0).Zahl <> 0
Case _input
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Print Vari(0).Stri;
If pBefehl->pArgument[1].Was <> _String Then
Dim eingabe As Double
Input "",eingabe
SetZahl(@pBefehl->pArgument[1],eingabe)
Else
Dim eingabe As String
Input "",eingabe
SetString(@pBefehl->pArgument[1],eingabe)
EndIf
Case _sleep
Dim Vari(1) As TRet
If pBefehl->numArgumente = 0 Then
Sleep
ElseIf pBefehl->numArgumente = 1 Then
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Sleep Vari(0).Zahl
Else
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
Sleep Vari(0).Zahl,Vari(1).Zahl
EndIf
Case _inkey
Zurueck.Was = _String
Zurueck.Stri = InKey
Case _if
Dim Vari(1) As TRet
Lastif = 0
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
If Vari(0).Zahl Then
Lastif = 1
Vari(1) = RunScript(pBefehl->pArgument[1].Zeiger)
EndIf
Case _else
Dim Vari(0) As TRet
If Lastif = 0 Then
Vari(0) = RunScript(pBefehl->pArgument[0].Zeiger)
EndIf
Case _elseif
Dim Vari(1) As TRet
If Lastif = 0 Then
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
If Vari(0).Zahl Then
Lastif = 1
Vari(1)= RunScript(pBefehl->pArgument[1].Zeiger)
EndIf
EndIf
Case _locate
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
Locate Vari(0).Zahl,Vari(1).Zahl
Case _color
Dim Vari(1) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
color Vari(0).Zahl,Vari(1).Zahl
Case _rgb
Dim Vari(2) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
Vari(2) = GetVari(pBefehl->pArgument[2].Was,pBefehl->pArgument[2].Zeiger)
Zurueck.Was = _Single
Zurueck.Zahl = Vari(2).Zahl Shl 24 + Vari(1).Zahl Shl 16 + Vari(0).Zahl Shl 8
Case _rgba
Dim Vari(2) As TRet
Vari(0) = GetVari(pBefehl->pArgument[0].Was,pBefehl->pArgument[0].Zeiger)
Vari(1) = GetVari(pBefehl->pArgument[1].Was,pBefehl->pArgument[1].Zeiger)
Vari(2) = GetVari(pBefehl->pArgument[2].Was,pBefehl->pArgument[2].Zeiger)
Vari(3) = GetVari(pBefehl->pArgument[3].Was,pBefehl->pArgument[3].Zeiger)
Zurueck.Was = _Single
Zurueck.Zahl = Vari(2).Zahl Shl 24 + Vari(1).Zahl Shl 16 + Vari(0).Zahl Shl 8 + Vari(3).Zahl
Case _chr
Case _chr
Dim Vari(0) As TRet
Zurueck.Was = _String
For i As UInteger = 1 To pBefehl->numArgumente
Vari(0) = GetVari(pBefehl->pArgument[i-1].Was,pBefehl->pArgument[i-1].Zeiger)
Zurueck.Stri += Chr(Vari(0).Zahl)
Next
End Select
pBefehl = pBefehl->NextBefehl
Loop Until pBefehl = 0
Return Zurueck
End Function
Sub ZLDeleteScript(ByVal Script As TBefehl Ptr)
Dim pBefehl As TBefehl Ptr
Dim pLastBefehl As TBefehl Ptr
pBefehl = Script
Do
For i As Integer = 0 To pBefehl->numArgumente-1
If pBefehl->pArgument[i].Was = _Befehl Then
ZLDeleteScript(pBefehl->pArgument[i].Zeiger)
ElseIf between(pBefehl->pArgument[i].Was, _Byte, _String) Then
'memfree(@Cast(Any Ptr,Cast(TVari Ptr,pBefehl->pArgument[i].Zeiger)->Zeiger))
memfree(@Cast(TVari Ptr,pBefehl->pArgument[i].Zeiger))
EndIf
Next
memfree(@pBefehl->pArgument)
pLastBefehl = pBefehl
pBefehl = pLastBefehl->NextBefehl
memfree(@pLastBefehl)
Loop Until pBefehl = 0
End Sub
Function GetVari(ByVal Was As UInteger, ByVal Zeiger As Any Ptr)As TRet
Dim Ret As TRet
Ret.Was = _Single
Select Case Was
Case _befehl
Ret = RunScript(Zeiger)
Case _Byte
Ret.Zahl = *Cast(Byte Ptr,Cast(TVari Ptr,Zeiger)->Zeiger)
Case _UByte
Ret.Zahl = *Cast(UByte Ptr,Cast(TVari Ptr,Zeiger)->Zeiger)
Case _Short
Ret.Zahl = *Cast(Short Ptr,Cast(TVari Ptr,Zeiger)->Zeiger)
Case _UShort
Ret.Zahl = *Cast(UShort Ptr,Cast(TVari Ptr,Zeiger)->Zeiger)
Case _Integer
Ret.Zahl = *Cast(Integer Ptr,Cast(TVari Ptr,Zeiger)->Zeiger)
Case _UInteger
Ret.Zahl = *Cast(UInteger Ptr,Cast(TVari Ptr,Zeiger)->Zeiger)
Case _Single
Ret.Zahl = *Cast(Single Ptr,Cast(TVari Ptr,Zeiger)->Zeiger)
Case _String
Ret.Was = _String
Ret.Stri = *Cast(ZString Ptr,Cast(TVari Ptr,Zeiger)->Zeiger)
Case _const_Integer
Ret.Zahl = *Cast(Integer Ptr,Zeiger)
Case _const_Single
Ret.Zahl = *Cast(Single Ptr,Zeiger)
Case _const_String
Ret.Was = _String
Ret.Stri = *Cast(ZString Ptr,Zeiger)
Case Else
Print Was
Print "GetVari Error"
End Select
Return Ret
End Function