Threaded Mode | Linear Mode

***Aurel*** · 01-30-2020, 09:57 PM

source code for microB interpreter A01

Code:

'microB_Interpreter - with recursive descent token evaluator

' by Aurel - 26.3.2019 - last test 30.1.2020

include "awinh037.inc"                              ' awinh GUI api function

include "microAT.inc"                               'tokenizer include

#lookahead

int tc=0                                            ' token count

string token                                        ' def token

'*********************************************************************

'globals

INT win,x=0,y=0,w=400,h=300,wstyle = WS_MINMAXSIZE

INT button0,b0ID=100

' open window with message loop...

win = SetWindow("GUI_microB:",x,y,w,h,0,wstyle)

'button0 = SetButton(win,180,4,80,26,"Close (X)",0x50001000,0x200,b0ID)

'*********************************************************************

'test 1 - load source string from microB.inc Tokenizer

string code = "1-2*3-4" + crlf             'enter your expression / crlf=EOL

codeLen=len(code)

tn = run_tokenizer(code) 

MsgBox  str(tn) ,"Tokenizer Out"                     ' 1 means OK!

'---------------------------------------------------------------

' sintax / logic error block ?

'---------------------------------------------------------------

'if tokenization error=0 then OK!..execute

If tokerr = 0

exec()

End if

'================================================================

Wait()  '/// without message loop ///

'===============================================================

Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback

SELECT hwnd

CASE win

Select wmsg

    CASE WM_CLOSE

    CloseWindow(win)

    EndProgram

End Select

END SELECT

RETURN Default

END FUNCTION

'================================================================

'-----------------------------------------------------

sub gettok()

tc++

token = tokList[tc] 

'test

if tokList[tc+1] <> "" then return

end sub

'----------------------------------------------------

sub expr() as float

float v

If token = "-" 

 v = -(term())

else

 v = term()

end if 

while token = "+" or token = "-"

if token = "+": gettok() : v = v + term(): end if

if token = "-": gettok() : v = v - term(): end if

wend

return v

end sub

'---------------------------------------------------

sub term() as float

float v 

v = factor()

while token = "*" or token = "/"

if token = "*": gettok() : v = v * factor(): end if

if token = "/": gettok() : v = v / factor(): end if

wend

return v

end sub 

'-------------------------------------------------------

sub factor() as float

float v

if asc(token)>47  and asc(token)<58 'nums

v = val(token) 

'print str(v)+ " factor"

gettok()

end if

if asc(token)=40 and asc(token)<>41 'match (...)

gettok() : v = expr() : gettok()

end if

return v

end sub

'execute-----------------------------------------------------

sub exec

gettok()'start

float res = expr()

print "RESULT=" + str(res)

end sub

***Aurel*** · 03-07-2020, 05:02 AM

Testing micro(A) execution time
tokenization time show 0 ...which is ok for a such a small code
(just a simple math expression)
"1+2.3*4 +(10.6/2.43+0.6)*0.7/1.44-0.7*(2.3+0.6)"
and funny thing execution time shows no mather what size of
expession is similar results
between 0,7 - 1,9 seconds
Big Grin

Code:

'microB_Interpreter - with recursive descent token evaluator

' by Aurel - 26.3.2019 - last test 30.1.2020

include "awinh037.inc"                              ' awinh GUI api function

include "microAT.inc"                               'tokenizer include

#lookahead

int tc=0                                            ' token count

string token                                        ' def token

'*********************************************************************

'globals

INT win,x=0,y=0,w=400,h=300,wstyle = WS_MINMAXSIZE

INT button0,b0ID=100

' open window with message loop...

win = SetWindow("GUI_microB:",x,y,w,h,0,wstyle)

'button0 = SetButton(win,180,4,80,26,"Close (X)",0x50001000,0x200,b0ID)

'*********************************************************************

'test 1 - load source string from microB.inc Tokenizer

string code = "1+2.3*4 +(10.6/2.43+0.6)*0.7/1.44-0.7*(2.3+0.6)" + crlf             'enter your expression / crlf=EOL

codeLen=len(code)

tn = run_tokenizer(code) 

MsgBox  str(tn) ,"Tokenizer Out"                     ' 1 means OK!

'---------------------------------------------------------------

' sintax / logic error block ?

'---------------------------------------------------------------

'if tokenization error=0 then OK!..execute

If tokerr = 0

 startTime = GetTickCount() 

exec()

   endTime = GetTickCount()                  ' stop tick counter

   procTime = (EndTime - startTime)/1000     ' in seconds

   MsgBox "Exec Time: " + str(procTime) + " s", "Execution Time"

End if

'================================================================

Wait()  '/// without message loop ///

'===============================================================

Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback

SELECT hwnd

CASE win

Select wmsg

    CASE WM_CLOSE

    CloseWindow(win)

    EndProgram

End Select

END SELECT

RETURN Default

END FUNCTION

'================================================================

'-----------------------------------------------------

sub gettok()

tc++

token = tokList[tc] 

'test

if tokList[tc+1] <> "" then return

end sub

'----------------------------------------------------

sub expr() as float

float v

If token = "-" 

 v = -(term())

else

 v = term()

end if 

while token = "+" or token = "-"

if token = "+": gettok() : v = v + term(): end if

if token = "-": gettok() : v = v - term(): end if

wend

return v

end sub

'---------------------------------------------------

sub term() as float

float v 

v = factor()

while token = "*" or token = "/"

if token = "*": gettok() : v = v * factor(): end if

if token = "/": gettok() : v = v / factor(): end if

wend

return v

end sub 

'-------------------------------------------------------

sub factor() as float

float v

if asc(token)>47  and asc(token)<58 'nums

v = val(token) 

'print str(v)+ " factor"

gettok()

end if

if asc(token)=40 and asc(token)<>41 'match (...)

gettok() : v = expr() : gettok()

end if

return v

end sub

'execute-----------------------------------------------------

sub exec

gettok()'start

float res = expr()

print "RESULT=" + str(res)

end sub

***Aurel*** · 04-10-2020, 01:10 AM

latest code ,,testing varID

Code:

'micro(A) Interpreter - with recursive descent token evaluator

' by Aurel - 26.3.2019 - last test 30.1.2020

include "awinh037.inc"                              ' awinh GUI api function

include "microAT.inc"                               ' tokenizer include

#lookahead

int tc=0 , ierror=0                                 ' token count, interpreting  error

string token : int tkTyp                            ' define  token as STRING : tkType as INT

'*********************************************************************

'globals

INT win,x=0,y=0,w=400,h=300,wstyle = WS_MINMAXSIZE

INT button0,b0ID=100

NumberFormat 6,1,0,0,0,0

'Interpreter Globals .........................................................................

string kwList[32]   'keyword list 

kwList[1] = "VARNUM" : kwList[2] = "VARSTR" : kwList[3] = "VARPTR" : kwList[4] = "IF" : kwList[5] = "ELSE" : kwList[6] = "ENDIF"

kwList[7] = "WHILE" : kwList[8] = "WEND" : kwList[9] = "FOR" : kwList[10] = "TO" : kwList[11] = "STEP" : kwList[12] = "NEXT"

kwList[13]="PRINT" : kwList[14]="STR" : kwList[15]="VAL"

'...............................................................................​...............

int tkSTRING = 32, tkFLOAT = 33 , tkPOINTER = 34 , tkIF = 35 , tkELSE = 36, tkENDIF = 37

int tkWHILE = 38, tkWEND = 39 , tkFOR = 40 , tkTO = 41 , tkSTEP = 42 , tkNEXT = 43

int tkPRINT = 44 , tkSTR = 45, tkVAL = 46

'Global Variable,ID etc array ................................................................

int varID = 0

int varList[1024] : int varType[1024] :string varName[1024]: string varStr[1024] : float varNum[1024] : int varPtr[1024]

int ifCounter=0, elseCounter=0, endifCounter=0, whileCounter=0,wendCounter=0 ,forCounter=0,nextCounter=0

' Open Window with message loop...

win = SetWindow("micro(A):",x,y,w,h,0,wstyle)'

'button0 = SetButton(win,180,4,80,26,"Close (X)",0x50001000,0x200,b0ID)

'*********************************************************************

'test 1 - load source code into (microAT.inc) Tokenizer

string code = "varNum a: a=3 " + crlf            'enter your expression / crlf=EOL

codeLen=len(code)

tn = run_tokenizer(code) 

MsgBox  str(tn) ,"Tokenizer Out"                     ' 1 means OK!

'---------------------------------------------------------------

' prescan for variables,commands....

'---------------------------------------------------------------

'if tokenization error=0 then OK!..preScan()

int ps

If tokerr = 0 and tn = 1

   ps = preScan()   

Else

   MsgBox "END" ,"Program Exit!"

End if

'if ps = 1 then OK...........................

if ps = 1 

   MsgBox "PreScan:OK!" ,"Continue..."

   tokInterpreter()                  ' run token-interpreter

Else

   MsgBox "END" ,"Program Exit!"

End if

'================================================================

Wait()  '/// message loop ///

'===============================================================================​============

Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback

SELECT hwnd

CASE win

Select wmsg

    CASE WM_CLOSE

    CloseWindow(win) 

    EndProgram

End Select

END SELECT

RETURN Default

END FUNCTION

'===============================================================================​============

Sub preScan() as int

'MsgBox "OK..." ,"Pre:SCAN"

int i , numOfTokens = nTokens ,lineNum=0 ,varID=0, vID, n ,vTyp    ' numofTokens as local/reset global nTokens

string vName

    For i = 1 to numOfTokens

        IF typList[i]=tkEOL: tokList[i]="EOL": lineNum++ : END IF  'check EndOfLine

        IF typList[i] = tkIDENT

           If ucase(tokList[i]) = kwList[1]: typList[i] = tkFLOAT  'if varNUM ...........................

              if typList[i+1] <> tkIDENT 'check err

                 MsgBox "Missing variable after VARNUM! line: " + str(lineNum),"ERROR": return 0

            else

              i=i+1 ' next token

               While typList[i] <> tkCOLON And typList[i] <> tkEOL  'store num variable              -low case var name-

                  If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID : varName[varID] = lcase(tokList[i]) : varType[varID] = tkFLOAT :varNum[varID] = 0 

                     MsgBox "Variable name: " + tokList[i] + " VAR.TYPE: " + str(varType[varID]) , "TYPE"

                  End if

                i++

               Wend 

             end if

          End if  ' endOf varNUM..........................................................................​

          If ucase(tokList[i]) = kwList[2]: typList[i] = tkSTRING  'if varSTR ...........................

              if typList[i+1] <> tkIDENT 'check err

                 MsgBox "Missing variable after VARSTR! line: " + str(lineNum),"ERROR": return 0

            else

              i=i+1 ' next token

               While typList[i] <> tkCOLON And typList[i] <> tkEOL  'store str variable

                  If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID :: varName[varID] = lcase(tokList[i]): varType[varID] = tkSTRING: varStr[varID] = "" 

                     MsgBox "Variable name: " + tokList[i] ,"variable->STR"

                  End if

                i++

               Wend 

             end if

              End if  ' endOf varSTR.......................................

          If ucase(tokList[i]) = kwList[3]: typList[i] = tkPOINTER  'if varPTR ...........................

              if typList[i+1] <> tkIDENT 'check err

                 MsgBox "Missing variable after VARPTR! line: " + str(lineNum),"ERROR": return 0

            else

              i=i+1 ' next token

               While typList[i] <> tkCOLON And typList[i] <> tkEOL  'store ptr variable

                  If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID :: varName[varID] = lcase(tokList[i]): varType[varID] = tkPOINTER: varPtr[varID] = 0 

                     MsgBox "Variable name: " + tokList[i] ,"variable->PTR"

                  End if

                i++

               Wend 

             end if

          End if  ' endOf varPTR.......................................

          If ucase(tokList[i]) = kwList[4]  : typList[i] = tkIF : ifCounter++ : End If        'if token 'IF

          If ucase(tokList[i]) = kwList[5]  : typList[i] = tkELSE : elseCounter++ : End If    'if token 'ELSE

          If ucase(tokList[i]) = kwList[6]  : typList[i] = tkENDIF : endifCounter++ : End If  'if token 'ENDIF'

          If ucase(tokList[i]) = kwList[7]  : typList[i] = tkWHILE : whileCounter++ : End If  'if token 'WHILE

          If ucase(tokList[i]) = kwList[8]  : typList[i] = tkWEND : wendCounter++ : End If    'if token 'WEND

          If ucase(tokList[i]) = kwList[9]  : typList[i] = tkFOR : forCounter++ : End If      'if token 'FOR

          If ucase(tokList[i]) = kwList[10] : typList[i] = tkTO : End If                      'if token 'TO

          If ucase(tokList[i]) = kwList[11] : typList[i] = tkSTEP : End If                    'if token 'STEP

          If ucase(tokList[i]) = kwList[12] : typList[i] = tkNEXT : nextCounter++ : End If    'if token 'NEXT

          If ucase(tokList[i]) = kwList[13] : typList[i] = tkPRINT : End If                   'if token 'PRINT

          ELSE 

          'error

       END IF

        ' if is variable outside declaration varNUM,varSTR,varPTR...

        ' search for varible name and return variable ID

       IF typList[i] = tkIDENT

               vName = tokList[i] : print "Variable_Name: " + vName : vID=0

               'loop to find var name,id,typ

               For n = 1 to varID

                    if vName = lcase(varName[n]) : print "match_name"

                       vID = n  'id is n

                       vTyp = varType[vID] : print "vtyp: " + str(vTyp)

                       varList[i] = vID  ' set var list with id from varName array-> tokList[i],typList[i],varList[i]=id

                    end if

               Next n

               if vID = 0 : print "error-varID not found!": return 0: end if

       END IF

    Next i

return 1

End sub

'===============================================================================​==================================

Sub tokInterpreter()

    int tok=0,ntok=0,vID=0 ,vTyp=0

    tc=0

    While tc < nTokens

         start:

        gettok() : print "TOKEN:" + tokList[tc]

         tok = tkTyp : ntok = typList[tc+1]

         IF tok = tkFLOAT ' token is varNUM

            tc++

            While typList[tc] <> tkCOLON And typList[tc] <> tkEOL 'skip tokens to colon/eol

            tc++

            Wend

            print "TC-test" + str(tc)

            'goto start

         END IF

        IF tok = tkIDENT

           print "IDENT-TOKEN:" + tokList[tc] 

           print "tok:" + str(tok)

           print "varType:" + str(varType[tc])

           vID = varList[tc]  'get ID

           vTyp = varType[vID]

           ' vID = varList[tc] : vTyp = varType[vID] : print "varID: " + str(vID) + ":VarType:: " + str(vTyp) 

             If vTyp = tkFLOAT  ' numeric var

                 if ntok = tkEQUAL 

                    tc++  : print "TC:" + str(tc) ' skip "=" is assign

                    exec_expr()

                  end if 

              End if

         END IF

    Wend

End Sub

'===============================================================================​==================================

'-----------------------------------------------------

sub gettok()

tc++

token = tokList[tc] : tkTyp = typList[tc] 

'test

if tokList[tc+1] <> "" then return

end sub

'----------------------------------------------------

sub expr() as float

float v

If token = "-" 

 v = -(term())

else

 v = term()

end if 

while token = "+" or token = "-"

if token = "+": gettok() : v = v + term(): end if

if token = "-": gettok() : v = v - term(): end if

wend

return v

end sub

'---------------------------------------------------

sub term() as float

float v 

v = factor()

while token = "*" or token = "/"

if token = "*": gettok() : v = v * factor(): end if

if token = "/": gettok() : v = v / factor(): end if

wend

return v

end sub 

'-------------------------------------------------------

sub factor() as float

float v

if asc(token)>47  and asc(token)<58 'nums

v = val(token) 

gettok()

end if

if asc(token)=40 and asc(token)<>41 'match (...)

gettok() : v = expr() : gettok()

end if

return v

end sub

'execute-----------------------------------------------------

sub exec_expr

gettok()'start

float res = expr()

MsgBox "RESULT=" + str(res) , "EXEC_EXPR:"

end sub

***Aurel*** · 05-13-2020, 04:33 PM

test numeric and string expressions:
varStr a,b,c : varNum d,e,f
d=625 : e=25.1 : f = d/e
a= "aurel"
b= " micro(A)"
c=a+b

Code:

'micro(A) Interpreter - with recursive descent token evaluator

' by Aurel - 26.3.2019 - last test 12.5.2020

$ filename "microA_Interpreter.exe"                 'compiled to exe

include "RTL32.inc"

include "awinh037.inc"                              ' awinh GUI api function

include "microAT.inc"                               ' tokenizer include

#lookahead

int tc=0 , ierror=0                                 ' token count, interpreting  error

string token : int tkTyp                            ' define  token as STRING : tkType as INT

string DQ = chr(34)                                 ' DQ as double quote "

'*********************************************************************

'globals

INT win,x=0,y=0,w=400,h=300,wstyle = WS_MINMAXSIZE

INT button0,b0ID=100

NumberFormat 6,1,0,0,0,0

' global HDC and on screen functions...

INT hdc

'Interpreter Globals .........................................................................

string kwList[32]   'keyword list 

kwList[1] = "VARNUM" : kwList[2] = "VARSTR" : kwList[3] = "VARPTR" : kwList[4] = "IF" : kwList[5] = "ELSE" : kwList[6] = "ENDIF"

kwList[7] = "WHILE" : kwList[8] = "WEND" : kwList[9] = "FOR" : kwList[10] = "TO" : kwList[11] = "STEP" : kwList[12] = "NEXT"

kwList[13]="PRINT" : kwList[14]="STR" : kwList[15]="VAL"

'...............................................................................​...............

int tkSTRING = 32, tkFLOAT = 33 , tkPOINTER = 34 , tkIF = 35 , tkELSE = 36, tkENDIF = 37

int tkWHILE = 38, tkWEND = 39 , tkFOR = 40 , tkTO = 41 , tkSTEP = 42 , tkNEXT = 43

int tkPRINT = 44 , tkSTR = 45, tkVAL = 46

'Global Variable,ID etc array ................................................................

int varID = 0

int varList[1024] : int varType[1024] :string varName[1024]: string varStr[1024] : float varNum[1024] : int varPtr[1024]

int ifCounter=0, elseCounter=0, endifCounter=0, whileCounter=0,wendCounter=0 ,forCounter=0,nextCounter=0

' Open Window with message loop...

win = SetWindow("micro(A):",x,y,w,h,0,wstyle)'

'button0 = SetButton(win,180,4,80,26,"Close (X)",0x50001000,0x200,b0ID)

'*********************************************************************

'test 1 - load source code into (microAT.inc) Tokenizer / PASS1 /'test str expr

string code = "varStr a,b,c : varNum d,e,f"  + crlf +

              "d=625:e=25.1: f = d/e"        + crlf +

              "a=" + DQ +"aurel" + DQ        + crlf +

              "b=" + DQ +" micro(A)" + DQ    + crlf +           

              "c=a+b" + crlf

codeLen=len(code)

tn = run_tokenizer(code) 

MsgBox  str(tn) ,"Tokenizer Out"                     ' 1 means OK!

'---------------------------------------------------------------

' prescan for variables,commands....

'---------------------------------------------------------------

'if tokenization error=0 then OK!..preScan()/PASS2

int ps

If tokerr = 0 and tn = 1

   ps = preScan()   

Else

   MsgBox "END" ,"Program Exit!"

End if

'if ps = 1 then OK...........................

if ps = 1 

   MsgBox "PreScan:OK!" ,"Continue..."  

   tokInterpreter()                  ' run token-interpreter

Else

   MsgBox "END" ,"Program Exit!"

End if

'================================================================

Wait()  '/// message loop ///

'===============================================================================​============

Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback

SELECT hwnd

CASE win

Select wmsg

     CASE WM_PAINT

    CASE WM_CLOSE

    CloseWindow(win) 

    EndProgram

End Select

END SELECT

RETURN Default

END FUNCTION

'===============================================================================​============

Sub preScan() as int

'MsgBox "OK..." ," PASS 2"

int i , numOfTokens = nTokens ,lineNum=0 ,varID=0, vID, n ,vTyp    ' numofTokens as local/reset global nTokens

string vName : int match_name

    For i = 1 to numOfTokens

        IF typList[i]=tkEOL: tokList[i]="EOL": lineNum++ : END IF  'check EndOfLine

        IF typList[i] = tkIDENT

           If ucase(tokList[i]) = kwList[1]: typList[i] = tkFLOAT  'if varNUM ...........................

              if typList[i+1] <> tkIDENT 'check err

                 MsgBox "Missing variable after VARNUM! line: " + str(lineNum),"ERROR": return 0

            else

              i=i+1 ' next token

               While typList[i] <> tkCOLON And typList[i] <> tkEOL  'store num variable              -low case var name-

                  If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID : varName[varID] = lcase(tokList[i]) : varType[varID] = tkFLOAT :varNum[varID] = 0 

                    ' MsgBox "Variable name: " + tokList[i] + " VAR.TYPE: " + str(varType[varID]) , "TYPE"

                  End if

                i++

               Wend 

             end if

          End if  ' endOf varNUM..........................................................................​

          If ucase(tokList[i]) = kwList[2]: typList[i] = tkSTRING  'if varSTR ...........................

              if typList[i+1] <> tkIDENT 'check err

                 MsgBox "Missing variable after VARSTR! line: " + str(lineNum),"ERROR": return 0

            else

              i=i+1 ' next token

               While typList[i] <> tkCOLON And typList[i] <> tkEOL  'store str variable

                  If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID :: varName[varID] = lcase(tokList[i]): varType[varID] = tkSTRING: varStr[varID] = "" 

                     MsgBox "Variable name: " + tokList[i] ,"variable->STR"

                  End if

                i++

               Wend 

             end if

              End if  ' endOf varSTR.......................................

            If ucase(tokList[i]) = kwList[3]: typList[i] = tkPOINTER  'if varPTR ...........................

              if typList[i+1] <> tkIDENT 'check err

                 MsgBox "Missing variable after VARPTR! line: " + str(lineNum),"ERROR": return 0

            else

              i=i+1 ' next token

               While typList[i] <> tkCOLON And typList[i] <> tkEOL  'store ptr variable

                  If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID :: varName[varID] = lcase(tokList[i]): varType[varID] = tkPOINTER: varPtr[varID] = 0 

                     MsgBox "Variable name: " + tokList[i] ,"variable->PTR"

                  End if

                i++

               Wend 

             end if

          End if  ' endOf varPTR.......................................

          If ucase(tokList[i]) = kwList[4]  : typList[i] = tkIF : ifCounter++ : End If        'if token 'IF

          If ucase(tokList[i]) = kwList[5]  : typList[i] = tkELSE : elseCounter++ : End If    'if token 'ELSE

          If ucase(tokList[i]) = kwList[6]  : typList[i] = tkENDIF : endifCounter++ : End If  'if token 'ENDIF'

          If ucase(tokList[i]) = kwList[7]  : typList[i] = tkWHILE : whileCounter++ : End If  'if token 'WHILE

          If ucase(tokList[i]) = kwList[8]  : typList[i] = tkWEND : wendCounter++ : End If    'if token 'WEND

          If ucase(tokList[i]) = kwList[9]  : typList[i] = tkFOR : forCounter++ : End If      'if token 'FOR

          If ucase(tokList[i]) = kwList[10] : typList[i] = tkTO : End If                      'if token 'TO

          If ucase(tokList[i]) = kwList[11] : typList[i] = tkSTEP : End If                    'if token 'STEP

          If ucase(tokList[i]) = kwList[12] : typList[i] = tkNEXT : nextCounter++ : End If    'if token 'NEXT

          If ucase(tokList[i]) = kwList[13] : typList[i] = tkPRINT : End If                   'if token 'PRINT

          ELSE 

          'error

       END IF

        ' if variable is outside of declaration varNUM,varSTR,varPTR...

        ' search for varible name and return variable ID

       IF typList[i] = tkIDENT

               vName = tokList[i] : match_name=0

               'loop to find var name,id,typ

               For n = 1 to 1024

                    vID = varList[n]  : vTyp = varType[vID]  ' check ID and Type                                  

                    if vName = lcase(varName[n])             ' if var is in list

                       vID = n                               ' id is n

                       vTyp = varType[vID]                   ' check type

                       varList[i] = vID         ' set var list with ID from varName array-> tokList[i],typList[i],varList[i]=id

                       exit for       

                    end if                     

               Next n

               ' if var type is 0 then error

               if vTyp=0 : MsgBox "Variable ID not found! -{ " + vName +" }-Line: " + str(lineNum),"ERROR": return 0: end if        

       END IF

    Next i

return 1

End sub

'===============================================================================​==================================

Sub tokInterpreter()

    int tok=0,ntok=0,vID=0 ,vTyp=0

    float numRes : string strRes : int ptrRes

    tc=0

    While tc < nTokens

         start:

        gettok() : print "TOKEN:" + tokList[tc]

         tok = tkTyp : ntok = typList[tc+1]

         IF tok = tkFLOAT ' token is def varNUM...'skip tokens to colon/eol

            tc++ : While typList[tc] <> tkCOLON And typList[tc] <> tkEOL : tc++ : Wend

         END IF

        IF tok = tkSTRING ' token is def varSTR...'skip tokens to colon/eol

            tc++ : While typList[tc] <> tkCOLON And typList[tc] <> tkEOL : tc++ : Wend

         END IF

        IF tok = tkIDENT

           vID = varList[tc]  'get ID

           vTyp = varType[vID]

           ' vID = varList[tc] : vTyp = varType[vID] : print "varID: " + str(vID) + ":VarType:: " + str(vTyp) 

             If vTyp = tkFLOAT    ' numeric var

                 if ntok = tkEQUAL 

                    tc++            ' skip "=" is assign

                    numRes = exec_expr() : varNum[vID] = numRes ' store result in varNum[] list

                  end if 

              End if

             If vTyp = tkSTRING    ' string var

                 if ntok = tkEQUAL 

                    tc++            ' skip "=" is assign

                    strRes = exec_strExpr() : varStr[vID] = strRes ' store result in varStr[] list

                  end if 

              End if

            If vTyp = tkPOINTER    ' pointer/int var

                 if ntok = tkEQUAL 

                    tc++            ' skip "=" is assign

                    ptrRes = exec_expr() : varPtr[vID] = INT(ptrRes) ' store result in varStr[] list

                  end if 

              End if

         END IF

    Wend

End Sub

'===============================================================================​==================================

'-----------------------------------------------------

sub gettok()

tc++

token = tokList[tc] : tkTyp = typList[tc] 

'test

if tokList[tc+1] <> "" then return

end sub

'----------------------------------------------------

sub expr() as float

float v

If token = "-" 

 v = -(term())

else

 v = term()

end if 

while token = "+" or token = "-"

if token = "+": gettok() : v = v + term(): end if

if token = "-": gettok() : v = v - term(): end if

wend

return v

end sub

'---------------------------------------------------

sub term() as float

float v 

v = factor()

while token = "*" or token = "/"

if token = "*": gettok() : v = v * factor(): end if

if token = "/": gettok() : v = v / factor(): end if

wend

return v

end sub 

'-------------------------------------------------------

sub factor() as float

float v : int vID, vTyp

if asc(token)>47  and asc(token)<58 'nums

v = val(token) 

gettok()

end if

if asc(token)=40 and asc(token)<>41 'match (...)

gettok() : v = expr() : gettok()

end if

if tkTyp = tkIDENT

'gettok()

vID = varList[tc]  : vTyp = varType[vID] : print "token->"+ token +" var_ID:" + str(vID) + "_varType: " + str(vTyp)

IF vTyp = tkFLOAT : v = varNum[vID] : end if

 gettok()

end if

return v

end sub

'execute numeric expression----------------------------------------------

Sub exec_expr() as float

gettok()'start

float res = expr()

MsgBox "RESULT=" + str(res) , "EXEC_EXPR:"

TextOn (win,30,30, str(res))

Return res

End sub 

' execute string expression---------------------------------------------

Sub exec_strExpr() as string

gettok()'start

string res 

res = strExpr()

MsgBox "STR_RESULT=" + res , "EXEC_STR_EXPR:"

TextOn (win,30,60, res)

Return res

End sub

'----------------------------------------------------------------------

Sub strExpr() as string

string vs

if token <> "+"

vs = strFactor()

end if

while token = "+"

if token = "+": gettok() : vs = vs + strFactor(): end if

wend

return vs

End Sub

'---------------------------------------------------------------------

Sub strFactor() as string

string vs : int vID, vTyp

if tkTyp = tkIDENT

print "IDENT-STR:" + token

vID = varList[tc]  : vTyp = varType[vID] : print "token->"+ token +" var_ID:" + str(vID) + "_varType: " + str(vTyp)

IF vTyp = tkSTRING : vs = varStr[vID] : end if

 gettok()

end if

if tkTyp = tkQSTRING

print "STR-FACTOR:" + token

vs = token :  gettok()

end if

return vs

End Sub

'================================================================

'  SHOW EXPRESSION RESULT ON WINDOW 

'================================================================

SUB TextOn(wID as INT,tx as INT,ty as INT,txt as string)

hdc = GetDC(wID)

'draw text to screen DC

TextOut hdc,tx,ty,txt,Len(txt)

'blit screen DC to memDC

'BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB

***Aurel*** · 05-17-2020, 12:14 AM

Latest code ; 16.5.2020
print x,y,var
error checking

Code:

'micro(A) Interpreter - with recursive descent token evaluator

' by Aurel - 26.3.2019 - last test 12.5.2020

$ filename "microA_Interpreter.exe"                 'compiled to exe

include "RTL32.inc"

include "awinh037.inc"                              ' awinh GUI api function

include "microAT.inc"                               ' tokenizer include

#lookahead

int tc=0 , ierror=0                                 ' token count, interpreting  error

string token : int tkTyp                            ' define  token as STRING : tkType as INT

string DQ = chr(34)                                 ' DQ as double quote "

'*********************************************************************

'globals

INT win,x=0,y=0,w=400,h=300,wstyle = WS_MINMAXSIZE

INT button0,b0ID=100

NumberFormat 6,1,0,0,0,0

' global HDC and on screen functions...

INT hdc

'Interpreter Globals .........................................................................

string kwList[32]   'keyword list 

kwList[1] = "VARNUM" : kwList[2] = "VARSTR" : kwList[3] = "VARPTR" : kwList[4] = "IF" : kwList[5] = "ELSE" : kwList[6] = "ENDIF"

kwList[7] = "WHILE" : kwList[8] = "WEND" : kwList[9] = "FOR" : kwList[10] = "TO" : kwList[11] = "STEP" : kwList[12] = "NEXT"

kwList[13]="PRINT" : kwList[14]="STR" : kwList[15]="VAL"

'...............................................................................​...............

int tkSTRING = 32, tkFLOAT = 33 , tkPOINTER = 34 , tkIF = 35 , tkELSE = 36, tkENDIF = 37

int tkWHILE = 38, tkWEND = 39 , tkFOR = 40 , tkTO = 41 , tkSTEP = 42 , tkNEXT = 43

int tkPRINT = 44 , tkSTR = 45, tkVAL = 46

'Global Variable,ID etc array ................................................................

int varID = 0

int varList[1024] : int varType[1024] :string varName[1024]: string varStr[1024] : float varNum[1024] : int varPtr[1024]

int ifCounter=0, elseCounter=0, endifCounter=0, whileCounter=0,wendCounter=0 ,forCounter=0,nextCounter=0

' Open Window with message loop...

win = SetWindow("micro(A):",x,y,w,h,0,wstyle)'

'button0 = SetButton(win,180,4,80,26,"Close (X)",0x50001000,0x200,b0ID)

'*********************************************************************

'test 1 - load source code into (microAT.inc) Tokenizer / PASS1 /'test str expr

string code = "varStr a,b,c : varNum d,e,f"                + crlf +

              "d=625:e=25: f = d/e: print d,10,f "        + crlf +

              "a=" + DQ +"aurel" + DQ                      + crlf +

              "b=" + DQ +" micro(A)" + DQ                  + crlf +           

              "c=a+b" + crlf

codeLen=len(code)

tn = run_tokenizer(code) 

MsgBox  str(tn) ,"Tokenizer Out"                     ' 1 means OK!

'---------------------------------------------------------------

' prescan for variables,commands....

'---------------------------------------------------------------

'if tokenization error=0 then OK!..preScan()/PASS2

int ps

If tokerr = 0 and tn = 1

   ps = preScan()   

Else

   MsgBox "END" ,"Program Exit!"

End if

'if ps = 1 then OK...........................

if ps = 1 

   MsgBox "PreScan:OK!" ,"Continue..."  

   tokInterpreter()                  ' run token-interpreter

Else

   MsgBox "END" ,"Program Exit!"

End if

'================================================================

Wait()  '/// message loop ///

'===============================================================================​============

Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback

SELECT hwnd

CASE win

Select wmsg

     CASE WM_PAINT

    CASE WM_CLOSE

    CloseWindow(win) 

    EndProgram

End Select

END SELECT

RETURN Default

END FUNCTION

'===============================================================================​============

Sub preScan() as int

'MsgBox "OK..." ," PASS 2"

int i , numOfTokens = nTokens ,lineNum=0 ,varID=0, vID, n ,vTyp    ' numofTokens as local/reset global nTokens

string vName : int match_name

    For i = 1 to numOfTokens

        IF typList[i]=tkEOL: tokList[i]="EOL": lineNum++ : END IF  'check EndOfLine

        IF typList[i] = tkIDENT

           If ucase(tokList[i]) = kwList[1]: typList[i] = tkFLOAT  'if varNUM ...........................

              if typList[i+1] <> tkIDENT 'check err

                 MsgBox "Missing variable after VARNUM! line: " + str(lineNum),"ERROR": return 0

            else

              i=i+1 ' next token

               While typList[i] <> tkCOLON And typList[i] <> tkEOL  'store num variable              -low case var name-

                  If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID : varName[varID] = lcase(tokList[i]) : varType[varID] = tkFLOAT :varNum[varID] = 0 

                    ' MsgBox "Variable name: " + tokList[i] + " VAR.TYPE: " + str(varType[varID]) , "TYPE"

                  End if

                i++

               Wend 

             end if

          End if  ' endOf varNUM..........................................................................​

          If ucase(tokList[i]) = kwList[2]: typList[i] = tkSTRING  'if varSTR ...........................

              if typList[i+1] <> tkIDENT 'check err

                 MsgBox "Missing variable after VARSTR! line: " + str(lineNum),"ERROR": return 0

            else

              i=i+1 ' next token

               While typList[i] <> tkCOLON And typList[i] <> tkEOL  'store str variable

                  If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID :: varName[varID] = lcase(tokList[i]): varType[varID] = tkSTRING: varStr[varID] = "" 

                     MsgBox "Variable name: " + tokList[i] ,"variable->STR"

                  End if

                i++

               Wend 

             end if

              End if  ' endOf varSTR.......................................

            If ucase(tokList[i]) = kwList[3]: typList[i] = tkPOINTER  'if varPTR ...........................

              if typList[i+1] <> tkIDENT 'check err

                 MsgBox "Missing variable after VARPTR! line: " + str(lineNum),"ERROR": return 0

            else

              i=i+1 ' next token

               While typList[i] <> tkCOLON And typList[i] <> tkEOL  'store ptr variable

                  If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID :: varName[varID] = lcase(tokList[i]): varType[varID] = tkPOINTER: varPtr[varID] = 0 

                     MsgBox "Variable name: " + tokList[i] ,"variable->PTR"

                  End if

                i++

               Wend 

             end if

          End if  ' endOf varPTR.......................................

          If ucase(tokList[i]) = kwList[4]  : typList[i] = tkIF : ifCounter++ : End If        'if token 'IF

          If ucase(tokList[i]) = kwList[5]  : typList[i] = tkELSE : elseCounter++ : End If    'if token 'ELSE

          If ucase(tokList[i]) = kwList[6]  : typList[i] = tkENDIF : endifCounter++ : End If  'if token 'ENDIF'

          If ucase(tokList[i]) = kwList[7]  : typList[i] = tkWHILE : whileCounter++ : End If  'if token 'WHILE

          If ucase(tokList[i]) = kwList[8]  : typList[i] = tkWEND : wendCounter++ : End If    'if token 'WEND

          If ucase(tokList[i]) = kwList[9]  : typList[i] = tkFOR : forCounter++ : End If      'if token 'FOR

          If ucase(tokList[i]) = kwList[10] : typList[i] = tkTO : End If                      'if token 'TO

          If ucase(tokList[i]) = kwList[11] : typList[i] = tkSTEP : End If                    'if token 'STEP

          If ucase(tokList[i]) = kwList[12] : typList[i] = tkNEXT : nextCounter++ : End If    'if token 'NEXT

          If ucase(tokList[i]) = kwList[13] : typList[i] = tkPRINT : End If                   'if token 'PRINT

          ELSE 

          'error

       END IF

        ' if variable is outside of declaration varNUM,varSTR,varPTR...

        ' search for varible name and return variable ID

       IF typList[i] = tkIDENT

               vName = tokList[i] : match_name=0

               'loop to find var name,id,typ

               For n = 1 to 1024

                    vID = varList[n]  : vTyp = varType[vID]  ' check ID and Type                                  

                    if vName = lcase(varName[n])             ' if var is in list

                       vID = n                               ' id is n

                       vTyp = varType[vID]                   ' check type

                       varList[i] = vID         ' set var list with ID from varName array-> tokList[i],typList[i],varList[i]=id

                       exit for       

                    end if                     

               Next n

               ' if var type is 0 then error

               if vTyp=0 : MsgBox "Variable ID not found! -{ " + vName +" }-Line: " + str(lineNum),"ERROR": return 0: end if        

       END IF

       'check PRINT x(+1),(+2)y(+3),(+4)var(+5)

       If typList[i] = tkPRINT

             'check next token as var/num(arg1)

          If typList[i+1] <> tkIDENT and typList[i+1] <> tkNUMBER

            MsgBox "Argument Wrong Type! -{ " + tokList[i+1] +" }-Line: " + str(lineNum),"ERROR": return 0

          End if

          'if typList[i+1] = tkNUMBER: print "tkNUMBER": endif 

          ' if typList[i+1] = tkIDENT: print "tkIDENT": endif

          If typList[i+2] <> tkCOMMA  '2

            MsgBox "Argument Separator Error! -{ " + tokList[i+2] +" }-Line: " + str(lineNum),"ERROR": return 0

          End if

           If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER '3

            MsgBox "Argument Wrong Type! -{ " + tokList[i+3] +" }-Line: " + str(lineNum),"ERROR": return 0

          End if

         If typList[i+4] <> tkCOMMA '4

            MsgBox "Argument Separator Error! -{ " + tokList[i+4] +" }-Line: " + str(lineNum),"ERROR": return 0

          End if

          If typList[i+5] <> tkIDENT and typList[i+3] <> tkNUMBER '5

            MsgBox "Argument Wrong Type! -{ " + tokList[i+5] +" }-Line: " + str(lineNum),"ERROR": return 0

          End if

      End if

    Next i

return 1

End sub

'===============================================================================​==================================

Sub tokInterpreter()

    int tok=0,ntok=0,vID=0 ,vTyp=0

    float numRes : string strRes : int ptrRes

    tc=0

    While tc < nTokens

         start:

        gettok() : print "TOKEN:" + tokList[tc]

         tok = tkTyp : ntok = typList[tc+1]

         IF tok = tkFLOAT ' token is def varNUM...'skip tokens to colon/eol

            tc++ : While typList[tc] <> tkCOLON And typList[tc] <> tkEOL : tc++ : Wend

         END IF

        IF tok = tkSTRING ' token is def varSTR...'skip tokens to colon/eol

            tc++ : While typList[tc] <> tkCOLON And typList[tc] <> tkEOL : tc++ : Wend

         END IF

        IF tok = tkIDENT

           vID = varList[tc]  'get ID

           vTyp = varType[vID]

           ' vID = varList[tc] : vTyp = varType[vID] : print "varID: " + str(vID) + ":VarType:: " + str(vTyp) 

             If vTyp = tkFLOAT    ' numeric var

                 if ntok = tkEQUAL 

                    tc++            ' skip "=" is assign

                    numRes = exec_expr() : varNum[vID] = numRes ' store result in varNum[] list

                  end if 

              End if

             If vTyp = tkSTRING    ' string var

                 if ntok = tkEQUAL 

                    tc++            ' skip "=" is assign

                    strRes = exec_strExpr() : varStr[vID] = strRes ' store result in varStr[] list

                  end if 

              End if

            If vTyp = tkPOINTER    ' pointer/int var

                 if ntok = tkEQUAL 

                    tc++            ' skip "=" is assign

                    ptrRes = exec_expr() : varPtr[vID] = INT(ptrRes) ' store result in varStr[] list

                  end if 

              End if

         END IF

    Wend

End Sub

'===============================================================================​==================================

'-----------------------------------------------------

sub gettok()

tc++

token = tokList[tc] : tkTyp = typList[tc] 

'test

if tokList[tc+1] <> "" then return

end sub

'----------------------------------------------------

sub expr() as float

float v

If token = "-" 

 v = -(term())

else

 v = term()

end if 

while token = "+" or token = "-"

if token = "+": gettok() : v = v + term(): end if

if token = "-": gettok() : v = v - term(): end if

wend

return v

end sub

'---------------------------------------------------

sub term() as float

float v 

v = factor()

while token = "*" or token = "/"

if token = "*": gettok() : v = v * factor(): end if

if token = "/": gettok() : v = v / factor(): end if

wend

return v

end sub 

'-------------------------------------------------------

sub factor() as float

float v : int vID, vTyp

if asc(token)>47  and asc(token)<58 'nums

v = val(token) 

gettok()

end if

if asc(token)=40 and asc(token)<>41 'match (...)

gettok() : v = expr() : gettok()

end if

if tkTyp = tkIDENT

'gettok()

vID = varList[tc]  : vTyp = varType[vID] : print "token->"+ token +" var_ID:" + str(vID) + "_varType: " + str(vTyp)

IF vTyp = tkFLOAT : v = varNum[vID] : end if

 gettok()

end if

return v

end sub

'execute numeric expression----------------------------------------------

Sub exec_expr() as float

gettok()'start

float res = expr()

MsgBox "RESULT=" + str(res) , "EXEC_EXPR:"

TextOn (win,30,30, str(res))

Return res

End sub 

' execute string expression---------------------------------------------

Sub exec_strExpr() as string

gettok()'start

string res 

res = strExpr()

MsgBox "STR_RESULT=" + res , "EXEC_STR_EXPR:"

TextOn (win,30,60, res)

Return res

End sub

'----------------------------------------------------------------------

Sub strExpr() as string

string vs

if token <> "+"

vs = strFactor()

end if

while token = "+"

if token = "+": gettok() : vs = vs + strFactor(): end if

wend

return vs

End Sub

'---------------------------------------------------------------------

Sub strFactor() as string

string vs : int vID, vTyp

if tkTyp = tkIDENT

print "IDENT-STR:" + token

vID = varList[tc]  : vTyp = varType[vID] : print "token->"+ token +" var_ID:" + str(vID) + "_varType: " + str(vTyp)

IF vTyp = tkSTRING : vs = varStr[vID] : end if

 gettok()

end if

if tkTyp = tkQSTRING

print "STR-FACTOR:" + token

vs = token :  gettok()

end if

return vs

End Sub

'================================================================

'  SHOW EXPRESSION RESULT ON WINDOW 

'================================================================

SUB TextOn(wID as INT,tx as INT,ty as INT,txt as string)

hdc = GetDC(wID)

'draw text to screen DC

TextOut hdc,tx,ty,txt,Len(txt)

'blit screen DC to memDC

'BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB

***Aurel*** · 05-01-2022, 05:31 PM

[code]'micro(A) Interpreter - with recursive descent token evaluator
'testing version
' by Aurel - last update: 7.4.2022 v06
$ filename "microA07.exe" 'compiled to exe
include "RTL32.inc"
include "awinh037.inc" ' awinh GUI api function
include "microAT.inc" ' tokenizer include
#lookahead
int tc=0 , ierror=0 ' token count, interpreting error
string token : int tkTyp ' define token as STRING : tkType as INT
string DQ = chr(34) ' DQ as double quote "
sys sys_mode=3
Declare Function SetPixelV Lib "gdi32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Declare Function SetStretchBltMode Lib "gdi32.dll" (ByVal hdc As sys, ByVal nStretchMode As Long) As Long
Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As sys, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
'*********************************************************************
'globals -> window size
INT win,x=0,y=0, w = 800, h = 600 ,wstyle = WS_MINMAXSIZE
INT button0,b0ID=100
SYS fseed = 0x12345678 ' seed number
NumberFormat 6,1,0,0,0,0
' global HDC and on screen functions.........................................................
PAINTSTRUCT ps
INT hdc, hdcMem, hdcImg, hbmMem, ww, wh, oldBmp, oldBrush, oldPen, oldFont, fColor,bColor ,selBmp, hImg
INT np, op, nB, oB ,cix ,ciy, cra
int msgQuit=0
'Interpreter Globals .........................................................................
string kwList[64] 'keyword list
kwList[1] ="VAR" : kwList[2] = "STR" : kwList[3] = "PTR" : kwList[4] = "IF" : kwList[5] = "ELSE" : kwList[6] = "ENDIF"
kwList[7] ="WHILE" : kwList[8] = "WEND" : kwList[9] = "FOR" : kwList[10] = "TO" : kwList[11] = "STEP" : kwList[12] = "NEXT"
kwList[13]="PRINT" : kwList[14]="STRS" : kwList[15]="VAL" : kwList[16]="LABEL" : kwList[17]="GOTO"
kwList[18]="WCOLOR" : kwList[19]="FCOLOR" : kwList[20]="BCOLOR" : kwList[21]="PSET": kwList[22]="CIRCLE" : kwList[23]="RECT"
kwList[24]="LINE" : kwList[25]="RND" : kwList[26]="SIN" : kwList[27]="COS": kwList[28]="TAN" :kwList[29]="SWAP" :kwList[30]="RAND"
kwList[31]="ABS" : kwList[32]="ATAN" : kwList[33]="SQR" : kwList[34]="LOG" : kwList[35]="ROUND" : kwList[36]="INT"
kwList[37]="FUNC" : kwList[38]="ENDFN" : kwList[39]="FRAC" : kwList[40]="WINMSG" : kwList[41]="ENDWM"
kwList[42]="MOUSEX" : kwList[43]="MOUSEY" : kwList[44]="HWPARAM" : kwList[45]="HLPARAM" '46,47,48,49,50
kwList[51]="LOADIMG" :kwList[52]="SHOWIMG" : kwList[53]="SHOWIMGT"
kwList[60]="MSTR" :kwList[61]="LSTR" : kwList[62]="RSTR"

'............................... ...............................................................
int tkSTRING = 32, tkFLOAT = 33 , tkPOINTER = 34 , tkIF = 35 , tkELSE = 36, tkENDIF = 37
int tkWHILE = 38, tkWEND = 39 , tkFOR = 40 , tkTO = 41 , tkSTEP = 42 , tkNEXT = 43
int tkPRINT = 44 , tkSTRS = 45, tkVAL = 46, tkLABEL = 47, tkGOTO = 48 ,tkPSET = 49, tkRND = 50, tkWCOLOR = 51
int tkSIN = 52, tkCOS = 53, tkTAN = 54, tkFCOLOR = 55, tkBCOLOR = 56 , tkCIRCLE = 57, tkRECT=58, tkLINE = 59,tkSWAP=60
int tkRAND = 61 ,tkABS = 62, tkATAN = 63, tkSQR = 64, tkLOG = 65, tkROUND = 66, tkINT = 67
int tkFUNC = 68, tkENDFN = 69 ,tkFRAC = 70, tkWINMSG = 71,tkENDWM = 72, tkMOUSEX = 73, tkMOUSEY = 74
int tkHWPARAM = 75, tkHLPARAM = 76 ' 77,78,79,90
int tkLOADIMG = 91,tkSHOWIMG = 92,tkSHOWIMGT = 93
int tkMIDSTR = 100, tkLEFTSTR = 101 , tkRIGHTSTR = 102

'Global Variable,Function ................................................................
int varID = 0, fnID=0
int varList[1024] : int varType[1024] :string varName[1024]: string varStr[1024] : float varNum[1024] : int varPtr[1024]
int fnList[1024] : int fnType[1024] :string fnName[1024] 'functions

'Arrays ..for now 8 for each type ........................................................................
int arrayID = 0 ' hold array identifier
int arrayList[1024] ' hold arrayID
string arrayName[1024] ' hold array name
int arrayType[1024] ' array type 1->var , 2->str ,3-ptr
float arrayNum[1024] ' testing array float
int arraySize[1024] ' hold array size upper bound
'int arrayIndex[1024] 'array Index/element -> hold array index/element

float farr01[4096], farr02[4096], farr03[4096], farr04[4096], farr05[4096], farr06[4096], farr07[4096], farr08[4096]

string sarr01[4096],sarr02[4096],sarr03[4096],sarr04[4096],sarr05[4096],sarr06[4096],sarr07[4096],sarr08[4096]

int parr01[4096],parr02[4096],parr03[4096],parr04[4096],parr05[4096],parr06[4096],parr07[4096],parr08[4096]
'........................................................................................................
int ifCounter=0, endifCounter=0, whileCounter=0,wendCounter=0 ,forCounter=0,nextCounter=0
int prX,prY,prZ,piX,piY,piZ,piQ ,backBlue,backGreen,backRed, winBlue, winGreen, winRed
int frontRed,frontGreen,frontBlue, lineX1,lineY1,lineX2,lineY2
string prStr ' for print
int vYES=1, vNO = 0 ' for if
int hMouseX,hMouseY ' for mouse pointer coordinate
int hWParam,hLParam ' for wparam, lparam handlers
'stacks label,while,for...................................................................
int labelStack[1024] , labelCounter=0 : string labelName[1024] : int gotoID[1024]
int whileStack[1024] , whileCounter=0 , whileID[1024]
int fnStack[1024] , fnCounter=0, endFnCounter=0 ,wMsgCounter=0,endWMsgCounter=0
'images id
int imgID[1024], imgHDC[64]
' win messge token positions.............................................................
int pos_wmMouseMove , pos_wmKeyDown , pos_wmLeftBDown, pos_wmTimer

' Open Window with message loop ======================================================
win = SetWindow("micro(A)_07:", x , y , w , h , 0 , wstyle)
InitDraw(win) : 'hdcImg = CreateCompatibleDC(0)
WindowFont( 16, 8, 0, "Consolas")
Randomize()
'exe name

string fname = GetCommandLine ()
'fName = chr(34) + fname + chr(34)
'MsgBox fname , "CommandLine:"
IF fname<>""
'LoadFromFile
STRING args,src,tmp
INT qPos,qPos2,dot
'tmp = Trim(fname)
dot = instr(1,fname,".")
'print "DOT:" + str(dot) '64 .exe"

' remove the executable information
tmp = mid(fname,dot+5, 254)
'print "TEMP:" + tmp
' get quote position
qPos = instr(2,tmp, chr(34))
'print "DQ1:" + str(qPos)
qPos2 = instr(qPos+1,tmp, chr(34))
'print "DQ2:" + str(qPos2)
'print str(qpos)
args = Mid(tmp,qPos+1,qPos2-3)
src = Trim(args)
'print "SRC:" + src

If len(src) < 1
args="No Source"
'info=args : IF LEN(info)=0 then info = "No Source"
End if
'print args...if is empty then compiler trow F ???
'SendMessage edit1,WM_SETTEXT,0,strptr args

code = GetFile src
END IF

codeLen=len(code)
tn = run_tokenizer(code)
'MsgBox str(tn) ,"Tokenizer Out" ' 1 means OK!
'---------------------------------------------------------------
' prescan for variables,commands....
'---------------------------------------------------------------
'if tokenization error=0 then OK!..preScan()/PASS2
int pscan=0
If tokerr = 0 and tn = 1
pscan = preScan()
Else
MsgBox "END" ,"Program Exit!"
ExitProcess 0
End if

'if ps = 1 then OK...........................
if pscan = 1
'MsgBox "PreScan:OK!" ,"Continue..."
tokInterpreter() ' run token-interpreter
Else
MsgBox "END" ,"Program Exit!"
End if

ExitProgram:

'================================================================
Wait() '/// message loop ///
'================================================================
Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback
SELECT hwnd
CASE win
Select wmsg

CASE WM_PAINT
'paintstruct ps
BeginPaint win,ps
BitBlt(hDC, 0, 0, ww, wh, hdcMem, 0, 0, SRCCOPY)
'InvalidateRect(win, 0, 0)
EndPaint win,ps

'CASE WM_ERASEBKGND
' return 1
'processing windows messages by Interpreter..................................................
CASE WM_MOUSEMOVE
hMouseX = LoWord(lParam)
hMouseY = HiWord(lParam)
'call block winMsg
if pos_wmMouseMove > 0
tc = pos_wmMouseMove : tokInterpreter()
end if
'keybord event...............................................................................
CASE WM_KEYDOWN
hWParam = wParam
'call block winMsg
if pos_wmKeyDown > 0
tc = pos_wmKeyDown : tokInterpreter()
tc=0
end if
'............................................................................................
CASE WM_TIMER
'call block winMsg
if pos_wmTimer > 0
tc = pos_wmTimer : tokInterpreter()
tc=0
end if
'............................................................................................

CASE WM_CLOSE
CloseWindow(win)
msgQuit=1
EndProgram()

End Select
END SELECT
RETURN Default
END FUNCTION

'===========================================================================================

Sub preScan() as int
'MsgBox "OK..." ," PASS 2"
int i,f, numOfTokens = nTokens ,lineNum=1 ,varID=0, vID, n ,vTyp ,fID ' numofTokens as local/reset global nTokens
string vName : int match_name, wm_Name : string gotoName : string funName, msgName, tbuff
whileCounter=0 :wendCounter=0: fnCounter=0 :endFnCounter=0: fnID =0 : ifCounter=0 : endifCounter=0

'record keywords from token list ...........................................
For i = 1 to numOfTokens
If ucase(tokList[i]) = kwList[4] : typList[i] = tkIF : ifCounter++ : End If
If ucase(tokList[i]) = kwList[5] : typList[i] = tkELSE : End If
If ucase(tokList[i]) = kwList[6] : typList[i] = tkENDIF : endifCounter++ : End If
If ucase(tokList[i]) = kwList[7] : typList[i] = tkWHILE : whileCounter++ : End If
If ucase(tokList[i]) = kwList[8] : typList[i] = tkWEND : wendCounter++ : End If
If ucase(tokList[i]) = kwList[9] : typList[i] = tkFOR : forCounter++ : End If
If ucase(tokList[i]) = kwList[10] : typList[i] = tkTO : End If
If ucase(tokList[i]) = kwList[11] : typList[i] = tkSTEP : End If
If ucase(tokList[i]) = kwList[12] : typList[i] = tkNEXT : nextCounter++ : End If
If ucase(tokList[i]) = kwList[13] : typList[i] = tkPRINT : End If
If ucase(tokList[i]) = kwList[14] : typList[i] = tkSTRS : End If
If ucase(tokList[i]) = kwList[15] : typList[i] = tkVAL : End If

If ucase(tokList[i]) = kwList[16] : typList[i] = tkLABEL : End If
If ucase(tokList[i]) = kwList[17] : typList[i] = tkGOTO : End If
If ucase(tokList[i]) = kwList[18] : typList[i] = tkWCOLOR : End If
If ucase(tokList[i]) = kwList[19] : typList[i] = tkFCOLOR : End If
If ucase(tokList[i]) = kwList[20] : typList[i] = tkBCOLOR : End If
If ucase(tokList[i]) = kwList[21] : typList[i] = tkPSET : End If
If ucase(tokList[i]) = kwList[22] : typList[i] = tkCIRCLE : End If
If ucase(tokList[i]) = kwList[23] : typList[i] = tkRECT : End If
If ucase(tokList[i]) = kwList[24] : typList[i] = tkLINE : End If
If ucase(tokList[i]) = kwList[25] : typList[i] = tkRND : End If
If ucase(tokList[i]) = kwList[26] : typList[i] = tkSIN : End If
If ucase(tokList[i]) = kwList[27] : typList[i] = tkCOS : End If
If ucase(tokList[i]) = kwList[28] : typList[i] = tkTAN : End If
If ucase(tokList[i]) = kwList[29] : typList[i] = tkSWAP : End If
If ucase(tokList[i]) = kwList[30] : typList[i] = tkRAND : End If
If ucase(tokList[i]) = kwList[31] : typList[i] = tkABS : End If
If ucase(tokList[i]) = kwList[32] : typList[i] = tkATAN : End If
If ucase(tokList[i]) = kwList[33] : typList[i] = tkSQR : End If
If ucase(tokList[i]) = kwList[34] : typList[i] = tkLOG : End If
If ucase(tokList[i]) = kwList[35] : typList[i] = tkROUND : End If
If ucase(tokList[i]) = kwList[36] : typList[i] = tkINT : End If
If ucase(tokList[i]) = kwList[37] : typList[i] = tkFUNC : fnCounter++ : End If
If ucase(tokList[i]) = kwList[38] : typList[i] = tkENDFN : endFnCounter++ : End If
If ucase(tokList[i]) = kwList[39] : typList[i] = tkFRAC : End If
If ucase(tokList[i]) = kwList[40] : typList[i] = tkWINMSG : wMsgCounter++ : End If
If ucase(tokList[i]) = kwList[41] : typList[i] = tkENDWM : endWMsgCounter++ : End If
If ucase(tokList[i]) = kwList[42] : typList[i] = tkMOUSEX : End If
If ucase(tokList[i]) = kwList[43] : typList[i] = tkMOUSEY : End If
If ucase(tokList[i]) = kwList[44] : typList[i] = tkHWPARAM : End If
If ucase(tokList[i]) = kwList[45] : typList[i] = tkHLPARAM : End If

If ucase(tokList[i]) = kwList[51] : typList[i] = tkLOADIMG : End If
If ucase(tokList[i]) = kwList[52] : typList[i] = tkSHOWIMG : End If
If ucase(tokList[i]) = kwList[53] : typList[i] = tkSHOWIMGT : End If

If ucase(tokList[i]) = kwList[60] : typList[i] = tkMIDSTR : End If
If ucase(tokList[i]) = kwList[61] : typList[i] = tkLEFTSTR : End If
If ucase(tokList[i]) = kwList[62] : typList[i] = tkRIGHTSTR : End If

Next i
i=0
'search for labels in code and if exist then record them.....................
For n = 1 to numOfTokens
IF typList[n] = tkLABEL
If typList[n+1] <> tkIDENT
MsgBox "Label witout name! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~LABEL": return 0
End if
If typList[n+1] = tkIDENT
labelCounter++ ': print "Label_Count:" + str(labelCounter) 'label counter = tok pos
labelName[n+1] = tokList[n+1] 'set labelName [index] as token pos with label name
'print "TOKEN NAME:" + tokList[n+1]
End if
END IF
Next n
n=0
'
'search for function in code and if exist then record them.....................
'example func myFunc ( )
For n = 1 to numOfTokens
IF typList[n] = tkFUNC
If typList[n+1] <> tkIDENT
MsgBox "Function witout name! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~FUNC": return 0
End if
' null func -> subroutine as -> FUNC myFunc<-1 (<-2 )<-3
If typList[n+1] = tkIDENT and typList[n+2] = tkLPAREN and typList[n+3] = tkRPAREN
'fnCounter++ ': print "Function_Count:" + str(fnCounter) 'func counter = tok pos
fnName[n+1] = lcase(tokList[n+1]) 'set (LCASE)funcName [index] as token pos with function name
fnID = n+1 : fnList[n+1] = fnID : ' fnlist[index] hold function token position
'print "PASS2:FUNC ID:" + str( fnList[fnID] ) ' show fnID value -> func pos
End if

END IF
Next n
n=0
'----------------------------------------------------------------------------
'variables,arrays...
For i = 1 to numOfTokens

IF typList[i]=tkEOL: tokList[i]="EOL": lineNum++ : END IF 'check EndOfLine

IF typList[i] = tkIDENT
If ucase(tokList[i]) = kwList[1]: typList[i] = tkFLOAT 'if varNUM def var .................
if typList[i+1] <> tkIDENT 'check err
MsgBox "Missing variable after VAR! line: " + str(lineNum),"ERROR": return 0
else
i=i+1 ' next token
While typList[i] <> tkCOLON And typList[i] <> tkEOL 'store num variable -low case var name-
If typList[i] = tkIDENT and typList[i+1] <> tkLBRACKET
varID = varID + 1 : varList[i] = varID : varName[varID] = lcase(tokList[i]) : varType[varID] = tkFLOAT :varNum[varID] = 0
'MsgBox "Variable name: " + tokList[i] + " VAR.TYPE: " + str(varType[varID]) , "TYPE"
End if
'check if is array []
If typList[i] = tkIDENT and typList[i+1] = tkLBRACKET
'set array ID
arrayID = arrayID + 1 : arrayList[i] = arrayID : arrayName[arrayID] = lcase(tokList[i]): arrayType[arrayID] = tkFLOAT
arraySize[arrayID] = val(tokList[i+2])
'tbuff ="Test Array:" + crlf
'tbuff = tbuff + "ARRAY NAME: " + tokList[i] + crlf
'tbuff = tbuff + "ARRAY_ID: " + str(arrayList[i]) + crlf
'tbuff = tbuff + "ARRAY_TYPE: " + str(arrayType[arrayID]) + crlf
'tbuff = tbuff + "ARRAY_SIZE:" + str(arraySize[arrayID]) + crlf
'MsgBox tbuff,"ARRAY"

End if

i++
Wend
end if

End if ' endOf varNUM..........................................................................
If ucase(tokList[i]) = kwList[2]: typList[i] = tkSTRING 'if varSTR def str .....................
if typList[i+1] <> tkIDENT 'check err
MsgBox "Missing variable after STR! line: " + str(lineNum),"ERROR": return 0
else
i=i+1 ' next token
While typList[i] <> tkCOLON And typList[i] <> tkEOL 'store str variable
If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID : varName[varID] = lcase(tokList[i]): varType[varID] = tkSTRING: varStr[varID] = ""
'MsgBox "Variable name: " + tokList[i] ,"variable->STR"
End if
i++
Wend
end if
End if ' endOf varSTR.......................................

If ucase(tokList[i]) = kwList[3]: typList[i] = tkPOINTER 'if varPTR def ptr....................
if typList[i+1] <> tkIDENT 'check err
MsgBox "Missing variable after PTR! line: " + str(lineNum),"ERROR": return 0
else
i=i+1 ' next token
While typList[i] <> tkCOLON And typList[i] <> tkEOL 'store ptr variable
If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID : varName[varID] = lcase(tokList[i]): varType[varID] = tkPOINTER: varPtr[varID] = 0
'MsgBox "Variable name: " + tokList[i] ,"variable->PTR"
End if
i++
Wend
end if
End if ' endOf varPTR.......................................

ELSE
'error
END IF
' VARIABLE is outside of declaration varNUM,varSTR,varPTR...
' search for varible name and return variable ID
IF typList[i] = tkIDENT and typList[i-1] <> tkLABEL and typList[i-1] <> tkGOTO and typList[i-1] <> tkFUNC
if typList[i+1] <> tkLPAREN And typList[i+1] <> tkLBRACKET
vName = tokList[i] : match_name=0: vTyp=0
'loop to find variable name,id,typ
For n = 1 to 1024
vID = varList[n] : vTyp = varType[vID] ' check ID and Type
if lcase(vName) = varName[n] ' if var is in list
vID = n ' id is n
vTyp = varType[vID] ' check type
varList[i] = vID ' set var list with ID from varName array-> tokList[i],typList[i],varList[i]=id
exit for
end if
Next n

' if var type is 0 then error
if vTyp=0 : MsgBox "Variable ID not found! -{ " + vName +" }-Line: " + str(lineNum+1),"ERROR": return 0: end if
end if
END IF
' ARRAY is outside of declaration var[],str[],ptr[]..
' search for array name and return array ID
IF typList[i] = tkIDENT and typList[i-1] <> tkLABEL and typList[i-1] <> tkGOTO and typList[i-1] <> tkFUNC
if typList[i+1] = tkLBRACKET
' print "ARRAY is outside of declaration: " + tokList[i]
vName = tokList[i] : match_name=0 : vTyp=0
'loop to find array name,id,typ
For n = 1 to 1024
vID = arrayList[n] : vTyp = arrayType[vID] ' check ID and Type
if lcase(vName) = arrayName[n] ' if array is in list
vID = n ' id is n
vTyp = arrayType[vID] ' check type
arrayList[i] = vID ' set array list with ID from arrayName array-> tokList[i],typList[i],varList[i]=id
exit for
end if
Next n

' if array type is 0 then error
if vTyp=0 : MsgBox "Array ID not found! -{ " + vName +" }-Line: " + str(lineNum+1),"ERROR": return 0: end if
end if
END IF
' FUNCTION name is outside of declaration and continue with LParen & RParen like myVar() then is FUNCTION call
' search for function name and return function ID
IF typList[i] = tkIDENT and typList[i-1] <> tkLABEL and typList[i-1] <> tkGOTO and typList[i-1] <> tkFUNC ' myfn , ( , )
match_name = 1
if typList[i+1] = tkLPAREN and typList[i+2] <> tkIDENT
funName = tokList[i] : match_name=0
'loop to find func name,id,typ
For n = 1 to 1024
fID = fnList[n] ': vTyp = varType[vID] ' check ID and Type
if lcase(funName) = fnName[n] ' if func is in list
fID = n ' id is n
'vTyp = varType[vID] ' check type
fnList[i] = fID ' set var list with ID from fnName
match_name=1 :' print "Function name found: " + funName + " fnID/pos-> " + str(fID)
exit for
end if
Next n

' if func name not found then error
if match_name <> 1 : MsgBox "Function not found! -{ " + funName +" }-Line: " + str(lineNum),"FN_ERROR": return 0: end if
end if
END IF

'check WINMSG -> winMsg msgName -> winMSG ptr<INT>(wmMouseMove).......................................................
IF typList[i] = tkWINMSG
'check next token as ptr/num(arg1)
If typList[i+1] <> tkIDENT
MsgBox "Invalid Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~WIN_MSG": return 0
End if

If ucase(tokList[i+1]) = "WMMOUSEMOVE" :wm_Name=1 : pos_wmMouseMove = i+1 : End If 'set msg position
If ucase(tokList[i+1]) = "WMKEYDOWN" :wm_Name=1 : pos_wmKeyDown = i+1 : End If
If ucase(tokList[i+1]) = "WMTIMER" :wm_Name=1 : pos_wmTimer = i+1 : End If

' if msg name not found then error
msgName = tokList[i+1]
if wm_name <> 1 : MsgBox "Message not valid! -{ " + msgName +" }-Line: " + str(lineNum),"ERROR": return 0: end if
END IF

'check MOUSEX var, MOUSEY var-----------------------------------------------------------------------------------------
IF typList[i] = tkMOUSEX
If typList[i+1] <> tkIDENT
MsgBox "Invalid Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~MOUSEX": return 0
End if
END IF
IF typList[i] = tkMOUSEY
If typList[i+1] <> tkIDENT
MsgBox "Invalid Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~MOUSEY": return 0
End if
END IF

'check WPARAM var, LPARAM var-----------------------------------------------------------------------------------------
IF typList[i] = tkHWPARAM
If typList[i+1] <> tkIDENT
MsgBox "Invalid Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~HWPARAM": return 0
End if
END IF
IF typList[i] = tkHLPARAM
If typList[i+1] <> tkIDENT
MsgBox "Invalid Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~HLPARAM": return 0
End if
END IF

'check PRINT x(+1),(+2)y(+3),(+4)var(+5) ..var= varName|number|quoted string ----------------------------------------------
IF typList[i] = tkPRINT
'check next token as var/num(arg1)
If typList[i+1] <> tkIDENT and typList[i+1] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~print": return 0
End if
If typList[i+2] <> tkCOMMA '2 comma
MsgBox "Comma Separator(2) -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~print": return 0
End if
If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER '3
MsgBox "Wrong Argument()2! -{ " + tokList[i+3] +" }-Line: " + str(lineNum+1),"ERROR~print": return 0
End if
If typList[i+4] <> tkCOMMA '4 comma
MsgBox "Comma Separator (4) -{ " + tokList[i+4] +" }-Line: " + str(lineNum+1),"ERROR~print": return 0
End if
If typList[i+5] <> tkIDENT and typList[i+5] <> tkNUMBER and typList[i+5] <> tkQSTRING '5
MsgBox "Wrong Argument(3)! -{ " + tokList[i+5] +" }-Line: " + str(lineNum+1),"ERROR~print": return 0
End if
END IF

IF typList[i] = tkPSET
'check next token as var/num(arg1)
If typList[i+1] <> tkIDENT and typList[i+1] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~PSET": return 0
End if
If typList[i+2] <> tkCOMMA '2
MsgBox "Comma Separator ? -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~PSET": return 0
End if
If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER '3
MsgBox "Wrong Argument()2! -{ " + tokList[i+3] +" }-Line: " + str(lineNum+1),"ERROR~PSET": return 0
End if
END IF

IF typList[i] = tkLINE
'check line 1,2,3,4
If typList[i+1] <> tkIDENT and typList[i+1] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~PSET": return 0
End if
If typList[i+2] <> tkCOMMA '2 comma
MsgBox "Comma Separator ? -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~PSET": return 0
End if
If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER '3
MsgBox "Wrong Argument()2! -{ " + tokList[i+3] +" }-Line: " + str(lineNum+1),"ERROR~PSET": return 0
End if
If typList[i+4] <> tkCOMMA '4 comma
MsgBox "Comma Separator ? -{ " + tokList[i+4] +" }-Line: " + str(lineNum+1),"ERROR~PSET": return 0
End if
If typList[i+5] <> tkIDENT and typList[i+5] <> tkNUMBER '5
MsgBox "Wrong Argument()2! -{ " + tokList[i+5] +" }-Line: " + str(lineNum+1),"ERROR~PSET": return 0
End if
If typList[i+2] <> tkCOMMA '6 comma
MsgBox "Comma Separator ? -{ " + tokList[i+6] +" }-Line: " + str(lineNum+1),"ERROR~PSET": return 0
End if
If typList[i+7] <> tkIDENT and typList[i+7] <> tkNUMBER '7
MsgBox "Wrong Argument()2! -{ " + tokList[i+7] +" }-Line: " + str(lineNum+1),"ERROR~PSET": return 0
End if
END IF

IF typList[i] = tkRECT
'check rect 1,2,3,4
If typList[i+1] <> tkIDENT and typList[i+1] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~RECT": return 0
End if
If typList[i+2] <> tkCOMMA '2 comma
MsgBox "Comma Separator ? -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~RECT": return 0
End if
If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER '3
MsgBox "Wrong Argument()2! -{ " + tokList[i+3] +" }-Line: " + str(lineNum+1),"ERROR~RECT": return 0
End if
If typList[i+4] <> tkCOMMA '4 comma
MsgBox "Comma Separator ? -{ " + tokList[i+4] +" }-Line: " + str(lineNum+1),"ERROR~RECT": return 0
End if
If typList[i+5] <> tkIDENT and typList[i+5] <> tkNUMBER '5
MsgBox "Wrong Argument()2! -{ " + tokList[i+5] +" }-Line: " + str(lineNum+1),"ERROR~RECT": return 0
End if
If typList[i+2] <> tkCOMMA '6 comma
MsgBox "Comma Separator ? -{ " + tokList[i+6] +" }-Line: " + str(lineNum+1),"ERROR~RECT": return 0
End if
If typList[i+7] <> tkIDENT and typList[i+7] <> tkNUMBER '7
MsgBox "Wrong Argument()2! -{ " + tokList[i+7] +" }-Line: " + str(lineNum+1),"ERROR~RECT": return 0
End if
END IF

'check IF x(1) <(2) y(3) &(4) a=v | c="X" if var = varName|number|quoted string cop(<,>,=,!) LESS,GREAT,EQUAL,NOT------
IF typList[i] = tkIF
'check next token as var(arg1)
If typList[i+1] <> tkIDENT
MsgBox "Wrong Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~IF": return 0
End if
'check operator <,>,=,!
If instr("<>=!",tokList[i+2]) = 0
MsgBox "Wrong operator(2)! -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~IF": return 0
End if
'check next arg(3)
If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER and typList[i+3] <> tkQSTRING
MsgBox "Wrong Argument(3)! -{ " + tokList[i+3] +" }-Line: " + str(lineNum+1),"ERROR~IF": return 0
End if
'check logic operator AND or OR -> & or | (used in micro(A)) ..........................................
IF typList[i+4] = tkAND OR typList[i+4] = tkOR
'MsgBox "token AND or OR","AND~OR"-> if a>b & c=d
If typList[i+5] <> tkIDENT
MsgBox "Wrong Argument(5)! -{ " + tokList[i+5] +" }-Line: " + str(lineNum+1),"ERROR~IF": return 0
End if
'check operator <,>,=,!
If instr("<>=!",tokList[i+6]) = 0
MsgBox "Wrong operator(2)! -{ " + tokList[i+6] +" }-Line: " + str(lineNum+1),"ERROR~IF": return 0
End if
'check next arg(7)
If typList[i+7] <> tkIDENT and typList[i+7] <> tkNUMBER and typList[i+7] <> tkQSTRING
MsgBox "Wrong Argument(7)! -{ " + tokList[i+7] +" }-Line: " + str(lineNum+1),"ERROR~IF": return 0
End if
END IF

END IF
'check WHILE x(1) <(2) y(3)... WHILE var = varName|number|quoted string cop(<,>,=,!) LESS,GREAT,EQUAL,NOT------
IF typList[i] = tkWHILE
'check next token as var(arg1)
If typList[i+1] <> tkIDENT
MsgBox "Wrong Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~WHILE": return 0
End if
'check operator <,>,=,!
If instr("<>=!",tokList[i+2]) = 0
MsgBox "Wrong operator(2)! -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~WHILE": return 0
End if
'check next arg(3)
If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER and typList[i+3] <> tkQSTRING
MsgBox "Wrong Argument(3)! -{ " + tokList[i+3] +" }-Line: " + str(lineNum+1),"ERROR~WHILE": return 0
End if
'whileCounter++ ' incr wc+1
whileID[i] = i ' save whileID as token position
' whileStack[whileCounter] = whileID[i] ' save while pos in stack
END IF
'check wend..................................................
IF typList[i] = tkWEND
' whileID[i] = i

END IF

'check goto ------ goto $name................................
IF typList[i] = tkGOTO
If typList[i+1] <> tkIDENT
MsgBox "Goto witout name! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERROR~GOTO": return 0
End if
If typList[i+1] = tkIDENT 'goto name
gotoName = lcase(tokList[i+1]) : match_name=0 :'print "gtName:"+ gotoN
' search for label name...
for n = 1 to 1024
if gotoName = lcase(labelName[n]) 'lcase->gotoname = lcase->labelname
'print "GOTO-NAME:" + gotoName
match_name=1
'store label pos into gotoID array
gotoID[i+1] = n ': print "gotoID: "+ str(gotoID[n]) + " LabelStack;" + str(labelStack[n]) ' 45
exit for
end if
next n
If match_name=0
MsgBox "Cannot found label :" + tokList[i+1] + " -Line: " + str(lineNum+1),"ERROR~GOTO" : return 0
End If
End if
END IF

'check RND,SIN,COS,TAN....................................................................................
IF typList[i] = tkRND
'check next token as var/num(arg1)
If typList[i+2] <> tkIDENT and typList[i+2] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~RND": return 0
End if
END IF
IF typList[i] = tkSIN
If typList[i+2] <> tkIDENT and typList[i+2] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~SIN": return 0
End if
END IF
IF typList[i] = tkCOS
If typList[i+2] <> tkIDENT and typList[i+2] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~COS": return 0
End if
END IF
IF typList[i] = tkTAN
If typList[i+2] <> tkIDENT and typList[i+2] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~TAN": return 0
End if
END IF
IF typList[i] = tkRAND
If typList[i+2] <> tkIDENT and typList[i+2] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~RAND": return 0
End if
END IF

'check STRS()..VAL()..................................................................................
IF typList[i] = tkSTRS
'print "STRS().found!"
If typList[i+2] <> tkIDENT and typList[i+2] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERROR~STRS": return 0
End if
END IF

'check WCOLOR --------------------------------------------------------------------------------------------
IF typList[i] = tkWCOLOR
If typList[i+1] <> tkIDENT and typList[i+1] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERR~WCOLOR": return 0
End if
If typList[i+2] <> tkCOMMA or typList[i+4] <> tkCOMMA '2 & 4
MsgBox "Comma Separator ? -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERR~WCOLOR": return 0
End if
If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER '3
MsgBox "Wrong Argument(2)! -{ " + tokList[i+3] +" }-Line: " + str(lineNum+1),"ERR~WCOLOR": return 0
End if
If typList[i+5] <> tkIDENT and typList[i+5] <> tkNUMBER
MsgBox "Wrong Argument(3)! -{ " + tokList[i+5] +" }-Line: " + str(lineNum+1),"ERR~WCOLOR": return 0
End if
END IF
'check FCOLOR ---------------------------------------------------------------------------------------------
IF typList[i] = tkFCOLOR
If typList[i+1] <> tkIDENT and typList[i+1] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERR~FCOLOR": return 0
End if
If typList[i+2] <> tkCOMMA or typList[i+4] <> tkCOMMA '2 & 4
MsgBox "Comma Separator ? -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERR~FCOLOR": return 0
End if
If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER '3
MsgBox "Wrong Argument(2)! -{ " + tokList[i+3] +" }-Line: " + str(lineNum+1),"ERR~FCOLOR": return 0
End if
If typList[i+5] <> tkIDENT and typList[i+5] <> tkNUMBER
MsgBox "Wrong Argument(3)! -{ " + tokList[i+5] +" }-Line: " + str(lineNum+1),"ERR~FCOLOR": return 0
End if
END IF
'check BCOLOR ---------------------------------------------------------------------------------------------
IF typList[i] = tkBCOLOR
If typList[i+1] <> tkIDENT and typList[i+1] <> tkNUMBER
MsgBox "Wrong Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERR~BCOLOR": return 0
End if
If typList[i+2] <> tkCOMMA or typList[i+4] <> tkCOMMA '2 & 4
MsgBox "Comma Separator ? -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERR~BCOLOR": return 0
End if
If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER '3
MsgBox "Wrong Argument(2)! -{ " + tokList[i+3] +" }-Line: " + str(lineNum+1),"ERR~BCOLOR": return 0
End if
If typList[i+5] <> tkIDENT and typList[i+5] <> tkNUMBER
MsgBox "Wrong Argument(3)! -{ " + tokList[i+5] +" }-Line: " + str(lineNum+1),"ERR~BCOLOR": return 0
End if
END IF

'check LoadImage LoadImage (INT hInst,STR lpsz, INT dwType,INT Width,INT Height, INT Flags )
'himg = LoadImage(0, "micData\mImg1.bmp", 0, 16, 16, 24) ...load bitmap
' icon = LoadImage(0, "micData\icOpen.ico", 1, 32, 32, 24) ...load icon
'syntax-> LoadImg (1)hImg , (3)str "img.bmp" ,(5)imgType , (7)w , (9)h, (11)colorFlags
IF typList[i] = tkLOADIMG
'check LoadImg 1,2,3,4
If typList[i+1] <> tkIDENT 'hImg image handler ,must be variable!
MsgBox "Wrong Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERR-LoadImg": return 0
End if
If typList[i+2] <> tkCOMMA '2 comma
MsgBox "Comma Separator ? -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERR-LoadImg": return 0
End if
If typList[i+3] <> tkIDENT and typList[i+3] <> tkQSTRING '3
MsgBox "Wrong Argument(2)! -{ " + tokList[i+3] +" }-Line: " + str(lineNum+1),"ERR-LoadImg": return 0
End if
If typList[i+4] <> tkCOMMA '4 comma
MsgBox "Comma Separator ? -{ " + tokList[i+4] +" }-Line: " + str(lineNum+1),"ERR-LoadImg": return 0
End if
If typList[i+5] <> tkIDENT and typList[i+5] <> tkNUMBER '5
MsgBox "Wrong Argument(3)! -{ " + tokList[i+5] +" }-Line: " + str(lineNum+1),"ERR-LoadImg": return 0
End if
If typList[i+6] <> tkCOMMA '6 comma
MsgBox "Comma Separator ? -{ " + tokList[i+6] +" }-Line: " + str(lineNum+1),"ERR-LoadImg": return 0
End if
If typList[i+7] <> tkIDENT and typList[i+7] <> tkNUMBER '7
MsgBox "Wrong Argument(4)! -{ " + tokList[i+7] +" }-Line: " + str(lineNum+1),"ERR-LoadImg": return 0
End if
If typList[i+8] <> tkCOMMA '8 comma
MsgBox "Comma Separator ? -{ " + tokList[i+8] +" }-Line: " + str(lineNum+1),"ERR-LoadImg": return 0
End if
If typList[i+9] <> tkIDENT and typList[i+9] <> tkNUMBER '9
MsgBox "Wrong Argument(5)! -{ " + tokList[i+7] +" }-Line: " + str(lineNum+1),"ERR-LoadImg": return 0
End if
If typList[i+10] <> tkCOMMA '10 comma
MsgBox "Comma Separator ? -{ " + tokList[i+10] +" }-Line: " + str(lineNum+1),"ERR-LoadImg": return 0
End if
If typList[i+11] <> tkIDENT and typList[i+11] <> tkNUMBER '11
MsgBox "Wrong Argument(6)! -{ " + tokList[i+7] +" }-Line: " + str(lineNum+1),"ERR-LoadImg": return 0
End if
END IF

'check ShowImage hImg, x,y,w,h -> syntax ShowImg himg, ix,iy,iw,ih
IF typList[i] = tkSHOWIMG
'check LoadImg 1,2,3,4
If typList[i+1] <> tkIDENT 'hImg image handler ,must be variable!
MsgBox "Wrong Argument(1)! -{ " + tokList[i+1] +" }-Line: " + str(lineNum+1),"ERR-ShowImg": return 0
End if
If typList[i+2] <> tkCOMMA '2 comma
MsgBox "Comma Separator ? -{ " + tokList[i+2] +" }-Line: " + str(lineNum+1),"ERR-ShowImg": return 0
End if
If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER '3
MsgBox "Wrong Argument(2)! -{ " + tokList[i+3] +" }-Line: " + str(lineNum+1),"ERR-ShowImg": return 0
End if
If typList[i+4] <> tkCOMMA '4 comma
MsgBox "Comma Separator ? -{ " + tokList[i+4] +" }-Line: " + str(lineNum+1),"ERR-ShowImg": return 0
End if
If typList[i+5] <> tkIDENT and typList[i+5] <> tkNUMBER '5
MsgBox "Wrong Argument(3)! -{ " + tokList[i+5] +" }-Line: " + str(lineNum+1),"ERR-ShowImg": return 0
End if
If typList[i+6] <> tkCOMMA '6 comma
MsgBox "Comma Separator ? -{ " + tokList[i+6] +" }-Line: " + str(lineNum+1),"ERR-ShowImg": return 0
End if
If typList[i+7] <> tkIDENT and typList[i+7] <> tkNUMBER '7
MsgBox "Wrong Argument(4)! -{ " + tokList[i+7] +" }-Line: " + str(lineNum+1),"ERR-ShowImg": return 0
End if

END IF

Next i

'check counters
If whileCounter > wendCounter
MsgBox "WHILE without WEND , check code!","LOOP ERROR" : return 0
End If
If wendCounter > whileCounter
MsgBox "WEND without WHILE , check code!","LOOP ERROR" : return 0
End If
If ifCounter > endifCounter
MsgBox "IF without ENDIF , check code!","IF/ENDIF ERROR": return 0
End If
If endIfCounter > ifCounter
MsgBox "ENDIF without IF , check code!","IF/ENDIF ERROR": return 0
End If
If fnCounter > endFnCounter
MsgBox "FUNC without ENDFN , check code!","FUNC ERROR" : return 0
End If
If endFnCounter > fnCounter
MsgBox "ENDFN without FUNC , check code!","FUNC ERROR" : return 0
End If
If wMsgCounter > endWMsgCounter
MsgBox "WINMSG without ENDWM , check code!","WMSG ERROR" : return 0
End If
If endWMsgCounter > wMsgCounter
MsgBox "ENDWM without WINMSG, check code!","WMSG ERROR" : return 0
End If

return 1

End sub
'=================================================================================================================
Sub tokInterpreter()
int tok=0,ntok=0,vID=0 ,vTyp=0, funcCall=0, funcID=0: float frnd : INT whileTOS=0 , wcount,cond1,cond2 = -1, logOP
float numRes=0 : string strRes ,funcName : int ptrRes : int resIF , resWhile, labelPos, whilePos,wendPos,funcPos,callPos
float fop1,fop2,fop3,fop4 : int iop1,iop2,iop3,iop4 : string sop1,sop2,sop3,sop4
int imgType,imgX,imgY,imgW,imgH,cFlag,htc, arrID,arrTyp,varIndex,strIndex,ptrIndex
int intImg ,imageID,iID,
msgQuit=0

While tc < nTokens
start:
gettok() :' print "TOKEN:" + tokList[tc]
tok = tkTyp : ntok = typList[tc+1]

Select tok

case tkFLOAT
'IF tok = tkFLOAT ' token is def varNUM...'skip tokens to colon/eol
tc++ : While typList[tc] <> tkCOLON And typList[tc] <> tkEOL : tc++ : Wend
'END IF
case tkSTRING
'IF tok = tkSTRING ' token is def varSTR...'skip tokens to colon/eol
tc++ : While typList[tc] <> tkCOLON And typList[tc] <> tkEOL : tc++ : Wend
'END IF

case tkIDENT
' if is variable ...NOT func NOT array
IF ntok <> tkLPAREN
vID = varList[tc] 'get ID
vTyp = varType[vID]
' vID = varList[tc] : vTyp = varType[vID] : print "varID: " + str(vID) + ":VarType:: " + str(vTyp)
If vTyp = tkFLOAT ' numeric var
if ntok = tkEQUAL
tc++ ' skip "=" is assign
numRes = exec_expr() : varNum[vID] = numRes ' store result in varNum[] list
end if
End if

If vTyp = tkSTRING ' string var
if ntok = tkEQUAL
tc++ ' skip "=" is assign
strRes = exec_strExpr() : varStr[vID] = strRes ' store result in varStr[] list
end if
End if
If vTyp = tkPOINTER ' pointer/int var
if ntok = tkEQUAL
tc++ ' skip "=" is assign
ptrRes = exec_expr() : varPtr[vID] = INT(ptrRes) ' store result in varPtr[] list
end if
End if
END IF

'if is array ...NOT variable NOT func
IF ntok = tkLBRACKET
arrID = arrayList[tc] 'get array ID
arrTyp = arrayType[arrID] 'get array type
tc++ ' skip [
'print "should be [ : " + tokList[tc]
tc++ 'next token
'var_array / FLOAT arr[1|n].................................................................
If arrTyp = tkFLOAT
'print "array type float : " + str(arrTyp)
if typList[tc] = tkNUMBER
varIndex = val(tokList[tc]) ':' print "INDEX VALUE IS: " + str(varIndex)
tc++ : tc++
numRes = exec_expr() ': print "NUM_RES: " + str(numRes)
'set var array element ( arrId, arrIndex ,element value
SetVarArrayElement(arrID, varIndex, numRes)
end if

if typList[tc] = tkIDENT
varIndex = val(tokList[tc]) ': print "INDEX VALUE IS: " + str(varIndex)
tc++ : tc++
numRes = exec_expr() ': print "NUM_RES: " + str(numRes)
'set var array element ( arrId, arrIndex ,element value
SetVarArrayElement(arrID, varIndex, numRes)
end if
End if
'var_array / INT arr[1|n].................................................................
If arrTyp = tkPOINTER
' print "array type float : " + str(arrTyp)
if typList[tc] = tkNUMBER
varIndex = val(tokList[tc])' : print "INDEX VALUE IS: " + str(varIndex)
tc++ : tc++
numRes = exec_expr()
'set ptr array element ( arrId, arrIndex ,element value
SetPtrArrayElement(arrID, varIndex, numRes)
end if

if typList[tc] = tkIDENT
varIndex = val(tokList[tc]) ': print "INDEX VALUE IS: " + str(varIndex)
tc++ : tc++ :
numRes = exec_expr() :' print "NUM_RES: " + str(numRes)
'set ptr array element ( arrId, arrIndex ,element value
SetPtrArrayElement(arrID, varIndex, numRes)
end if
End if

'string array?
END IF

'if ident is function call...ident()
if ntok = tkLPAREN
funcName = tokList[tc] :' print "I->Function name:" + funcName
callPos = tc
funcID = fnList[tc] :' print "I->Func ID:" + str(funcID) ' get funcID-> call pos
'print "I-> func_token: " + tokList[funcID-1] " -->name on pos: " + tokList[funcID]
tc = funcID + 2 ' jump to func pos ,skip 2 tokens ( )...
goto start
end if

case tkFUNC
'if func call = 0 then skip code to end of function
if funcCall = 0 ' function is not called
do ' loop to ENDFN
tc++
if typList[tc] = tkENDFN ' found a endFN statement
exit do
end if
end do
tc++ ' skip endFN and get EOL -> continue
end if

case tkENDFN
tc = callPos
goto start

case tkENDWM 'end win msg -> return
Return
' EXIT SUB

case tkMOUSEX
gettok() : tok = tkTyp
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : varNum[vID] = hMouseX : end if 'push value of MouseX into var
End if

case tkMOUSEY
gettok() : tok = tkTyp
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : varNum[vID] = hMouseY : end if 'push value of MouseY into var
End if

case tkHWPARAM
gettok() : tok = tkTyp
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : varNum[vID] = hWParam : end if 'push value of WParam into var
End if

case tkPRINT
'IF tok = tkPRINT
gettok() : tok = tkTyp
If tok = tkNUMBER : prX = val(tokList[tc]) : End if 'if number
If tok = tkIDENT
if vTyp = tkFLOAT : prX = varNum[vID] : end if
End if
'strRes="" 'skip comma
tc++ : gettok() : tok = tkTyp
If tok = tkNUMBER : prY = val(tokList[tc]) : End if 'if number
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : prY = varNum[vID] : end if
End if

tc++ : gettok() : tok = tkTyp 'skip comma,get token type
'variable
IF typList[tc+1] <> tkLBRACKET
vID = varList[tc]: vTyp = varType[vID]
If tok = tkNUMBER : numRes = val(tokList[tc]) : strRes = str(numRes) : End if 'if is number
If vTyp = tkFLOAT : numRes = varNum[vID] : strRes = str(numRes): End if 'if is numVar
If vTyp = tkPOINTER : numRes = varPtr[vID] : strRes = str(numRes): End if
If vTyp = tkSTRING : vID = varList[tc] : strRes = varStr[vID] : End if 'if is strVar
if tok = tkQSTRING : strRes = tokList[tc] : End if
END IF
'array
IF typList[tc+1] = tkLBRACKET
'print "next_token:" + tokList[tc+1]
arrID = arrayList[tc] : arrTyp = arrayType[arrID]
If arrTyp = tkFLOAT
numRes = factor() 'get array element value
strRes = str(numRes)
End if
If arrTyp = tkPOINTER
numRes = factor() 'get array element value
strRes = str(numRes)
End if
END IF

'print on window
TextOut hdcMem,prX,prY,strRes,Len(strRes)
ReleaseDC( win, hdcMem)
'END IF

case tkPSET
'IF tok = tkPSET
gettok() : tok = tkTyp
If tok = tkNUMBER : piX = val(tokList[tc]) : End if 'if number
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : piX = varNum[vID] : end if
End if
'tc++ 'skip comma
tc++ : gettok() : tok = tkTyp
If tok = tkNUMBER : piY = val(tokList[tc]) : End if 'if number
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : piY = varNum[vID] : end if
End if

'pixel on window
SetPixel ( hdcMem, piX, piY, fColor)
'SetPixel( hdc, piX, piY, fColor)
'BitBlt(hDC, 0, 0, ww, wh, hdcMem, 0, 0, SRCCOPY)
'ReleaseDC( win, hdc)
'END IF

case tkSWAP
'IF tok = tkSWAP
'flip DC buffer
if msgQuit=0
BitBlt(hDC, 0, 0, ww, wh, hdcMem, 0, 0, SRCCOPY)
end if
'GetClientRect win, rc
'SetStretchBltMode hdc,sys_mode
'StretchBlt hdc,0,0,rc.right,rc.bottom,hdcMem,0,0,ww,wh,0xCC0020
' END IF
case tkIF
'IF tok = tkIF.................................................................
gettok(): tok = tkTyp : vID = varList[tc]: vTyp = varType[vID] 'get (1)
IF vTyp = tkFLOAT
' 'if numeric var
vID = varList[tc] : fop1 = varNum[vID] 'op1
resIF = getBoolean()
END IF
updateIF: '<- label update IF
'exec_IF----------------------------
'if resIF = vYES :goto continueIF :end if
' continueIF:
'continue until tkELSE
if resIF = TRUE 'bool vNO
do
tc++
if typList[tc] = tkELSE : goto start : end if
if typList[tc] = tkENDIF : exit do : end if
end do
'end if
'else
' goto start
end if

case tkELSE
'exec_ELSE.........................................
'IF tok = tkELSE
if resIF = FALSE
do
tc++
'if typList[tc] = tkELSE : goto start : end if
if typList[tc] = tkENDIF : exit do : end if
end do
'end if
'else
' goto start
end if
'END IF

'exec_While----------------------------------------------------------------------------
'IF tok = tkWHILE
case tkWHILE
' print "RES-WHILE:" + str(resWhile)
whilePos = whileID[tc] ': print "WHILE-POS:" + str(whilePos ) 'get last whileID from token pos
gettok(): tok = tkTyp : vID = varList[tc]: vTyp = varType[vID] 'get (1)
If vTyp = tkFLOAT
vID = varList[tc] : fop1 = varNum[vID] 'op1
tc++ : gettok() : tok = tkTyp : vID = varList[tc]: vTyp = varType[vID] 'skip cond1
If vTyp = tkFLOAT : vID = varList[tc] : fop2 = varNum[vID] :End if 'get (2)
If tok = tkNUMBER : fop2 = val(tokList[tc]) : end if
if vTyp <> tkFLOAT AND tok <> tkNUMBER: MsgBox "Wrong Type! " + token ,"ERROR":goto ExitProgram : end if 'wrong type
tc=tc-2 : gettok() : tok = tkTyp 'get cond1 back(-2),gt(+1)
'If ntok <> tkAND or ntok <> tkOR
resWhile = vNO
Select tok
Case tkLESS
if fop1 < fop2 : resWhile = vYES : end if
Case tkMORE
if fop1 > fop2 : resWhile = vYES : end if
Case tkEQUAL
if fop1 = fop2 : resWhile = vYES : end if
Case tkNOT
if fop1 <> fop2 : resWhile = vYES : end if
End select
cond1 = resWhile
End If
' shift tc>> = skip var after operator [op] [var] >>
tc=tc+2 ': print ">>TOKEN:" + tokList[tc] + ">TC: " + str(tc)
IF typList[tc] <> tkAND AND typList[tc] <> tkOR : goto update_while_stack : end if 'if there is no AND or OR then jump over
IF typList[tc] = tkAND : logOP = tkAND : END IF 'if logical operator is AND / &
IF typList[tc] = tkOR : logOP = tkOR : END IF 'if logical operator is OR / |
gettok(): tok = tkTyp : vID = varList[tc]: vTyp = varType[vID] 'get ar(3)
If vTyp = tkFLOAT
vID = varList[tc] : fop3 = varNum[vID] 'op2
tc++ : gettok() : tok = tkTyp : vID = varList[tc]: vTyp = varType[vID] 'skip cond2
If vTyp = tkFLOAT : vID = varList[tc] : fop4 = varNum[vID] :End if 'get (3)
If tok = tkNUMBER : fop4 = val(tokList[tc]) : end if
if vTyp <> tkFLOAT AND tok <> tkNUMBER: MsgBox "Wrong Type! " + token ,"ERROR":goto ExitProgram : end if 'wrong type
tc=tc-2 : gettok() : tok = tkTyp 'get cond2 back(-2),gt(+1)
'If ntok <> tkAND or ntok <> tkOR
resWhile = vNO
Select tok
Case tkLESS
if fop3 < fop4 : resWhile = vYES : end if
Case tkMORE
if fop3 > fop4 : resWhile = vYES : end if
Case tkEQUAL
if fop3 = fop4 : resWhile = vYES : end if
Case tkNOT
if fop3 <> fop4 : resWhile = vYES : end if
End select
cond2 = resWhile
End If
tc=tc+2 'skip var after operator [op] [var] >>
update_while_stack: '<-label

/* update stack values +1 */
whileTOS = whileTOS + 1
whileStack[whileTOS] = whilePos '52, TOS=2- 52 , 1-52
wcount = 1
'-----------------------------------------------------------------------------
IF logOP = tkAND
IF cond1 = vYES AND cond2 = vYES : resWhile = vYES : end if ' check cond
IF cond1 = vNO AND cond2 = vNO : resWhile = vNO : end if
IF cond1 = vYES AND cond2 = vNO : resWhile = vNO : end if
IF cond1 = vNO AND cond2 = vYES : resWhile = vNO : end if
END IF
'-----------------------------------------------------------------------------
IF logOP = tkOR
IF cond1 = vYES OR cond2 = vYES : resWhile = vYES : end if
IF cond1 = vYES OR cond2 = vNO : resWhile = vYES : end if
IF cond1 = vNO OR cond2 = vYES : resWhile = vYES : end if
IF cond1 = vNO OR cond2 = vNO : resWhile = vNO : end if
END IF
'------------------------------------------------------------------------------

if resWhile = vNO
whileTOS = whileTOS - 1

do ' jump beyond WEND
tc++
if typList[tc] = tkWHILE : wcount++ : end if ' if found a WHILE statement, count it
if typList[tc] = tkWEND ' if found an WEND statement...
wcount--
if wcount = 0 : exit do : end if ' if found the one we want...
end if
end do
tc++ ' skip wend and get EOL
'print "TOKEN>>" + tokList[tc] + ">TC: " + str(tc)
end if

'exec wend if vYES..................................................................
case tkWEND
' if resWhile = vYES
'print "TRUE ->jump back to WHILE"
'if whileTOS
tc = whileStack[whileTOS]-1 ': print "WEND TO->POS:" + str(tc)
/* unload WHILE stack, which will be reloaded by the call to WHILE */
whileTOS = whileTOS - 1 ' TOS-1 ->1 -> 0
'end if

'END IF
case tkGOTO
'exec_GOTO------------------------
'IF tok = tkGOTO
gettok() : tok = tkTyp
'If tok = tkIDENT
'print "LABEL_POS:" + str(gotoID[tc])
tc = gotoID[tc] ' jump to label pos
goto start
' End if

'END IF
case tkWCOLOR
'exec_window color -------------------------
'IF tok = tkWCOLOR
gettok() : tok = tkTyp
If tok = tkNUMBER : winRed = val(tokList[tc]) : End if 'if number
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : winRed = varNum[vID] : end if
End if
'tc++ 'skip comma
tc++ : gettok() : tok = tkTyp
If tok = tkNUMBER : winGreen = val(tokList[tc]) : End if 'if number
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : winGreen = varNum[vID] : end if
End if
'tc++ 'skip comma
tc++ : gettok() : tok = tkTyp
If tok = tkNUMBER : winBlue = val(tokList[tc]) : End if 'if number
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : winBlue = varNum[vID] : end if
End if
'set window color
WinColor( win, winRed, winGreen, winBlue)

'END IF

case tkFCOLOR
'exec front color -------------------------
'IF tok = tkFCOLOR
gettok() : tok = tkTyp
If tok = tkNUMBER : frontRed = val(tokList[tc]) : End if 'if number
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : frontRed = varNum[vID] : end if
End if
'tc++ 'skip comma
tc++ : gettok() : tok = tkTyp
If tok = tkNUMBER : frontGreen = val(tokList[tc]) : End if 'if number
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : frontGreen = varNum[vID] : end if
End if
'tc++ 'skip comma
tc++ : gettok() : tok = tkTyp
If tok = tkNUMBER : frontBlue = val(tokList[tc]) : End if 'if number
If tok = tkIDENT
vID = varList[tc] : vTyp = varType[vID]
if vTyp = tkFLOAT : frontBlue = varNum[vID] : end if
End if
'set front color
fColor = RGB( frontRed, frontGreen, frontBlue)
SetTextColor( hDCMem, fColor)
'SetBkColor( hDCMem, bCol