Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
zlscript_phaser.bi
| Uploader: |  XOR |
| Datum/Zeit: | 06.01.2011 02:59:49 |
Function Script_Phase(ByVal Text As String) As String
Dim ScriptText As String
Dim EndText As String
Dim inStri As Byte
ScriptText = Script_Phase_Entferne_Koments(Text)
ScriptText = Script_Phase_set_klammern(ScriptText)
For i As UInteger = 1 To Len(ScriptText)
If Mid(ScriptText,i,1) = Chr(34) Then inStri = Not(inStri)
If inStri = 0 Then
EndText+=LCase(Mid(ScriptText,i,1))
Else
EndText+=Mid(ScriptText,i,1)
EndIf
Next
Print ScriptText
Return EndText
End Function
Function Script_Phase_set_klammern(ByVal Text As String) As String
Dim ScriptText As String
Dim Linie As String
Dim LinieNew As String
Dim Leer As Byte
Dim LetLet As Byte
Dim Posi As TPosi
Dim inText As Byte
Dim Endung As String
Posi.a = 0
Posi.n = InStr(Posi.a+1,Text,any ";{}")
Do
Leer = 0
LetLet = 0
Linie = Mid(Text,Posi.a+1,Posi.n-Posi.a-1)
Endung = Mid(Text,Posi.n,1)
For i As UInteger = Posi.n+1 To Len(Text)
If Mid(Text,i,1) <> " " And Mid(Text,i,1) <> "}" Then
Exit For
EndIf
If Mid(Text,i,1) = "}" Then
Leer+=1
EndIf
Next
For i As Integer = 0 To Leer-1
If Endung = ";" Then Endung = ""
Endung += "}"
Next
Print Linie
Leer = 0
For i As UInteger = 1 To Len(Linie)
Select Case Mid(Linie,i,1)
Case "="
LetLet = 1
Linie = Linie
Exit For
Case "0" To "9",Chr(34)
If i = 1 Then Return ""
If Leer = 1 Then
Linie = Mid(Linie,1,i-1)+"("+Mid(Linie,i)+")"+Endung
Exit For
EndIf
Case "a" To "z", "a" To "z", "_"
If Leer = 1 Then
Linie = Mid(Linie,1,i-1)+"("+Mid(Linie,i)+")"+Endung
Exit For
EndIf
Case " "
Leer = 1
Case "("
Linie += Endung
Exit For
End Select
If i = Len(Linie) Then
Linie = Mid(Linie,1,i)+"()"+Endung
EndIf
Next
Print Linie
LinieNew = ""
For i As UInteger = 1 To Len(Linie)
If Mid(Linie,i,1) = Chr(34) Then inText = Not(inText)
If inText = 0 Then
If Mid(Linie,i,1) <> " " And Mid(Linie,i,1) <> Chr(9) Then
LinieNew += Mid(Linie,i,1)
EndIf
Else
LinieNew += Mid(Linie,i,1)
EndIf
Next
If LetLet = 1 Then
For i As UInteger = 1 To Len(Linie)
If Mid(LinieNew,i,1) = "=" Then
LinieNew = "let("+Mid(LinieNew,1,i-1)+","+Script_Phase_Rechnung(Mid(LinieNew,i+1))+")"+Endung
Exit for
EndIf
Next
Else
For i As UInteger = 1 To Len(LinieNew)
If Mid(LinieNew,i,1) = "(" Then
Dim LinieNew1 As String
LinieNew1 = Mid(LinieNew,1,i)
For j As Integer = 1 To GetNumArgumente(Mid(LinieNew,i+1,Len(LinieNew)-i-1-Len(Endung)))
LinieNew1+=Script_Phase_Rechnung(GetArgument(Mid(LinieNew,i+1,Len(LinieNew)-i-1-Len(Endung)),j))
If not(j = GetNumArgumente(Mid(LinieNew,i+1))) Then
LinieNew1+=","
EndIf
Next
LinieNew = LinieNew1+")"+Endung
EndIf
Next
EndIf
Print LinieNew
ScriptText+=LinieNew
Posi.a = Posi.n
Posi.n = InStr(Posi.a+1,Text,any ";{}")
Loop Until Posi.n = 0
Return ScriptText
End Function
Function Script_Phase_Rechnung(ByVal Text As String) As String
Dim Term As String
If Text = "" Then Return "0"
Term = LCase(Text)
Dim Ret As String
Ret = Script_Phase_RechnungOp1(Term)
If Ret <> "" Then Return Ret
Ret = Script_Phase_RechnungOp2(Term)
If Ret <> "" Then Return Ret
Ret = Script_Phase_RechnungOp3(Term)
If Ret <> "" Then Return Ret
Ret = Script_Phase_RechnungOp4(Term)
If Ret <> "" Then Return Ret
Ret = Script_Phase_RechnungOp5(Term)
If Ret <> "" Then Return Ret
Select Case mid(Term,1,1)
Case "("
Return Script_Phase_Rechnung(Mid(Term,2,Len(Term)-2))
Case "a"To"z","a"To"z"
Dim Ok As Byte
Dim Posi As UInteger
For i As UInteger = 1 To Len(Term)
If Mid(Term,i,1) = Chr(34) Then Ok = Not(OK)
If Ok = 0 Then
If Mid(Term,i,1) = "(" Then
Posi = i
Exit For
EndIf
EndIf
Next
If Posi <> 0 Then
Return Mid(Term,1,Posi)+FuncPara(Mid(Term,Posi+1,Len(Term)-Posi-1))+")"
EndIf
End Select
Return Text
End Function
Function Script_Phase_RechnungOp1(ByVal Text As String) As String
Dim Term As String
Dim Sperren As UByte
Term = Text
Sperren = 0
For i As UInteger = Len(Term) To 1 Step -1
If Mid(Term,i,1) = "(" Then Sperren += 1
If Sperren = 0 Then
If Mid(Term,i,3) = "and" Then
Return "f_and("+Script_Phase_Rechnung(Mid(Term,1,i-1))+","+Script_Phase_Rechnung(Mid(Term,i+3))+")"
ElseIf Mid(Term,i,3) = "xor" Then
Return "f_xor("+Script_Phase_Rechnung(Mid(Term,1,i-1))+","+Script_Phase_Rechnung(Mid(Term,i+3))+")"
ElseIf Mid(Term,i,2) = "or" And Not(Mid(Term,i-1,1) = "x") Then
Return "f_or("+Script_Phase_Rechnung(Mid(Term,1,i-1))+","+Script_Phase_Rechnung(Mid(Term,i+2))+")"
EndIf
EndIf
If Mid(Term,i,1) = ")" Then Sperren -= 1
Next
Return ""
End Function
Function Script_Phase_RechnungOp2(ByVal Text As String) As String
Dim Term As String
Dim Sperren As UByte
Term = Text
For i As UInteger = Len(Term) To 1 Step -1
If Mid(Term,i,1) = "(" Then Sperren += 1
If Sperren = 0 Then
If Mid(Term,i-1,2) = ">=" Then
Return "biggerorsame("+Script_Phase_Rechnung(Mid(Term,1,i-2))+","+Script_Phase_Rechnung(Mid(Term,i+1))+")"
ElseIf Mid(Term,i-1,2) = "<=" Then
Return "smalerorsame("+Script_Phase_Rechnung(Mid(Term,1,i-2))+","+Script_Phase_Rechnung(Mid(Term,i+1))+")"
ElseIf Mid(Term,i-1,2) = "<>" Then
Return "notsame("+Script_Phase_Rechnung(Mid(Term,1,i-2))+","+Script_Phase_Rechnung(Mid(Term,i+1))+")"
ElseIf Mid(Term,i,1) = ">" Then
Return "bigger("+Script_Phase_Rechnung(Mid(Term,1,i-1))+","+Script_Phase_Rechnung(Mid(Term,i+1))+")"
ElseIf Mid(Term,i,1) = "<" Then
Return "smaler("+Script_Phase_Rechnung(Mid(Term,1,i-1))+","+Script_Phase_Rechnung(Mid(Term,i+1))+")"
ElseIf Mid(Term,i,1) = "=" Then
Return "same("+Script_Phase_Rechnung(Mid(Term,1,i-1))+","+Script_Phase_Rechnung(Mid(Term,i+1))+")"
EndIf
EndIf
If Mid(Term,i,1) = ")" Then Sperren -= 1
Next
Return ""
End Function
Function Script_Phase_RechnungOp3(ByVal Text As String) As String
Dim Term As String
Dim Sperren As UByte
Term = Text
For i As UInteger = Len(Term) To 1 Step -1
If Mid(Term,i,1) = "(" Then Sperren += 1
If Sperren = 0 then
If Mid(Term,i,1) = "+" Or Mid(Term,i,1) = "-" Then
If Mid(Term,i,1) = "+" Then
Return "add("+Script_Phase_Rechnung(Mid(Term,1,i-1))+","+Script_Phase_Rechnung(Mid(Term,i+1))+")"
Else
Return "sub("+Script_Phase_Rechnung(Mid(Term,1,i-1))+","+Script_Phase_Rechnung(Mid(Term,i+1))+")"
EndIf
EndIf
EndIf
If Mid(Term,i,1) = ")" Then Sperren -= 1
Next
Return ""
End Function
Function Script_Phase_RechnungOp4(ByVal Text As String) As String
Dim Term As String
Dim Sperren As UByte
Term = Text
For i As UInteger = Len(Term) To 1 Step -1
If Mid(Term,i,1) = "(" Then Sperren += 1
If Sperren = 0 Then
If Mid(Term,i,1) = "*" Or Mid(Term,i,1) = "/" Then
If Mid(Term,i,1) = "*" Then
Return "mul("+Script_Phase_Rechnung(Mid(Term,1,i-1))+","+Script_Phase_Rechnung(Mid(Term,i+1))+")"
Else
Return "div("+Script_Phase_Rechnung(Mid(Term,1,i-1))+","+Script_Phase_Rechnung(Mid(Term,i+1))+")"
EndIf
EndIf
EndIf
If Mid(Term,i,1) = ")" Then Sperren -= 1
Next
Return ""
End Function
Function Script_Phase_RechnungOp5(ByVal Text As String) As String
Dim Term As String
Dim Sperren As UByte
Term = Text
For i As UInteger = Len(Term) To 1 Step -1
If Mid(Term,i,1) = "(" Then Sperren += 1
If Sperren = 0 Then
If Mid(Term,i,1) = "^" Then
Return "pot("+Script_Phase_Rechnung(Mid(Term,1,i-1))+","+Script_Phase_Rechnung(Mid(Term,i+1))+")"
EndIf
EndIf
If Mid(Term,i,1) = ")" Then Sperren -= 1
Next
Return ""
End Function
Function Script_Phase_Entferne_Koments(ByVal Text As String) As String
Dim ScriptText As String
Dim Komentar As UByte
Dim inText As Byte
Dim Last As Byte
For i As UInteger = 1 To Len(Text)
If Mid(Text,i,2) = "//" Then
Komentar = 1
ElseIf Mid(Text,i,2) = "/*" Then
Komentar = 2
ElseIf Mid(Text,i-2,2) = "*/" And Komentar = 2 Then
Komentar = 0
ElseIf Mid(Text,i-2,2) = Chr(13,10) And Komentar = 1 Then
Komentar = 0
EndIf
If Komentar = 0 Then
ScriptText += Mid(Text,i,1)
EndIf
Next
Text = ScriptText
ScriptText = ""
For i As UInteger = 1 To Len(Text)
If Mid(Text,i,1) = Chr(34) Then inText = Not(inText)
If inText = 0 Then
If Mid(Text,i,2) <> Chr(13,10) and Mid(Text,i-1,2) <> Chr(13,10) Then
If Last = 1 Then
If Mid(Text,i,1) <> " " Then
ScriptText += Mid(Text,i,1)
Last = 0
EndIf
Else
ScriptText += Mid(Text,i,1)
EndIf
Else
Last = 1
EndIf
Else
ScriptText += Mid(Text,i,1)
EndIf
Next
Return ScriptText
End Function
Function FuncPara(ByVal Para As String) As String
Dim LastKomma As UInteger
Dim Zurueck As String
Dim Hohe As UInteger
For i As UInteger = 1 To Len(Para)
If Mid(Para,i,1) = "(" Then Hohe+=1
If Mid(Para,i,1) = "," And Hohe = 0 Then
Zurueck+=Script_Phase_Rechnung(Mid(Para,LastKomma+1,i-LastKomma-1))+","
LastKomma = i
EndIf
If Mid(Para,i,1) = ")" Then Hohe-=1
Next
Zurueck+=Script_Phase_Rechnung(Mid(Para,LastKomma+1))
Return Zurueck
End Function