Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Easybasic V2 (update 1)

Uploader:MitgliedAndT
Datum/Zeit:29.11.2007 00:13:35

' Kein Release(erst ab 1.00.00!!!!!)


' EasyBasicEngine V2 beta

' Zum Programmieren muss eine eine prog.txt erstellt werden wo dann der Quellcode reingeschrieben wird.

' _____ Programmintern(erforderlich)_____

Print "EasyScriptEngine V 0.1.00 beta"
Print "Initalizing Programm.."

#include "windows.bi"
#define debug 0
#define noblock 1
#define developer 1
locate ,,0 ' Schaltet Courser aus


#if(debug=1)
print "it works"
sleep
end
#endif
' Declarationen

dim as integer doline
dim as integer TastID
dim as string Taste
dim as integer dbm
dim as integer mous_x,mous_y
dim as ubyte ctrlchar
dim as double maxv1,maxv2,maxv3,maxv4,dbgmd
dim as integer x,y,gfxcol
dim as integer x2,y2,gfxcol2
dim as double v1,v2,v3,v4
dim as integer runs,dummy
dim as string prgfile = "prog.txt" ' Datei zum Ausführen
#if (noblock = 0)
prgfile = command
open command for input as #1
if command = "" then print "Keine Datei angegeben":sleep:end
if lof(1) = 0 then print "Fehler beim oeffen von"; command;".":sleep:end
close #1
#endif

' Function für ConsolenPrint
sub consprint (byval Text as string)
    dim as integer ff = freefile
    open cons for output as #ff
    print #ff,Text
    close #ff
end sub

' _____ Anzahl der Zeilen scannen ____

Print "Zeilen :";
open prgfile for input as #1
do
    input #1,dummy
    runs+=1
loop until eof (1)

close #1
print runs
Print "Code Laden.."


dim shared as string cfgcode(runs) ' Programmcodespeicher Declarieren


' ____ Programm Laden ____

open prgfile for input as #1
for i as integer  = 1 to runs

input #1,cfgcode(i)
if left(cfgcode(i),1)="'" then Print "Zeile";i;": ";right(cfgcode(i),len(cfgcode(i))-1)
next
close #1
Print "Fertig."
#if (developer = 1)
screen 18
#endif

' ____ Programm Ausführen ____
dim as ubyte char,cmpbol
dim as string cmd
for i as integer = 1 to runs
cmd = lcase(cfgcode(i))


'==== Debugging ====
#if (debug < 0)
#if (debug < -1)
sleep
#endif
color 15
locate 1,1
print v1,v2,v3,v4;" "
print maxv1,maxv2,maxv3,maxv4;" "
locate 4,1: print " ";cmd;" "

#endif
#if (developer = 1)
consprint str(V1)+"***"+str(V2)+"***"+str(V3)+"***"+str(V4)
taste = inkey
if taste = chr(27) then exit for
#endif

'==== Math Check ====


'=== Testcode ===




select case cmd
' Ab hier können Befehle eingetragen werden
' Syntax Befehl = CMD, cfgcode(nr) = Zeile in prog.txt
' Komplexere Befehle sind auch rein Theroetisch auch möglich.

' Derzeit genügen dieser String und der CodeArry mehr als genug ;)


' ====== Grafiksystemteil ======
case "res"
    screenres val(cfgcode(i+1)),val(cfgcode(i+2))
case "screen"
    screen val(cfgcode(i+1))
case "full_circle"
    circle (val(cfgcode(i+1)),val(cfgcode(i+2))),val(cfgcode(i+3)),val(cfgcode(i+4)),,,,F
case "circle"
    circle (val(cfgcode(i+1)),val(cfgcode(i+2))),val(cfgcode(i+3)),val(cfgcode(i+4))
case "full_line"
    line(val(cfgcode(i+1)),val(cfgcode(i+2)))-(val(cfgcode(i+3)),val(cfgcode(i+4))),val(cfgcode(i+5)),bf
case "line"
    line(val(cfgcode(i+1)),val(cfgcode(i+2)))-(val(cfgcode(i+3)),val(cfgcode(i+4))),val(cfgcode(i+5))
case "drawstring"
    select case cfgcode(i+1)
    case "v1"
        x2=v1
    case "v2"
        x2=v2
    case "v3"
        x2=v3
    case "v4"
        x2=v4
    case else
        x2=val(cfgcode(i+1))
    end select
    select case cfgcode(i+2)
    case "v1"
        y2=v1
    case "v2"
        y2=v2
    case "v3"
        y2=v3
    case "v4"
        y2=v4
    case else
        y2=val(cfgcode(i+1))
    end select

    draw string (x2,y2),cfgcode(i+3),15

' ------ Ausgebauter Teil ------
case  "smv"
    select case val(cfgcode(i+1))
    case 1
        maxv1=val(cfgcode(i+2))
    case 2
        maxv2=val(cfgcode(i+2))
    case 3
        maxv3=val(cfgcode(i+2))
    case 4
        maxv4=val(cfgcode(i+2))
    end select

case "col"
        select case cfgcode(i+1)
        case "v1"
            color v1
        case "v2"
            color v2
        case "v3"
            color v3
        case "v4"
            color v4
        case else
            color val(cfgcode(i+1))
        end select

case "pset"
    select case cfgcode(i+1)
        case "v1"
            x=v1
        case "v2"
            x=v2
        case "v3"
            x=v3
        case "v4"
            x=v4
        case else
            x = val(cfgcode(i+1))
    end select

    select case cfgcode(i+2)
        case "v1"
            y=v1
        case "v2"
            y=v2
        case "v3"
            y=v3
        case "v4"
            y=v4
        case else
            y = val(cfgcode(i+2))
    end select

    select case cfgcode(i+3)
        case "v1"
            gfxcol=v1
        case "v2"
            gfxcol=v2
        case "v3"
            gfxcol=v3
        case "v4"
            gfxcol=v4
        case else
            gfxcol= val(cfgcode(i+3))
    end select
        pset (x,y),gfxcol



' ====== Dateisystemteil ======
case "load"
    open cfgcode(i+1) for binary as #1
case "close"
    close #1
case "comp"
    if char = val(cfgcode(i+1)) then cmpbol = 1 else cmpbol = 0
case "get"
    get #1,val(cfgcode(i+1)),char
    case "put"
    char = val(cfgcode(i+2))
    put #1,val(cfgcode(i+1)),char
case "char2v"
    select case val(cfgcode(i+1))
    case 1
        v1 = char
    case 2
        v2 = char
    case 3
        v3 = char
    case 4
        v4 = char
    end select
case "v2char"
    select case val(cfgcode(i+1))
    case 1
        v1 = char
    case 2
        v2 = char
    case 3
        v3 = char
    case 4
        v4 = char
    end select



' ====== Main base ======

    case "shell"
        shell cfgcode(i+1)
    case "beep"
        beep
    case "echo"
        select case cfgcode(i+1)
        case "v1"
            print v1
        case "v2"
            print v2
        case "v3
            print v3
        case "v4"
            print v4
        case else
            print cfgcode(i+1)
        end select

    case "exit"
        exit for
    case "
goto"
        i=val(cfgcode(i+1))-1
    case "
escrout"
        Taste = Inkey
        if Taste = chr(27) then exit for
    case "
sleep"
        sleep val(cfgcode(i+1))
    case "
locate"
        locate val(cfgcode(i+1)),val(cfgcode(i+2))
    case "
cls"
        cls
        
    case "
<=0_check"
       select case cfgcode(i+1)
        case "v1"
            if v1 < 0 then v1=0
        case "v2"
            if v2 < 0 then v2=0
        case "v3"
            if v3 < 0 then v3=0
        case "v4"
            if v4 < 0 then v4=0
        end select

       case "maxvck"
           select case cfgcode(i+1)
            case "v1"
                IF V1 > maxv1 then V1=0
            case "v2"
                IF V2 > maxv2 then V2=0
            case "v3"
                IF V3 > maxv3 then V3=0
            case "v4"
                IF V4 > maxv4 then V4=0
        end select

    '-- Addons

    case "tjmp"
    select case cfgcode(i+1)
        case "v1"
            if v1=val(cfgcode(i+2)) then I = val(cfgcode(i+3))-1
        case "v2"
            if v1=val(cfgcode(i+2)) then I = val(cfgcode(i+3))-1
        case "v3"
            if v1=val(cfgcode(i+2)) then I = val(cfgcode(i+3))-1
        case "v4"
            if v1=val(cfgcode(i+2)) then I = val(cfgcode(i+3))-1
    end select

    '-- Eingabesteuerng
case "trgvctrl"
    select case cfgcode(i+1)
        case "
cv1+"
            if multikey(val(cfgcode(i+2))) then v1+=1
        case "
cv1-"
            if multikey(val(cfgcode(i+2))) then v1-=1
        case "
cv2+"
            if multikey(val(cfgcode(i+2))) then v2+=1
        case "
cv2-"
            if multikey(val(cfgcode(i+2))) then v2-=1
    end select
    
' Maus und Joystick muss noch intrigiert werden
' Die Eingabesteuerung wird derzeit verbessert

    
    
        
' ====== Debugging =======

' Zeigt genau die Zeile an wo myline steht (nützlich für goto schleifen)
case "
myline"
    print i-1
    
' ====== Mathengine (beta) ======
    case "
mathset"
    select case cfgcode(i+1)
        case "v1"
            v1=val(cfgcode(i+2))
        case "v2"
            v2=val(cfgcode(i+2))
        case "v3"
            v3=val(cfgcode(i+2))
        case "v4"
            v4=val(cfgcode(i+2))
        end select

    case "add"
        select case cfgcode(i+1)
        case "v1"
            v1+=val(cfgcode(i+2))
        case "v2"
            v2+=val(cfgcode(i+2))
        case "v3"
            v3+=val(cfgcode(i+2))
        case "v4
            v4+=val(cfgcode(i+2))
        end select

    case "sub"
        select case cfgcode(i+1)
        case "v1"
            v1-=val(cfgcode(i+2))
        case "v2"
            v2-=val(cfgcode(i+2))
        case "v3"
            v3-=val(cfgcode(i+2))
        case "v4
            v4-=val(cfgcode(i+2))
        end select
        
    case "
mult"
        select case cfgcode(i+1)
         case "v1"
            v1*=val(cfgcode(i+2))
        case "v2"
            v2*=val(cfgcode(i+2))
        case "v3"
            v3*=val(cfgcode(i+2))
        case "v4"
            v4*=val(cfgcode(i+2))
        end select

        case "div"
        select case cfgcode(i+1)
         case "v1"
            v1/=val(cfgcode(i+2))
        case "v2"
            v2/=val(cfgcode(i+2))
        case "v3"
            v3/=val(cfgcode(i+2))
        case "v4"
            v4/=val(cfgcode(i+2))
        end select

    case "randomize"
        randomize val(cfgcode(i+1))
        
    case "
rnd"
        select case cfgcode(i+1)
        case "v1"
            v1 = int(rnd *val(cfgcode(i+1)))
        case "v2"
            v2 = int(rnd *val(cfgcode(i+1)))
        case "v3"
            v3 = int(rnd *val(cfgcode(i+1)))
        case "v4"
            v4 = int(rnd *val(cfgcode(i+1)))
    end select


' === Do, Loop ===

 case "do"
     doline = i
    
 case "
loop"
     i = doline

' ====WinApi====
' Wird noch eingebaut..

#IFDEF __FB_WIN32__

case "
winmsg"
    MessageBox( null, cfgcode(i+2), cfgcode(i+1), MB_ICONINFORMATION )
    
#ENDIF

' ====OpenGL Engine====
' ist geplant..


' ==== Main Run ====

end select

next

' ==== End of Program ====
color 15
consprint "
Programm beendet"
Print "
--- END OF PROGRAM ---"
sleep