Sorry your browser is not supported!

#CONSTANT FALSE = 0
#CONSTANT TRUE = 1

#CONSTANT KEYWORD = 1
#CONSTANT NUMBERS = 2
#CONSTANT STR = 3
#CONSTANT COMMENT = 4
#CONSTANT NORM = 5


dim colors(5) as dword
colors(KEYWORD) = rgb(255,128,0)
colors(NUMBERS) = rgb(0,255,0)
colors(STR)     = rgb(200,0,200)
colors(COMMENT) = rgb(192,192,192)
colors(NORM) = rgb(255,255,255)


remstart
 * Each segment contains the character 
 * indices of what code is to be 
 * highlighted between them, inclusive.
remend
type ColorSegment
    beginIndex as integer
    endIndex as integer
    keyType as integer
endtype

remstart
 * Array of ColorSegments
remend
dim segments() as ColorSegment


remstart
 * Document, a text file made up
 * of an array of strings
remend
dim Document(0) as string

restore KeywordsFile
read t
dim keywords(t) as string

for i = 1 to t
    read z$
    keywords(i) = z$
next i


loadFile("D:\Programming\DBPro Source\syntax highlighter.dba")
parseDocument()

fromLine = 1
pageSize = 40

sync on
repeat
    cls
    if downkey()=1 then inc fromLine
    if upkey()=1 then dec fromLine    
    if fromLine < 1 then fromLine = 1
    if fromLine+pageSize > array count(Document()) then fromLine = array count(Document())-pageSize
    
    displayDocument(fromLine, fromLine+pageSize)
    sync
until spacekey()


END




remstart
 * parses the text
remend
function parseDocument()
    ink rgb(255,0,0),0
    set cursor 0,200
    offset = 0
    
    for index = 1 to array count(Document())
        txt$ = Document(index)
        start = 1
        for i = 2 to len(txt$)
            sub$ = lower$(substring$(txt$, start, i))
            match = matches(sub$)
            
            rem exactly 1 match found
            if match = 0
                if i=len(txt$) OR checkSpecial(mid$(txt$,i+1))
                    keyType = KEYWORD
                    if sub$ = "rem" 
                        keyType = COMMENT
                        i = len(txt$)
                    endif
                    addColorSegment(offset+start, offset+i, keyType)
                    start = i+1
                endif
            else
                if match = -1 then start = i+1
            endif
        next i
        inc offset, len(txt$)
    next index

endfunction


remstart
 * checks if a single char 'c' is a special character
remend
function checkSpecial(c as string)
    if c = " " or c = "(" or c = ":" or asc(c) = 13 then exitfunction TRUE
endfunction FALSE


remstart
 * searches for matches between 'sub'
 * and any keywords in the keyword array 
 * -1 = no matches
 *  0 = exact match found
 *  1 = 1 or more matches possible
 * many keywords containing spaces can potentially
 * have other matches
 * if the parser has only read as far as SYNC, we could
 * potentially be matching this to SYNC ON so therefore
 * we do not end the matching with just SYNC.
 *
 * Highly inefficient method for finding keywords
 * Implement a binary search on a sorted keyword list
 * or possibly use some sort of tree map
remend
function matches(sub as string)
    count = -1
    temp$ = ""
    for i = 1 to array count(keywords())
        if startsWith(keywords(i), sub)
            inc count
            temp$ = keywords(i)
        endif
    next i
    if count = 0 and sub <> temp$ then inc count
endfunction count


remstart
 * Adds color segment to array
remend
function addColorSegment(beginIndex as integer, endIndex as integer, keyType as integer)
    array insert at bottom segments()
    index = array count(segments())
    segments(index).beginIndex = beginIndex
    segments(index).endIndex = endIndex
    segments(index).keyType = keyType
endfunction


remstart
 * returns a substring of 's'
 * indices are inclusive
remend
function substring$(s as string, beginIndex as integer, endIndex as integer)
    r$ = left$(s, endIndex)
    r$ = right$(r$, len(r$)-(beginIndex-1))
endfunction r$


remstart
 * returns true if 's' starts with
 * the the substring 'sub'
remend
function startsWith(s as string, sub as string)
    if len(sub) > len(s) then exitfunction FALSE
    for i = 1 to len(sub)
        if mid$(s, i) <> mid$(sub, i) then exitfunction FALSE
    next i
endfunction TRUE


remstart
 * Displays the highlighted document
remend
function displayDocument(fromLine as integer, toLine as integer)
    displayLine = 0
    H = text height(" ")
    seg = 0
    charOffset = 0

    for i = 1 to fromLine-1
        inc charOffset, len(Document(i))
    next i


    rem loop through all lines in document
    for index = fromLine to toLine        
        X = 0
        lastChar = 0
        charMax = len(Document(index))
        endLine = 0
        
        rem display only the lines we want
        if index > toLine then exitfunction
        if index < fromLine
            inc displayLine
            inc charOffset, len(Document(index))
        else
            rem else if we SHOULD display this line then
            if seg <=  array count(segments())
                while seg <= array count(segments()) AND endLine = 0
                    rem does this segment start in this line
                    if segments(seg).beginIndex < charMax + charOffset
                        rem make sure text before this segment his been displayed
                        if segments(seg).beginIndex-1 > lastChar+charOffset
                            ink colors(NORM), 0
                            sub$ = substring$(Document(index), lastChar+1, (segments(seg).beginIndex-1)-charOffset)
                            text X, displayLine*H, sub$
                            inc X, text width(sub$)
                        endif
                        rem display this segment in its chosen highlighted color                    
                        sub$ = substring$(Document(index), segments(seg).beginIndex-charOffset, segments(seg).endIndex-charOffset)
                        ink colors(segments(seg).keyType),0
                        text X, displayLine*H, sub$
                        inc X, text width(sub$)
                        lastChar = segments(seg).endIndex-charOffset
                        rem increment to next segment in array
                        inc seg
                    else
                        rem segment starts on another line, display remainder of text
                        ink colors(NORM), 0
                        sub$ = substring$(Document(index),lastChar+1 ,charMax)
                        text X, displayLine*H, sub$
                        endLine = 1
                    endif
                endwhile
                rem increment char index pointer
                inc charOffset, len(Document(index))
            else
                ink colors(NORM), 0
                text X, displayLine*H, Document(index)
            endif
            inc displayLine
        endif
    next index
endfunction


remstart
 * reads a file into the 'Document' array
remend
function loadFile(file as string)
    open to read 1, file
    
    while file end(1) = FALSE
        read string 1, r$
        array insert at bottom Document()
        Document(array count(Document())) = r$
    endwhile
    
    close file 1
endfunction


KeywordsFile:
data 46
data "#constant", "function", "endfunction", "string", "if", "then", "else", "for", "to", "next"
data "dim","string","integer","byte","dword","print","wait","wait key","end", "and"
data "type", "endtype", "string", "ink", "rgb", "read string", "array insert at bottom", "array count", "open to read", "close file"
data "while", "endwhile", "exitfunction", "file end", "as", "upper$", "inc", "len", "data", "sync"
data "sync on", "sync rate", "repeat", "until", "spacekey"
data "rem"