AppTitle "Funktionsgraph"

Dim fx$(100,1) ; (nummer,(0=funktion|1=zeichen(ja/nein)))

;Einstellungen ---------------------------------------------------------------------

;------Funktion-------------Funktion zeichnen?------------
fx(1,0) = "abs(x^2-2)"       : fx(1,1) = "1"
fx(2,0) = "x^3"              : fx(2,1) = "1"
fx(3,0) = "(1/x)+sin(x)"     : fx(3,1) = "1"
;...

Global xmin# = -5
Global xmax# = 5
Global ymin# = -5
Global ymax# = 5

Global xscale# = 1
Global yscale# = 1 

Global ge# = 100       ;Genauigkeit
Global gitter = 1      ;0 | 1

Global debug = 0

Global tracef = 0      ;0 | 1
Global plotmode = 0    ;0 | 1

Global gw#=800,gh#=600
;-----------------------------------------------------------------------------------

Graphics gw#,gh#,32,2
Global v1#
Global v2#

Global mx#=gw-(xmax*gw/v1)
Global my#=gh-((ymin*-1)*gh/v2)

Global tstep# = 0.05
Global bgimg = CreateImage(gw,gh)

Global font = LoadFont("Arial",12)
SetFont font

drawbg()

Color 0,0,0
HidePointer

;Hauptschleife
Repeat
   Cls
   DrawImage bgimg,0,0
   
   If tracef = 0 Then
      Text MouseX()+10,MouseY(),"["+Int((MouseX()*v1/gw+xmin)*100.0)/100.0 + " | " + Int(((MouseY()*v2/gh+ymin)*-1)*100.0)/100.0 +"]"
      Rect MouseX()-8,MouseY(),17,1
      Rect MouseX(),MouseY()-8,1,17
   Else
      f1x# = Int((MouseX()*v1/gw+xmin)*100.0)/100.0
      f1y# = calc(fx(tracef,0),"x="+f1x#)

      Text MouseX()+10,MouseY(),"f"+tracef+"("+f1x+") = "+ f1y
      
      Rect MouseX() , (my+f1y*(gh/v2)*-1.0)-8 ,1,17
       Rect MouseX()-8 , (my+f1y*(gh/v2)*-1.0) ,17,1
       Oval MouseX()-8 , (my+f1y*(gh/v2)*-1.0)-8 ,17,17,0

      Rect MouseX()-2,MouseY(),5,1
      Rect MouseX(),0,1,gh
    EndIf

   If KeyHit(200) Then ymin = ymin + 1 : ymax = ymax + 1 : drawbg()
   If KeyHit(208) Then ymin = ymin - 1 : ymax = ymax - 1: drawbg()
   
   If KeyHit(205) Then xmin = xmin + 1 : xmax = xmax + 1 : drawbg()
   If KeyHit(203) Then xmin = xmin - 1 : xmax = xmax - 1 : drawbg()
   
   If KeyHit(74) Then
      xmin = xmin * 7/6 : xmax = xmax * 7/6 : ymin = ymin * 7/6 : ymax = ymax * 7/6
      xscale = Abs(ymax)/6 : yscale = Abs(xmax)/6
      drawbg()
   EndIf
   If KeyHit(78) Then
      xmin = xmin * 5/6 : xmax = xmax * 5/6 : ymin = ymin * 5/6 : ymax = ymax * 5/6
      xscale = Abs(ymax)/6 : yscale = Abs(xmax)/6
      drawbg()
   EndIf
   
   Delay 2
   Flip
Until KeyHit(1)


;Funktionen
;Hintergrund zeichnen
Function drawbg()

   If xmin <= 0 And xmax >= 0 Then
      v1# = Abs(xmin)+Abs(xmax)
   ElseIf xmax < 0
      v1# = Abs(xmin)-Abs(xmax)
   ElseIf xmin > 0 Then
      v1# = Abs(xmax)-Abs(xmin)
   EndIf

   If ymin <= 0 And ymax >= 0 Then
      v2# = Abs(ymin)+Abs(ymax)
   ElseIf ymin > 0 
      v2# = Abs(ymax)-Abs(ymin)
   ElseIf ymax < 0
      v2# = Abs(ymin)-Abs(ymax)
   EndIf

   
   ;v2# = Abs(ymin)+Abs(ymax)
   
   mx#=gw-(xmax*gw/v1)
    my#=gh-((ymin*-1)*gh/v2)

   SetBuffer ImageBuffer(bgimg)
   ClsColor 255,255,255
   Cls
   
   ;Linien und makierung für x-Bereich
   i#=0
   Repeat
      Color 220,220,220
      If gitter = 1 Then Rect mx+(i#*gw/(v1#)),0,1,gh
      Color 166,166,166
      Rect mx+(i#*gw/(v1#)),my-4,1,8
      Text mx+(i#*gw/(v1#)),my+5,RoundTo#(i,2)

      i# = i# + xscale   
   Until i# > xmax
   i#=0
   Repeat
      Color 220,220,220
      If gitter = 1 Then Rect mx+(i#*gw/(v1#)),0,1,gh
      Color 166,166,166
      Rect mx+(i#*gw/(v1#)),my-4,1,8
      Text mx+(i#*gw/(v1#)),my+5,RoundTo#(i,2)
      i# = i# - xscale   
   Until i# < xmin
   
   ;Linien und makierung für y-Bereich
   i#=0
   Repeat
      Color 220,220,220
      If gitter = 1 Then Rect 0,my-(i#*gh/(v2#)),gw,1
      Color 166,166,166
      Rect mx-4,my-(i#*gh/(v2#)),8,1
      Text mx+5,my-(i#*gh/(v2#)),RoundTo#(i,2)      
      i# = i# - yscale   
   Until i# < ymin
   
   Repeat
      Color 220,220,220
      If gitter = 1 Then Rect 0,my-(i#*gh/(v2#)),gw,1
      Color 166,166,166
      Rect mx-4,my-(i#*gh/(v2#)),8,1
      Text mx+5,my-(i#*gh/(v2#)),RoundTo#(i,2)      
      i# = i# + yscale   
   Until i# > ymax


   ;x und y Achse zeichnen
   Color 166,166,166
   Line mx,0,mx,gh
   Line 0,my,gw,my

   ;Funktionen zeichnen
   For i=1 To 100
      c = i Mod 4
      If c = 1 Then
         r=155 : g=0 : b=0
      ElseIf c = 2 Then
         r=0 : g=155 : b=0
      ElseIf c = 3 Then
         r=0 : g=0 : b=155
      Else
         r=255 : g=128 : b=0
      EndIf
      If(fx(i,1) = "1") Then
         AppTitle "Funktionsgraph zeichne f" + Int(i) +"(x)"
         drawfunc(fx(i,0),r,g,b)
      EndIf
      AppTitle "Funktionsgraph"
      
   Next
   SetBuffer BackBuffer()
End Function

Function drawfunc(fx0$,r,g,b)
   Color r,g,b
   
   tstep# = v1/(5*ge)
   If tstep# < 0.01 Then tstep# = 0.01
   
   i# = xmin
   timer#=MilliSecs()
   
   While i < xmax Or timer + 200 > MilliSecs()
      ax#=x#
      ay#=y#
      ayr# = yr#
   
      x#=mx+i*gw/v1#
      If Abs(i) < 0.01 Then i = 0
      
      yr# = calc(fx0$,"x="+Str(i))
      y#=my+ (Float(yr#)*(gh/v2))*-1.0
      ;DebugLog "("+x + " | " + y+")"
   
      If i# <> xmin Then
         If plotmode = 0 Then
            If Not((Abs(yr)+Abs(ayr) > 5) And Int(i*10) = 0) Then Line x,y,ax,ay
         Else
            Plot x,y
         EndIf
      EndIf
      If debug = 1 Then Rect x,y-8,1,16,1
      
      i# = i# + tstep
      ;If i# < 0.01 Then i#=0
      ;DebugLog i
   Wend

End Function

Function calc$(term$,par$="")

   ;Variabeln
   term$ = Replace(term$,"pi","3,141")
   If par <> "" Then
      While Instr(par$,"=") <> 0   
         pos = Instr(par$,"=")
         
         n1$="" : i=pos-1
         While checkchar(Mid(par$,i,1)) = 3
            n1$=Mid(par$,i,1)+n1$
            i=i-1
            If i = 0 Then Exit      
         Wend
         t_start=i
         
         n2$ = "" : i = pos+1
         While (checkchar(Mid(par$,i,1)) = 1) Or (checkchar(Mid(par$,i,1)) = 2)
            n2$=n2$+Mid(par$,i,1)
            i=i+1
            If i = Len(par$)+1 Then Exit   
         Wend
         t_end=i
         
         par = Mid(par,1,t_start) + Mid(par$,t_end,-1)
         term$ = Replace(term$,n1,n2)
         ;DebugLog n1 + " = " + n2
      Wend   
   EndIf

   ;Leerzeichen entfernen
   term$ = Replace(term$," ","")
   
   term$ = Replace(term$,"--","+")
    term$ = Replace(term$,"++","+")
   term$ = Replace(term$,"-+","-")
    term$ = Replace(term$,"+-","-")
   
   ;Funktionen
   For t=0 To 4
      Select t
         Case 0: fnk$ = "sin("
         Case 1: fnk$ = "cos("
         Case 2: fnk$ = "tan("
         Case 3: fnk$ = "sqr("
         Case 4: fnk$ = "abs("
      End Select
      While Instr(term$,fnk$) <> 0
         pos = Instr(term$,fnk$)+Len(fnk$)
         For i = pos To Len(term)
            If(Mid(term,i,1)= ")") Then Exit
            c=c+1
         Next
            
         Select t
            Case 0: tresult$ = Sin(Float(calc(Mid(term,pos,c)))*18*Pi)
            Case 1: tresult$ = Cos(Float(calc(Mid(term,pos,c)))*18*Pi)
            Case 2: tresult$ = Tan(Float(calc(Mid(term,pos,c)))*18*Pi)
            Case 3: tresult$ = Sqr(Float(calc(Mid(term,pos,c))))
            Case 4: tresult$ = Abs(Float(calc(Mid(term,pos,c))))
         End Select
         
         If Instr(tresult$,"e") <> 0 Then tresult$ = "0"
         term = Mid(term,1,pos-1-Len(fnk$))+tresult+Mid(term,pos+c+1,-1)
      Wend
   Next
   
   term$ = Replace(term$,"--","+")
    term$ = Replace(term$,"++","+")
   term$ = Replace(term$,"-+","-")
    term$ = Replace(term$,"+-","-")
   
   ;Klammern
   While Instr(term$,"(") <> 0
      For i = 1 To Len(term)
         If(Mid(term,i,1)= "(") Then pos1 = i
      Next
      
      c=0
      For i = pos1 To Len(term)
         c=c+1
         If(Mid(term,i,1)= ")") Then Exit
      Next
      c=c-2
                        
      term$ = Mid(term$,1,pos1-1)+calc(Mid(term,pos1+1,c))+Mid(term$,pos1+c+2,-1)
   Wend   
   
   term$ = Replace(term$,"--","+")
    term$ = Replace(term$,"++","+")
   term$ = Replace(term$,"-+","-")
    term$ = Replace(term$,"+-","-")

   ;Rechnung
   For j = 0 To 4
      Select j
         Case 0 op$ = "^"
         Case 1 op$ = "/"
         Case 2 op$ = "*"
         Case 3 op$ = "-"
         Case 4 op$ = "+"
      End Select
      term$ = Replace(term$,"&","-")
      
      While Instr(term$,op$) <> 0
         pos = Instr(term$,op$)
      
         ;Erste Zahl
         n1$ = "" : i = pos-1
         If i > 0 Then
            While checkchar(Mid(term$,i,1)) = 1
               n1$=Mid(term$,i,1)+n1$
               i=i-1
               If i = 0 Then Exit      
            Wend
            t_start = i
         EndIf
         If op$ = "-" And n1$ = "" Then term$ = Mid(term$,1,pos-1)+"&"+Mid(term$,pos+1,-1) : e=1
         If i <> 0 Then
            If checkchar(Mid(term$,i,1)) = 2 Then n1$=Mid(term$,i,1)+n1$ : i=i-1 :t_start = i
            EndIf
         
         ;Zweite Zahl
         n2$ = "" : i = pos+1
         If checkchar(Mid(term$,i,1)) = 2 Then n2$=n2$+Mid(term$,i,1) : i=i+1                  
         While checkchar(Mid(term$,i,1)) = 1
            n2$=n2$+Mid(term$,i,1)
            i=i+1
            If i = Len(term)+1 Then Exit   
         Wend
         t_end = i
         
         ;Ergebnis
         If Instr(n1,"e") <> 0 Then n1 = "0"
         If Instr(n2,"e") <> 0 Then n2 = "0"
         n1 = Replace(n1,"&","-")
         n2 = Replace(n2,"&","-")
         
         Select j
            Case 0 result# = Float(n1) ^ Float(n2)
            Case 1 result# = Float(n1) / Float(n2)   
            Case 2 result# = Float(n1) * Float(n2)   
            Case 3 result# = Float(n1) - Float(n2)   
            Case 4 result# = Float(n1) + Float(n2)   
         End Select   
         
         If Instr(result,"e") <> 0 Then result = "0"      
         If e = 0 Then
            term$ = Mid(term$,1,t_start)+Str(result#)+Mid(term$,t_end,-1)
         Else
            e=0
         EndIf
         ;DebugLog n1+ " " + op + " " + n2+ " | " + result + " ||| "+ term
      Wend
   Next
   
   Return term
End Function

Function checkchar$(char$)
   If Asc(char)>=48 And Asc(char)<=57 Then Return 1
   If Asc(char)=44 Or Asc(char)=46 Or Asc(char)=101 Then Return 1
   If Asc(char)=45 Or Asc(char) = 38 Then Return 2
   If Asc(char)>=97 And Asc(char)<=122 Then Return 3
End Function

Function RoundTo#(zahl#,a)
   Return Int(zahl*10^a)/10^a
End Function