; Termberechnung ;---------------- Declare.f Term(Term$) Procedure.f SplitTermL(Term$, Position) Ergebnis.f SplitTerm$ = Mid(Term$, 1, Position-1) Ergebnis = Term(SplitTerm$) ProcedureReturn Ergebnis EndProcedure Procedure.f SplitTermR(Term$, Position) Ergebnis.f SplitTerm$ = Mid(Term$, Position+1, Len(Term$)-Position) Ergebnis = Term(SplitTerm$) ProcedureReturn Ergebnis EndProcedure Procedure.f SplitTermM(Term$, Position1, l) Ergebnis.f SplitTerm$ = Mid(Term$, Position1+1, l-1) Ergebnis = Term(SplitTerm$) ProcedureReturn Ergebnis EndProcedure Procedure.f Term(Term$) Ergebnis.f : KlammerErgebnis.f ; Ersetzt Konstanten Term$=ReplaceString(Term$, "#PI", "3.14159265",1) Term$=ReplaceString(Term$, "#E" , "2.71828183",1) ; Ermittelt eine mögliche Funktion Restore Funktionstypen Position = 1000 Read Str$ While Str$ Pos = FindString(UCase(Term$), Str$, 1) : If Pos And Pos < Position Funktion$ = Str$ Position = Pos Else; Read Str$ EndIf Wend ; Löscht wenn nöten den FunktionsString$ auf dem Term$ Position1 = FindString(Term$, "{", 1) If Position < Position1 Term$ = Mid(Term$,1,Position-1)+Mid(Term$,Position+Len(Funktion$),Len(Term$)) Else Funktion$ = "" EndIf ; Ermittelt eine geöffnete Klammer (auch bei Funktionen) Position1 = FindString(Term$, "{", 1) Position2 = 0 If Position1 KlammerAuf = Position1 Repeat Position1 = FindString(Term$, "{", Position1+1) Position2 = FindString(Term$, "}", Position2+1) Until Position1 = 0 Or Position1 > Position2 KlammerZu = Position2 KlammerErgebnis = SplitTermM(Term$, KlammerAuf, KlammerZu-KlammerAuf) ; Passt das KlammerErgebnis an, als es eine Funktion war Select Funktion$ Case "ABS" : KlammerErgebnis = Abs(KlammerErgebnis) Case "SIN" : KlammerErgebnis = Sin(KlammerErgebnis) Case "COS" : KlammerErgebnis = Cos(KlammerErgebnis) Case "TAN" : KlammerErgebnis = Tan(KlammerErgebnis) Case "ARCSIN" : KlammerErgebnis = ASin(KlammerErgebnis) Case "ARCCOS" : KlammerErgebnis = ACos(KlammerErgebnis) Case "ARCTAN" : KlammerErgebnis = ATan(KlammerErgebnis) Case "LOG" : KlammerErgebnis = Log10(KlammerErgebnis) Case "LN" : KlammerErgebnis = Log(KlammerErgebnis) Case "INT" : KlammerErgebnis = Int(KlammerErgebnis) EndSelect Ergebnis = Term( Mid(Term$, 1, KlammerAuf-1) + StrF(KlammerErgebnis) + Mid(Term$, KlammerZu+1, Len(Term$)-KlammerZu) ) Else ; 1. Stufe der Operationszeichen Position1 = FindString(Term$, "+", 1) Position2 = FindString(Term$, "_", 1) Zeichen$ = Mid(Term$,Position2-1,1) If Position1 Ergebnis = SplitTermL(Term$,Position1) + SplitTermR(Term$,Position1) ElseIf Position2; And Zeichen$<>"*" And Zeichen$<>"/" And Zeichen$<>"+" And Zeichen$<>"^"; And Position2<>1 Ergebnis = SplitTermL(Term$,Position2) - SplitTermR(Term$,Position2) Else ; 2. Stufe der Operationszeichen Position1 = FindString(Term$, "*", 1) Position2 = FindString(Term$, "/", 1) If Position1 Ergebnis = SplitTermL(Term$,Position1) * SplitTermR(Term$,Position1) ElseIf Position2 Ergebnis = SplitTermL(Term$,Position2) / SplitTermR(Term$,Position2) Else ; 3. Stufe der Operationszeichen Position1 = FindString(Term$, "^", 1) If Position1 Ergebnis = Pow( SplitTermL(Term$,Position1) , SplitTermR(Term$,Position1) ) Else Ergebnis = ValF(Term$) EndIf EndIf EndIf EndIf ProcedureReturn Ergebnis EndProcedure DataSection Funktionstypen: Data.s "ABS", "ARCSIN", "ARCCOS", "ARCTAN", "SIN", "COS", "TAN", "LOG", "LN", "INT", "" EndDataSection ;---------------- Structure DIC_MultiString Vor$ Mitte$ Nach$ EndStructure Structure DIC_LastError Zeile.l Nummer.l Var$ EndStructure Global DIC_LastError.DIC_LastError Structure VAR Name$ Wert$ EndStructure ; ; 3.3 => 4.x Update ; ;------------------- ; Procedure.s StringField(String$, Index, TrennString$) ; Stelle = 1-Len(TrennString$) ; For n = 1 To Index ; x = Stelle+Len(TrennString$) ; Stelle = FindString(String$+TrennString$, TrennString$, x) ; If Stelle = 0 : n = Index : EndIf ; Next n ; If Stelle ; NewString$ = Mid(String$, x, Stelle-x) ; EndIf ; ProcedureReturn NewString$ ; EndProcedure ; ;------------------- Procedure FindThisString(String$, Str$, Start) Pos = FindString(String$, Str$, Start) If Pos Restore Teiler Read T$ While T$ Davor$ = Mid(String$, Pos-1, 1) If Davor$ = T$ Or Pos = 1 VorOK = #True EndIf Danach$ = Mid(String$, Pos+Len(Str$), 1) If Danach$ = T$ Or Pos = Len(String$)-Len(Str$)+1 NachOK = #True EndIf If VorOK And NachOK T$ = "" ProcedureReturn Pos Else Read T$ EndIf Wend EndIf ProcedureReturn #False EndProcedure Procedure SplitThisDoubleString(String$, Str1$, Str2$, *SplitString.DIC_MultiString) Str1 = Len(Str1$) Str2 = Len(Str2$) Position1 = FindThisString(String$, Str1$, 1) Position2 = 0 If Position1 KlammerAuf = Position1 Repeat Position1 = FindThisString(String$, Str1$, Position1+Str1) Position2 = FindThisString(String$, Str2$, Position2+Str2) Until Position1 = 0 Or Position1 > Position2 KlammerZu = Position2 If KlammerAuf And KlammerZu *SplitString\Vor$ = Trim(Left(String$, KlammerAuf-1)) *SplitString\Mitte$ = Trim(Mid(String$, KlammerAuf+Str1, KlammerZu-KlammerAuf-Str1)) *SplitString\Nach$ = Trim(Right(String$, Len(String$)-KlammerZu-Str2+1)) ProcedureReturn #True EndIf EndIf ProcedureReturn #False EndProcedure ;------------------- ; DIC-Debugger ;-------------- Global DIC_Debugger,DIC_Schub Procedure StartDebuggerDIC() CreateFile(1, "Debugger.html") WriteStringN(1,"
")
 DIC_Debugger = #True
EndProcedure
Procedure DIC_Debugger(String$,Schub)
 If DIC_Debugger
  If Schub > 0
   WriteStringN(1,Space(DIC_Schub)+String$)
   DIC_Schub + Schub
  Else
   DIC_Schub + Schub
   WriteStringN(1,Space(DIC_Schub)+String$)
  EndIf
 EndIf
EndProcedure
;--------------



; DIC
;-----
Global NewList DICVar.VAR()

Procedure SetDICVar(Name$, Wert$)
 ResetList(DICVar())
 While NextElement(DICVar()) 
  If DICVar()\Name$ = Name$
   DICVar()\Wert$ = Wert$
   ProcedureReturn #True
  EndIf
 Wend
 AddElement(DICVar())
 DICVar()\Name$ = Name$
 DICVar()\Wert$ = Wert$
 ProcedureReturn #True
EndProcedure
Procedure.s GetDICVar(Name$)
 ResetList(DICVar())
 While NextElement(DICVar()) 
  If DICVar()\Name$ = Name$
   ProcedureReturn DICVar()\Wert$
  EndIf
 Wend
 ProcedureReturn ""
EndProcedure

; Interne DIC Proceduren
;------------------------
Procedure.s DIC_SetVar(Index,Str$)
 Pos = FindString(Str$, "=", Pos)
 If Pos
  VarName$ = Trim(Mid(Str$, 1, Pos-1))
  VarWert$ = Trim(Mid(Str$, Pos+1, Len(Str$)))
  If VarName$ = ""  Or FindString(VarWert$, "=", 1)
   DIC_LastError\Nummer = 1
   DIC_LastError\Zeile = Index
  EndIf
  ResetList(DICVar())
  While NextElement(DICVar()) 
   VarWert$ = ReplaceString(VarWert$, DICVar()\Name$, DICVar()\Wert$)
  Wend  
  ReplaceString(VarWert$, "-", "_",2)
  ReplaceString(VarWert$, "(", "{",2)
  ReplaceString(VarWert$, ")", "}",2)
  EchterVarWert$ = StrF(Term(VarWert$))
  DIC_Debugger("SETZTE     "+VarName$+" = "+EchterVarWert$+"",0)
  SetDICVar(VarName$, EchterVarWert$)
  ProcedureReturn EchterVarWert$
 EndIf
EndProcedure

Procedure.f DIC_Vergleich(Index,Str$)
 DIC_Debugger("VERGLEICH  "+Str$+"",1)
 Restore Aussagen
 ; Echter Vergleich
 Read Aus$
 While Aus$
  Pos = FindString(Str$, Aus$, 1)
  If Pos 
   Term1$ = Trim(Mid(Str$, 1, Pos-1))
   Term2$ = Trim(Mid(Str$, Pos+Len(Aus$), Len(Str$)))
   If Term1$ = "" Or Term2$ = ""
    DIC_LastError\Nummer = 1
    DIC_LastError\Zeile = Index
   EndIf
   ResetList(DICVar())
   While NextElement(DICVar()) 
    Term1$ = ReplaceString(Term1$, DICVar()\Name$, DICVar()\Wert$)
    Term2$ = ReplaceString(Term2$, DICVar()\Name$, DICVar()\Wert$)
   Wend  
   ReplaceString(Term1$, "-", "_",2)
   ReplaceString(Term2$, "-", "_",2)
   EchterTerm1$ = StrF(Term(Term1$))
   EchterTerm2$ = StrF(Term(Term2$))
   OK = #False
   If Aus$="=" : If EchterTerm1$ = EchterTerm2$ : OK = #True : EndIf
   ElseIf Aus$="<" : If EchterTerm1$ < EchterTerm2$ : OK = #True : EndIf
   ElseIf Aus$=">" : If EchterTerm1$ > EchterTerm2$ : OK = #True : EndIf
   ElseIf Aus$="<=" : If EchterTerm1$ <= EchterTerm2$ : OK = #True : EndIf
   ElseIf Aus$=">=" : If EchterTerm1$ >= EchterTerm2$ : OK = #True : EndIf
   ElseIf Aus$="<>" : If EchterTerm1$ <> EchterTerm2$ : OK = #True : EndIf
   EndIf
   Aus$=""
   If OK
    DIC_Debugger("##TRUE       ",-1)
    ProcedureReturn #True
   Else
    DIC_Debugger("##FALSE      ",-1)
    ProcedureReturn #False
   EndIf  
  Else
   Read Aus$
  EndIf
 Wend
 ; Unechter Vergleich
 Term1$ = Trim(Str$)
 If Term1$ = ""
  DIC_LastError\Nummer = 1
  DIC_LastError\Zeile = Index
 EndIf
 ResetList(DICVar())
 While NextElement(DICVar()) 
  Term1$ = ReplaceString(Term1$, DICVar()\Name$, DICVar()\Wert$)
 Wend  
 ReplaceString(Term1$, "-", "_",2)
 EchterTerm.f = Term(Term1$)
 If EchterTerm
  DIC_Debugger("##TRUE       "+StrF(EchterTerm)+"",-1)
  ProcedureReturn EchterTerm
 Else
  DIC_Debugger("##FALSE      ",-1)
  ProcedureReturn #False
 EndIf  
EndProcedure

Procedure.f DIC_Aussage(Index,Str$)
 DIC_Debugger("AUSSAGE    "+Str$+"",1)
 Position1 = FindString(Str$, "(", 1)
 Position2 = 0
 If Position1
  KlammerAuf = Position1
  Repeat
   Position1 = FindString(Str$, "(", Position1+1)
   Position2 = FindString(Str$, ")", Position2+1)
  Until Position1 = 0 Or Position1 > Position2
  KlammerZu = Position2  
  WahrheitsWertTerm.f = DIC_Aussage(Index,Trim(Mid(Str$, KlammerAuf+1, KlammerZu-KlammerAuf-1)))
  WahrheitsWertTerm = DIC_Aussage(Index, Mid(Str$, 1, KlammerAuf-1)+"{"+StrF(WahrheitsWertTerm)+"}"+Mid(Str$, KlammerZu+1, Len(Str$)-KlammerZu))
  If WahrheitsWertTerm
   DIC_Debugger("##TRUE       "+StrF(WahrheitsWertTerm)+"",-1)
   ProcedureReturn WahrheitsWertTerm
  Else
   DIC_Debugger("##FALSE      ",-1)
   ProcedureReturn #False
  EndIf
 EndIf
 Pos = FindString(Str$, " AND ", 1)
 If Pos
  WahrheitsWert1 = DIC_Aussage(Index,Trim(Mid(Str$, 1, Pos-1)))
  WahrheitsWert2 = DIC_Aussage(Index,Trim(Mid(Str$, Pos+5, Len(Str$))))
  If WahrheitsWert1 And WahrheitsWert2
  DIC_Debugger("##TRUE       ",-1)
  ProcedureReturn #True
 Else
  DIC_Debugger("##FALSE      ",-1)
  ProcedureReturn #False
  EndIf
 EndIf
 Pos = FindString(Str$, " OR ", 1)
 If Pos
  WahrheitsWert1 = DIC_Aussage(Index,Trim(Mid(Str$, 1, Pos-1)))
  WahrheitsWert2 = DIC_Aussage(Index,Trim(Mid(Str$, Pos+4, Len(Str$))))
  If WahrheitsWert1 Or WahrheitsWert2
   DIC_Debugger("##TRUE       ",-1)
   ProcedureReturn #True
  Else
   DIC_Debugger("##FALSE      ",-1)
   ProcedureReturn #False
  EndIf
 EndIf
 WahrheitsWertTerm.f = DIC_Vergleich(Index,Str$)
 If WahrheitsWertTerm
  DIC_Debugger("##TRUE       "+StrF(WahrheitsWertTerm)+"",-1)
  ProcedureReturn WahrheitsWertTerm
 Else
  DIC_Debugger("##FALSE      ",-1)
  ProcedureReturn #False
 EndIf
EndProcedure


Declare DIC_Abfrage(Parameter$)
Declare DIC_Schleife(Parameter$)

Procedure DIC_Code(Parameter$)
 CODE.DIC_MultiString
 ; Nächstes Schlüsselwort
 Wort1 = FindThisString(Parameter$, "IF", 1)
 Wort2 = FindThisString(Parameter$, "FOR", 1)
 If Wort1 And (Wort2 = 0 Or Wort1 < Wort2) And SplitThisDoubleString(Parameter$, "IF", "ENDIF", CODE)
  DIC_Code(CODE\Vor$)
  DIC_Abfrage(CODE\Mitte$)
  DIC_Code(CODE\Nach$)
 ElseIf Wort2 And (Wort1 = 0 Or Wort2 < Wort1) And SplitThisDoubleString(Parameter$, "FOR", "NEXT", CODE)
  DIC_Code(CODE\Vor$)
  DIC_Schleife(CODE\Mitte$)
  DIC_Code(CODE\Nach$)
 Else
  Index=1
  Repeat 
   Code$ = " "+StringField(Parameter$, Index, ":")+" "
   If Trim(Code$)
    DIC_Debugger("CODE      "+Code$+"",0)
    DIC_SetVar(Index,Code$)
   EndIf
   Index+1
  Until Trim(Code$) = ""
 EndIf 
EndProcedure
Procedure DIC_Abfrage(Parameter$)
 Pos = FindString(Parameter$, ":", 1)
 Aussage$ = Trim(Mid(Parameter$, 1, Pos-1))
 DIC_Debugger("CODE       IF "+Aussage$+"",4)
 WahrheitsWert = DIC_Aussage(Index,Aussage$)
 If WahrheitsWert 
  InnererCode$ = Trim(Mid(Parameter$, Pos+1, Len(Parameter$)))
  DIC_Code(InnererCode$)
 EndIf 
 DIC_Debugger("CODE       ENDIF ",-4)
EndProcedure
Procedure DIC_Schleife(Parameter$)
 Pos_TO = FindThisString(Parameter$, "TO", 1)
 Pos = FindString(Parameter$, ":", 1)
 Zuweisung$ = Trim(Mid(Parameter$, 1, Pos_TO-1))
 Von = Val(DIC_SetVar(Index,Zuweisung$))
 Bis$ = Mid(Parameter$, Pos_TO+2, Pos-Pos_TO-2)
 ReplaceString(Bis$, "-", "_",2)
 Bis = Term(Bis$)
 DIC_Debugger("CODE       FOR "+Zuweisung$+" TO "+Str(Bis)+"",4)
 For n = 0 To Bis-Von
  DIC_SetVar(Index,Zuweisung$+"+"+Str(n))
  InnererCode$ = Trim(Mid(Parameter$, Pos+1, Len(Parameter$)))
  DIC_Code(InnererCode$)
 Next n  
 DIC_Debugger("CODE       NEXT ",-4)
EndProcedure 


Procedure RunDIC(Parameter$)
 DIC_LastError\Nummer = 0
 DIC_LastError\Zeile = 0
 DIC_LastError\Var$ = ""
 DIC_Code(Parameter$)
EndProcedure

Procedure.s LastErrorDIC()
 Select DIC_LastError\Nummer
  Case 1  : Error$ = "Zeile "+Str(DIC_LastError\Zeile)+" : Syntax error"
  Case 2  : Error$ = "Unfinished condition"
 EndSelect
 If DIC_Debugger
  CloseFile(1)
  RunProgram("Debugger.html")
 EndIf
 ProcedureReturn Error$
EndProcedure

DataSection
 Aussagen:
 Data.s "<=", ">=", "<>", "=", "<", ">", ""
 Teiler:
 Data.s "(", ")", " ", ":", ""
EndDataSection 
; IDE Options = PureBasic 4.20 Beta 1 (Windows - x86)
; CursorPosition = 459
; FirstLine = 429
; Folding = ------