Graphenzeichner (BlitzPlus)

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Mr.Keks

Betreff: Graphenzeichner (BlitzPlus)

 BeitragSo, Mai 01, 2005 16:41
Antworten mit Zitat
Benutzer-Profile anzeigen
Ein Berechner und Zeichner für Funktionsgraphen, nicht sehr weit entwickelt, mehr so eine Spielerei, weil ich keine Lust auf Mathehausaufgaben hatte... Der zweite Code ist ein minimal angepasster Parser aus dem AE-Skript. Lässt sich für allesmögliche missbrauchen. Enthält daher aber auch dutzende nicht benötigte Funktionen...

Da es wie gesagt auf AE-Skript basiert, lassen sich Befehle einbauen. Dafür ist die Syntax etwas umständlich. Variablen haben ein $, Werte stehen in Anführungszeichen und mathematische Klammern sind eckig. Eine Formel sieht da wie folgt aus (Coole Graphen übrigens Wink): [x$+"1"]^x$ oder x$^"2"+["1"/x$]


http://www.inarie.de/screens/trash/6.png

Würde mich freuen, wenn irgendwer Verwendung dafür hätte...

Code: [AUSKLAPPEN]
Include "parser.bb"

Global win = CreateWindow("Graphenzeichner",0,0,450,300,Desktop())
   new_function = CreateButton("Neue Funktion",10,10,100,20,win)

Global wintab = CreateWindow("Werte",450,0,400,300,win)

Global wingra = CreateWindow("Graphen",0,300,680,680,win,1+32)
   Global gra_canvas   = CreateCanvas(10,10,660,660,wingra)

;vars$(23) = 20
;Prs_QuickLineComp("var y$=x$*"+Chr(34)+"2"+Chr(34)+"; ")
;Print vars$(24)
;Flip

Global range# = 2
Global rangey# = 16

Repeat
   Select WaitEvent()
   Case $401
      source = EventSource()
      Select source
      Case new_function
         Add_Funktion()
      Default
         Funk_Event($401,source)
      End Select
   Case $803
      End
   End Select
   Draw_Graphen()
Forever


Function Draw_Graphen()
   SetBuffer CanvasBuffer(gra_canvas)
   ClsColor 255,255,255
   Cls
   Origin 330,330
   
   Color 200,200,200
   For i = -range To range
      Rect i*320/range,-330,1,660
   Next
   For i = -rangey To rangey
      Rect -330,i*320/rangey,660,1
   Next
   
   Color 0,0,0
   Rect -330,0,660,1
   Rect 0,-330,1,660
   For i = -range To range
      Rect i*320/range,-2,1,4
   Next
   For i = -rangey To rangey
      Rect -2,i*320/rangey,4,1
   Next
   
   For f.funktion = Each funktion
      Color 0,0,f\rgb
      For x = 0 To 5000
         Plot (x*640/5000)-320,-PeekFloat(f\values,x*4)*320/rangey
      Next
   Next
   FlipCanvas gra_canvas
End Function

Type funktion
   Field id
   Field formel$
   Field values
   Field rgb
   Field gad[6]
End Type

Global funk_id

Function Add_Funktion()
   funk_id = funk_id + 1
   
   f.funktion   = New funktion
   f\id      = funk_id
   f\values   = CreateBank(5*4004)
   f\gad[0]   = CreateLabel(f\id+"  y=",5,17+f\id*20,25,20,win)
   f\gad[1]   = CreateTextField(30,15+f\id*20,300,20,win)
   f\gad[2]   = CreateButton("Color",332,15+f\id*20,50,20,win)
   f\gad[3]   = CreateButton("X",395,15+f\id*20,20,20,win)
   
   f\gad[5]   = CreateLabel("",5,17+f\id*20,300,20,wintab)
   f\gad[6]   = CreateButton("Update",332,15+f\id*20,50,20,wintab)
End Function

Function Update_Funktion(f.funktion)
   f\formel = TextFieldText(f\gad[1])
   For i = 0 To 5000
      x# = Float(i*range)/2500.00-range
      vars(23) = x#
      Prs_QuickLineComp("var y$="+f\formel+"; ")
      PokeFloat f\values,i*4,Float(vars$(24))
   Next
End Function

Function Funk_Event(id,source)
   For f.funktion = Each funktion
      If id = $401
         Select source
         Case f\gad[1]
            f\formel = GadgetText(f\gad[1])   
         Case f\gad[2]
            t = RequestColor()
            If t
               f\rgb=RequestedRed()*$10000 + RequestedGreen()*$100 + RequestedBlue()
            EndIf
         Case f\gad[3]
            
         Case f\gad[6]
            Update_Funktion(f)
         End Select
      EndIf
   Next
End Function


Code: [AUSKLAPPEN]
Global Prs_Pointer    = -1
Global Prs_LToken$   = 0

Type prs_bracks
   Field startpos
   Field endpos
   Field depth
End Type

Dim Vars$(701)


Function Prs_Interpret(file,start,ende)
   prs_pointer = start
   Repeat
      token$ = Prs_GetToken(file,Prs_Pointer)
      If Prs_Pointer >= ende
         Exit
      Else
         DebugLog token
         
         Prs_InterpretCommand$(file,token)
      EndIf
   Forever
End Function

Function Prs_InterpretCommand$(file,token$)
   Local retur$
   
   eot$ = Right(token,1)
   
   Select Left(token,Len(token)-1)
   Case "var"; var variable$ = value$ ; define / set variable
      var$ = Prs_GetToken(file,Prs_Pointer)
      If Right(prs_ltoken,1) <> "$" Then RuntimeError "Expecting Variable$"
      
      var$ = Left(var,Len(var)-1)
      If Len(var) = 1
         id = Asc(var)-97
      Else
         id = (Asc(Left(var,1))-96) * 26  +  Asc(Right(var,1)) - 97
      EndIf
      
      If Prs_GetToken(file,Prs_Pointer) <> "=" Then RuntimeError "Expecting ="
      
      para$ = Prs_GetPara(file,Prs_Pointer)
      
      Vars(id) = para
      DebugLog "Set Var"+id+"("+var$+") to "+ para
   Case "if" ; if ( true ) { ... }
      Prs_Pointer = Util_FindNext(file,prs_pointer-1,Asc("("))
      
      condition   = Prs_GetPara$(file,prs_pointer)
      
      start      = Util_FindNext(file,prs_pointer,Asc("{"))
      
      If condition
         Prs_Pointer = start
      Else
         For b.prs_bracks = Each prs_bracks
            If b\startpos = start
               Prs_Pointer = b\endpos
               Exit
            EndIf
         Next
      EndIf
   Case "print" ; print Text$
      para$ = Prs_GetPara(file,Prs_Pointer)
      Print para
      DebugLog "Print "+para
   Case "apptitle" ; apptitle titel$
      AppTitle Prs_GetPara(file,Prs_pointer)
   Case "rand"
      value%      = Rand(Prs_GetPara(file,prs_pointer),Prs_GetPara(file,prs_pointer))
      retur$      = value
      DebugLog "rand: "+retur
   Case "rnd"
      valu#      = Rnd#(Prs_GetPara(file,prs_pointer),Prs_GetPara(file,prs_pointer))
      retur$      = valu#
      DebugLog "rnd: "+valu
   End Select
   
   Return retur$
End Function


Function Prs_PreCompFile(path$,path2$)
   Prs_Pointer = -1
   Print path$+", "+path2
   
   file = Util_FileToBank(path$)
   size = BankSize(file)
   
   out = CreateBank(size)
   DebugLog BankSize(out)
   
   incode = 1
   
   Repeat
      token$ = Prs_GetToken(file,Prs_Pointer)
      If Prs_Pointer >= size-1
         Exit
      Else
         DebugLog token
         
         ;If Right(token,1) = Chr(34) Then incode = 1-incode
         If (Asc(Right(token,1)) > 31 And Asc(Left(token,1))>32)
            If PeekByte(out,opos) = 32 And Prs_AscIsSeperator(Asc(Left(token,1)))
               opos = opos - 1
               RuntimeError ""
            EndIf
            
            Util_PokeString out,opos,token$
            opos = opos + Len(token$)
         EndIf
      EndIf
   Forever
   ResizeBank out,opos+1
   
   Util_BankToFile(out,path2$)
   
   FreeBank file
   FreeBank out
End Function

Function Prs_CompFile(path$)
   Prs_Pointer = -1
   file      = Util_FileToBank(path$)
   size      = BankSize(File)
   
   Repeat
      token$ = Prs_GetToken(file,Prs_Pointer)
      If Prs_Pointer >= size-1
         Exit
      Else
         DebugLog token
         
         eot$ = Right(token,1)
         
         Select token
         
         End Select
         
         Select eot
         Case "{"
            brackdepth   = brackdepth + 1
            
            b.prs_bracks= New prs_bracks
            b\startpos   = prs_pointer
            b\endpos   = -1
            b\depth      = brackdepth
         Case "}"
            For b.prs_bracks = Each prs_bracks
               If b\depth = brackdepth And b\endpos = -1
                  b\endpos = prs_pointer
                  DebugLog "Bracks:"+b\startpos+", "+b\endpos
               EndIf
            Next
            brackdepth   = brackdepth - 1
         End Select
      EndIf
   Forever
   
   Return file
End Function

Function Prs_CompBank(file)
   Prs_Pointer = -1
   size      = BankSize(File)
   
   Repeat
      token$ = Prs_GetToken(file,Prs_Pointer)
      If Prs_Pointer >= size-1
         Exit
      Else
         DebugLog token
         
         eot$ = Right(token,1)
         
         Select token
         
         End Select
         
         Select eot
         Case "{"
            brackdepth   = brackdepth + 1
            
            b.prs_bracks= New prs_bracks
            b\startpos   = prs_pointer
            b\endpos   = -1
            b\depth      = brackdepth
         Case "}"
            For b.prs_bracks = Each prs_bracks
               If b\depth = brackdepth And b\endpos = -1
                  b\endpos = prs_pointer
                  DebugLog "Bracks:"+b\startpos+", "+b\endpos
               EndIf
            Next
            brackdepth   = brackdepth - 1
         End Select
      EndIf
   Forever
   
   Return file
End Function



Function Prs_QuickLineComp(Lin$)
   file = CreateBank(Len(lin)+1)
   Util_PokeString(file,0,lin)
   Prs_QuickComp(file)
   FreeBank file
End Function

Function Prs_QuickComp(file)
   Prs_Pointer = -1
   size      = BankSize(File)-1
   
   Delete Each prs_bracks
   
   Repeat
      token$ = Prs_GetToken(file,Prs_Pointer)
      If Prs_Pointer >= size-1
         Exit
      Else
         DebugLog token
         
         eot$ = Right(token,1)
         
         Select token
         
         End Select
         
         Select eot
         Case "{"
            brackdepth   = brackdepth + 1
            
            b.prs_bracks= New prs_bracks
            b\startpos   = prs_pointer
            b\endpos   = -1
            b\depth      = brackdepth
         Case "}"
            For b.prs_bracks = Each prs_bracks
               If b\depth = brackdepth And b\endpos = -1
                  b\endpos = prs_pointer
                  DebugLog "Bracks:"+b\startpos+", "+b\endpos
               EndIf
            Next
            brackdepth   = brackdepth - 1
         End Select
      EndIf
   Forever
   
   Prs_Interpret(file,-1,size)
   
   Return file
End Function


Function Prs_GetToken$(bank,pos)
   Repeat
      pos = pos + 1
      b = PeekByte(bank,pos)
      txt$ = txt + Chr(b)
      If Prs_AscIsSeperator(b)
         If b = 34 Or b=39 Then
            pos2 = Util_FindNext(bank,pos,34)
            txt = txt + Util_PeekString$(bank,pos+1,pos2)
            pos = pos2
         ElseIf b = 92
            txt = Left(txt,Len(txt)-1)
            pos = Util_FindNext(bank,pos,92)
         EndIf
         Prs_Pointer = pos
         Prs_LToken   = txt
         Return txt
      EndIf
   Forever
   Prs_Pointer = pos
End Function


; Zu "startedwith":
Const PRS_PLSTART   = 0
Const PRS_PLSTRING   = 1
Const PRS_PLBRACK   = 2
Const PRS_PLBOOL   = 3
Const PRS_PLADDI   = 4
Const PRS_PLMULTI   = 5
Const PRS_PLPOWER   = 6

Function Prs_GetPara$(bank,pos,startedwith=0);*
   Prs_Pointer = pos
   
   Repeat
      token$ = Prs_GetToken(bank,Prs_Pointer)
      eot$ = Right(token,1)
      Select eot
      Case Chr(34)
         para$ = Mid(token,2,Len(token)-2)
      Case "$"
         var$ = Left(token,Len(token)-1)
         If Len(var) = 1
            id = Asc(var)-97
         Else
            id = (Asc(Left(var,1))-96) * 26  +  Asc(Right(var,1)) - 97
         EndIf
         para$ = Vars(id)
      Case " ","("
         para = Prs_InterpretCommand$(bank,token)
      Case "+"
         If startedwith > PRS_PLADDI Then
            Prs_Pointer = Prs_Pointer - 1
            Return para
         EndIf
         para = Float(para) + Float(Prs_GetPara(bank,Prs_Pointer,PRS_PLADDI))
      Case "-"
         If startedwith > PRS_PLADDI Then
            Prs_Pointer = Prs_Pointer - 1
            Return para
         EndIf
         para = Float(para) - Float(Prs_GetPara(bank,Prs_Pointer,PRS_PLADDI))
      Case "*"
         If startedwith > PRS_PLMULTI Then
            Prs_Pointer = Prs_Pointer - 1
            Return para
         EndIf
         para = Float(para) * Float(Prs_GetPara(bank,Prs_Pointer,PRS_PLMULTI))
      Case "/"
         If startedwith > PRS_PLMULTI Then
            Prs_Pointer = Prs_Pointer - 1
            Return para
         EndIf
         para = Float(para) / Float(Prs_GetPara(bank,Prs_Pointer,PRS_PLMULTI))
      Case "^"
         If startedwith > PRS_PLPOWER Then
            Prs_Pointer = Prs_Pointer - 1
            Return para
         EndIf
         para = Float(para) ^ Float(Prs_GetPara(bank,Prs_Pointer,PRS_PLPOWER))
      Case "="
         If startedwith > PRS_PLBOOL Then
            Prs_Pointer = Prs_Pointer - 1
            Return para
         EndIf
         para = (para = Prs_GetPara(bank,Prs_Pointer,PRS_PLBOOL))
      Case ">"
         If startedwith > PRS_PLBOOL Then
            Prs_Pointer = Prs_Pointer - 1
            Return para
         EndIf
         para = (para > Prs_GetPara(bank,Prs_Pointer,PRS_PLBOOL))
      Case "<"
         If startedwith > PRS_PLBOOL Then
            Prs_Pointer = Prs_Pointer - 1
            Return para
         EndIf
         para = (para < Prs_GetPara(bank,Prs_Pointer,PRS_PLBOOL))
      Case "["
         para = Prs_GetPara(bank,Prs_Pointer,PRS_PLBRACK)
      Case "]"
         Return para$
      End Select
   Until eot = ")" Or eot = ";" Or eot = ","
   If startedwith > PRS_PLSTART Then Prs_Pointer = Prs_Pointer - 1
   Return para$
End Function

Function Prs_AscIsSeperator(b)
   Return (b < 48) Or (b > 57 And b < 65) Or (b > 90 And b < 95) Or (b > 122 And b < 127)
   ;b = 3 Or b = 13 Or (b > 31 And
End Function


;Bankzeugs ####################################################

Function Util_PokeString(bank,pos,txt$)
   For i = 1 To Len(txt)
      PokeByte bank,pos + i - 1, Asc(Mid(txt,i,1))
   Next
End Function

Function Util_PeekString$(bank,start,Ende)
   For i = start To ende
      txt$ = txt$ + Chr(PeekByte(bank,i))
   Next
   Return txt$
End Function

Function Util_FindNext(bank,pos,byte)
   size = BankSize(bank)
   For i = pos+1 To size
      If PeekByte(bank,i) = byte Then Return i
   Next
End Function

Function Util_FileToBank(path$)
   size = FileSize(path)
   bank = CreateBank(size+1)
   file = ReadFile(path)
      
   For i = 0 To size-1
      PokeByte bank,i,ReadByte(file)
   Next
   PokeByte bank,size,3
   
   CloseFile file
   Return bank
End Function

Function Util_BankToFile(bank,path$)
   file = WriteFile(path)
      
   For i = 0 To BankSize(bank)-1
      WriteByte file, PeekByte(bank,i)
   Next
   
   CloseFile file
End Function
MrKeks.net
 

FBI-blitz

 BeitragSo, Mai 01, 2005 19:05
Antworten mit Zitat
Benutzer-Profile anzeigen
nicht schlecht!
Computer 1: AMD Athlon64 3500+ | nVidia GF 7900GT | 1024 MB DDR-RAM | ASUS A8N-SLI Preimium | 250 GB SATA 2 || WindowsXP | Blitz3D | Blitz+
Computer 2: AMD AthlonXP 2400+ | ATI Radeon 9500 | 512 MB DDR-RAM | MSI K7N2 | 80 GB IDE | 160 GB IDE || WindowsXP | Blitz3D | Blitz+
Computer 3: Intel Pentium MMX | onBoard-Grafik | 32 MB RAM | 1 GB IDE || Windows 98 SE | Blitz+

Triton

 BeitragMo, Mai 02, 2005 16:00
Antworten mit Zitat
Benutzer-Profile anzeigen
es fehlt eine Achseneinteilung und Pfeile an den Achsen (x nach rechts, y nach oben)
Coding: silizium-net.de | Portfolio: Triton.ch.vu

Mr.Keks

 BeitragMo, Mai 02, 2005 19:45
Antworten mit Zitat
Benutzer-Profile anzeigen
Zitat:
Zeichner für Funktionsgraphen, nicht sehr weit entwickelt,
kam halt noch nicht dazu...
MrKeks.net

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group