Global delimiter$ as string
Global string$ as string
Global token$ as string
Global stringLength as integer
Global startingPosition as integer
Global delimiterLength as integer
delimiter$= " "
startingPosition = 1
delimiterLength = len(delimiter$)
 
string$ = "if ( thing = true ) then"
token$ = ""
stringLength = len(string$)
 
 
dim arrayA$(0)
dim arrayB$(0)
dim symbols$(0)
 
restore array1
read a$
while a$ <> "."
   array insert at top arrayA$()
   arrayA$(0) = a$
   read a$
endwhile
 
restore array2
read a$
while a$ <> "."
   array insert at top arrayB$()
   arrayB$(0) = a$
   read a$
endwhile
 
restore symbols
read a$
while a$ <> "."
   array insert at top symbols$()
   symbols$(0) = a$
   read a$
endwhile
 
 
 
rem text file to display
filename$ = "c:\parseExample.txt"
rem array list to hold text from file
dim words$(0) as string
 
rem check to see if file specified is a text file
if lower$(right$(filename$, 4)) = ".txt"
  rem check if file exists
  if file exist(filename$)
      rem open file for reading
      open to read 1, filename$
      rem add text from file to array list
      while file end(1) = 0
        read string 1, temp$
        array insert at bottom words$(0)
        words$(array count(words$(0))) = temp$
      endwhile
  endif
endif
rem close the file
close file 1
 
 
   parse()
repeat
until spacekey()
 
 
function parse()
   for t = 1 to array count(words$())
      parseString(t*14,words$(t))
   next t
 
 
endfunction
 
 
function parseString(v,txt$)
   token$ = ""
   startingPosition = 1
   string$ = txt$
   stringLength = len(string$)
 
   color as dword
   x = 10
   y = v
   width = 0
 
   while hasMoreTokens() = 1
      color = rgb(255,255,255)
      word$ = nextToken$()
      flag = 0
      for i=0 to array count(arrayA$())
         if arrayA$(i) = word$
            color = rgb(255,0,0)
            flag = 1
            exit
         endif
      next i
 
      if flag = 0
         for i=0 to array count(arrayB$())
            if arrayB$(i) = word$
               color = rgb(205,180,0)
               flag = 1
               exit
            endif
         next i
      endif
 
      if flag = 0
         for i=0 to array count(symbols$())
            if symbols$(i) = word$
               color = rgb(120,0,210)
               flag = 1
               exit
            endif
         next i
      endif
 
      ink color,0
      text x+width,y,word$+" "
 
      width = width + text width(word$+" ")
 
   endwhile
 
endfunction
 
 
 
 
REM Returns the next token from the string
function nextToken$()
  flag = 0
 
  if delimiter$ = ""
      startingPosition = stringLength
      token$ = string$
  endif
 
  for i = startingPosition to stringLength-1
      for x = 1 to delimiterLength
        if mid$(delimiter$,x) = mid$(string$,i)
            token$ = subString(string$, startingPosition-1, i-1)
            startingPosition = i+1
            flag = 1
            sp = startingPosition
            repeat
               hit = 0
               for x = 1 to delimiterLength
                  if mid$(delimiter$,x) = mid$(string$,sp) then hit = 1
               next x
               if hit = 1 then inc sp, 1
            until hit = 0
            startingPosition = sp
            exit
        endif
        if (i = stringLength-1)
            token$ = subString(string$, startingPosition-1, i+1)
            startingPosition = i+1
            flag = 1
        endif
      next x
 
      if flag = 1 then exit
  next i
endfunction token$
 
 
 
REM Returns true(1) if the string has more tokens left
function hasMoreTokens()
  if startingPosition <= stringLength-1 then exitfunction 1
endfunction 0
 
 
 
REM Returns a chunk of a whole string
REM starp - is the starting position of the substring that
REM        you want to be returned. The character at that
REM        position is not included in the returned result.
REM endp - is the position of the last character in the string
REM        you want to be returned.
function subString(s$ as string, startp as integer, endp as integer)
  l = len(s$)
  s$ = right$(s$,l-startp)
  s$ = left$(s$, endp-startp)
endfunction s$
 
 
 
 
 
 
array1:
data "if","else","then","endif","while","endwhile","type","endtype","integer","float","dword","."
 
array2:
data """","(",")","as","."
 
symbols:
data "+","-","*","/","<>","=","<",">","."