Post Reply 
Social Buttons
 
Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
ANI script v3
04-22-2018, 05:12 AM (This post was last modified: 04-24-2018 09:41 PM by Aurel.)
Post: #1
ANI script v3
without richedit

Code:
$ Filename "ANIscript.exe" ' o2
include "RTL32.inc"
include "awinh037.inc"
#lookahead
string KEYWORDS[] = {"CLS","PRINT","IF","ELSE","FOR","TO","NEXT","ENDIF","WHILE","WEND","UNTIL","DO","LOOP","THEN"}
string SYMBOLS = ":=()+-*/<>"
string ALPHABETS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$#"
string DQ = chr(34)
string NUMBERS = "0123456789"
string NUMBERS_WITH_DECIMALPOINT = NUMBERS + "."
string ALPHANUMBERS = ALPHABETS + NUMBERS
string ALPHANUMBERS_WITH_UNDERSCORE = ALPHANUMBERS + "_"
string tokens  'token buffer          'tokens[1024] ' token list
string crlf = chr(13)+chr(10)
'------------------------------------------------------------------------
INT win,wx=100,wy=0,ww=840,wh=640,wstyle = WS_MINMAXSIZE
INT bt0,b0ID=100,bt1,b1ID=101,bt2,b2ID=102 'buttons
INT static1,stID1=10,static2,staticID2=11,static3,staticID3=12,static4,staticID4=13,​static5,staticID5=14  'staticTX
INT edit1,ed1ID=200,riched,richID=400,LBoxH,LBid=500,edit2,editID2=50
INT edit3,editID3=51,edit4,editID4=52,edit5,editID5=53,edit6,editID6=54
STRING  outBuff="processing..." + crlf
STRING source[1000] ' source lines array
string pt = Space (255)
'bitmap image handlers -------------------------------------------------
INT bb0,bb1,bb2
'create main window ||||||||||||||||||||||||||||||||||||||||||||||||||||
win=SetWindow("ANI:v1",wx,wy,ww,wh,0,wstyle)
    InitDrawing(win)
    WindowColor( win, 220, 230, 250)
InvalidateRect(win, 0, 0)
'crete buttons||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
bt0 = SetButton(win,4,60,34,34,"New", 1409384576,0x200,b0ID)  'as image button flat 1409384576 - 1409351808
bb0 = LoadImage(0,"bScan.bmp",0,32,32,16):SendMessage(bt0, 247, 0, bb0) 'add bitmap to button
bt1 = SetButton(win,4,98,34,34,"Open", 1409384576,0x200,b1ID)
bb1 = LoadImage(0,"bOpen.bmp",0,32,32,16):SendMessage(bt1, 247, 0, bb1)
bt2 = SetButton(win,4,140,34,34,"Save", 1409384576,0x200,b2ID)
bb2 = LoadImage(0,"bProc.bmp",0,32,32,16):SendMessage(bt2, 247, 0, bb2)

'create EDIT1 - multiline --------------------------------------------
edit1 = SetEditBox(win,44,480,500,80, outBuff,  WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUT​OVSCROLL,0x200,ed1ID) '50B01004 processing box
'create static control
static1 = SetStatic(win,6,8,54,16,"LINES",0,0,stID1) 'static 'LINES'
static2 = SetStatic(win,6,35,54,16,"LINE >>",0,0,staticID2) 'static 'LINES'
edit2 = SetEditBox(win,50,5,70,20,"num of Lines",0x50800000,0x200,editID2) 'edit for number of lines
edit3 = SetEditBox(win,50,32,710,22,"current Line",0x50800000,0x200,editID2) 'edit for current line
ControlFont(edit3, 15, 8, 400, "Courier New"): SetFocus edit3
static3 = SetStatic(win,120,8,54,16,"T-LINE",0,0,staticID3) 'static 'LINES'
edit4 = SetEditBox(win,160,6,60,20,"Line Num",0x50800000,0x200,editID4)

static4 = SetStatic(win,230,8,54,16,"T-CHAR",0,0,staticID4) 'static 'temp char
edit5 = SetEditBox(win,280,6,60,20,"CHAR",0x50800000,0x200,editID5) ' show char
ControlFont(edit5, 16, 9, 600, "Courier New")

static5 = SetStatic(win,350,8,54,16,"CHAR-POS",0,0,staticID5) 'static 'charPos
edit6 = SetEditBox(win,410,6,60,20,"POS",0x50800000,0x200,editID6) ' position in line

'create RICHEDIT1 ################################################################################​##########
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_NOHIDESEL
INT reStyle = 0x508010C4 '/::src code line::
riched = SetRichEdit(win, 44,60,500,400,"", reStyle,0x200,richID)
print str(riched)
ControlFont(riched, 15, 8, 400, "Courier New") :' SetRichEditBackColor riched, RGB(250,244,179)
'SetEditSelection( riched, -1,-1):InvalidateRect( riched, 0, 0)

'create listbox for token list ##########################################################################
LBoxH = SetListBox(win,560,60,100,300,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LBid)
ControlFont(LBoxH, 16,9, 300, "Courier New")
SendMessage LboxH, LB_ADDSTRING, 0, "TOKENS"
'----------------------------------------------------------------------
Wait()  'message loop
'----------------------------------------------------------------------
'func main
Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback
SELECT hwnd
    CASE win
        Select wmsg

            CASE WM_CREATE
             'InitDrawing(win)
             'WindowColor( win, 220, 230, 250)

            CASE WM_PAINT
             BitBlt(hDC, 0, 0, ww, hh, hdcMem, 0, 0, SRCCOPY)
             InvalidateRect(win, 0, 0)
                
            CASE WM_CLOSE
                CloseWindow(win)
                EndProgram
                  ExitProcess 0

            CASE WM_COMMAND
                controlID = LoWord(wParam) 'get control ID
                notifyCode = HiWord(wParam) 'get notification message

                select controlID
                    case b1ID  'open file
                       if notifycode=0
                       doOpen()
                    end if

                    case b0ID 'scan >>>
                       if notifycode=0
                       doScan()
                    end if

                  end select
        End Select
END SELECT
RETURN Default
END FUNCTION

'************************************************
'****    A N I -> P R O C E S S I N G    ********
'************************************************

'open source file
Sub doOpen
string fName="", dir="", sep=chr(0) , title="Open File... "
filter = "All Files "+sep+"*.*"+sep+"Bscript files "+sep+"*.bas"
title="Open File... "
fName = FileDialog(dir,filter,title,0,0,"txt")
IF fName = ""  'almost useless ?
SendMessage edit1,WM_SETTEXT,0,strptr("NO FILE ! ") : Return
END IF
'SendMessage status,WM_SETTEXT,0,strptr(fName)
char tx[500000] : tx =  GetFile fName      'load file into char buffer
'SendMessage riched, 12, 0, strptr(tx)       'show file in richedit
SetText (riched,tx)
string numOfLines : int LineCount : LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0
numOfLines = str(LineCount) : SetText (edit2,numOfLines) ' show result in edit2
outBuff = outBuff + "file_loaded..." + crlf                  : SetText (edit1,outBuff)
outBuff = outBuff + "number of lines : " + numOfLines + crlf : SetText (edit1,outBuff)
frees tx
End Sub

'scan source line -----------------------------------------------------------------------
Sub doScan
string s,sc,cLine, tbuff
string pt = Space (255)  ' also you may try char pt[255]=""
int i ,LineCount=1 ,crPos, first
SetText(edit3,"")  ' clear current line box
LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0 ' get number of Lines
SetText (edit1,"WAIT..scanning >>>>") : MsgBox "SCAN FILE","OK!..START"
'scan each line
For n = 0 to LineCount-1
    ' enable events..so i use PeekMessage
         while PeekMessage (wm,0,0,0,Pm_Remove)>0 ' //peek
            TranslateMessage (wm)
            DispatchMessage (wm)
        wend
    SendMessage (riched, EM_GETLINE, n,strptr pt) ' get line from richedit control
    'first = SendMessage riched, EM_LINEINDEX, i, 0
    'MsgBox pt , "INFO"
     if pt <> ""
        s = Ltrim(pt)               'trim left side
         crPos = instr(pt,chr(13)) : ' check CR position /msgbox "POS:"+str(crPos),"CHR(13).POS"
         s = MID( pt, 1, crPos-1)    ' extract string / text
     else
        s=""                        
     end if
    
      SetText edit4, str(n)            'show line number
      SetText(edit3, s)                'show current line in single-Line edit box
      cLine = GetText(edit3)           'get text from edit control
     'msgBox cLine,"LINE:"+str(i)      'check this
      Tokenizer(cLine)                 'tokenize line
     'get char func >>>>>>>>>>>>>>>>>>>>>
        GetChar(cLine)
      '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        'Sendmessage riched,EM_HIDESEL,i,0
        'SetEditSelection( riched, first,len pt)
        'Sendmessage riched,EM_HIDESEL,i,0

      s="" : 'sleep = 100                  ' slow down..tweak for your computer-200
SendMessage riched,EM_SCROLL ,1,0
Next n
SetText edit1,"FINISHED!"
End Sub
'-----------------------------------------------------------------------------------------

SUB GetChar(string sLine)
int pos=1,lineSize
string ch,nextCh,tLine
    tLine = Mid(sLine,1,Len(sLine))
    lineSize=LEN(tLine)
        while pos <= lineSize
            ch = Mid( tLine,pos,1)
                ' sleep 100  '200
                 SetText(edit5,ch)       'show character
                 SetText(edit6,str(pos)) 'show char position in line
                 ch=""
            pos=pos+1
        wend
End Sub
'-----------------------------------------------------------------------------------------

Function SetEditSelection(int eHandle, sStart, sEnd)
  SendMessage( ehandle, EM_SETSEL, sstart, send)
End Function

function tokenizer(string code)  ' as string
    string token, ch
    '
    'load file?
    '
    INT i,j
    '................................
    'print str(len(code))
    '.................................
    i=1
    WHILE i <= len(code)
        
        IF instr(ALPHABETS, mid(code,i,1)) <> 0            'isAlpha
            while i <= len(code) and INSTR(ALPHABETS ,mid(code,i,1)) > 0
                token = token + mid(code, i, 1)            
                  i=i+1
             wend  
            ' PRINT str i
            'print token        
             if  ucase(token)= isKeyword(token)   ' search keyword list
                tokens = tokens + token '+ " ~ KEYWORD
                  SendMessage LboxH, LB_ADDSTRING, 0,  token + "~KEYWORD"
                  token=""
            else
                tokens = tokens + token +' " ~ IDENTIFIER" + crlf  'variabe
                 SendMessage LboxH, LB_ADDSTRING, 0, token + "~IDENTIFIER"    
                   token=""
             end if
            'token=""
            'i=i+1
          END IF  
        
        IF i <= len(code) and instr(SYMBOLS, mid(code, i, 1)) > 0  'sym operators
              token = mid(code, i, 1)
               'print token
            tokens = tokens + token '+ " ~ SYMBOL" + crlf
               SendMessage LboxH, LB_ADDSTRING, 0, token +  "~SYMBOL"
            i=i+1
            token=""
        END IF
  
        IF instr(NUMBERS, mid(code, i, 1)) <> 0    'numbers
            while i <= len(code) and INSTR(NUMBERS_WITH_DECIMALPOINT,mid(code,i,1)) <> 0
                token = token + mid(code,i,1)
                  i=i+1
              wend
            tokens = tokens + token' + "  ~ NUMBER" + crlf
             SendMessage LboxH, LB_ADDSTRING, 0, token + "~NUMBERS"
             token=""
        END IF

        'elseif ch = chr(34) 'quote "
          IF INSTR(mid(code,i,1),DQ) <> 0
            'token = ""
            i = i + 1 ' skip first quote "......
            while i<= len(code) and mid(code,i+1,1) <> chr(34) 'string literal inside quotes "......."
                token = token + mid(code,i,1)
                i=i+1
              wend
                tokens = tokens + token '+ " ~ STRING-LITERAL" + crlf
                 SendMessage LboxH, LB_ADDSTRING, 0, token + "~STRING-LITERAL"
              token=""
              i=i+1 ' skip second quote  ......"
        END IF

        IF i <= len(code) and mid(code, i, 1) = " "  'whitespace
              'token=""
            i=i+1 'skip whitespace
        END IF

        'elseif ch = chr(10) ' not used because of CRLF in bufer -> tokens
         'IF i <= len(code) and mid(code,i,1) = chr(10)
            'tokens = tokens + mid(code,i,1) + " :NEWLINE" + crlf ' or end of instruction
              
            'i=i+1
        ' END IF
        'else
            'tokens = tokens + ch + " :UNINDENTIFIED - ERROR!" + crlf
            'i=i+1

        
    
      
    WEND

    'Return token

end function
'...........................................................
function isKeyword(byval tok as string) as string
'string ret
for n = 1 to 14
    if ucase(tok) = KEYWORDS[n]     ' if is KEYWORD
        RETURN KEYWORDS[n]  
    end if
next n
Return ""
end function
Find all posts by this user
Quote this message in a reply
04-24-2018, 02:42 AM (This post was last modified: 04-24-2018 09:41 PM by Aurel.)
Post: #2
RE: ANI script v3
I have problems with SYMBOL chars ..so i use fancy
byte t at strptr(token) selection
and now seems to me that all tokens are presented properly.

This should be small code analyzer Big Grin

Code:
$ Filename "ANIscript.exe" ' o2
include "RTL32.inc"
include "awinh.inc"
#lookahead
string KEYWORDS[] = {"CLS","PRINT","IF","ELSE","FOR","TO","NEXT","ENDIF","WHILE","WEND","UNTIL","DO","LOOP","THEN"}
string SYMBOLS = ",:=()+-*/<>[]^"
string ALPHABETS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$#"
string DQ = chr(34)
string NUMBERS = ".0123456789"
string NUMBERS_WITH_DECIMALPOINT = NUMBERS + "."
string ALPHANUMBERS = ALPHABETS + NUMBERS
string ALPHANUMBERS_WITH_UNDERSCORE = ALPHANUMBERS + "_"
string tokens  'token buffer          'tokens[1024] ' token list
string crlf = chr(13)+chr(10)
'------------------------------------------------------------------------
INT win,wx=100,wy=0,ww=840,wh=640,wstyle = WS_MINMAXSIZE
INT bt0,b0ID=100,bt1,b1ID=101,bt2,b2ID=102 'buttons
INT static1,stID1=10,static2,staticID2=11,static3,staticID3=12,static4,staticID4=13,​static5,staticID5=14  'staticTX
INT edit1,ed1ID=200,riched,richID=400,LBoxH,LBid=500,edit2,editID2=50
INT edit3,editID3=51,edit4,editID4=52,edit5,editID5=53,edit6,editID6=54
INT ipos ' LB item pos
STRING  outBuff="processing..." + crlf
STRING source[1000] ' source lines array
string pt = Space (255)
'bitmap image handlers -------------------------------------------------
INT bb0,bb1,bb2
'create main window ||||||||||||||||||||||||||||||||||||||||||||||||||||
win=SetWindow("ANI::v2",wx,wy,ww,wh,0,wstyle)
    InitDrawing(win)
    WindowColor( win, 220, 230, 250)
InvalidateRect(win, 0, 0)
'crete buttons||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
bt0 = SetButton(win,4,60,34,34,"New", 1409384576,0x200,b0ID)  'as image button flat 1409384576 - 1409351808
bb0 = LoadImage(0,"bScan.bmp",0,32,32,16):SendMessage(bt0, 247, 0, bb0) 'add bitmap to button
bt1 = SetButton(win,4,98,34,34,"Open", 1409384576,0x200,b1ID)
bb1 = LoadImage(0,"bOpen.bmp",0,32,32,16):SendMessage(bt1, 247, 0, bb1)
bt2 = SetButton(win,4,140,34,34,"Save", 1409384576,0x200,b2ID)
bb2 = LoadImage(0,"bProc.bmp",0,32,32,16):SendMessage(bt2, 247, 0, bb2)

'create EDIT1 - multiline --------------------------------------------
edit1 = SetEditBox(win,44,480,500,80, outBuff,  WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUT​OVSCROLL,0x200,ed1ID) '50B01004 processing box
'create static control
static1 = SetStatic(win,6,8,54,16,"LINES",0,0,stID1) 'static 'LINES'
static2 = SetStatic(win,6,35,54,16,"LINE >>",0,0,staticID2) 'static 'LINES'
edit2 = SetEditBox(win,50,5,70,20,"num of Lines",0x50800000,0x200,editID2) 'edit for number of lines
edit3 = SetEditBox(win,50,32,710,22,"current Line",0x50800000,0x200,editID2) 'edit for current line
ControlFont(edit3, 15, 8, 400, "Courier New"): SetFocus edit3
static3 = SetStatic(win,120,8,54,16,"T-LINE",0,0,staticID3) 'static 'LINES'
edit4 = SetEditBox(win,160,6,60,20,"Line Num",0x50800000,0x200,editID4)

static4 = SetStatic(win,230,8,54,16,"T-CHAR",0,0,staticID4) 'static 'temp char
edit5 = SetEditBox(win,280,6,60,20,"CHAR",0x50800000,0x200,editID5) ' show char
ControlFont(edit5, 17, 9, 600, "Courier New")

static5 = SetStatic(win,350,8,54,16,"CHAR-POS",0,0,staticID5) 'static 'charPos
edit6 = SetEditBox(win,410,6,60,20,"POS",0x50800000,0x200,editID6) ' position in line

'create RICHEDIT1 ################################################################################​##########
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4 /::src code line::
riched= SetRichEdit (win, 44,60,500,400,"a = a+b", WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_NOHIDESEL,0x200,richID)
ControlFont(riched, 15, 8, 400, "Courier New") : SetRichEditBackColor riched, RGB(250,244,179)
SetEditSelection( riched, -1,-1):InvalidateRect( riched, 0, 0)

'create listbox for token list ##########################################################################
LBoxH = SetListBox(win,560,60,200,400,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LBid)
ControlFont(LBoxH, 17,7, 100, "Courier New")
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-1"
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-2"

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

            CASE WM_CREATE
             'InitDrawing(win)
             'WindowColor( win, 220, 230, 250)

            CASE WM_PAINT
             BitBlt(hDC, 0, 0, ww, hh, hdcMem, 0, 0, SRCCOPY)
             InvalidateRect(win, 0, 0)
                
            CASE WM_CLOSE
                CloseWindow(win)
                EndProgram
                  ExitProcess 0

            CASE WM_COMMAND
                controlID = LoWord(wParam) 'get control ID
                notifyCode = HiWord(wParam) 'get notification message

                select controlID
                    case b1ID  'open file
                       if notifycode=0
                       doOpen()
                    end if

                    case b0ID 'scan >>>
                       if notifycode=0
                       doScan()
                    end if

                  end select
        End Select
END SELECT
RETURN Default
END FUNCTION

'************************************************
'****    A N I -> P R O C E S S I N G    ********
'************************************************

'open source file
Sub doOpen
string fName="", dir="", sep=chr(0) , title="Open File... "
filter = "All Files "+sep+"*.*"+sep+"Bscript files "+sep+"*.bas"
title="Open File... "
fName = FileDialog(dir,filter,title,0,0,"txt")
IF fName = ""  'almost useless ?
SendMessage edit1,WM_SETTEXT,0,strptr("NO FILE ! ") : Return
END IF
'SendMessage status,WM_SETTEXT,0,strptr(fName)
char tx[500000] : tx =  GetFile fName      'load file into char buffer
'SendMessage riched, 12, 0, strptr(tx)       'show file in richedit
SetText (riched,tx)
string numOfLines : int LineCount : LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0
numOfLines = str(LineCount) : SetText (edit2,numOfLines) ' show result in edit2
outBuff = outBuff + "file_loaded..." + crlf                  : SetText (edit1,outBuff)
outBuff = outBuff + "number of lines : " + numOfLines + crlf : SetText (edit1,outBuff)
frees tx
End Sub

'scan source line -----------------------------------------------------------------------
Sub doScan
string s,sc,cLine, tbuff
string pt = Space (255)  ' also you may try char pt[255]=""
int i ,LineCount=1 ,crPos, first
ipos=0 'reset item position
SetText(edit3,"")  ' clear current line box
LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0 ' get number of Lines
SetText (edit1,"WAIT..scanning >>>>") : MsgBox "SCAN FILE","OK!..START"
'scan each line
For i = 0 to LineCount-1
    ' enable events..so i use PeekMessage.....................
        ' while PeekMessage (&wm,0,0,0,Pm_Remove)>0 ' //peek
            'TranslateMessage (&wm)
            'DispatchMessage (&wm)
        'wend
    SendMessage (riched, EM_GETLINE, i, pt) ' get line from richedit control
    'first = SendMessage riched, EM_LINEINDEX, i, 0
    ' MsgBox pt , "INFO"
     if pt <> ""
        s = Ltrim(pt)                 'trim left side
         crPos = instr(pt,chr(13)) :   ' check CR position /msgbox "POS:"+str(crPos),"CHR(13).POS"
         s = MID( pt, 1, crPos-1)      ' extract string / text
     else
        s=""                        
     end if
    
      SetText edit4,  str(i)            'show line number
      SetText(edit3, s)                 'show current line in single-Line edit box
      cLine = GetText(edit3)            'get text from edit control
      Tokenizer(cLine)                  'tokenize line
  
     'get char func >>>>>>>>>>>>>>>>>>
        GetChar(cLine)
      '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        'Sendmessage riched,EM_HIDESEL,i,0
        'SetEditSelection( riched, first,len pt)
        'Sendmessage riched,EM_HIDESEL,i,0
      s="" : 'sleep = 100                  ' slow down..tweak for your computer-200
'SendMessage riched,EM_SCROLL ,1,0
Next i

SetText edit1,"FINISHED!"
End Sub
'-----------------------------------------------------------------------------------------

SUB GetChar(string sLine)
int pos=1,lineSize
string ch,nextCh,tLine
    tLine = Mid(sLine,1,Len(sLine))
    lineSize=LEN(tLine)
        while pos <= lineSize
            ch = Mid( tLine,pos,1)
                ' sleep 100  '200
                 SetText(edit5,ch)       'show character
                 SetText(edit6,str(pos)) 'show char position in line
                 ch=""
            pos=pos+1
        wend
End Sub
'-----------------------------------------------------------------------------------------

Function SetEditSelection(int eHandle, sStart, sEnd)
  SendMessage( ehandle, EM_SETSEL, sstart, send)
End Function

function tokenizer(code as string)
     'print "CODE:" + code
    string token, ch
    'load file?
    '
    INT i,j
    '................................
    'print "CODE-LEN:" + str(len(code))
    '.................................
    i=1
    WHILE i <= len(code)
        
        IF instr(ALPHABETS, mid(code,i,1)) <> 0            'isAlpha
            while i <= len(code) and INSTR(ALPHABETS ,mid(code,i,1)) > 0
                token = token + mid(code, i, 1)            
                  i=i+1
             wend  
             'PRINT "alpha:" str i
            'print token        
             if  ucase(token)= isKeyword(token)   ' search keyword list
                token = token + " ~ KEYWORD"
                  SendMessage LboxH, LB_ADDSTRING, 0, token
                  'ipos++
                  token=""
            else
                token = token + " ~ IDENTIFIER"  'variabe
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                   'ipos++
                   token=""
             end if
            'token=""
            'i=i+1
          END IF  
        
        IF instr(SYMBOLS, mid(code, i, 1)) > 0 and  i <= len(code)'sym operators
              token = mid(code, i, 1)
               'print token
              byte t at strptr(token)
             select t
              case "+"
            token = "+" + " ~PLUS"
              SendMessage LboxH, LB_ADDSTRING, 0, token
              case "-"
            token = "-" + " ~MINUS"
              SendMessage LboxH, LB_ADDSTRING, 0, token
            case "*"
            token = "*" + " ~MULTI"
              SendMessage LboxH, LB_ADDSTRING, 0, token
            case "/"
            token = "/" + " ~DIVIDE"
              SendMessage LboxH, LB_ADDSTRING, 0, token
            case "^"
            token = "^" + " ~POWER"
              SendMessage LboxH, LB_ADDSTRING, 0, token
            case "("
            token = "(" + " ~LPAREN"
              SendMessage LboxH, LB_ADDSTRING, 0, token
              case ")"
            token = ")" + " ~RPAREN"
              SendMessage LboxH, LB_ADDSTRING, 0, token
            case "["
            token = "[" + " ~LBRACKET"
              SendMessage LboxH, LB_ADDSTRING, 0, token
              case "]"
            token = "]" + " ~RBRACKET"
              SendMessage LboxH, LB_ADDSTRING, 0, token
            case ","
              token = "," + " ~COMMA"
            SendMessage LboxH, LB_ADDSTRING, 0, token
            case ":"
              token = ":" + " ~COLON"
            SendMessage LboxH, LB_ADDSTRING, 0, token
            case "="
              token = "=" + " ~EQUAL"
            SendMessage LboxH, LB_ADDSTRING, 0, token

            end select
            i=i+1
            token=""
        END IF
  
        IF instr(NUMBERS, mid(code, i, 1)) <> 0 and i <= len(code)   'numbers
            while i <= len(code) and INSTR(NUMBERS,mid(code,i,1)) <> 0
                token = token + mid(code,i,1)
                  i=i+1
              wend
            token = token + "  ~ NUMBER" + crlf
             SendMessage LboxH, LB_ADDSTRING, 0, token
              ' ipos++
             token=""
        END IF

        'elseif ch = chr(34) 'quote "
          IF INSTR(mid(code,i,1),DQ) <> 0
            'token = ""
            i = i + 1 ' skip first quote "......
            while mid(code,i,1) <> chr(34) 'string literal inside quotes "......."
                token = token + mid(code,i,1)
                i=i+1
              wend
                'tokens = tokens + token '+ " ~ STRING-LITERAL" + crlf
                 SendMessage LboxH, LB_ADDSTRING, 0, token + " ~STRING"
              token=""
              i=i+2 ' skip second quote  ......"
        END IF

        IF mid(code, i, 1) = " "  'whitespace
              'print "WHITE:" + str(i)
            i=i+1 'skip whitespace
        END IF

        'elseif ch = chr(10) ' not used because of CRLF in bufer -> tokens
         'IF i <= len(code) and mid(code,i,1) = chr(10)
            'tokens = tokens + mid(code,i,1) + " :NEWLINE" + crlf ' or end of instruction
          'print "NEWLINE"
           'return  
            'i=i+1
         'END IF
        'else
            'tokens = tokens + ch + " :UNINDENTIFIED - ERROR!" + crlf
            'i=i+1

        
    'PRINT "BEFORE_WEND:" + str(i)
    
    WEND

    'Return token
    ' Return

end function
'...........................................................
function isKeyword(byval tok as string) as string
'string ret
for n = 1 to 14
    if ucase(tok) = KEYWORDS[n]     ' if is KEYWORD
        RETURN KEYWORDS[n]  
    end if
next n
Return ""
end function


Attached File(s) Image(s)
   
Find all posts by this user
Quote this message in a reply
04-24-2018, 09:43 PM
Post: #3
RE: ANI script v3
small additions...token counter and hdc text

Code:
$ Filename "ANIscript.exe" ' o2
include "RTL32.inc"
include "awinh.inc"
#lookahead
string KEYWORDS[] = {"CLS","PRINT","IF","ELSE","FOR","TO","NEXT","ENDIF","WHILE","WEND","UNTIL","DOT","LINE","WINDOW"}
string SYMBOLS = ",:=()+-*/<>[]^"
string ALPHABETS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$#"
string DQ = chr(34)
string NUMBERS = ".0123456789"
string NUMBERS_WITH_DECIMALPOINT = NUMBERS + "."
string ALPHANUMBERS = ALPHABETS + NUMBERS
string ALPHANUMBERS_WITH_UNDERSCORE = ALPHANUMBERS + "_"
STRING tokens , tokenList[1024] ' token list
string crlf = chr(13)+chr(10)
INT tokTypeList[1024]           'token type list
int tokCount
'------------------------------------------------------------------------

INT win,wx=100,wy=0,ww=840,wh=640,wstyle = WS_MINMAXSIZE
INT bt0,b0ID=100,bt1,b1ID=101,bt2,b2ID=102 'buttons
INT static1,stID1=10,static2,staticID2=11,static3,staticID3=12,static4,staticID4=13,​static5,staticID5=14  'staticTX
INT edit1,ed1ID=200,riched,richID=400,LBoxH,LBid=500,edit2,editID2=50
INT edit3,editID3=51,edit4,editID4=52,edit5,editID5=53,edit6,editID6=54
INT ipos ' LB item pos
STRING  outBuff="processing..." + crlf
STRING source[1000] ' source lines array
string pt = Space (255)
'bitmap image handlers -------------------------------------------------
INT bb0,bb1,bb2
'create main window ||||||||||||||||||||||||||||||||||||||||||||||||||||
win=SetWindow("ANI::v2",wx,wy,ww,wh,0,wstyle)
    InitDrawing(win)
    WindowColor( win, 220, 230, 250)
InvalidateRect(win, 0, 0)
'crete buttons||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
bt0 = SetButton(win,4,60,34,34,"New", 1409384576,0x200,b0ID)  'as image button flat 1409384576 - 1409351808
bb0 = LoadImage(0,"bScan.bmp",0,32,32,16):SendMessage(bt0, 247, 0, bb0) 'add bitmap to button
bt1 = SetButton(win,4,98,34,34,"Open", 1409384576,0x200,b1ID)
bb1 = LoadImage(0,"bOpen.bmp",0,32,32,16):SendMessage(bt1, 247, 0, bb1)
bt2 = SetButton(win,4,140,34,34,"Save", 1409384576,0x200,b2ID)
bb2 = LoadImage(0,"bProc.bmp",0,32,32,16):SendMessage(bt2, 247, 0, bb2)

'create EDIT1 - multiline --------------------------------------------
edit1 = SetEditBox(win,44,480,500,100, outBuff,  WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUT​OVSCROLL,0x200,ed1ID) '50B01004 processing box
ControlFont(edit1, 17,7, 100, "Courier New")
'create static control
static1 = SetStatic(win,6,8,54,16,"LINES",0,0,stID1) 'static 'LINES'
static2 = SetStatic(win,6,35,54,16,"LINE >>",0,0,staticID2) 'static 'LINES'
edit2 = SetEditBox(win,50,5,70,20,"num of Lines",0x50800000,0x200,editID2) 'edit for number of lines
edit3 = SetEditBox(win,50,32,710,22,"current Line",0x50800000,0x200,editID2) 'edit for current line
ControlFont(edit3, 15, 8, 400, "Courier New"): SetFocus edit3
static3 = SetStatic(win,120,8,54,16,"T-LINE",0,0,staticID3) 'static 'LINES'
edit4 = SetEditBox(win,160,6,60,20,"Line Num",0x50800000,0x200,editID4)

static4 = SetStatic(win,230,8,54,16,"T-CHAR",0,0,staticID4) 'static 'temp char
edit5 = SetEditBox(win,280,6,60,20,"CHAR",0x50800000,0x200,editID5) ' show char
ControlFont(edit5, 17, 9, 600, "Courier New")

static5 = SetStatic(win,350,8,54,16,"CHAR-POS",0,0,staticID5) 'static 'charPos
edit6 = SetEditBox(win,410,6,60,20,"POS",0x50800000,0x200,editID6) ' position in line

'create RICHEDIT1 ################################################################################​##########
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4 /:rc code line::
riched= SetRichEdit (win, 44,60,500,400,"a = a+b", WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_NOHIDESEL,0x200,richID)
ControlFont(riched, 15, 8, 400, "Courier New") : SetRichEditBackColor riched, RGB(250,244,179)
SetEditSelection( riched, -1,-1):InvalidateRect( riched, 0, 0)

'create listbox for token list ##########################################################################
LBoxH = SetListBox(win,560,60,200,500,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LBid)
ControlFont(LBoxH, 17,7, 100, "Courier New"): TextColor ( win, RGB(100,120,180), RGB(210,220,250))
TextOn( win, 560, 562, "  TOKENS ")  ' print text on window
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-1"
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-2"

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

           CASE WM_CREATE
            'InitDrawing(win)
            'WindowColor( win, 220, 230, 250)

           CASE WM_PAINT
            BitBlt(hDC, 0, 0, ww, wh, hdcMem, 0, 0, SRCCOPY)
            InvalidateRect(win, 0, 0)
                
            CASE WM_CLOSE
                CloseWindow(win)
                EndProgram
                 ExitProcess 0

            CASE WM_COMMAND
                controlID = LoWord(wParam) 'get control ID
                notifyCode = HiWord(wParam) 'get notification message

                select controlID
                    case b1ID  'open file
                      if notifycode=0
                       doOpen()
                    end if

                    case b0ID 'scan >>>
                      if notifycode=0
                       doScan()
                    end if

                 end select
        End Select
END SELECT
RETURN Default
END FUNCTION

'************************************************
'****    A N I -> P R O C E S S I N G    ********
'************************************************

'open source file
Sub doOpen
string fName="", dir="", sep=chr(0) , title="Open File... "
filter = "All Files "+sep+"*.*"+sep+"Bscript files "+sep+"*.bas"
title="Open File... "
fName = FileDialog(dir,filter,title,0,0,"txt")
IF fName = ""  'almost useless ?
SendMessage edit1,WM_SETTEXT,0,strptr("NO FILE ! ") : Return
END IF
'SendMessage status,WM_SETTEXT,0,strptr(fName)
char tx[500000] : tx =  GetFile fName      'load file into char buffer
'SendMessage riched, 12, 0, strptr(tx)       'show file in richedit
SetText (riched,tx)
string numOfLines : int LineCount : LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0
numOfLines = str(LineCount) : SetText (edit2,numOfLines) ' show result in edit2
outBuff = outBuff + "file_loaded..." + crlf                  : SetText (edit1,outBuff)
outBuff = outBuff + "number of lines : " + numOfLines + crlf : SetText (edit1,outBuff)
frees tx
End Sub

'scan source line -----------------------------------------------------------------------
Sub doScan
string s,sc,cLine, tbuff
string pt = Space (255)  ' also you may try char pt[255]=""
int i ,LineCount=1 ,crPos, first
ipos=0 : tokCount = 0 'reset item position and token count
SetText(edit3,"")  ' clear current line box
LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0 ' get number of Lines
SetText (edit1,"WAIT..scanning >>>>") : MsgBox "SCAN CODE","OK!..START"
'scan each line
For i = 0 to LineCount-1
   ' enable events..so i use PeekMessage.....................
       ' while PeekMessage (&wm,0,0,0,Pm_Remove)>0 ' //peek
            'TranslateMessage (&wm)
            'DispatchMessage (&wm)
        'wend
    SendMessage (riched, EM_GETLINE, i, pt) ' get line from richedit control
   'first = SendMessage riched, EM_LINEINDEX, i, 0
   ' MsgBox pt , "INFO"
    if pt <> ""
        s = Ltrim(pt)                 'trim left side
        crPos = instr(pt,chr(13)) :   ' check CR position /msgbox "POS:"+str(crPos),"CHR(13).POS"
        s = MID( pt, 1, crPos-1)      ' extract string / text
    else
        s=""                        
    end if
  
     SetText edit4,  str(i)            'show line number
     SetText(edit3, s)                 'show current line in single-Line edit box
     cLine = GetText(edit3)            'get text from edit control
     Tokenizer(cLine)                  'tokenize line

     'get char func >>>>>>>>>>>>>>>>>>
        GetChar(cLine)
     '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        'Sendmessage riched,EM_HIDESEL,i,0
        'SetEditSelection( riched, first,len pt)
        'Sendmessage riched,EM_HIDESEL,i,0
     s="" : 'sleep = 100                  ' slow down..tweak for your computer-200
'SendMessage riched,EM_SCROLL ,1,0
Next i
outBuff = "TOKENIZATION FINISHED!" + crlf : outBuff = outBuff + "Token Count: " + str(tokCount) + crlf
SetText edit1, outBuff
End Sub
'-----------------------------------------------------------------------------------------

SUB GetChar(string sLine)
int pos=1,lineSize
string ch,nextCh,tLine
    tLine = Mid(sLine,1,Len(sLine))
    lineSize=LEN(tLine)
        while pos <= lineSize
            ch = Mid( tLine,pos,1)
               ' sleep 100  '200
                SetText(edit5,ch)       'show character
                SetText(edit6,str(pos)) 'show char position in line
                ch=""
            pos=pos+1
        wend
End Sub
'-----------------------------------------------------------------------------------------

Function SetEditSelection(int eHandle, sStart, sEnd)
SendMessage( ehandle, EM_SETSEL, sstart, send)
End Function

function tokenizer(code as string)
    'print "CODE:" + code
    string token, ch
    'load file?
    '
    INT i,j
    '................................
    'print "CODE-LEN:" + str(len(code))
   '.................................
    i=1
    WHILE i <= len(code)
        
        IF instr(ALPHABETS, mid(code,i,1)) <> 0            'isAlpha
            while i <= len(code) and INSTR(ALPHABETS ,mid(code,i,1)) > 0
                token = token + mid(code, i, 1)            
                 i=i+1
            wend  
            'PRINT "alpha:" str i
           'print token        
            if  ucase(token)= isKeyword(token)   ' search keyword list
                token = token + " ~ KEYWORD" : tokCount++
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                 'ipos++
                 token=""
            else
                token = token + " ~ IDENTIFIER" : tokCount++ 'variabe
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                  'ipos++
                  token=""
            end if
           'token=""
           'i=i+1
         END IF  
        
        IF instr(SYMBOLS, mid(code, i, 1)) > 0 and  i <= len(code)'sym operators
             token = mid(code, i, 1)
              'print token
             byte t at strptr(token)
            select t
             case "+"
            token = "+" + " ~PLUS"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
             case "-"
            token = "-" + " ~MINUS"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "*"
            token = "*" + " ~MULTI"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "/"
            token = "/" + " ~DIVIDE"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "^"
            token = "^" + " ~POWER"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "("
            token = "(" + " ~LPAREN"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
             case ")"
            token = ")" + " ~RPAREN"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "["
            token = "[" + " ~LBRACKET"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
             case "]"
            token = "]" + " ~RBRACKET"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case ","
             token = "," + " ~COMMA"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case ":"
             token = ":" + " ~COLON"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "="
             token = "=" + " ~EQUAL"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            end select
            i=i+1
           token=""
        END IF

        IF instr(NUMBERS, mid(code, i, 1)) <> 0 and i <= len(code)   'numbers
            while i <= len(code) and INSTR(NUMBERS,mid(code,i,1)) <> 0
                token = token + mid(code,i,1)
                 i=i+1
             wend
            token = token + "  ~ NUMBER" : tokCount++
             SendMessage LboxH, LB_ADDSTRING, 0, token
             ' ipos++
            token=""
        END IF

        'elseif ch = chr(34) 'quote "
         IF INSTR(mid(code,i,1),DQ) <> 0
            'token = ""
            i = i + 1 ' skip first quote "......
            while mid(code,i,1) <> chr(34) 'string literal inside quotes "......."
                token = token + mid(code,i,1)
                i=i+1
             wend
                'tokens = tokens + token '+ " ~ STRING-LITERAL" + crlf
                 SendMessage LboxH, LB_ADDSTRING, 0, token + " ~STRING": tokCount++
             token=""
             i=i+2 ' skip second quote  ......"
        END IF

        IF mid(code, i, 1) = " "  'whitespace
             'print "WHITE:" + str(i)
            i=i+1 'skip whitespace
        END IF

        'elseif ch = chr(10) ' not used because of CRLF in bufer -> tokens
        'IF i <= len(code) and mid(code,i,1) = chr(10)
            'tokens = tokens + mid(code,i,1) + " :NEWLINE" + crlf ' or end of instruction
         'print "NEWLINE"
          'return  
            'i=i+1
        'END IF
        'else
            'tokens = tokens + ch + " :UNINDENTIFIED - ERROR!" + crlf
            'i=i+1

      
    'PRINT "BEFORE_WEND:" + str(i)
  
    WEND

    'Return token
   ' Return

end function
'...........................................................
function isKeyword(byval tok as string) as string
'string ret
for n = 1 to 14
   if ucase(tok) = KEYWORDS[n]     ' if is KEYWORD
        RETURN KEYWORDS[n]  
   end if
next n
Return ""
end function

'##########################################################
SUB TextColor (wID as INT,byval frontColor as INT,byval  backColor as INT )
hdc = GetDC(wID)
SetTextColor( hDC, frontColor)
SetBkColor( hDC, backColor)
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
'########################################################

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
'..........................................................
Sub ELIPSE(int x, y, r1,r2, color)
hdc=GetDc win
SelectObject(hdc, CreateSolidBrush( color ))
Ellipse Hdc,x,y,r1+x,r2+y
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)
ReleaseDC( win, hdc)
End Sub

'##########################################################
SUB InitDrawing
''get current size of window
GetSize(win,0,0,ww,wh)
'get window DC
hdc=GetDC(win)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(hdc, ww, wh)
oldBmp = SelectObject( hdcMem, hbmMem )
oldBrush = SelectObject(hdcMem, CreateSolidBrush( RGB(231,223,231)) )
oldPen = SelectObject(hdcMem, CreatePen(PS_SOLID,1,RGB(231,223,231)))
'fill rectangle memDC with brush color
FillRect ( hdcMem,rc, oldBrush)
SetTextColor( hDC,RGB(0,0,0))
SetBkColor( hDC, RGB(231,223,231))
'blit to memDC
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( win, hdc)
End SUB

'##########################################################
SUB CleanUp

DeleteDC(hdcMem)
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldPen))
DeleteObject(SelectObject(hdcMem, oldBmp))


END SUB


Attached File(s) Image(s)
   
Find all posts by this user
Quote this message in a reply
05-02-2018, 01:55 AM
Post: #4
RE: ANI script v3
And more for FUN
In fact is NOT just for fun..or ( i don't know) Big Grin
Ok here is little bit more powerful version
I tested 400 lines of VB code ::

Code:
$ Filename "ANIscript.exe" ' o2
include "RTL32.inc"
include "awinh037.inc"
#lookahead
string KEYWORDS[] = {"CLS","PRINT","IF","ELSE","ENDIF","FOR","TO","NEXT","SUB","RETURN","CIRCLE","DOT","LINE","WINDOW"}
string SYMBOLS = ",:=()+-*/<>[]^&|%"
string ALPHABETS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$#"
string DQ = chr(34)
string NUMBERS = ".0123456789"
string NUMBERS_WITH_DECIMALPOINT = NUMBERS + "."
string ALPHANUMBERS = ALPHABETS + NUMBERS
string ALPHANUMBERS_WITH_UNDERSCORE = ALPHANUMBERS + "_"
STRING tokens , tokenList[1024] ' token list
string crlf = chr(13)+chr(10)
INT tokTypeList[1024]           'token type list
INT tokCount
'------------------------------------------------------------------------

INT win,wx=100,wy=0,ww=840,wh=640,wstyle = WS_MINMAXSIZE
INT bt0,b0ID=100,bt1,b1ID=101,bt2,b2ID=102 'buttons
INT static1,stID1=10,static2,staticID2=11,static3,staticID3=12,static4,staticID4=13,​static5,staticID5=14  'staticTX
INT edit1,ed1ID=200,riched,richID=400,LBoxH,LBid=500,edit2,editID2=50
INT edit3,editID3=51,edit4,editID4=52,edit5,editID5=53,edit6,editID6=54
INT ipos ' LB item pos
STRING  outBuff="processing..." + crlf
STRING source[1000] ' source lines array
string pt = Space (255)
'bitmap image handlers -------------------------------------------------
INT bb0,bb1,bb2
'create main window ||||||||||||||||||||||||||||||||||||||||||||||||||||
win=SetWindow("ANI::v3",wx,wy,ww,wh,0,wstyle)
    InitDrawing(win)
    WindowColor( win, 220, 230, 250)
InvalidateRect(win, 0, 0)
'crete buttons||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
bt0 = SetButton(win,4,60,34,34,"New", 1409384576,0x200,b0ID)  'as image button flat 1409384576 - 1409351808
bb0 = LoadImage(0,"bScan.bmp",0,32,32,16):SendMessage(bt0, 247, 0, bb0) 'add bitmap to button
bt1 = SetButton(win,4,98,34,34,"Open", 1409384576,0x200,b1ID)
bb1 = LoadImage(0,"bOpen.bmp",0,32,32,16):SendMessage(bt1, 247, 0, bb1)
bt2 = SetButton(win,4,140,34,34,"Save", 1409384576,0x200,b2ID)
bb2 = LoadImage(0,"bProc.bmp",0,32,32,16):SendMessage(bt2, 247, 0, bb2)

'create EDIT1 - multiline --------------------------------------------
edit1 = SetEditBox(win,44,480,500,100, outBuff,  WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUT​OVSCROLL,0x200,ed1ID) '50B01004 processing box
ControlFont(edit1, 17,7, 100, "Courier New")
'create static control
static1 = SetStatic(win,6,8,54,16,"LINES",0,0,stID1) 'static 'LINES'
static2 = SetStatic(win,6,35,54,16,"LINE >>",0,0,staticID2) 'static 'LINES'
edit2 = SetEditBox(win,50,5,70,20,"num of Lines",0x50800000,0x200,editID2) 'edit for number of lines
edit3 = SetEditBox(win,50,32,710,22,"current Line",0x50800000,0x200,editID2) 'edit for current line
ControlFont(edit3, 15, 8, 400, "Courier New"): SetFocus edit3
static3 = SetStatic(win,120,8,54,16,"T-LINE",0,0,staticID3) 'static 'LINES'
edit4 = SetEditBox(win,160,6,60,20,"Line Num",0x50800000,0x200,editID4)

static4 = SetStatic(win,230,8,54,16,"T-CHAR",0,0,staticID4) 'static 'temp char
edit5 = SetEditBox(win,280,6,60,20,"CHAR",0x50800000,0x200,editID5) ' show char
ControlFont(edit5, 17, 9, 600, "Courier New")

static5 = SetStatic(win,350,8,54,16,"CHAR-POS",0,0,staticID5) 'static 'charPos
edit6 = SetEditBox(win,410,6,60,20,"POS",0x50800000,0x200,editID6) ' position in line

'create RICHEDIT1 ################################################################################​##########
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4 /:rc code line::
riched= SetRichEdit (win, 44,60,500,400,"a = a+b", WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_NOHIDESEL,0x200,richID)
ControlFont(riched, 15, 8, 400, "Courier New") : SetRichEditBackColor riched, RGB(250,244,179)
SetEditSelection( riched, -1,-1):InvalidateRect( riched, 0, 0)

'create listbox for token list ##########################################################################
LBoxH = SetListBox(win,560,60,200,500,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LBid)
ControlFont(LBoxH, 17,7, 100, "Courier New"): TextColor ( win, RGB(100,120,180), RGB(210,220,250))
TextOn( win, 560, 562, "  TOKENS ")  ' print text on window
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-1"
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-2"

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

           'CASE WM_CREATE
            'InitDrawing(win)
            'WindowColor( win, 220, 230, 250)

           CASE WM_PAINT
            BitBlt(hDC, 0, 0, ww, wh, hdcMem, 0, 0, SRCCOPY)
            InvalidateRect(win, 0, 0)
                
            CASE WM_CLOSE
                CloseWindow(win)
                EndProgram
                 ExitProcess 0

            CASE WM_COMMAND
                controlID = LoWord(wParam) 'get control ID
                notifyCode = HiWord(wParam) 'get notification message

                select controlID
                    case b1ID  'open file
                      if notifycode=0
                       doOpen()
                    end if

                    case b0ID 'scan >>>
                      if notifycode=0
                       doScan()
                    end if

                 end select
        End Select
END SELECT
RETURN Default
END FUNCTION

'************************************************
'****    A N I -> P R O C E S S I N G    ********
'************************************************

'open source file
Sub doOpen
string fName="", dir="", sep=chr(0) , title="Open File... "
filter = "All Files "+sep+"*.*"+sep+"Bscript files "+sep+"*.bas"
title="Open File... "
fName = FileDialog(dir,filter,title,0,0,"txt")
IF fName = ""  'almost useless ?
SendMessage edit1,WM_SETTEXT,0,strptr("NO FILE ! ") : Return
END IF
'SendMessage status,WM_SETTEXT,0,strptr(fName)
char tx[500000] : tx =  GetFile fName      'load file into char buffer
'SendMessage riched, 12, 0, strptr(tx)       'show file in richedit
SetText (riched,tx)
string numOfLines : INT LineCount : LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0
numOfLines = str(LineCount) : SetText (edit2,numOfLines) ' show result in edit2
outBuff = outBuff + "file_loaded..." + crlf                  : SetText (edit1,outBuff)
outBuff = outBuff + "number of lines : " + numOfLines + crlf : SetText (edit1,outBuff)
frees tx
'reset lisbox content
SendMessage LBoxH,LB_RESETCONTENT,0, NULL
End Sub

'scan source line -----------------------------------------------------------------------
Sub doScan
string s,sc,cLine, tbuff
string pt = Space (255)  ' also you may try char pt[255]=""
INT i ,LineCount=1 ,crPos, first
ipos=0 : tokCount = 0 'reset item position and token count
SetText(edit3,"")  ' clear current line box
LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0 ' get number of Lines
SetText (edit1,"WAIT..scanning >>>>") : MsgBox "SCAN CODE","OK!..START"
'scan each line
For i = 0 to LineCount-1
   ' enable events..so i use PeekMessage.....................
        while PeekMessage (wm,0,0,0,Pm_Remove)>0 ' //peek
            TranslateMessage (wm)
            DispatchMessage (wm)
        wend
    SendMessage (riched, EM_GETLINE, i, pt) ' get line from richedit control
   'first = SendMessage riched, EM_LINEINDEX, i, 0
   ' MsgBox pt , "INFO"
    if pt <> ""
        s = Ltrim(pt)                 'trim left side
        crPos = instr(pt,chr(13)) :   ' check CR position /msgbox "POS:"+str(crPos),"CHR(13).POS"
        s = MID( pt, 1, crPos-1)      ' extract string / text
    else
        s=""                        
    end if
  
     SetText edit4,  str(i)            'show line number
     SetText(edit3, s)                 'show current line in single-Line edit box
     cLine = GetText(edit3)            'get text from edit control
     Tokenizer(cLine)                  'tokenize line

     'get char func >>>>>>>>>>>>>>>>>>
        GetChar(cLine)
     '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        'Sendmessage riched,EM_HIDESEL,i,0
        'SetEditSelection( riched, first,len pt)
        'Sendmessage riched,EM_HIDESEL,i,0
     s="" : 'sleep = 100                  ' slow down..tweak for your computer-200
SendMessage riched,EM_SCROLL ,1,0
Next i
outBuff = "TOKENIZATION FINISHED!" + crlf : outBuff = outBuff + "Token Count: " + str(tokCount) + crlf
SetText edit1, outBuff
End Sub
'-----------------------------------------------------------------------------------------

SUB GetChar(string sLine)
INT pos=1,lineSize
string ch,nextCh,tLine
    tLine = Mid(sLine,1,Len(sLine))
    lineSize=LEN(tLine)
        while pos <= lineSize
            ch = Mid( tLine,pos,1)
               ' sleep 100  '200
                SetText(edit5,ch)       'show character
                SetText(edit6,str(pos)) 'show char position in line
                ch=""
            pos=pos+1
        wend
End Sub
'-----------------------------------------------------------------------------------------

Function SetEditSelection(INT eHandle, sStart, sEnd)
SendMessage( ehandle, EM_SETSEL, sstart, send)
End Function

function tokenizer(code as string)
    'print "CODE:" + code
    string token, ch
    'load file?
    '
    INT i,j
    '................................
    'print "CODE-LEN:" + str(len(code))
   '.................................
    i=1
    WHILE i <= len(code)
        
        IF instr(ALPHABETS, mid(code,i,1)) <> 0            'isAlpha
            while i <= len(code) and INSTR(ALPHABETS ,mid(code,i,1)) > 0
                token = token + mid(code, i, 1)            
                 i=i+1
            wend  
            'PRINT "alpha:" str i
           'print token        
            if  ucase(token)= isKeyword(token)   ' search keyword list
                token = token + " ~ KEYWORD" : tokCount++
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                 'ipos++
                 token=""
            else
                token = token + " ~ IDENTIFIER" : tokCount++ 'variabe
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                  'ipos++
                  token=""
            end if
           'token=""
           'i=i+1
         END IF  
        
        IF instr(SYMBOLS, mid(code, i, 1)) > 0 and  i <= len(code)'sym operators
             token = mid(code, i, 1)
              'print token
             byte t at strptr(token)
            select t
             case "+"
            token = "+" + " ~PLUS"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
             case "-"
            token = "-" + " ~MINUS"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "*"
            token = "*" + " ~MULTI"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "/"
            token = "/" + " ~DIVIDE"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "^"
            token = "^" + " ~POWER"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "("
            token = "(" + " ~LPAREN"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
             case ")"
            token = ")" + " ~RPAREN"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "["
            token = "[" + " ~LBRACKET"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
             case "]"
            token = "]" + " ~RBRACKET"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case ","
             token = "," + " ~COMMA"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case ":"
             token = ":" + " ~COLON"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "="
             token = "=" + " ~EQUAL"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
           case "&"
             token = "&" + " ~AND"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
          case "|"
             token = "|" + " ~OR"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
          case "%"
             token = "%" + " ~MOD"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            end select
            i=i+1
           token=""
        END IF

        IF instr(NUMBERS, mid(code, i, 1)) <> 0 and i <= len(code)   'numbers
            while i <= len(code) and INSTR(NUMBERS,mid(code,i,1)) <> 0
                token = token + mid(code,i,1)
                 i=i+1
             wend
            token = token + "  ~ NUMBER" : tokCount++
             SendMessage LboxH, LB_ADDSTRING, 0, token
             ' ipos++
            token=""
        END IF

        'elseif ch = chr(34) 'quote "
         IF INSTR(mid(code,i,1),DQ) <> 0
            'token = ""
            i = i + 1 ' skip first quote "......
            while mid(code,i,1) <> chr(34) 'string literal inside quotes "......."
                token = token + mid(code,i,1)
                i=i+1
             wend
                'tokens = tokens + token '+ " ~ STRING-LITERAL" + crlf
                 SendMessage LboxH, LB_ADDSTRING, 0, token + " ~STRING": tokCount++
             token=""
             i=i+2 ' skip second quote  ......"
        END IF

        IF mid(code, i, 1) = " "  'whitespace
             'print "WHITE:" + str(i)
            i=i+1 'skip whitespace
        END IF

       IF mid(code, i, 1) = "'"  'comment
            i=i+1 ' skip char " ' "
            'loop untill you get end of line chr(10)
            while i <= len(code) AND mid(code, i, 1) <> chr(13)
            i=i+1 'skip chars under comment
            wend
            i=i+1
        END IF


        'elseif ch = chr(10) ' not used because of CRLF in bufer -> tokens
        'IF i <= len(code) and mid(code,i,1) = chr(10)
            'tokens = tokens + mid(code,i,1) + " :NEWLINE" + crlf ' or end of instruction
         'print "NEWLINE"
          'return  
            'i=i+1
        'END IF
        'else
            'tokens = tokens + ch + " :UNINDENTIFIED - ERROR!" + crlf
            'i=i+1

      
    'PRINT "BEFORE_WEND:" + str(i)
  
    WEND

    'Return token
   ' Return

end function
'...........................................................
function isKeyword(byval tok as string) as string
'string ret
for n = 1 to 14
   if ucase(tok) = KEYWORDS[n]     ' if is KEYWORD
        RETURN KEYWORDS[n]  
   end if
next n
Return ""
end function

'##########################################################
SUB TextColor (wID as INT,byval frontColor as INT,byval  backColor as INT )
hdc = GetDC(wID)
SetTextColor( hDC, frontColor)
SetBkColor( hDC, backColor)
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
'########################################################

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
'..........................................................
Sub ELIPSE(INT x, y, r1,r2, color)
hdc=GetDc win
SelectObject(hdc, CreateSolidBrush( color ))
Ellipse Hdc,x,y,r1+x,r2+y
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)
ReleaseDC( win, hdc)
End Sub

'##########################################################
SUB InitDrawing
''get current size of window
GetSize(win,0,0,ww,wh)
'get window DC
hdc=GetDC(win)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(hdc, ww, wh)
oldBmp = SelectObject( hdcMem, hbmMem )
oldBrush = SelectObject(hdcMem, CreateSolidBrush( RGB(231,223,231)) )
oldPen = SelectObject(hdcMem, CreatePen(PS_SOLID,1,RGB(231,223,231)))
'fill rectangle memDC with brush color
FillRect ( hdcMem,rc, oldBrush)
SetTextColor( hDC,RGB(0,0,0))
SetBkColor( hDC, RGB(231,223,231))
'blit to memDC
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( win, hdc)
End SUB

'##########################################################
SUB CleanUp

DeleteDC(hdcMem)
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldPen))
DeleteObject(SelectObject(hdcMem, oldBmp))


END SUB

test VB code (JEL)
'JEL -o2 version
' JEL Main Executing Module (with class)
' © Copyright 2000 By http://www.oogle.net


Public Script As String
Private VarNames As New Collection
Private Variables As New Collection
Private ScriptForm As New frmProgram

Public Event LineChange(nLine As Integer, sContents As String)
'-----------------------------------------------------------------------------------
Sub ScriptExecute()
Dim sCurrentLine As String, nCurrentLine As Integer
Dim lCrLfSpot As Long, lCrLfSpotOld As Long
Dim iTemp As Integer, iTemp2 As Integer, i As Integer
Dim sTemp As String, sTemp2 As String
Dim arTemp() As String, arTemp2() As String
Dim StopLabel As String
Dim Skip As Bool
Dim IfSkip As Bool

Dim InsideLoop As New Collection

arTemp = Split(Script, vbCrLf)

For nCurrentLine = LBound(arTemp) To UBound(arTemp)
sCurrentLine = arTemp(nCurrentLine)
If sCurrentLine = "" Then GoTo SkipCurrentDo:
RaiseEvent LineChange(nCurrentLine, sCurrentLine)

' Get rid of comments
iTemp = InStr(1, sCurrentLine, "#")
If iTemp <> 0 Then
sCurrentLine = Mid(sCurrentLine, 1, iTemp - 1)
If sCurrentLine = "" Then GoTo SkipCurrentDo:
End If

' Check for a label
If StopLabel <> "" Then
If sCurrentLine = StopLabel Then
StopLabel = ""
End If
GoTo SkipCurrentDo:
End If

' Check for end of a block
If Skip = True Then
If LCase(sCurrentLine) = "end" Then
Skip = False
End If
GoTo SkipCurrentDo:
End If

' Skipping if stuff...
If IfSkip = True Then
Select Case LCase(sCurrentLine)
Case "end"
IfSkip = False
Case "else"
IfSkip = False
End Select
GoTo SkipCurrentDo:
Else
If LCase(sCurrentLine) = "else" Then
Skip = True
GoTo SkipCurrentDo:
End If
End If

' Looping block
If LCase(sCurrentLine) = "end" And InsideLoop.Count > 0 Then
If Eval(Mid(InsideLoop(InsideLoop.Count), InStr(1, InsideLoop(InsideLoop.Count), ":") + 1)) Then
nCurrentLine = CInt(Mid(InsideLoop(InsideLoopCount), 1, InStr(1, InsideLoop(InsideLoopCount), ":") - 1)) - 1
Else
InsideLoop.Remove InsideLoopCount
End If
GoTo SkipCurrentDo:
End If

' Chck if its one of those crazy things
iTemp = InStr(1, sCurrentLine, " ")
If iTemp <> 0 Then
Select Case LCase(Mid(sCurrentLine, 1, iTemp - 1))
Case "if" ' Need I explain?
If Not Eval(Mid(sCurrentLine, iTemp + 1)) Then
IfSkip = True
End If

GoTo SkipCurrentDo:
Case "goto" ' Goto a label
StopLabel = Trim(Mid(sCurrentLine, iTemp + 1))

GoTo SkipCurrentDo:
Case "var" ' Create variable
arTemp2 = Split(Trim(Mid(sCurrentLine, iTemp + 1)), ",")
For i = LBound(arTemp2) To UBound(arTemp2)
VarNamesAdd Trim(arTemp2(i))
VariablesAdd ""
Next i
GoTo SkipCurrentDo:
Case "while" ' Loop
If Eval(Mid(sCurrentLine, iTemp + 1)) Then
InsideLoopAdd nCurrentLine + 1 & ":" & Trim(Mid(sCurrentLine, iTemp + 1))
Else
Skip = True
End If
GoTo SkipCurrentDo:
End Select
End If

For i = 1 To Len(sCurrentLine)
Select Case Mid(sCurrentLine, i, 1)
Case "=" ' Assignment
ChangeVar Trim(Mid(sCurrentLine, 1, InStr(1, sCurrentLine, "=") - 1)), Equation(Mid(sCurrentLine, InStr(1, sCurrentLine, "=") + 1))
GoTo SkipCurrentDo:
Case "~" ' Assignment from Function
ChangeVar Trim(Mid(sCurrentLine, 1, InStr(1, sCurrentLine, "~") - 1)), DoFunction(Mid(sCurrentLine, InStr(1, sCurrentLine, "~") + 1))
GoTo SkipCurrentDo:
Case "(" ' Procedure Call
DoFunction sCurrentLine
GoTo SkipCurrentDo:
End Select
Next i

'LABEL skip current DO
SkipCurrentDo:
Next nCurrentLine

' Its the clean up crew!
For i = VarNames.Count To 1 Step -1
VarNamesRemove i
VariablesRemove i
Next i
End Sub
'--------------------------------------------------------------------
Sub ChangeVar(TheVar As String, NewVal As Variant)
Dim i As Integer
For i = VarNames.Count To 1 Step -1
If VarNames(i) = TheVar Then
VariablesRemove i
VarNamesRemove i

VariablesAdd NewVal
VarNamesAdd TheVar
Exit Sub
End If
Next i
End Sub
'---------------------------------------------------------------------
Function GetVar(TheVar As String) As Variant
Dim i As Integer
For i = 1 To VarNames.Count
If VarNames(i) = TheVar Then
GetVar = Variables(i)
Exit Function
End If
Next i
End Function
'------------------------------------------------------------------------
Function Eval(ByVal sFormula As String) As Bool
Dim i As Integer, iWait As Integer
Dim LeftVal As String, RightVal As String, Operator As String
Dim sTemp As String

' Get the left value
For i = 1 To Len(sFormula)
sTemp = Mid(sFormula, i, 1)
Select Case sTemp
Case "("
iWait = iWait + 1
Case ")"
iWait = iWait - 1
If iWait = 0 Then
LeftVal = Mid(sFormula, 1, i)
sFormula = Trim(Mid(sFormula, i + 1))
Exit For
End If
Case Chr(34)
i = InStr(i + 1, sFormula, Chr(34))
If iWait = 0 Then
LeftVal = Mid(sFormula, 1, i)
sFormula = Trim(Mid(sFormula, i + 1))
Exit For
End If
Case Else
If sTemp = ">" Or sTemp = "<" Or sTemp = "=" Then
If iWait = 0 Then
LeftVal = Trim(Mid(sFormula, 1, i - 1))
sFormula = Trim(Mid(sFormula, i))
Exit For
End If
End If
End Select
Next i

' Get the comparison operator
sTemp = Mid(sFormula, 2, 1)
If sTemp = ">" Or sTemp = "<" Or sTemp = "=" Then
Operator = Left(sFormula, 2)
sFormula = Mid(sFormula, 3)
Else
Operator = Left(sFormula, 1)
sFormula = Mid(sFormula, 2)
End If

' Set the rest to the right side operator
RightVal = sFormula
sFormula = ""

' Solve these sides
LeftVal = Equation(LeftVal)
RightVal = Equation(RightVal)

Select Case Operator
Case ">"
If Val(LeftVal) > Val(RightVal) Then Eval = True
Case "<"
If Val(LeftVal) < Val(RightVal) Then Eval = True
Case "<>"
If Val(LeftVal) <> Val(RightVal) Then Eval = True
Case ">="
If Val(LeftVal) >= Val(RightVal) Then Eval = True
Case "<="
If Val(LeftVal) <= Val(RightVal) Then Eval = True
Case "="
If LeftVal = RightVal Then Eval = True
Case "=="
If LCase(LeftVal) = LCase(RightVal) Then Eval = True
End Select
End Function

Function Equation(ByVal sEquation As String) As Variant
' For solving full equations like: iTemp + ("3" * ("5" / "4"))
Dim iTemp As Integer, iTemp2 As Integer, i As Integer
Dim sTemp As String

' First lets change anything inside ()'s to a constant value
Do
For i = 1 To Len(sEquation)
sTemp = Mid(sEquation, i, 1)
If sTemp = Chr(34) Then
i = InStr(i + 1, sEquation, Chr(34))
ElseIf sTemp = "(" Then
iTemp = i
ElseIf sTemp = ")" Then
iTemp2 = i
Exit For
End If
Next i
If iTemp <> 0 Then
sEquation = Mid(sEquation, 1, iTemp - 1) & " " & Chr(34) & Solve(Mid(sEquation, iTemp + 1, iTemp2 - (iTemp + 1))) & Chr(34) & " " & Mid(sEquation, iTemp2 + 1)
iTemp = 0: iTemp2 = 0
Else
Exit Do
End If
Loop

' Now that all the ()'s are constant values, lets finish it up
Equation = Solve(sEquation)
End Function

Function Solve(sEquation As String) As Variant
' For solving equations without ()'s like: itemp + "3" / "2"
Dim i As Integer, iTemp As Integer
Dim sTemp As String, sTemp2 As String
Dim WaitVal As Variant
Dim WaitOp As String
Dim WaitVar

For i = 1 To Len(sEquation)
sTemp = Mid(sEquation, i, 1)
If sTemp = Chr(34) Then
iTemp = InStr(i + 1, sEquation, Chr(34))
WaitVal = Mid(sEquation, i + 1, iTemp - (i + 1))
i = iTemp
If WaitOp <> "" Then
Select Case WaitOp
Case "+"
Solve = Val(Solve) + Val(WaitVal)
Case "-"
Solve = Val(Solve) - Val(WaitVal)
Case "/"
Solve = Val(Solve) / Val(WaitVal)
Case "%"
Solve = Val(Solve) % Val(WaitVal)
Case "^"
Solve = Val(Solve) ^ Val(WaitVal)
Case "*"
Solve = Val(Solve) * Val(WaitVal)
Case "&" ' String Concentration
Solve = Solve & WaitVal
End Select
WaitOp = ""
Else
Solve = WaitVal
End If
ElseIf sTemp = " " Then
' Make sure it skips this
ElseIf sTemp = "+" Or sTemp = "-" Or sTemp = "/" Or sTemp = "^" Or sTemp = "&" Or sTemp = "*" Then
If WaitVar <> 0 Then
WaitVal = GetVar(Mid(sEquation, WaitVar, i - (WaitVar + 1)))
If WaitOp <> "" Then
Select Case WaitOp
Case "+"
Solve = Val(Solve) + Val(WaitVal)
Case "-"
Solve = Val(Solve) - Val(WaitVal)
Case "/"
Solve = Val(Solve) / Val(WaitVal)
Case "%"
Solve = Val(Solve) % Val(WaitVal)
Case "^"
Solve = Val(Solve) ^ Val(WaitVal)
Case "*"
Solve = Val(Solve) * Val(WaitVal)
Case "&" ' String Concentration
Solve = Solve & WaitVal
End Select
WaitOp = ""
Else
Solve = WaitVal
End If

WaitVar = 0
End If

WaitOp = sTemp
Else
If WaitVar = 0 Then WaitVar = i
If i >= Len(sEquation) Then
WaitVal = GetVar(Mid(sEquation, WaitVar, i))
If WaitOp <> "" Then
Select Case WaitOp
Case "+"
Solve = Val(Solve) + Val(WaitVal)
Case "-"
Solve = Val(Solve) - Val(WaitVal)
Case "/"
Solve = Val(Solve) / Val(WaitVal)
Case "%"
Solve = Val(Solve) % Val(WaitVal)
Case "^"
Solve = Val(Solve) ^ Val(WaitVal)
Case "*"
Solve = Val(Solve) * Val(WaitVal)
Case "&" ' String Concentration
Solve = Solve & WaitVal
End Select
WaitOp = ""
Else
Solve = WaitVal
End If
End If
End If
Next i
End Function

Function DoFunction(daCall As String) As Variant
Dim sName As String
Dim argList() As String
Dim i As Integer

sName = Trim(Mid(daCall, 1, InStr(1, daCall, "(") - 1))
argList = Split(Mid(daCall, InStr(1, daCall, "(") + 1, InStr(1, daCall, ")") - (InStr(1, daCall, "(") + 1)), ",")

For i = LBound(argList) To UBound(argList)
argList(i) = Equation(Trim(argList(i)))
Next i

DoFunction = ExecFunction(sName, argList())
End Function

Function ExecFunction(daFunction As String, argList() As String) As Variant
'On Error GoTo ErrorCatch:

Select Case LCase(daFunction)
Case "msgbox"
ExecFunction = MsgBox(argList(0), argList(1), argList(2))
Case "inputbox"
ExecFunction = InputBox(argList(0), argList(1), argList(2))

' String Manipulating Junk
Case "mid"
ExecFunction = Mid(argList(0), argList(1), argList(2))
Case "lcase"
ExecFunction = LCase(argList(0))
Case "ucase"
ExecFunction = UCase(argList(0))
Case "instr"
ExecFunction = InStr(argList(0), argList(1), argList(2))
Case "len"
ExecFunction = Len(argList(0))
Case "chr"
ExecFunction = Chr(argList(0))
Case "asc"
ExecFunction = Asc(argList(0))
Case "reverse"
ExecFunction = StrReverse(argList(0))

' Math stuff
Case "cos"
ExecFunction = Cos(argList(0))
Case "tan"
ExecFunction = Tan(argList(0))
Case "log"
ExecFunction = Log(argList(0))
Case "rnd"
ExecFunction = Rnd(argList(0))
Case "randomize"
Randomize
Case "int"
ExecFunction = Int(argList(0))


End Select

Exit Function

ErrorCatch:
Select Case ErrNumber
Case 9
MsgBox "Argument not optional in call to procedure: " & daFunction, vbCritical, "Error"
End Select
Resume Next
End Function


Attached File(s) Image(s)
   
Find all posts by this user
Quote this message in a reply
05-04-2018, 04:26 AM
Post: #5
RE: ANI script v3
And now easy part
first test with command WINDOW

Code:
$ Filename "ANIscript.exe" ' v3
include "RTL32.inc"
include "awinh037.inc"
#lookahead
string KEYWORDS[] = {"CLS","PRINT","IF","ELSE","ENDIF","FOR","TO","NEXT","SUB","RETURN","CIRCLE","DOT","LINE","WINDOW"}
string SYMBOLS = ",:=()+-*/<>[]^&|%"
string ALPHABETS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$#"
string DQ = chr(34)
string NUMBERS = ".0123456789"
string NUMBERS_WITH_DECIMALPOINT = NUMBERS + "."
string ALPHANUMBERS = ALPHABETS + NUMBERS
string ALPHANUMBERS_WITH_UNDERSCORE = ALPHANUMBERS + "_"
STRING tokens , tokList[1024] ' token list
string crlf = chr(13)+chr(10)
INT tokTypeList[1024]           'token type list
INT tokCount
INT wout
'------------------------------------------------------------------------

INT win,wx=100,wy=0,ww=840,wh=640,wstyle = WS_MINMAXSIZE
INT bt0,b0ID=100,bt1,b1ID=101,bt2,b2ID=102 'buttons
INT static1,stID1=10,static2,staticID2=11,static3,staticID3=12,static4,staticID4=13,​static5,staticID5=14  'staticTX
INT edit1,ed1ID=200,riched,richID=400,LBoxH,LBid=500,edit2,editID2=50
INT edit3,editID3=51,edit4,editID4=52,edit5,editID5=53,edit6,editID6=54
INT ipos ' LB item pos
STRING  outBuff="processing..." + crlf
STRING source[1000] ' source lines array
STRING pt = Space (255)
'bitmap image handlers -------------------------------------------------
INT bb0,bb1,bb2
'create main window ||||||||||||||||||||||||||||||||||||||||||||||||||||
win=SetWindow("ANI::v3",wx,wy,ww,wh,0,wstyle)
    InitDrawing(win)
    WindowColor( win, 220, 230, 250)
InvalidateRect(win, 0, 0)
'crete buttons||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
bt0 = SetButton(win,4,60,34,34,"New", 1409384576,0x200,b0ID)  'as image button flat 1409384576 - 1409351808
bb0 = LoadImage(0,"bScan.bmp",0,32,32,16):SendMessage(bt0, 247, 0, bb0) 'add bitmap to button
bt1 = SetButton(win,4,98,34,34,"Open", 1409384576,0x200,b1ID)
bb1 = LoadImage(0,"bOpen.bmp",0,32,32,16):SendMessage(bt1, 247, 0, bb1)
bt2 = SetButton(win,4,140,34,34,"Save", 1409384576,0x200,b2ID)
bb2 = LoadImage(0,"bProc.bmp",0,32,32,16):SendMessage(bt2, 247, 0, bb2)

'create EDIT1 - multiline --------------------------------------------
edit1 = SetEditBox(win,44,480,500,100, outBuff,  WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUT​OVSCROLL,0x200,ed1ID) '50B01004 processing box
ControlFont(edit1, 17,7, 100, "Courier New")
'create static control
static1 = SetStatic(win,6,8,54,16,"LINES",0,0,stID1) 'static 'LINES'
static2 = SetStatic(win,6,35,54,16,"LINE >>",0,0,staticID2) 'static 'LINES'
edit2 = SetEditBox(win,50,5,70,20,"num of Lines",0x50800000,0x200,editID2) 'edit for number of lines
edit3 = SetEditBox(win,50,32,710,22,"current Line",0x50800000,0x200,editID2) 'edit for current line
ControlFont(edit3, 15, 8, 400, "Courier New"): SetFocus edit3
static3 = SetStatic(win,120,8,54,16,"T-LINE",0,0,staticID3) 'static 'LINES'
edit4 = SetEditBox(win,160,6,60,20,"Line Num",0x50800000,0x200,editID4)

static4 = SetStatic(win,230,8,54,16,"T-CHAR",0,0,staticID4) 'static 'temp char
edit5 = SetEditBox(win,280,6,60,20,"CHAR",0x50800000,0x200,editID5) ' show char
ControlFont(edit5, 17, 9, 600, "Courier New")

static5 = SetStatic(win,350,8,54,16,"CHAR-POS",0,0,staticID5) 'static 'charPos
edit6 = SetEditBox(win,410,6,60,20,"POS",0x50800000,0x200,editID6) ' position in line

'create RICHEDIT1 ################################################################################​##########
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4 /:rc code line::
riched= SetRichEdit (win, 44,60,500,400,"a = a+b", WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_NOHIDESEL,0x200,richID)
ControlFont(riched, 15, 8, 400, "Courier New") : SetRichEditBackColor riched, RGB(250,244,179)
SetEditSelection( riched, -1,-1):InvalidateRect( riched, 0, 0)

'create listbox for token list ##########################################################################
LBoxH = SetListBox(win,560,60,200,500,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LBid)
ControlFont(LBoxH, 17,7, 100, "Courier New"): TextColor ( win, RGB(100,120,180), RGB(210,220,250))
TextOn( win, 560, 562, "  TOKENS ")  ' print text on window
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-1"
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-2"

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

           'CASE WM_CREATE
            'InitDrawing(win)
            'WindowColor( win, 220, 230, 250)

           CASE WM_PAINT
            BitBlt(hDC, 0, 0, ww, wh, hdcMem, 0, 0, SRCCOPY)
            InvalidateRect(win, 0, 0)
                
            CASE WM_CLOSE
                CloseWindow(win)
                EndProgram
                 ExitProcess 0

            CASE WM_COMMAND
                controlID = LoWord(wParam) 'get control ID
                notifyCode = HiWord(wParam) 'get notification message

                select controlID
                    case b1ID  'open file
                      if notifycode=0
                       doOpen()
                    end if

                    case b0ID 'scan >>>
                      if notifycode=0
                       doScan()
                    end if

                 case B2ID ' run/proc
                      if notifycode=0
                       InterpretTokens()
                    end if

                 end select
        End Select
'<<<<< window output - our display >>>>>>>>>>>>>>>>>>>>>
    CASE wout
        Select wmsg

             CASE WM_CLOSE
                    CloseWindow(wout)
                    EndProgram
                   ' ExitProcess 0

         End Select
'<<<<<<<<<<<<<<<<<<<<<<o>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
END SELECT
RETURN Default
END FUNCTION

'************************************************
'****    A N I -> P R O C E S S I N G    ********
'************************************************

'open source file
Sub doOpen
string fName="", dir="", sep=chr(0) , title="Open File... "
filter = "All Files "+sep+"*.*"+sep+"Bscript files "+sep+"*.bas"
title="Open File... "
fName = FileDialog(dir,filter,title,0,0,"txt")
IF fName = ""  'almost useless ?
SendMessage edit1,WM_SETTEXT,0,strptr("NO FILE ! ") : Return
END IF
'SendMessage status,WM_SETTEXT,0,strptr(fName)
char tx[500000] : tx =  GetFile fName      'load file into char buffer
'SendMessage riched, 12, 0, strptr(tx)       'show file in richedit
SetText (riched,tx)
string numOfLines : INT LineCount : LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0
numOfLines = str(LineCount) : SetText (edit2,numOfLines) ' show result in edit2
outBuff = outBuff + "file_loaded..." + crlf                  : SetText (edit1,outBuff)
outBuff = outBuff + "number of lines : " + numOfLines + crlf : SetText (edit1,outBuff)
frees tx
'reset lisbox content
SendMessage LBoxH,LB_RESETCONTENT,0, NULL
End Sub

'scan source line -----------------------------------------------------------------------
Sub doScan
string s,sc,cLine, tbuff
string pt = Space (255)  ' also you may try char pt[255]=""
INT i ,LineCount=1 ,crPos, first
ipos=0 : tokCount = 0 'reset item position and token count
SetText(edit3,"")  ' clear current line box
LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0 ' get number of Lines
SetText (edit1,"WAIT..scanning >>>>") : MsgBox "SCAN CODE","OK!..START"
'scan each line
For i = 0 to LineCount-1
   ' enable events..so i use PeekMessage.....................
        'while PeekMessage (wm,0,0,0,Pm_Remove)>0 ' //peek
            'TranslateMessage (wm)
            'DispatchMessage (wm)
        'wend
    SendMessage (riched, EM_GETLINE, i, pt) ' get line from richedit control
   'first = SendMessage riched, EM_LINEINDEX, i, 0
   ' MsgBox pt , "INFO"
    if pt <> ""
        s = Ltrim(pt)                 'trim left side
        crPos = instr(pt,chr(13)) :   ' check CR position /msgbox "POS:"+str(crPos),"CHR(13).POS"
        s = MID( pt, 1, crPos-1)      ' extract string / text
    else
        s=""                        
    end if
  
     SetText edit4,  str(i)            'show line number
     SetText(edit3, s)                 'show current line in single-Line edit box
     cLine = GetText(edit3)            'get text from edit control
     Tokenizer(cLine)                  'tokenize line

     'get char func >>>>>>>>>>>>>>>>>>
        GetChar(cLine)
     '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        'Sendmessage riched,EM_HIDESEL,i,0
        'SetEditSelection( riched, first,len pt)
        'Sendmessage riched,EM_HIDESEL,i,0
     s="" : 'sleep = 100                  ' slow down..tweak for your computer-200
SendMessage riched,EM_SCROLL ,1,0
Next i
outBuff = "TOKENIZATION FINISHED!" + crlf : outBuff = outBuff + "Token Count: " + str(tokCount) + crlf
SetText edit1, outBuff
End Sub
'-----------------------------------------------------------------------------------------

SUB GetChar(string sLine)
INT pos=1,lineSize
string ch,nextCh,tLine
    tLine = Mid(sLine,1,Len(sLine))
    lineSize=LEN(tLine)
        while pos <= lineSize
            ch = Mid( tLine,pos,1)
               ' sleep 100  '200
                SetText(edit5,ch)       'show character
                SetText(edit6,str(pos)) 'show char position in line
                ch=""
            pos=pos+1
        wend
End Sub
'-----------------------------------------------------------------------------------------

Function SetEditSelection(INT eHandle, sStart, sEnd)
SendMessage( ehandle, EM_SETSEL, sstart, send)
End Function

function tokenizer(code as string)
    'print "CODE:" + code
    string token, ch
    'load file?
    '
    INT i,j
    '................................
    'print "CODE-LEN:" + str(len(code))
   '.................................
    i=1
    WHILE i <= len(code)
        
        IF instr(ALPHABETS, mid(code,i,1)) <> 0            'isAlpha
            while i <= len(code) and INSTR(ALPHABETS ,mid(code,i,1)) > 0
                token = token + mid(code, i, 1)            
                 i=i+1
            wend  
            'PRINT "TCount:" + str tokcount
           'print token        
            if  ucase(token)= isKeyword(token)   ' search keyword list
                 tokCount++ : tokList[tokCount] = token : ' add key token to list
                token = token + " ~ KEYWORD"
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                 token=""
            else
            tokCount++
                tokList[tokCount] = token : ' add ident to list
                token = token + " ~ IDENTIFIER" : 'variabe
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                  token=""
            end if
           'token=""
           'i=i+1
         END IF  
        
        IF instr(SYMBOLS, mid(code, i, 1)) > 0 and  i <= len(code)'sym operators
             token = mid(code, i, 1)
              'print token
             byte t at strptr(token)
            select t
             case "+"
            tokList[tokCount] = token
            token = "+" + " ~PLUS"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

             case "-"
            token = "-" + " ~MINUS"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            tokList[tokCount] = token

            case "*"
            token = "*" + " ~MULTI"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "/"
            token = "/" + " ~DIVIDE"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "^"
            token = "^" + " ~POWER"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "("
            token = "(" + " ~LPAREN"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

             case ")"
            token = ")" + " ~RPAREN"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "["
            token = "[" + " ~LBRACKET"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
             case "]"
            token = "]" + " ~RBRACKET"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case ","
             token = "," + " ~COMMA"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case ":"
             token = ":" + " ~COLON"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
            case "="
             token = "=" + " ~EQUAL"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
           case "&"
             token = "&" + " ~AND"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
          case "|"
             token = "|" + " ~OR"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
          case "%"
             token = "%" + " ~MOD"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            end select
            i=i+1
           token=""
        END IF

        IF instr(NUMBERS, mid(code, i, 1)) <> 0 and i <= len(code)   'numbers
            while i <= len(code) and INSTR(NUMBERS,mid(code,i,1)) <> 0
                token = token + mid(code,i,1)
                 i=i+1
             wend
            token = token + "  ~ NUMBER" : tokCount++
             SendMessage LboxH, LB_ADDSTRING, 0, token
             tokList[tokCount] = token
            token=""
        END IF

        'elseif ch = chr(34) 'quote "
         IF INSTR(mid(code,i,1),DQ) <> 0
            'token = ""
            i = i + 1 ' skip first quote "......
            while mid(code,i,1) <> chr(34) 'string literal inside quotes "......."
                token = token + mid(code,i,1)
                i=i+1
             wend
                'tokens = tokens + token '+ " ~ STRING-LITERAL" + crlf
                 SendMessage LboxH, LB_ADDSTRING, 0, token + " ~STRING": tokCount++
                 tokList[tokCount] = token
             token=""
             i=i+2 ' skip second quote  ......"
        END IF

        IF mid(code, i, 1) = " "  'whitespace
             'print "WHITE:" + str(i)
            i=i+1 'skip whitespace
        END IF

       IF mid(code, i, 1) = "'"  'comment
            i=i+1 ' skip char " ' "
            'loop untill you get end of line chr(10)
            while i <= len(code) AND mid(code, i, 1) <> chr(13)
            i=i+1 'skip chars under comment
            wend
            i=i+1
        END IF


        'elseif ch = chr(10) ' not used because of CRLF in bufer -> tokens
        'IF i <= len(code) and mid(code,i,1) = chr(10)
            'tokens = tokens + mid(code,i,1) + " :NEWLINE" + crlf ' or end of instruction
         'print "NEWLINE"
          'return  
            'i=i+1
        'END IF
        'else
            'tokens = tokens + ch + " :UNINDENTIFIED - ERROR!" + crlf
            'i=i+1

      
    'PRINT "BEFORE_WEND:" + str(i)
  
    WEND

    'Return token
   ' Return

end function

'*********************************************************************
'::::::::::::::  INTERPRETER  ::::::::::::::::::::::::::::::::::::::::
'*********************************************************************
Function InterpretTokens()
'read tokens from token list and iterpret them (execute)
INT tc=1, itemp1,itemp2
STRING t, arg1, arg2

t = tokList[1] 'get token from list
'print t
'INT p at strptr t


IF t = "WINDOW" then
print "INSTRUCTION : Window executed!" 'info
tc++ : arg1 = tokList[tc]   'get next token
tc=tc+2 : arg2 = tokList[tc]   'get next token skiping comma
itemp1 = val(arg1) : itemp2 = val(arg2)  'arguments to values
'create new window
wout = CreateWindowEx ( 0x200,"Oxygen","ANI - Display", 524288 , 200, 200, itemp1, itemp2, 0, 0, null, 0)
ShowWindow wout,1 : UpdateWindow wout


END IF


End Function





'***********************************************************************
'::::::::::::::::  INTERPRETER  END OF CODE  :::::::::::::::::::::::::::
'***********************************************************************

Function execWindow( INT winW,winH)

End Function
'...........................................................
function isKeyword(byval tok as string) as string
'string ret
for n = 1 to 14
   if ucase(tok) = KEYWORDS[n]     ' if is KEYWORD
        RETURN KEYWORDS[n]  
   end if
next n
Return ""
end function

'##########################################################
SUB TextColor (wID as INT,byval frontColor as INT,byval  backColor as INT )
hdc = GetDC(wID)
SetTextColor( hDC, frontColor)
SetBkColor( hDC, backColor)
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
'########################################################

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
'..........................................................
Sub ELIPSE(INT x, y, r1,r2, color)
hdc=GetDc win
SelectObject(hdc, CreateSolidBrush( color ))
Ellipse Hdc,x,y,r1+x,r2+y
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)
ReleaseDC( win, hdc)
End Sub

'##########################################################
SUB InitDrawing
''get current size of window
GetSize(win,0,0,ww,wh)
'get window DC
hdc=GetDC(win)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(hdc, ww, wh)
oldBmp = SelectObject( hdcMem, hbmMem )
oldBrush = SelectObject(hdcMem, CreateSolidBrush( RGB(231,223,231)) )
oldPen = SelectObject(hdcMem, CreatePen(PS_SOLID,1,RGB(231,223,231)))
'fill rectangle memDC with brush color
FillRect ( hdcMem,rc, oldBrush)
SetTextColor( hDC,RGB(0,0,0))
SetBkColor( hDC, RGB(231,223,231))
'blit to memDC
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( win, hdc)
End SUB

'##########################################################
SUB CleanUp

DeleteDC(hdcMem)
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldPen))
DeleteObject(SelectObject(hdcMem, oldBmp))


END SUB


Attached File(s) Image(s)
   
Find all posts by this user
Quote this message in a reply
02-02-2019, 07:50 AM
Post: #6
RE: ANI script v3
And now some more code to tokenizer
to extract whole set of tokens for minimal
and simple interpreter:

token constants
'tokOPERATOR = 1 ' + - * / < = > & ! | { <= , >= (8,9) }
% tokPLUS = 1 : % tokMINUS = 2 : % tokMULTI = 3 : % tokDIVIDE = 4 : % tokLESS = 5 : % tokEQUAL = 6
% tokGREAT=7 : % tokAND = 10 : % tokOR = 11 : % tokNOT = 12
' paren,brackets... ( ) , [ ] , { } , :
% tokLPAREN = 13 : % tokRPAREN = 14 : % tokLBRACKET = 15 : % tokRBRACKET = 16 : % tokLBRACE = 17 : % tokRBRACE = 18
% tokCOMMA = 19 : % tokCOLON = 20
' variable - numeric , string , pointer
% tokNUMVAR = 21 : % tokSTRVAR = 22 : % tokPTRVAR = 23
' numeric func() , string func() , number , quoted string , comment
% tokNUMFUNC = 24 : % tokSTRFUNC = 25 : % tokNUMBER = 26 : % tokQUOTED = 27 : % tokCOMMENT = 28
' keywords ...
% tokDEFNUM = 30 'defnum
% tokDEFSTR = 31 'defstr
% tokWINDOW = 32 'window
% tokPRINT = 33 'print
% tokIF = 34 'if
% tokELSE = 35 'else
% tokENDIF = 36 'endif
% tokFOR = 37 'for
% tokTO = 38 'to
% tokNEXT = 39 'next
% tokSUB = 40 'sub
% tokRETURN = 41 'return
% tokFUNC = 42 'func

% tokCIRCLE = 50 'circle
% tokDOT = 51 'dot/pset
% tokLINE = 52 'line
% tokRECT = 53 'rectangle


Code:
' ANIscript v4(32bit)/(043-o2)  - by Aurel - 1.2.2019
$ Filename "ANIscript.exe" ' v4
include "RTL32.inc"
include "awinh037.inc"
#lookahead
string KEYWORDS[] = {"CLS","PRINT","IF","ELSE","ENDIF","FOR","TO","NEXT","SUB","RETURN","CIRCLE","DOT","LINE","WINDOW"}
string SYMBOLS = ",:=()+-*/<>[]^&|%!"
string ALPHABETS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$#"
string DQ = chr(34)
string NUMBERS = ".0123456789"
string NUMBERS_WITH_DECIMALPOINT = NUMBERS + "."
string ALPHANUMBERS = ALPHABETS + NUMBERS
string ALPHANUMBERS_WITH_UNDERSCORE = ALPHANUMBERS + "_"
STRING tokens , tokList[4096]   'token list / string array of tokens
string crlf = chr(13)+chr(10)   'end of line CRLF
INT tokTypeList[4096]           'token type list / int array
INT tokIDList[1024]             'token ID list / variable adress-index (int array)
INT tokCount                    'token count / number of tokens
INT wout                        'windouw output id
'------------------------------------------------------------------------
'token constants
'tokOPERATOR = 1         ' + - * / < = > & ! |  { <= , >= (8,9) }
% tokPLUS = 1 : % tokMINUS = 2 : % tokMULTI = 3 : % tokDIVIDE = 4 : % tokLESS = 5 : % tokEQUAL = 6
% tokGREAT=7 : % tokAND = 10 : % tokOR = 11 : % tokNOT = 12
' paren,brackets... ( ) , [ ] , { } , :
% tokLPAREN  = 13 : % tokRPAREN = 14 : % tokLBRACKET = 15 : % tokRBRACKET = 16 : % tokLBRACE = 17 : % tokRBRACE = 18
% tokCOMMA = 19 : % tokCOLON = 20
' variable  - numeric , string , pointer
% tokNUMVAR = 21 : % tokSTRVAR = 22 : % tokPTRVAR = 23
' numeric func() , string func() , number , quoted string  , comment
% tokNUMFUNC = 24 : % tokSTRFUNC = 25 : % tokNUMBER = 26 : % tokQUOTED = 27 : % tokCOMMENT = 28
' keywords ...
% tokDEFNUM = 30    'defnum
% tokDEFSTR = 31    'defstr
% tokWINDOW = 32    'window
% tokPRINT  = 33    'print
% tokIF     = 34    'if
% tokELSE   = 35    'else
% tokENDIF  = 36    'endif
% tokFOR    = 37    'for
% tokTO     = 38    'to
% tokNEXT   = 39    'next
% tokSUB    = 40    'sub
% tokRETURN = 41    'return
% tokFUNC   = 42    'func

% tokCIRCLE = 50    'circle
% tokDOT    = 51    'dot/pset
% tokLINE   = 52    'line
% tokRECT   = 53    'rectangle


'------------------------------------------------------------------------
INT win,wx=100,wy=0,ww=840,wh=640,wstyle = WS_MINMAXSIZE
'-----------------------------------------------------------------------
INT bt0,b0ID=100,bt1,b1ID=101,bt2,b2ID=102 'buttons
INT static1,stID1=10,static2,staticID2=11,static3,staticID3=12,static4,staticID4=13,​static5,staticID5=14  'staticTX
INT edit1,ed1ID=200,riched,richID=400,LBoxH,LBid=500,edit2,editID2=50
INT edit3,editID3=51,edit4,editID4=52,edit5,editID5=53,edit6,editID6=54
INT ipos ' LB item pos
STRING  outBuff="processing..." + crlf
STRING source[4096] ' source lines array
STRING pt = Space (255)
'bitmap image handlers -------------------------------------------------
INT bb0,bb1,bb2
'create main window ||||||||||||||||||||||||||||||||||||||||||||||||||||
win=SetWindow("ANI::v3",wx,wy,ww,wh,0,wstyle)
    InitDrawing(win)
    WindowColor( win, 220, 230, 250)
InvalidateRect(win, 0, 0)
'crete buttons||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
bt0 = SetButton(win,4,60,34,34,"New", 1409384576,0x200,b0ID)  'as image button flat 1409384576 - 1409351808
bb0 = LoadImage(0,"bScan.bmp",0,32,32,16):SendMessage(bt0, 247, 0, bb0) 'add bitmap to button
bt1 = SetButton(win,4,98,34,34,"Open", 1409384576,0x200,b1ID)
bb1 = LoadImage(0,"bOpen.bmp",0,32,32,16):SendMessage(bt1, 247, 0, bb1)
bt2 = SetButton(win,4,140,34,34,"Save", 1409384576,0x200,b2ID)
bb2 = LoadImage(0,"bProc.bmp",0,32,32,16):SendMessage(bt2, 247, 0, bb2)

'create EDIT1 - multiline --------------------------------------------
edit1 = SetEditBox(win,44,480,500,100, outBuff,  WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUT​OVSCROLL,0x200,ed1ID) '50B01004 processing box
ControlFont(edit1, 17,7, 100, "Courier New")
'create static control
static1 = SetStatic(win,6,8,54,16,"LINES",0,0,stID1) 'static 'LINES'
static2 = SetStatic(win,6,35,54,16,"LINE >>",0,0,staticID2) 'static 'LINES'
edit2 = SetEditBox(win,50,5,70,20,"num of Lines",0x50800000,0x200,editID2) 'edit for number of lines
edit3 = SetEditBox(win,50,32,710,22,"current Line",0x50800000,0x200,editID2) 'edit for current line
ControlFont(edit3, 15, 8, 400, "Courier New"): SetFocus edit3
static3 = SetStatic(win,120,8,54,16,"T-LINE",0,0,staticID3) 'static 'LINES'
edit4 = SetEditBox(win,160,6,60,20,"Line Num",0x50800000,0x200,editID4)

static4 = SetStatic(win,230,8,54,16,"T-CHAR",0,0,staticID4) 'static 'temp char
edit5 = SetEditBox(win,280,6,60,20,"CHAR",0x50800000,0x200,editID5) ' show char
ControlFont(edit5, 17, 9, 600, "Courier New")

static5 = SetStatic(win,350,8,54,16,"CHAR-POS",0,0,staticID5) 'static 'charPos
edit6 = SetEditBox(win,410,6,60,20,"POS",0x50800000,0x200,editID6) ' position in line

'create RICHEDIT1 ################################################################################​##########
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4 /:rc code line::
riched= SetRichEdit (win, 44,60,500,400,"a = a+b", WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_NOHIDESEL,0x200,richID)
ControlFont(riched, 15, 8, 400, "Courier New") : SetRichEditBackColor riched, RGB(250,244,179)
SetEditSelection( riched, -1,-1):InvalidateRect( riched, 0, 0)
'set richedit text color
CHARFORMAT cf
cf.cbSize      = SizeOf(CHARFORMAT)
cf.dwMask      = CFM_COLOR
cf.dwEffects   = 0
cf.yHeight     = 200
cf.yOffset     = 0
cf.crTextColor = RGB(150,150,180)
cf.bCharSet    = ANSI_CHARSET
cf.bPitchAndFamily = 0
'szFaceName[LF_FACESIZE]
SendMessage riched, EM_SETCHARFORMAT, SCF_ALL, @cf

'create listbox for token list ##########################################################################
LBoxH = SetListBox(win,560,60,200,500,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LBid)
ControlFont(LBoxH, 17,7, 100, "Courier New"): TextColor ( win, RGB(100,120,180), RGB(210,220,250))
TextOn( win, 560, 562, "  TOKENS ")  ' print text on window
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-1"
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-2"

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

           'CASE WM_CREATE
            'InitDrawing(win)
            'WindowColor( win, 220, 230, 250)

           CASE WM_PAINT
            BitBlt(hDC, 0, 0, ww, wh, hdcMem, 0, 0, SRCCOPY)
            InvalidateRect(win, 0, 0)
                
            CASE WM_CLOSE
                CloseWindow(win)
                EndProgram
                 ExitProcess 0

            CASE WM_COMMAND
                controlID = LoWord(wParam) 'get control ID
                notifyCode = HiWord(wParam) 'get notification message

                select controlID
                    case b1ID  'open file
                      if notifycode=0
                       doOpen()
                    end if

                    case b0ID 'scan >>>
                      if notifycode=0
                       doScan()
                    end if

                 case B2ID ' run/proc
                      if notifycode=0
                       InterpretTokens()
                    end if

                 end select
        End Select
'<<<<< window output - our display >>>>>>>>>>>>>>>>>>>>>
    CASE wout
        Select wmsg

             CASE WM_CLOSE
                    CloseWindow(wout)
                   ' EndProgram()
                   ' ExitProcess 0

         End Select
'<<<<<<<<<<<<<<<<<<<<<<o>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
END SELECT
RETURN Default
END FUNCTION

'************************************************
'****    A N I -> P R O C E S S I N G    ********
'************************************************

'open source file
Sub doOpen
string fName="", dir="", sep=chr(0) , title="Open File... "
filter = "All Files "+sep+"*.*"+sep+"Bscript files "+sep+"*.bas"
title="Open File... "
fName = FileDialog(dir,filter,title,0,0,"txt")
IF fName = ""  'almost useless ?
  SendMessage edit1,WM_SETTEXT,0,strptr("EMPTY FILENAME ! ") : Return
END IF
'SendMessage status,WM_SETTEXT,0,strptr(fName)
char tx[500000] : tx =  GetFile fName        'load file into char buffer
'SendMessage riched, 12, 0, strptr(tx)      
SetText (riched,tx)                          'show text in richedit control
string numOfLines : INT LineCount : LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0
numOfLines = str(LineCount) : SetText (edit2,numOfLines) ' show result in edit2
outBuff = outBuff + "file_loaded..." + crlf                  : SetText (edit1,outBuff)
outBuff = outBuff + "number of lines : " + numOfLines + crlf : SetText (edit1,outBuff)
frees tx   ' free tx buffer
'reset listbox content ------------------
SendMessage LBoxH,LB_RESETCONTENT,0, NULL
End Sub

'Scan source line -----------------------------------------------------------------------
Sub doScan
string s,sc,cLine,sLine, tbuff
string pt = Space (256)                 ' also you may try char pt[255]=""
INT i ,LineCount=1 ,crPos, first
ipos=0 : tokCount = 0                   ' reset item position and token count
SetText(edit3,"")                       ' clear current line box
LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0 ' get number of Lines

SetText (edit1,"WAIT..scanning >>>>") : MsgBox "SCAN CODE"+crlf + LineCount,"OK!..START"
'scan each line
For i = 0 to LineCount-1
'label again <<<<<<
pt=Space(256)  ' create line buffer
   ' enable events..so i use PeekMessage.....................
        'while PeekMessage (wm,0,0,0,Pm_Remove)>0 ' //peek
            'TranslateMessage (wm)
            'DispatchMessage (wm)
        'wend
    SendMessage (riched, EM_GETLINE, i, pt) ' get line from richedit control
   'first = SendMessage riched, EM_LINEINDEX, i, 0
sLine = Ltrim(pt)  'trim left side of line
   ' MsgBox pt , "INFO"..............................................................................
    IF  Len(sLine) > 1
        crPos = instr(sLine,chr(13)) :   ' check CR position /msgbox "POS:"+str(crPos),"CHR(13).POS"
        s = MID( sLine, 1, crPos-1)      ' extract string / text
    ELSE
      ' MsgBox (sLine + str(LineCount) , "EMPTY LINE")
        s=" "                         'clear s                  
    END IF
  
        SetText edit4,  str(i)            'show line number
        SetText(edit3, s)                 'show current line in single-Line edit box
        IF s <> " "                        'if line is not empty
          cLine = GetText(edit3)            'get text from edit control        
          Tokenizer(cLine)                  'tokenize line
          'get char func >>>>>>>>>>>>>>>>>>
          GetChar(cLine)
          '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        END IF
        'Sendmessage riched,EM_HIDESEL,i,0
        'SetEditSelection( riched, first,len pt)
        'Sendmessage riched,EM_HIDESEL,i,0
         s="" : sLine="" : pt=""      ' clear string buffers
        'sleep = 100                  ' slow down..tweak for your computer-200    
        'SendMessage riched,EM_SCROLL ,1,0
    'END IF : '...............................................................................​......
Next i
outBuff = "TOKENIZATION FINISHED!" + crlf : outBuff = outBuff + "Token Count: " + str(tokCount) + crlf
SetText (edit1, outBuff)
End Sub
'-----------------------------------------------------------------------------------------

SUB GetChar(string sLine)
INT pos=1,lineSize
string ch,nextCh,tLine
    tLine = Mid(sLine,1,Len(sLine))
    lineSize=LEN(tLine)
        while pos <= lineSize
            ch = Mid( tLine,pos,1)
               ' sleep 100  '200
                SetText(edit5,ch)       'show character
                SetText(edit6,str(pos)) 'show char position in line
                ch=""
            pos=pos+1
        wend
End Sub
'--------------------------------------------------------------------------------
Function SetEditSelection(INT eHandle, sStart, sEnd)
SendMessage( ehandle, EM_SETSEL, sstart, send)
End Function
'--------------------------------------------------------------------------------
Function Tokenizer(code as string)
    'print "CODE:" + code
    string token, ch
    'load file?
    INT i,j,tokTyp
    '................................
    'print "CODE-LEN:" + str(len(code))
   '.................................
    i=1
    WHILE i <= len(code)
        
        IF instr(ALPHABETS, mid(code,i,1)) <> 0            'isAlpha
            while i <= len(code) and INSTR(ALPHABETS ,mid(code,i,1)) > 0
                token = token + mid(code, i, 1)            
                 i=i+1
            wend  
            'PRINT "TCount:" + str tokcount
           'print token        
            if  ucase(token)= isKeyword(token)                                  ' search keyword list
                 tokCount++ : tokList[tokCount] = token :                       ' add key token to list
                 tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp  ' add tokType to list
                 token = token + " ~ KEYWORD"
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                 token="" : tokTyp = 0
            else
            tokCount++
                tokList[tokCount] = token : ' add ident to list
                token = token + " ~ IDENTIFIER" : 'variabe
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                  token=""
            end if
           'token=""
           'i=i+1
         END IF  
        
        IF instr(SYMBOLS, mid(code, i, 1)) > 0 and  i <= len(code)'sym operators
             token = mid(code, i, 1)
              'print token
           byte t at strptr(token)
           Select t
             case "+"
               tokList[tokCount] = token
               token = "+" + " ~PLUS"
               SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

             case "-"
               token = "-" + " ~MINUS"
               SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
               tokList[tokCount] = token

            case "*"
              token = "*" + " ~MULTI"
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "/"
             token = "/" + " ~DIVIDE"
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "^"
              token = "^" + " ~POWER"
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "("
              token = "(" + " ~LPAREN"
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case ")"
               token = ")" + " ~RPAREN"
               SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "["
              token = "[" + " ~LBRACKET"
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "]"
              token = "]" + " ~RBRACKET"
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case ","
              token = "," + " ~COMMA"
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case ":"
              token = ":" + " ~COLON"
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "="
              token = "=" + " ~EQUAL"
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

           case "&"
             token = "&" + " ~AND"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

           case "|"
             token = "|" + " ~OR"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

          case "%"
             token = "%" + " ~MOD"
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            end select
            i=i+1
           token=""
        END IF

        IF instr(NUMBERS, mid(code, i, 1)) <> 0 and i <= len(code)   'numbers
            while i <= len(code) and INSTR(NUMBERS,mid(code,i,1)) <> 0
                token = token + mid(code,i,1)
                 i=i+1
             wend
            token = token + "  ~ NUMBER" : tokCount++
             SendMessage LboxH, LB_ADDSTRING, 0, token
             tokList[tokCount] = token
            token=""
        END IF

        'elseif ch = chr(34) 'quote "
         IF INSTR(mid(code,i,1),DQ) <> 0
            'token = ""
            i = i + 1 ' skip first quote "......
            while mid(code,i,1) <> chr(34) 'string literal inside quotes "......."
                token = token + mid(code,i,1)
                i=i+1
             wend
                'tokens = tokens + token '+ " ~ STRING-LITERAL" + crlf
                 SendMessage LboxH, LB_ADDSTRING, 0, token + " ~STRING": tokCount++
                 tokList[tokCount] = token
             token=""
             i=i+2 ' skip second quote  ......"
        END IF

        IF mid(code, i, 1) = " "  'whitespace
             'print "WHITE:" + str(i)
            i=i+1 'skip whitespace
        END IF

       IF mid(code, i, 1) = "'"  'comment
            i=i+1 ' skip char " ' "
            'loop untill you get end of line chr(10)
            while i <= len(code) AND mid(code, i, 1) <> chr(13)
            i=i+1 'skip chars under comment
            wend
            i=i+1
        END IF


        'elseif ch = chr(10) ' not used because of CRLF in bufer -> tokens
        'IF i <= len(code) and mid(code,i,1) = chr(10)
            'tokens = tokens + mid(code,i,1) + " :NEWLINE" + crlf ' or end of instruction
         'print "NEWLINE"
          'return  
            'i=i+1
        'END IF
        'else
            'tokens = tokens + ch + " :UNINDENTIFIED - ERROR!" + crlf
            'i=i+1

      
    'PRINT "BEFORE_WEND:" + str(i)
  
    WEND

    'Return token
    Return

end function
'--------------------------------------------------------------------------
'......................................................................
Function IsKeyword(byval tok as string) as string
'string ret
FOR n = 1 TO 14
   If ucase(tok) = KEYWORDS[n]     ' if is KEYWORD
        RETURN KEYWORDS[n]  
   End if
NEXT n
Return ""
End Function
'......................................................................
Function SetTokenType(byval tok as string) as int
INT tokTyp
   if tok = "+"
      return tokPLUS
   end if

End Function

'*********************************************************************
'::::::::::::::  INTERPRETER  ::::::::::::::::::::::::::::::::::::::::
'*********************************************************************
Function InterpretTokens()
'read tokens from token list and iterpret them (execute)
INT tc=1, itemp1,itemp2
STRING t, arg1, arg2

t = tokList[1] 'get token from list
'print t
'INT p at strptr t


IF ucase(t) = "WINDOW" then
  print "INSTRUCTION : Window executed!" 'info
  tc++ : arg1 = tokList[tc]   'get next token
  tc=tc+2 : arg2 = tokList[tc]   'get next token skiping comma
  itemp1 = val(arg1) : itemp2 = val(arg2)  'arguments to values
'create new window
  wout = CreateWindowEx ( 0x200,"Oxygen","ANI - Display", 524288 , 200, 200, itemp1, itemp2, 0, 0, null, 0)
  ShowWindow wout,1 : UpdateWindow wout


END IF


End Function


'***********************************************************************
'::::::::::::::::  INTERPRETER  END OF CODE  :::::::::::::::::::::::::::
'***********************************************************************

Function execWindow( INT winW,winH)
End Function



'##########################################################
SUB TextColor (wID as INT,byval frontColor as INT,byval  backColor as INT )
hdc = GetDC(wID)
SetTextColor( hDC, frontColor)
SetBkColor( hDC, backColor)
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
'########################################################

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
'..........................................................
Sub ELIPSE(INT x, y, r1,r2, color)
hdc=GetDc win
SelectObject(hdc, CreateSolidBrush( color ))
Ellipse Hdc,x,y,r1+x,r2+y
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)
ReleaseDC( win, hdc)
End Sub

'##########################################################
SUB InitDrawing
''get current size of window
GetSize(win,0,0,ww,wh)
'get window DC
hdc=GetDC(win)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(hdc, ww, wh)
oldBmp = SelectObject( hdcMem, hbmMem )
oldBrush = SelectObject(hdcMem, CreateSolidBrush( RGB(231,223,231)) )
oldPen = SelectObject(hdcMem, CreatePen(PS_SOLID,1,RGB(231,223,231)))
'fill rectangle memDC with brush color
FillRect ( hdcMem,rc, oldBrush)
SetTextColor( hDC,RGB(0,0,0))
SetBkColor( hDC, RGB(231,223,231))
'blit to memDC
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( win, hdc)
End SUB

'##########################################################
SUB CleanUp

DeleteDC(hdcMem)
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldPen))
DeleteObject(SelectObject(hdcMem, oldBmp))


END SUB
Find all posts by this user
Quote this message in a reply
02-02-2019, 09:38 AM
Post: #7
RE: ANI script v3
More addition to tokenizer and some problems with o2 parser...
dont like to many % constants in line with colon separator

Code:
' ANIscript v4(32bit)/(043-o2)  - by Aurel - 1.2.2019
$ Filename "ANI_v4.exe" ' v4
include "RTL32.inc"
include "awinh037.inc"
#lookahead
string KEYWORDS[] = {"CLS","PRINT","IF","ELSE","ENDIF","FOR","TO","NEXT","SUB","RETURN","CIRCLE","DOT","LINE","WINDOW"}
string SYMBOLS = ",:=()+-*/<>[]^&|%!"
string ALPHABETS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$#"
string DQ = chr(34)
string NUMBERS = ".0123456789"
string NUMBERS_WITH_DECIMALPOINT = NUMBERS + "."
string ALPHANUMBERS = ALPHABETS + NUMBERS
string ALPHANUMBERS_WITH_UNDERSCORE = ALPHANUMBERS + "_"
STRING tokens , tokList[4096]   'token list / string array of tokens
string crlf = chr(13)+chr(10)   'end of line CRLF
INT tokTypeList[4096]           'token type list / int array
INT tokIDList[1024]             'token ID list / variable adress-index (int array)
INT tokCount                    'token count / number of tokens
INT wout                        'windouw output id
'------------------------------------------------------------------------
'token constants
'tokOPERATOR = 1         ' + - * / < = > & ! |  { <= , >= (8,9) }
% tokPLUS = 1
% tokMINUS = 2
% tokMULTI = 3
% tokDIVIDE = 4
% tokLESS = 5
% tokEQUAL = 6
% tokGREAT = 7
% tokAND = 10
% tokOR = 11
% tokNOT = 12
' paren,brackets... ( ) , [ ] , { } , :
% tokLPAREN  = 13
% tokRPAREN = 14  
% tokLBRACKET = 15
% tokRBRACKET = 16
% tokLBRACE = 17  
% tokRBRACE = 18
% tokCOMMA = 19
% tokCOLON = 20
' variable  - numeric , string , pointer
% tokNUMVAR = 21
% tokSTRVAR = 22
% tokPTRVAR = 23
' numeric func() , string func() , number , quoted string  , comment
% tokNUMFUNC = 24
% tokSTRFUNC = 25
% tokNUMBER = 26
% tokQUOTED = 27
% tokCOMMENT = 28
' keywords ...
% tokDEFNUM = 30    'defnum
% tokDEFSTR = 31    'defstr
% tokWINDOW = 32    'window
% tokPRINT  = 33    'print
% tokIF     = 34    'if
% tokELSE   = 35    'else
% tokENDIF  = 36    'endif
% tokFOR    = 37    'for
% tokTO     = 38    'to
% tokNEXT   = 39    'next
% tokSUB    = 40    'sub
% tokRETURN = 41    'return
% tokFUNC   = 42    'func

% tokCIRCLE = 50    'circle
% tokDOT    = 51    'dot/pset
% tokLINE   = 52    'line
% tokRECT   = 53    'rectangle


'------------------------------------------------------------------------
INT win,wx=100,wy=0,ww=840,wh=640,wstyle = WS_MINMAXSIZE
'-----------------------------------------------------------------------
INT bt0,b0ID=100,bt1,b1ID=101,bt2,b2ID=102 'buttons
INT static1,stID1=10,static2,staticID2=11,static3,staticID3=12,static4,staticID4=13,​static5,staticID5=14  'staticTX
INT edit1,ed1ID=200,riched,richID=400,LBoxH,LBid=500,edit2,editID2=50
INT edit3,editID3=51,edit4,editID4=52,edit5,editID5=53,edit6,editID6=54
INT ipos ' LB item pos
STRING  outBuff="processing..." + crlf
STRING source[4096] ' source lines array
STRING pt = Space (255)
'bitmap image handlers -------------------------------------------------
INT bb0,bb1,bb2
'create main window ||||||||||||||||||||||||||||||||||||||||||||||||||||
win=SetWindow("ANI::v3",wx,wy,ww,wh,0,wstyle)
    InitDrawing(win)
    WindowColor( win, 220, 230, 250)
InvalidateRect(win, 0, 0)
'crete buttons||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
bt0 = SetButton(win,4,60,34,34,"New", 1409384576,0x200,b0ID)  'as image button flat 1409384576 - 1409351808
bb0 = LoadImage(0,"bScan.bmp",0,32,32,16):SendMessage(bt0, 247, 0, bb0) 'add bitmap to button
bt1 = SetButton(win,4,98,34,34,"Open", 1409384576,0x200,b1ID)
bb1 = LoadImage(0,"bOpen.bmp",0,32,32,16):SendMessage(bt1, 247, 0, bb1)
bt2 = SetButton(win,4,140,34,34,"Save", 1409384576,0x200,b2ID)
bb2 = LoadImage(0,"bProc.bmp",0,32,32,16):SendMessage(bt2, 247, 0, bb2)

'create EDIT1 - multiline --------------------------------------------
edit1 = SetEditBox(win,44,480,500,100, outBuff,  WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUT​OVSCROLL,0x200,ed1ID) '50B01004 processing box
ControlFont(edit1, 17,7, 100, "Courier New")
'create static control
static1 = SetStatic(win,6,8,54,16,"LINES",0,0,stID1) 'static 'LINES'
static2 = SetStatic(win,6,35,54,16,"LINE >>",0,0,staticID2) 'static 'LINES'
edit2 = SetEditBox(win,50,5,70,20,"num of Lines",0x50800000,0x200,editID2) 'edit for number of lines
edit3 = SetEditBox(win,50,32,710,22,"current Line",0x50800000,0x200,editID2) 'edit for current line
ControlFont(edit3, 15, 8, 400, "Courier New"): SetFocus edit3
static3 = SetStatic(win,120,8,54,16,"T-LINE",0,0,staticID3) 'static 'LINES'
edit4 = SetEditBox(win,160,6,60,20,"Line Num",0x50800000,0x200,editID4)

static4 = SetStatic(win,230,8,54,16,"T-CHAR",0,0,staticID4) 'static 'temp char
edit5 = SetEditBox(win,280,6,60,20,"CHAR",0x50800000,0x200,editID5) ' show char
ControlFont(edit5, 17, 9, 600, "Courier New")

static5 = SetStatic(win,350,8,54,16,"CHAR-POS",0,0,staticID5) 'static 'charPos
edit6 = SetEditBox(win,410,6,60,20,"POS",0x50800000,0x200,editID6) ' position in line

'create RICHEDIT1 ################################################################################​##########
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4 /:rc code line::
riched= SetRichEdit (win, 44,60,500,400,"a = a+b", WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCR​OLL|ES_AUTOHSCROLL|ES_NOHIDESEL,0x200,richID)
ControlFont(riched, 15, 8, 400, "Courier New") : SetRichEditBackColor riched, RGB(250,244,179)
SetEditSelection( riched, -1,-1):InvalidateRect( riched, 0, 0)
'set richedit text color
CHARFORMAT cf
cf.cbSize      = SizeOf(CHARFORMAT)
cf.dwMask      = CFM_COLOR
cf.dwEffects   = 0
cf.yHeight     = 200
cf.yOffset     = 0
cf.crTextColor = RGB(150,150,180)
cf.bCharSet    = ANSI_CHARSET
cf.bPitchAndFamily = 0
'szFaceName[LF_FACESIZE]
SendMessage riched, EM_SETCHARFORMAT, SCF_ALL, @cf

'create listbox for token list ##########################################################################
LBoxH = SetListBox(win,560,60,256,500,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LBid)
ControlFont(LBoxH, 17,7, 100, "Courier New"): TextColor ( win, RGB(100,120,180), RGB(210,220,250))
TextOn( win, 560, 562, "  TOKENS ")  ' print text on window
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-1"
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-2"

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

           'CASE WM_CREATE
            'InitDrawing(win)
            'WindowColor( win, 220, 230, 250)

           CASE WM_PAINT
            BitBlt(hDC, 0, 0, ww, wh, hdcMem, 0, 0, SRCCOPY)
            InvalidateRect(win, 0, 0)
                
            CASE WM_CLOSE
                CloseWindow(win)
                EndProgram
                 ExitProcess 0

            CASE WM_COMMAND
                controlID = LoWord(wParam) 'get control ID
                notifyCode = HiWord(wParam) 'get notification message

                select controlID
                    case b1ID  'open file
                      if notifycode=0
                       doOpen()
                    end if

                    case b0ID 'scan >>>
                      if notifycode=0
                       doScan()
                    end if

                 case B2ID ' run/proc
                      if notifycode=0
                       InterpretTokens()
                    end if

                 end select
        End Select
'<<<<< window output - our display >>>>>>>>>>>>>>>>>>>>>
    CASE wout
        Select wmsg

             CASE WM_CLOSE
                    CloseWindow(wout)
                   ' EndProgram()
                   ' ExitProcess 0

         End Select
'<<<<<<<<<<<<<<<<<<<<<<o>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
END SELECT
RETURN Default
END FUNCTION

'************************************************
'****    A N I -> P R O C E S S I N G    ********
'************************************************

'open source file
Sub doOpen
string fName="", dir="", sep=chr(0) , title="Open File... "
filter = "All Files "+sep+"*.*"+sep+"Bscript files "+sep+"*.bas"
title="Open File... "
fName = FileDialog(dir,filter,title,0,0,"txt")
IF fName = ""  'almost useless ?
  SendMessage edit1,WM_SETTEXT,0,strptr("EMPTY FILENAME ! ") : Return
END IF
'SendMessage status,WM_SETTEXT,0,strptr(fName)
char tx[500000] : tx =  GetFile fName        'load file into char buffer
'SendMessage riched, 12, 0, strptr(tx)      
SetText (riched,tx)                          'show text in richedit control
string numOfLines : INT LineCount : LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0
numOfLines = str(LineCount) : SetText (edit2,numOfLines) ' show result in edit2
outBuff = outBuff + "file_loaded..." + crlf                  : SetText (edit1,outBuff)
outBuff = outBuff + "number of lines : " + numOfLines + crlf : SetText (edit1,outBuff)
frees tx   ' free tx buffer
'reset listbox content ------------------
SendMessage LBoxH,LB_RESETCONTENT,0, NULL
End Sub

'Scan source line -----------------------------------------------------------------------
Sub doScan
string s,sc,cLine,sLine, tbuff
string pt = Space (256)                 ' also you may try char pt[255]=""
INT i ,LineCount=1 ,crPos, first
ipos=0 : tokCount = 0                   ' reset item position and token count
SetText(edit3,"")                       ' clear current line box
LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0 ' get number of Lines

SetText (edit1,"WAIT..scanning >>>>") : MsgBox "SCAN CODE"+crlf + LineCount,"OK!..START"
'scan each line
For i = 0 to LineCount-1
'label again <<<<<<
pt=Space(256)  ' create line buffer
   ' enable events..so i use PeekMessage.....................
        'while PeekMessage (wm,0,0,0,Pm_Remove)>0 ' //peek
            'TranslateMessage (wm)
            'DispatchMessage (wm)
        'wend
    SendMessage (riched, EM_GETLINE, i, pt) ' get line from richedit control
   'first = SendMessage riched, EM_LINEINDEX, i, 0
sLine = Ltrim(pt)  'trim left side of line
   ' MsgBox pt , "INFO"..............................................................................
    IF  Len(sLine) > 1
        crPos = instr(sLine,chr(13)) :   ' check CR position /msgbox "POS:"+str(crPos),"CHR(13).POS"
        s = MID( sLine, 1, crPos-1)      ' extract string / text
    ELSE
      ' MsgBox (sLine + str(LineCount) , "EMPTY LINE")
        s=" "                         'clear s                  
    END IF
  
        SetText edit4,  str(i)            'show line number
        SetText(edit3, s)                 'show current line in single-Line edit box
        IF s <> " "                        'if line is not empty
          cLine = GetText(edit3)            'get text from edit control        
          Tokenizer(cLine)                  'tokenize line
          'get char func >>>>>>>>>>>>>>>>>>
          GetChar(cLine)
          '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        END IF
        'Sendmessage riched,EM_HIDESEL,i,0
        'SetEditSelection( riched, first,len pt)
        'Sendmessage riched,EM_HIDESEL,i,0
         s="" : sLine="" : pt=""      ' clear string buffers
        'sleep = 100                  ' slow down..tweak for your computer-200    
        'SendMessage riched,EM_SCROLL ,1,0
    'END IF : '...............................................................................​......
Next i
outBuff = "TOKENIZATION FINISHED!" + crlf : outBuff = outBuff + "Token Count: " + str(tokCount) + crlf
SetText (edit1, outBuff)
End Sub
'-----------------------------------------------------------------------------------------

SUB GetChar(string sLine)
INT pos=1,lineSize
string ch,nextCh,tLine
    tLine = Mid(sLine,1,Len(sLine))
    lineSize=LEN(tLine)
        while pos <= lineSize
            ch = Mid( tLine,pos,1)
               ' sleep 100  '200
                SetText(edit5,ch)       'show character
                SetText(edit6,str(pos)) 'show char position in line
                ch=""
            pos=pos+1
        wend
End Sub
'--------------------------------------------------------------------------------
Function SetEditSelection(INT eHandle, sStart, sEnd)
SendMessage( ehandle, EM_SETSEL, sstart, send)
End Function
'--------------------------------------------------------------------------------
Function Tokenizer(code as string)
    'print "CODE:" + code
    string token, ch
    'load file?
    INT i,j,tokTyp
    '................................
    'print "CODE-LEN:" + str(len(code))
   '.................................
    i=1
    WHILE i <= len(code)
        
        IF instr(ALPHABETS, mid(code,i,1)) <> 0            'isAlpha
            while i <= len(code) and INSTR(ALPHABETS ,mid(code,i,1)) > 0
                token = token + mid(code, i, 1)            
                 i=i+1
            wend  
            'PRINT "TCount:" + str tokcount
           'print token        
            if  ucase(token)= isKeyword(token)                                  ' search keyword list
                 tokCount++ : tokList[tokCount] = token                         ' add key token to list
                 tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp  ' add tokType to list
                 token = token + " ~KEYWORD~~~~~~ "
                 SendMessage LboxH, LB_ADDSTRING, 0, token
                 token="" : tokTyp = 0
            else
            tokCount++
                tokList[tokCount] = token : ' add ident to list
                token = token + " ~IDENTIFIER~~~~ " : 'variabe
                SendMessage LboxH, LB_ADDSTRING, 0, token
                  token=""
            end if
           'token=""
           'i=i+1
         END IF  
      
    IF instr(SYMBOLS, mid(code, i, 1)) > 0 and  i <= len(code)'sym operators
        token = mid(code, i, 1)
              'print token
         byte t at strptr(token)
        Select t
             case "+"
             tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "+" + " ~PLUS~~~~~~~ " + str(tokTyp)
               SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

             case "-"
             tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
               token = "-" + " ~MINUS~~~~~~ " + str(tokTyp)
               SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++
               tokList[tokCount] = token

            case "*"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "*" + " ~MULTI~~~~~~~ " + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "/"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "/" + " ~DIVIDE~~~~~~~ " + str(tokTyp)
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "^"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "^" + " ~POWER~~~~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "("
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "(" + " ~LPAREN~~~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case ")"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
               token = ")" + " ~RPAREN~~~" + str(tokTyp)
               SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "["
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "[" + " ~LBRACKET~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "]"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "]" + " ~RBRACKET~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case ","
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "," + " ~COMMA~~~~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case ":"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = ":" + " ~COLON~~~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            case "="
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
              token = "=" + " ~EQUAL~~~" + str(tokTyp)
              SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

           case "&"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "&" + " ~AND~~~~~~" + str(tokTyp)
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

           case "|"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "|" + " ~OR~~~~~~" + str(tokTyp)
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

          case "!"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "!" + " ~NOT~~~~~" + str(tokTyp)
            SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

          case ">"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = ">" + " ~GREAT~~~~~" + str(tokTyp)
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

          case "<"
            tokList[tokCount] = token : tokTyp = SetTokenType(token) : tokTypeList[tokCount] = tokTyp
             token = "<" + " ~LESS~~~~~" + str(tokTyp)
             SendMessage LboxH, LB_ADDSTRING, 0, token: tokCount++

            end select
            i=i+1
           token=""
        END IF

        IF instr(NUMBERS, mid(code, i, 1)) <> 0 and i <= len(code)   'numbers
            while i <= len(code) and INSTR(NUMBERS,mid(code,i,1)) <> 0
                token = token + mid(code,i,1)
                 i=i+1
             wend
            token = token + "  ~ NUMBER" : tokCount++
             SendMessage LboxH, LB_ADDSTRING, 0, token
             tokList[tokCount] = token
            token=""
        END IF

        'elseif ch = chr(34) 'quote "
         IF INSTR(mid(code,i,1),DQ) <> 0
            'token = ""
            i = i + 1 ' skip first quote "......
            while mid(code,i,1) <> chr(34) 'string literal inside quotes "......."
                token = token + mid(code,i,1)
                i=i+1
             wend
                'tokens = tokens + token '+ " ~ STRING-LITERAL" + crlf
                 SendMessage LboxH, LB_ADDSTRING, 0, token + " ~STRING": tokCount++
                 tokList[tokCount] = token
             token=""
             i=i+2 ' skip second quote  ......"
        END IF

        IF mid(code, i, 1) = " "  'whitespace
             'print "WHITE:" + str(i)
            i=i+1 'skip whitespace
        END IF

       IF mid(code, i, 1) = "'"  'comment
            i=i+1 ' skip char " ' "
            'loop untill you get end of line chr(10)
            while i <= len(code) AND mid(code, i, 1) <> chr(13)
            i=i+1 'skip chars under comment
            wend
            i=i+1
        END IF


        'elseif ch = chr(10) ' not used because of CRLF in bufer -> tokens
        'IF i <= len(code) and mid(code,i,1) = chr(10)
            'tokens = tokens + mid(code,i,1) + " :NEWLINE" + crlf ' or end of instruction
         'print "NEWLINE"
          'return  
            'i=i+1
        'END IF
        'else
            'tokens = tokens + ch + " :UNINDENTIFIED - ERROR!" + crlf
            'i=i+1

      
    'PRINT "BEFORE_WEND:" + str(i)
  
    WEND

    'Return token
    Return

end function
'--------------------------------------------------------------------------
'......................................................................
Function IsKeyword(byval tok as string) as string
'string ret
FOR n = 1 TO 14
   If ucase(tok) = KEYWORDS[n]     ' if is KEYWORD
        RETURN KEYWORDS[n]  
   End if
NEXT n
Return ""
End Function
'......................................................................
Function SetTokenType(byval tok as string) as int
'return token Type
    if tok = "+" : return tokPLUS        : end if
    if tok = "-" : return tokMINUS       : end if
    if tok = "*" : return tokMULTI       : end if
    if tok = "/" : return tokDIVIDE      : end if
    if tok = "&" : return tokAND         : end if
    if tok = "|" : return tokOR          : end if
    if tok = "!" : return tokNOT         : end if
    if tok = "(" : return tokLPAREN      : end if
    if tok = ")" : return tokRPAREN      : end if
    if tok = "[" : return tokLBRACKET    : end if
    if tok = "]" : return tokRBRACKET    : end if
    if tok = "{" : return tokLBRACE      : end if
    if tok = "}" : return tokRBRACE      : end if
    if tok = "," : return tokCOMMA       : end if
    if tok = ":" : return tokCOLON       : end if
    if tok = "=" : return tokEQUAL       : end if
    if tok = ">" : return tokGREAT       : end if
    if tok = "<" : return tokLESS        : end if

    'keywords...
    if Ucase(tok) = "WINDOW" : return tokWINDOW     : end if
    


End Function

'*********************************************************************
'::::::::::::::  INTERPRETER  ::::::::::::::::::::::::::::::::::::::::
'*********************************************************************
Function InterpretTokens()
'read tokens from token list and iterpret them (execute)
INT tc=1, itemp1,itemp2
STRING t, arg1, arg2

t = tokList[1] 'get token from list
'print t
'INT p at strptr t


IF ucase(t) = "WINDOW" then
  print "INSTRUCTION : Window executed!" 'info
  tc++ : arg1 = tokList[tc]   'get next token
  tc=tc+2 : arg2 = tokList[tc]   'get next token skiping comma
  itemp1 = val(arg1) : itemp2 = val(arg2)  'arguments to values
'create new window
  wout = CreateWindowEx ( 0x200,"Oxygen","ANI - Display", 524288 , 200, 200, itemp1, itemp2, 0, 0, null, 0)
  ShowWindow wout,1 : UpdateWindow wout


END IF


End Function


'***********************************************************************
'::::::::::::::::  INTERPRETER  END OF CODE  :::::::::::::::::::::::::::
'***********************************************************************

Function execWindow( INT winW,winH)
End Function



'##########################################################
SUB TextColor (wID as INT,byval frontColor as INT,byval  backColor as INT )
hdc = GetDC(wID)
SetTextColor( hDC, frontColor)
SetBkColor( hDC, backColor)
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
'########################################################

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
'..........................................................
Sub ELIPSE(INT x, y, r1,r2, color)
hdc=GetDc win
SelectObject(hdc, CreateSolidBrush( color ))
Ellipse Hdc,x,y,r1+x,r2+y
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)
ReleaseDC( win, hdc)
End Sub

'##########################################################
SUB InitDrawing
''get current size of window
GetSize(win,0,0,ww,wh)
'get window DC
hdc=GetDC(win)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(hdc, ww, wh)
oldBmp = SelectObject( hdcMem, hbmMem )
oldBrush = SelectObject(hdcMem, CreateSolidBrush( RGB(231,223,231)) )
oldPen = SelectObject(hdcMem, CreatePen(PS_SOLID,1,RGB(231,223,231)))
'fill rectangle memDC with brush color
FillRect ( hdcMem,rc, oldBrush)
SetTextColor( hDC,RGB(0,0,0))
SetBkColor( hDC, RGB(231,223,231))
'blit to memDC
BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)

ReleaseDC( win, hdc)
End SUB

'##########################################################
SUB CleanUp

DeleteDC(hdcMem)
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldPen))
DeleteObject(SelectObject(hdcMem, oldBmp))


END SUB


Attached File(s) Image(s)
   
Find all posts by this user
Quote this message in a reply
Post Reply 


Forum Jump:


User(s) browsing this thread: