Kleine ScriptEngine

Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Neue Antwort erstellen

Moep

Betreff: Kleine ScriptEngine

 BeitragSa, Jul 28, 2007 21:29
Antworten mit Zitat
Benutzer-Profile anzeigen
Moin Leute

Hab mal was kleines Zusammengebastelt , was man vielleicht schon ScriptEngine nennen könnte ^^.

(Ich sag lieber im Vorraus dass die Calc Funktionen nicht von mir sind , ich hab sie nur verändert
Hier das Original https://www.blitzforum.de/foru...hp?t=21892)

Erstmal Vorteile und Nachteile :


Vorteile : (einige Punkte werde ich unten näher erleutern)
+Man kann ganz einfach Eigene Funktionen hinzufügen
+Man kann Variablen aus der Programmlaufzeit hinzufügen
+While,If,For und selbst definierte Funktionen im Script möglich
+Lässt sich recht leicht erweitern
+Eigene Operatoren möglich

Nachteile :
-Ich denke es ist noch recht Instabil
-Ziemlich langsam meiner meinung nach(Testscript unten)
-Operatoren dürfen nur ein Zeichen haben.

Sonstiges :
Ziemlich Tollerant, nicht Case-Sensitiv etc.


So jetz einige kleine Infos die ihr vielleicht wissen solltet^^.

Man hat eine eigene Funktion im Programm :

Code: [AUSKLAPPEN]
Function foo#(a#,b#)
     return a+b
End Function


Um diese Funktion dem Script hinzuzufügen müssen Rückgabewert und Parameter alles Strings sein:
(Bisl aufwändig werden manche denken, aber in anderen Scriptsprachen ist es nicht leichter.Hier isses eigentlich nur Copy and Paste and a lil bit ändern)

Code: [AUSKLAPPEN]
Function foo$(a$,b$)
     return float(a)+float(b)
End Function

AddFunction(foo,"Foo")


So jetzt zu den Variablen aus der Programmlaufzeit.
Code: [AUSKLAPPEN]

Local a:String=123      ' ja da ham wir wieder die Strings
SetVar("a",a,"program")


Wenn man nun die Variable a im Programm verändert , so ändert sich auch der Wert im Script automatisch mit.(Ich hoffe man versteht das.)

Mein Lieblings Teil : Operatoren Cool
Ähnlich wie bei den Funktionen müssen hier Rückgabewert und Parameter vom Typ Float
sein.

Hier ein beispiel (Im Programm , nicht im Script^^) Ich denke selbsterklärend :
Code: [AUSKLAPPEN]
Function Modulo#(links#,rechts#)
   Return links mod rechts
End Function
Operator.Create("%",Modulo)


Durch diesen code wird jetzt immer wenn man im Script eingibt "100 % 50" die Funktion zurückgeliefert (logisch oder?)

So , jetzt zumQuellcode Wink

Ich weiß nicht ob es sinnvoll ist den Quellcode zu posten , denn der ist ziemlich unübersichtlich.
Deswegen hab ich das ganze mal als rar Datei verpackt und Hochgeladen.

http://moep123.mo.ohost.de/Original.rar

Aber damit manche Leute hier nicht rummäckern und sagen dies ist ein Codearchiv und hier gehören nur Quellcodes rein:

(Ich hab kommentiert welcher Teil in welche datei müsste)

Code: [AUSKLAPPEN]
'Functions.bmx
Function GetBlock:TList(list:TList,Pos,z1$="{",z2$="}")
   Local l$
   Local cnt=list.Count()-1
   
   Local newlist:TList=CreateList()
   
   Local sp=-1
   
   Local open
      

   For i = Pos To cnt
      l$=String(list.ValueAtIndex(i))

      If l=z1    
         If sp=-1   
            sp=i+1
         EndIf   
         open:+1
      EndIf   
         
      If l=z2
         open:-1      
         If open=0
            ep=i-1
            Exit               
         EndIf   
      EndIf
   Next
      
   For index = sp To ep
      str$=String(list.ValueAtIndex(index))
      newlist.AddLast str
   Next
   
   Return newlist
End Function

Function getp$[](str$)
   Local offen
   Local arr$[]   
      
   For i = 0 To Len(str)-1
      c$=Chr(str[i])
      Select c
         Case "("
            offen:+1
         Case ")"
            offen:-1
         Case ","
            If offen<>0
               str=Left(str,i)+"@"+Mid(str,i+2)
            EndIf
      End Select
   Next
      
   arr=splitstring(str,",")   
      
   For i = 0 To arr.length-1
      arr[i] =  Replace(arr[i],"@",",")
   Next   
      
   Return arr
End Function

Function InBlock(Pos,list:TList)
   For i = 0 To Pos
      l$=String(list.ValueAtIndex(i))   
            
      If i=Pos and open<>0
         Return True
      End If         
      If l="{"
         If i = Pos Return False
         open:+1
      EndIf   
         
      If l="}"
         If i = Pos Return False
         open:-1      
      EndIf
         
   Next
End Function

Function GetParams$[](str$)
   Local arr$[]

   Pos=Instr(str,"(")
   If Pos
      str=Mid(str,Pos+1)
                              
      str=cut(str,0,Len(str))
   
      arr=getp(str)
      
      If not Instr(str,",")      

         arr=arr[..1]
         arr[0]=str
         
         Return arr
      EndIf
   
      Return arr
   EndIf
End Function

Function GetLast(str$,l$)
   Local Pos=Instr(str,l)
   Local ret
      
   pos1=Pos
   While pos1
      pos1=Instr(str,l,pos1+1)      
      If pos1
         ret=pos1
      Else
         ret=Pos
      EndIf
   Wend
   
   Return ret
End Function

Function ContainsChr(str$)
   For i = 0 To Len(str)-1
      If (str[i]<=47 or str[i]>=58 ) and not (str[i]=45 or str[i] = 46)
         Return 1
      EndIf
   Next
   Return 0
End Function

Function AddToArray(arr$[] Var,V$)
   arr=arr[..arr.length+1]
   arr[arr.length-1]=V
End Function

Function posBeetween(r$,Pos)
   For i = 0 To Len(r)-1
      c$=Chr(r[i])
      If i = Pos and offen=True and c<>Chr(34)
         Return True
      End If
      Select c
         Case Chr(34)
            offen=not offen
      End Select
   Next
End Function

Function instr2(str$,sub$)
   Pos=Instr(str,sub)
   If Pos
      If not posBeetween(str,Pos)
         Return Pos
      Else
         While posbeetween(str,Pos) and i<Len(str)
            Pos=Instr(str,sub,Pos+1)
            i=i+1
         Wend
         Return Pos
      End If
   End If
End Function

Function Replace2$(str$,r$,w$)
   Pos=instr2(str,r)
   If Pos
      str=Left(str,Pos-1)+w+Mid(str,Pos+Len(r))
      Return replace2(str,r,w)
   Else
      Return str
   EndIf
End Function

Function FPS:Int( l_in:Short = 1000)
   Global  gfps:Int, gtempfps:Int ,gtime:Int
   
   If MilliSecs()- gtime>l_in
      gfps = gtempfps
      gtempfps = 0
      gtime = MilliSecs()
   EndIf
   
   gtempfps:+1
   Return gfps
End Function

Function SplitString$[](str$,sep$)
   Local Pos
   Local arr$[]
   Local slen=sep.length
   
   Pos=Instr(str,sep)
   
   While Pos
      Pos=Instr(str,sep)
      tmp$=Mid(str,Pos+slen)
      e$=Left(str,Pos-slen)
      
      AddToArray arr,e
      
      str=tmp
      
      If not Instr(str,sep)
         Exit
      EndIf
   Wend
   
   AddToArray arr,str
   
   Return arr
   
End Function

' Calc.bmx
Function calc$(r$)

   r=Replace2(r,"and","&")
   r=Replace2(r,"or","|")   
   r=Replace2(r,"mod","%")
   r=Replace2(r,"==","\")
   r=Replace2(r,"!","-")
   r=Replace2(r,"false","0")
   r=Replace2(r,"true","1")
      
   Local arr$[]=SplitOperators(r)      
   

   For i = 0 To arr.length-1
      If i>0
         arr[i]=Mid(arr[i],2)      
      EndIf
      If isSomething(arr[i])
         r=Replace(r,arr[i],parseonething(arr[i]))
         arr[i]=parseonething(arr[i])
      EndIf
      For o:Operator=EachIn Operator.list
         If Instr(r,o.symbol)
            oldarr$=arr[i]
            arr[i]=Replace(arr[i],o.symbol,"?"+Asc(o.symbol)+"?")
            r=Replace(r,oldarr,arr[i])
         EndIf
      Next
   Next

   
   While Instr2(r,"(")>0
      
      kla=1
      tmp$=Mid(r,kla,1)
      While tmp<>"(" or (Instr(tmp,"(") < Instr(tmp,")") and Instr(tmp,"(") > 0)
         kla=kla+1
      Wend
      
      klz=Instr(Mid(r,kla+1),")")+kla
      
      If kla = 1 Then
         r=calc2(Mid(r,kla+1,klz-1-kla))+Mid(r,klz+1)
         ElseIf (Mid(r,kla-1,1)="+" or Mid(r,kla-1,1)="-" or Mid(r,kla-1,1)="*" or Mid(r,kla-1,1)="/" or Mid(r,kla-1,1)="^" or Mid(r,kla-1,1)="(") Then
         r=Left(r,kla-1)+calc2(Mid(r,kla+1,klz-1-kla))+Mid(r,klz+1)      
      EndIf
   Wend

   r=Replace(calc2(r$),Chr(34),"")

   
   For o:Operator=EachIn Operator.list
      If Instr(r,"?"+Asc(o.symbol)+"?")
         r=Replace(r,"?"+Asc(o.symbol)+"?",o.symbol)
      EndIf
   Next   

   Return r

End Function

Function isSomething$(str$)
   str=Trim(str)
   str=Lower(str)
   For V:TVar=EachIn TVar.list
      If V.name=str
         Return True
      End If
   Next
      
   For f:TFunc = EachIn TFunc.funclist
      If getCommand(str)=f.name                  
         Return "function"
      EndIf
   Next
   
   For sf:TScriptFunction=EachIn TScriptFunction.list
      If getCommand(str)=sf.name
         Return "function"
      EndIf
   Next
End Function

Function SplitOperators$[](str$)
   Local arr$[]
   Local offen
   str=str.Replace("'",Chr(34))
   
   For o:Operator=EachIn Operator.list
      offen=0
      For i = 0 To Len(str)-1
         c$=Chr(str[i])
         
         Select c
            Case "("
               offen:+1
            Case ")"
               offen:-1
            Case Chr(34)
               'offen=Not offen
            Case o.symbol
               If offen or posBeetween(str,i)
                  str=Left(str,i)+o.symbol+Mid(str,i+2)
                  
               Else
                  str=Left(str,i)+";"+o.symbol+Mid(str,i+2)
                  i=i+1
               EndIf
         End Select
         
      Next   
   Next

   arr=splitstring(str,";")         
               
   Return arr
End Function

Function calc2$(r$)

   Repeat
      r=Replace(r,"++","+")
      r=Replace(r,"+++","+")
      r=Replace(r,"+-","-")
      r=Replace(r,"-+","-")
      r=Replace(r,"--","+")
      r=Replace(r,"---","-")
   Until Instr(r,"++")=0 and Instr(r,"--")=0 and Instr(r,"+-")=0 and Instr(r,"-+")=0
   If Left(r,1)="+" Then r=Mid(r,2)
   

   
   While Instr(r,"^")
      r=calc3(r,"^")
   Wend
   
   While Instr(r,"*")or Instr(r,"/")
      
      Pos=Instr(r,"*-")
      While Pos
         r$=Left(r,Pos)+"#"+Mid(r,Pos+2)
         Pos=Instr(r,"*-")
      Wend
      
      Pos=Instr(r,"*-")
      While Pos
         r$=Left(r,Pos)+"#"+Mid(r,Pos+2)
         Pos=Instr(r,"*-")
      Wend
      
      z$="*"
      If (Instr(r,"/") < Instr(r,"*") and Instr(r,"/")>0) or Instr(r,"*") = 0 Then z="/"
      r=calc3(r,z)
   Wend
   
   While Instr(r,"+")  or Instr(Mid(r,2),"-")
      If Left(r,1) = "-" Then r="#"+Mid(r,2)
      
      z="+"
      If (Instr(r,"-") < Instr(r,"+") and Instr(r,"-")>0) or Instr(r,"+") = 0 Then z="-"
         
      If z="+"      
         r=replace2(r," ","")
         Pos=Instr(r,z)
         links$=Left(r,Pos-1)
         rechts$=Mid(r,Pos+1)
         If Chr(links[0])=Chr(34)
            links$=Left(r,Pos-2)
            rechts$=Mid(r,Pos+1)
            ParseString(rechts)
            r=links+rechts
         Else
            r=calc3(r,z)
         EndIf
      Else
         r=calc3(r,z)
      EndIf
   Wend
   
   For o:Operator=EachIn Operator.list
      If o.symbol<>"^" and o.symbol<>"+" and o.symbol<>"-" and o.symbol<>"/" and o.symbol<>"*"

         While Instr(r,o.symbol)
            r=calc3(r,o.symbol)
         Wend
      EndIf
   Next
   
   Return r$

End Function

Type Operator
   Global list:TList=CreateList()
   
   Field symbol$
   Field Calc:Float(rechts#,links#)
   
   Method New()
      list.AddLast(Self)
   End Method
   
   Function Create(symbol$,func:Float(rechts#,links#))
      o:Operator = New operator
      o.symbol=symbol
      o.calc=func
   End Function
   
End Type

Function isOperator(ch$)
   For o:Operator=EachIn operator.list
      If ch=o.symbol Return True
   Next
End Function

Function calc3$(r$,z$)
   
   op=Instr(r,z)
   
   za=op-1
   
   While not isOperator(Mid(r,za,1))
      za=za-1      
      If za = 0 Then Exit
   Wend
   
   ze=op+1
   While not isOperator(Mid(r,ze,1)) and ze<=Len(r)
      ze=ze+1   
   Wend

   For i = 0 To Len(r)-1
      c$=Chr(r[i])

      Select c
         Case Chr(34)
            offen=not offen
         Case "#"
            If not offen
               r=Left(r,i)+"-"+Mid(r,i+2)
            EndIf
      End Select
      
   Next
   
   links#=Float(Mid(r,za+1,op-1))   
   rechts#=Float(Mid(r,op+1,ze-1))

   For o:Operator=EachIn Operator.list
      If z=o.symbol
         erg#=o.calc(links,rechts)
         Exit
      EndIf
   Next
   
   r=Left(r,za)+String(erg)+Mid(r,ze)
   
   
   Return r$
   
End Function

' Keys.bmx
SVar.Create("KEY_BACKSPACE",8)
SVar.Create("KEY_TAB",9)
SVar.Create("KEY_CLEAR",12)
SVar.Create("KEY_RETURN",13)
SVar.Create("KEY_ENTER",13)
SVar.Create("KEY_PAUSE",19)
SVar.Create("Lock,KEY_CAPSLOCK",20)
SVar.Create("KEY_ESCAPE",27)
SVar.Create("KEY_SPACE",32)
SVar.Create("Up,KEY_PAGEUP",33)
SVar.Create("Down,KEY_PAGEDOWN",34)
SVar.Create("KEY_END",35)
SVar.Create("KEY_HOME",36)
SVar.Create("KEY_LEFT",37)
SVar.Create("KEY_UP",38)
SVar.Create("KEY_RIGHT",39)
SVar.Create("KEY_DOWN",40)
SVar.Create("KEY_SELECT",41)
SVar.Create("KEY_PRINT",42)
SVar.Create("KEY_EXECUTE",43)
SVar.Create("KEY_SCREEN",44)
SVar.Create("KEY_INSERT",45)
SVar.Create("KEY_DELETE",46)
SVar.Create("KEY_HELP",47)
SVar.Create("KEY_0",48)
SVar.Create("KEY_1",49)
SVar.Create("KEY_2",50)
SVar.Create("KEY_3",51)
SVar.Create("KEY_4",52)
SVar.Create("KEY_5",53)
SVar.Create("KEY_6",54)
SVar.Create("KEY_7",55)
SVar.Create("KEY_8",56)
SVar.Create("KEY_9",57)
SVar.Create("KEY_A",65)
SVar.Create("KEY_B",66)
SVar.Create("KEY_C",67)
SVar.Create("KEY_D",68)
SVar.Create("KEY_E",69)
SVar.Create("KEY_F",70)
SVar.Create("KEY_G",71)
SVar.Create("KEY_H",72)
SVar.Create("KEY_I",73)
SVar.Create("KEY_J",74)
SVar.Create("KEY_K",75)
SVar.Create("KEY_L",76)
SVar.Create("KEY_M",77)
SVar.Create("KEY_N",78)
SVar.Create("KEY_O",79)
SVar.Create("KEY_P",80)
SVar.Create("KEY_Q",81)
SVar.Create("KEY_R",82)
SVar.Create("KEY_S",83)
SVar.Create("KEY_T",84)
SVar.Create("KEY_U",85)
SVar.Create("KEY_V",86)
SVar.Create("KEY_W",87)
SVar.Create("KEY_X",88)
SVar.Create("KEY_Y",89)
SVar.Create("KEY_Z",90)
SVar.Create("KEY_LSYS",91)
SVar.Create("KEY_RSYS",92)
SVar.Create("KEY_NUM0",96)
SVar.Create("KEY_NUM1",97)
SVar.Create("KEY_NUM2",98)
SVar.Create("KEY_NUM3",99)
SVar.Create("KEY_NUM4",100)
SVar.Create("KEY_NUM5",101)
SVar.Create("KEY_NUM6",102)
SVar.Create("KEY_NUM7",103)
SVar.Create("KEY_NUM8",104)
SVar.Create("KEY_NUM9",105)
SVar.Create("KEY_NUMMULTIPLY",106)
SVar.Create("KEY_NUMADD",107)
SVar.Create("KEY_NUMSUBTRACT",109)
SVar.Create("KEY_NUMDECIMAL",110)
SVar.Create("KEY_NUMDIVIDE",111)
SVar.Create("KEY_F1",112)
SVar.Create("KEY_F2",113)
SVar.Create("KEY_F3",114)
SVar.Create("KEY_F4",115)
SVar.Create("KEY_F5",116)
SVar.Create("KEY_F6",117)
SVar.Create("KEY_F7",118)
SVar.Create("KEY_F8",119)
SVar.Create("KEY_F9",120)
SVar.Create("KEY_F10",121)
SVar.Create("KEY_F11",122)
SVar.Create("KEY_F12",123)
SVar.Create("KEY_NUMLOCK",144)
SVar.Create("KEY_SCROLL",145)
SVar.Create("KEY_LSHIFT",160)
SVar.Create("KEY_RSHIFT",161)
SVar.Create("KEY_LCONTROL",162)
SVar.Create("KEY_RCONTROL",163)
SVar.Create("KEY_LALT",164)
SVar.Create("KEY_RALT",165)
SVar.Create("KEY_TILDE",192)
SVar.Create("KEY_MINUS",107)
SVar.Create("KEY_EQUALS",109)
SVar.Create("KEY_OPENBRACKET",219)
SVar.Create("KEY_CLOSEBRACKET",221)
SVar.Create("KEY_BACKSLASH",226)
SVar.Create("KEY_SEMICOLON",186)
SVar.Create("KEY_QUOTES",222)
SVar.Create("KEY_COMMA",188)
SVar.Create("KEY_PERIOD",190)
SVar.Create("KEY_SLASH",191)


' Operators.bmx
Function Add#(a#,b#)
   Return a+b
End Function
Function sub#(a#,b#)
   Return a-b
End Function
Function mul#(a#,b#)
   Return a*b
End Function
Function div#(a#,b#)
   Return a/b
End Function
Function pot#(a#,b#)
   Return a^b
End Function
Function modulo#(a#,b#)
   Return a mod b
End Function
Function bigger#(a#,b#)
   Return a > b
End Function
Function smaller#(a#,b#)
   Return a < b
End Function
Function SAnd#(a#,b#)
   Return a and b
End Function
Function SOr#(a#,b#)
   Return a or b
End Function
Function Compare#(a#,b#)
   Return a = b
End Function

Operator.Create("\",Compare)
Operator.Create("+",Add)
Operator.Create("-",sub)
Operator.Create("/",div)
Operator.Create("*",mul)
Operator.Create("^",pot)
Operator.Create("%",modulo)
Operator.Create("<",smaller)
Operator.Create(">",bigger)
Operator.Create("&",sand)
Operator.Create("|",sor)

'Script.bmx
Type Script
   Field filename$
   Field lines:TList=CreateList()
   Field onLoad=True
   Field blocks:TList=CreateList()
End Type

Function LoadScript:script(path$)
   Local s:script = New script
   Local open=0
   
   s.filename=path$
   
   File = ReadFile(path)
   
   While not Eof(File)
      l$=Trim(ReadLine(File))
         
      If l
         s.lines.AddLast(l)      
      EndIf
      
   Wend
   
   While i<s.lines.Count()

      line$=String(s.lines.ValueAtIndex(i))
      command$=Left(line,Instr(line," ")-1)
            
      Select Lower(Command)
         Case "function"
            block:TList=GetBlock(s.lines,i+1)   
            cutlist(s.lines,i,i+block.Count()+2)
            
            funcLine$=Mid(line,Instr(line," ")+1)
            funcName$=getcommand(funcline)
            funcParams$=Mid(Funcline,Instr(line,funcname)+Len(funcname)+2)
            funcParams$=Left(funcparams,Len(funcparams)-1)
            
            TScriptFunction.Create(funcname,funcParams,block)
      End Select
      i=i+1
   Wend
   
   Return s
End Function

Function cutList:TList(list:TList Var,p1,p2)
   Local list2:TList=CreateList()
   
   For i = 0 To list.Count()-1
      If i<p1 or i>p2
         list2.AddLast(list.ValueAtIndex(i))
      End If
   Next
   
   list=list2
End Function

Function GetCommand$(str$)
   Pos = Instr(str,"(")
   If Pos
      command$ = Left(str,Pos)
      command = command.Replace("(","")
      Return Lower(command)
   Else
      Return Lower(str)
   EndIf
End Function

Function ParseString(str$ Var)

   str=str.Replace("'",Chr(34))
   
   Pos=Instr(str,"=")
   If Pos
      If not Instr(str,"==")
         str=Mid(str,Pos+1)
      EndIf
   EndIf

   str=calc(str)
End Function

Function Cut$(str$,s,e)
   Return Mid(str,s,e-s)
End Function

Function ParseLine(line$)
   line=Replace(line,"'",Chr(34))
      
   Local command$
   Local p$[]
   Local rechts$,links$

   command=getcommand(line)

   Local arr$[]=splitoperators(line)   
   line=arr[0]
   

   p=GetParams(line)
   For i = 0 To p.length-1
      parsestring(p[i])
   Next
   
   
   CallFunc(command,Array(p,0),Array(p,1),Array(p,2),Array(p,3),Array(p,4),Array(p,5),Array(p,6),Array(p,7),Array(p,8),Array(p,9),Array(p,10),Array(p,11),Array(p,12),Array(p,13),Array(p,14),Array(p,15),Array(p,16),Array(p,17),Array(p,18),Array(p,19))

   Pos=Instr(line,"=")
   If Pos
      If not Instr(line,"==")
         links=Trim(Lower(Left(line,Pos-1)))
         rechts=Trim(Mid(line,Pos+1))
         parsestring(rechts)
   
         If arr.length>1
            For i = 0 To arr.length-1
               rechts=rechts+arr[i]
            Next
            parsestring(rechts)
         EndIf
         
         SetVar(links,rechts,"script")
                  
      EndIf
   EndIf   
End Function

Function ParseOneThing$(str$)
   str=Trim(str)
   str=Lower(str)

   V$=getvar(str)
   If V
      Return V
   End If
      
   For f:TFunc = EachIn TFunc.funclist
      command$=getCommand(str)
      If command=f.name
            
         If splitstring(str,"(")[1]<>")"      
            Local p$[]=getparams(str)   
            For i = 0 To p.length-1
               p[i]=parseonething(p[i])
            Next
         EndIf
         
                                                      
         Return f.func(Array(p,0),Array(p,1),Array(p,2),Array(p,3),Array(p,4),Array(p,5),Array(p,6),Array(p,7),Array(p,8),Array(p,9),Array(p,10),Array(p,11),Array(p,12),Array(p,13),Array(p,14),Array(p,15),Array(p,16),Array(p,17),Array(p,18),Array(p,19))
      EndIf
   Next
   
   For sf:TScriptFunction=EachIn TScriptFunction.list
      command$=getCommand(str)
      If command=sf.name
      
         If splitstring(str,"(")[1]<>")"      
            p=getparams(str)   
            For i = 0 To p.length-1
               p[i]=parseonething(p[i])
               pstr$=pstr$+p[i]+","
               
            Next
            pstr=Left(pstr,Len(pstr)-1)
         EndIf                                                      
         Return sf.call(pstr)
      EndIf
   Next
   
   Return str
End Function

Function Array$(arr$[],i)
   If arr.length-1>=i
      Return arr[i]
   EndIf
End Function

Function DoScript(s:script)
   doBlock(s.lines)
   
   s.onload=False
End Function

Function DoBlock$(list:TList,params$[]=Null)
   Local command$
   Local p$[]
   Local block:TList
   Local parse=True
   
   For i = 0 To list.Count()-1

      If block
         If inBlock(i,list)
            Continue
         End If
      EndIf
   
      line$=String(list.ValueAtIndex(i))         
                  
      Pos=Instr(Lower(line),"return")
      If Pos
         retstring$=Mid(line,Pos+Len("return")+1)
         parsestring(retstring)
         Return retstring
      End If      
            
      command=getcommand(line)
      
      Select Command
         Case "if"
            block:TList=GetBlock(list,i+1)   
                  
                        
            p=GetParams(line)
            parsestring(p[0])
         
            If Int(p[0])
               DoBlock(block)
            EndIf
         Case "while"
            block:TList=GetBlock(list,i+1)
            
            
            p=GetParams(line)
            parsestring(p[0])
            
            While Int(p[0])
               DoBlock(block)
                  
               p=GetParams(line)
               parsestring(p[0])
            Wend
         
         Case "for"
            block:TList=GetBlock(list,i+1)   
            p=GetParams(line)
                  
            a$=""
            SetVar(p[0],a)
            
            parseString(p[1])
            parseString(p[2])
            
            If p.length<4
               addtoarray p,"1"
            Else
               parseString(p[3])
            End If
            
            c#=Float(p[1])      
                  
            While c<=Float(p[2])
               a=c
               SetVar(p[0],a)
               
               DoBlock(block)
               c=c+Float(p[3])
            Wend
      End Select
   
      parseline(line)
   Next

End Function

'ScriptFunctions.bmx
Function Text$(t$,x$,y$)
   DrawText t,Float(x),Float(y)
End Function
Function Quit$()
   End
End Function   
Function GetMx$()
   Return String(MouseX())
End Function
Function GetMy$()
   Return String(MouseY())
End Function   
Function Rect(x$,y$,w$,h$)
   DrawRect Float(x),Float(y),Float(w),Float(h)
End Function
Function flp(p1$=0)
   Flip Int(p1)
End Function
Function clearscreen()
   Cls
End Function
Function keyh$(k$)
   Return KeyHit(Int(k))
End Function
Function mouseh$(k$)
   Return MouseHit(Int(k))
End Function
Function keyD$(k$)
   Return KeyDown(Int(k))
End Function
Function moused$(k$)
   Return MouseDown(Int(k))
End Function   
Function SGraphics(w$=800,h$=600,d$=0)
   Graphics Int(w),Int(h),Int(d)
End Function
Function sMillisecs$()
   Return MilliSecs()
End Function

AddFunction(SGraphics,"Graphics")
AddFunction(Text,"DrawText")
AddFunction(Quit,"End")   
AddFunction(Rect,"DrawRect")
AddFunction(clearscreen,"cls")
AddFunction(flp,"flip")
AddFunction(moused,"MouseDown")   
AddFunction(mouseh,"MouseHit")   
AddFunction(keyD,"KeyDown")   
AddFunction(keyh,"KeyHit")   
AddFunction(GetMx,"MouseX")
AddFunction(GetMy,"MouseY")
AddFunction(sMillisecs,"Millisecs")

'TFunc.bmx
Type TFunc
   Global funclist:TList = CreateList()
   Field func$(p1$,p2$,p3$,p4$,p5$,p6$,p7$,p8$,p9$,p10$,p11$,p12$,p13$,p14$,p15$,p16$,p17$,p18$,p19$,p20$)
   Field name$
   
   Method Get$(p$[])
      Return CallFunc(command,Array(p,0),Array(p,1),Array(p,2),Array(p,3),Array(p,4),Array(p,5),Array(p,6),Array(p,7),Array(p,8),Array(p,9),Array(p,10),Array(p,11),Array(p,12),Array(p,13),Array(p,14),Array(p,15),Array(p,16),Array(p,17),Array(p,18),Array(p,19))
   End Method
End Type

Function AddFunction(func:Byte Ptr,name$)
   f:Tfunc= New Tfunc
   f.name = Lower(name)
   f.func$ = func
   TFunc.funclist.AddLast(f)
End Function

Function CallFunc$(str$,p1$="",p2$="",p3$="",p4$="",p5$="",p6$="",p7$="",p8$="",p9$="",p10$="",p11$="",p12$="",p13$="",p14$="",p15$="",p16$="",p17$="",p18$="",p19$="",p20$="")
   Local this:TFunc=GetTFuncByName(str)
   If this
      ret$=this.func(p1$,p2$,p3$,p4$,p5$,p6$,p7$,p8$,p9$,p10$,p11$,p12$,p13$,p14$,p15$,p16$,p17$,p18$,p19$,p20$)
      Return ret$
   EndIf
   Local this2:TScriptFunction=GetTScriptFunctionByName(str)
   If this2
      Local params$
      params=p1$+","+p2$+","+p3$+","+p4$+","+p5$+","+p6$+","+p7$+","+p8$+","+p9$+","+p10$+","+p11$+","+p12$+","+p13$+","+p14$+","+p15$+","+p16$+","+p17$+","+p18$+","+p19$+","+p20$
      Local p$[]=getp(params)
      params=""
      For i = 0 To p.length-1
         If p[i]
            params=params+","+p[i]
         End If
      Next
      params=Mid(params,2)
      
      
      Return this2.Call(params)
   End If
End Function

Function GetTfuncByName:TFunc(str$)
   For f:TFunc = EachIn TFunc.funclist
      If f.name = Lower(str)
         Return f
      EndIf
   Next
End Function

Function GetTScriptFunctionByName:TScriptFunction(str$)
   For f:TScriptFunction = EachIn TScriptFunction.list
      If f.name = Lower(str)
         Return f
      EndIf
   Next
End Function

Type TScriptFunction
   Global list:TList=CreateList()
   Field name$
   Field params$
   Field block:TList

   Method New()
      list.AddLast(Self)
   End Method

   Function Create(name$,params$,block:TList)
      f:TScriptFunction=New TScriptFunction
      f.name=name
      f.block=block
      f.params=params
                  
   End Function
   
   Method Call$(params$)
      Local p$[]=getp(params)
      Local pName$[]=getp(Self.params)
                  
      For i = 0 To pName.length-1
      
         Pos=Instr(pName[i],"=")
         If Pos
            parseline(pName[i])
            pName[i]=Left(pName[i],Pos-1)
         EndIf
      Next      
         
      For i = 0 To p.length-1
         setvar(pName[i],p[i])
      Next
   
      a$=DoBlock(block)
   
      For i = 0 To p.length-1
         deletevar(pname[i])
      Next
      
      Return a$
   End Method
End Type

'Tvar.bmx
Type TVar
   Global list:TList=CreateList()
   Field Value$
   Field name:String
   Field typ:String
   Field place$
   
   Method New()
      list.AddLast(Self)
   End Method
   
   Method Set(Value:String)
      Self.Value=Value
   EndMethod
   
   Method Get:String()         
      Return Value
   EndMethod
   
EndType

Type SVar Extends TVar   
   Function Create(name$,Value:String)
      V:Svar=New svar
      V.name=Lower(name)
      V.Value=Value
      V.place="script"
   End Function
End Type

Type PVar Extends TVar   
   Field data:Byte Ptr
         
   Method Set(Value:String)
      MemCopy data,VarPtr(Value),4
   EndMethod
   
   Method Get:String()
      Local tmp:String
      MemCopy VarPtr(tmp),data,4
         
      Return tmp
   EndMethod
   
   Function Create(name$,Value:String Var)
      Local V:Pvar=New Pvar
      V.name=Lower(name)
      V.data=VarPtr(Value)
      V.place="program"
   EndFunction

EndType

Function UpdateVars()
   For V:TVar=EachIn TVar.list
      If ContainsChr(V.get())
         V.typ="String"
      Else
         V.typ="Number"
      EndIf
   Next
End Function

Function GetTyp$(str$)
   If ContainsChr(str)
         Return "String"
      Else
         Return "Number"
      EndIf
End Function

Function GetVar:String(name$)
   name=Lower(name)
   For V:TVar=EachIn TVar.list
      If name=V.name
         Return V.Get()
      End If
   Next
End Function

Function SetVar$(name$,val:String Var,place$="script")
   name=Lower(name)
   For V:TVar=EachIn TVar.list
      If name=V.name
         V.Set(val)
         gef=True
      End If
   Next
   If not gef
      Select place
         Case "script"
            svar.Create(name,val)
         Case "program"
            pvar.Create(name,val)
      EndSelect
   End If
End Function

Function TVarByName:TVar(str$)
   For V:TVar=EachIn TVar.list
      If name=V.name
         Return V
      End If
   Next
End Function

Function DeleteVar(str$)
   TVar.list.Remove(TVarByName(str))
End Function



'Main.bmx

'Include "Functions.bmx"
'Include "Script.bmx"
'Include "TFunc.bmx"
'Include "TVar.bmx"
'Include "Calc.bmx"
'Include "Operators.bmx"
'Include "Keys.bmx"
'Include "ScriptFunctions.bmx"

Local scr:Script=LoadScript("test.txt")

doScript scr

End



und hier noch ein Beispiel Script (bei der Rar Datei mit dabei), jaja komische Syntax, aber mir gefällts so ^^
Code: [AUSKLAPPEN]
Graphics(800,600)

SeedRnd(millisecs())

rx=0
ry=300

while(keyHit(key_escape)==false)
{
   myFPS=FPS()
   

   mx = mousex()
   my = MouseY()


   rx=rx+1
   rx=rx mod 800
   DrawRect(rx,ry,100,100)

   DrawText("FPS :" + myfps,20,20)
   
   Flip()
   Cls()
}

Function FPS()   
{
   If(MilliSecs()- gtime>1000)
   {
      gfps = gtempfps
      gtempfps = 0
      gtime = MilliSecs()
   }
   
   gtempfps=gtempfps+1
   Return gfps
}



Der Code an sich hat einen Vorteil und einen Nachteil :
Vorteil : Er Funktioniert (hoffe ich zumindest XD)
Nachteil : Ziemlich unübersichtlich und unproffesionell angefangen und deshalb auch so beendet xD (keine Kommentare, noch sehr viele Verbesserungsmöglichkeiten,etc.)

Fragen könnt ihr natürlich stellen und konstruktive Kritik ist erwünscht (sowohl am Programm als auch am Beitrag)

PS : Ich habe nicht wirklich Lust daran weiter zu machen, da ich wie gesagt schlecht angefangen habe und durch jede kleine Neuerung zich neue Fehler auftauchen.

mfg Moep
Hardstyle Schleichwerbung:
http://www.youtube.com/user/Hackepeter42

Achtung: Suchtgefahr!
moep123.ohost.de

Farbfinsternis

 BeitragSo, Jul 29, 2007 20:33
Antworten mit Zitat
Benutzer-Profile anzeigen
Wozu soll das gut sein? Nimm LUA!
Farbfinsternis.tv

Moep

 BeitragSo, Jul 29, 2007 22:44
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich hatte nicht vor das Teil mit LUA zu vergleichen, ich dachte nur es wäre gut wenn ich das ganze hier Poste, da es sonst eigentlich sogut wie umsonst gemacht ist
Hardstyle Schleichwerbung:
http://www.youtube.com/user/Hackepeter42

Achtung: Suchtgefahr!
moep123.ohost.de

DamienX

 BeitragMo, Jul 30, 2007 0:39
Antworten mit Zitat
Benutzer-Profile anzeigen
Farbfinsternis hat Folgendes geschrieben:
Wozu soll das gut sein? Nimm LUA!


Nicht jeder will vorgefertigte Lösungen haben. Wenn das der Fall wäre dann würden hier nicht Leute an der x-ten GUI oder dem "abertausendsten" Tetris-, Pong-, SpaceInvadersklon schreiben weil die gibts schon zu genüge.
Aber es ist durchaus hilfreich das Können zu besitzen solche Sachen zu schreiben weil man daraus auch einiges lernt und nicht auf bereits bestehende Lösungen angewiesen ist.

Grüße Dx
Lets make things better...

Neue Antwort erstellen


Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group