AURELSOFT Friday, 2017-11-24, 4:05 PM
Welcome Guest | RSS
Site menu

Statistics

Total online: 1
Guests: 1
Users: 0

Home » 2016 » February » 25 » EdToy3
10:14 AM
EdToy3

'toy3 - GUI version/24.2.2016 mod by Aurel
' Grammar:
'
'pgm = {int_decl} stmt_seq .
'int_decl = "integer" ident {"," ident} .
'stmt_seq = {print_stmt | halt_stmt | while_stmt | assign | if_stmt} .
'print_stmt = "print" (string | expr) {, (string | expr) } .
'halt_stmt = "halt" .
'while_stmt = "while" expr "do" stmt_seq "end" "while" .
'assign = ident "=" expr .
'if_stmt = "if" expr "then" stmt_seq ["else" stmt_seq] "end" "if" .
'exp    = orexp .
'orexp  = andexp {"or" andexp} .
'andexp = eqlexp {"and" eqlexp} .
'eqlexp = relexp {eqlop relexp} .
'relexp = addexp {relop addexp} .
'addexp = mulexp {addop mulexp} .
'mulexp = factor {mulop factor} .
'factor = '(' exp ')' | number | ident .
'unary_exp  = "not" | "-" .
'eqlop = "=" | "<>"
'relop = "<" | "<=" | ">" | ">="
'addop = "+" | "-"
'mulop = "*" | "/" | "mod"
'
' example program - find primes:
'
'   integer n, lim, k, p
'   n = 1
'   lim = 100
'   while n < lim do
'       k = 3
'       p = 1
'       n = n + 2
'       while k * k <= n and p do
'           p = n / k * k <> n
'           k = k + 2
'       end while
'       if p then
'           print n, " is prime"
'       end if
'   end while
'
' Comments are denoted by the single quote, and extend until the end-of-line

$Filename "toy3.exe"
include "awinh.inc"
'include "RTL32.inc"
'include "console.inc"

'! sub SetCurrentDirectoryA lib "kernel32.dll" (lpPathName as asciiz)

#lookahead

const as long true = -1, false = 0
string cr=chr(13),crlf=chr(13)+chr(10)
int ty =10 ' first line of text on window y-coor
' variables for the lexer

dim as string cur_line    ' text of current line
dim as string cur_ch      ' the current character
dim as long sym           ' the current symbol (keyword, operator, etc)
dim as string token       ' text version of current symbol

dim as long cur_col
dim as long cur_line_num
dim as long error_line
dim as long error_col

type Key_words
    keyword as string
    sym as long
end type

const as long MAX_KEYWORDS = 13, MAX_SYMTAB = 100, MAX_CODE = 1000, MAX_STACK = 1000

dim key_words_tab(MAX_KEYWORDS) as Key_words

' symbol table - all program identifiers stored here

type Symbol_table
    ident as string
    data_index as long
end type

dim sym_tab(MAX_SYMTAB) as Symbol_table
dim as long sym_tab_used ' highest used entry

dim as long data_index ' highest used data entry - symbol table version

' Virtual Machine

dim as long code_index ' highest used code position
dim as long data_size ' highest used data entry - VM version
dim as long code_arr(MAX_CODE) ' code store

' Equates for the symbol type, e.g. what type of symbol have we just read
' the lexer sets variable sym to one of these
const as long sym_unknown = 0, sym_eoi = 1, sym_string_const = 2, sym_lparen = 3, sym_rparen = 4
const as long sym_multiply = 5, sym_plus = 6, sym_comma = 7, sym_minus = 8, sym_divide = 9
const as long sym_integer_const = 10, sym_ident = 11, sym_print = 12, sym_while = 13
const as long sym_do = 14, sym_end = 15, sym_halt = 16, sym_if = 17, sym_then = 18
const as long sym_else = 19, sym_integer_var = 20, sym_equal = 21, sym_mod = 22, sym_or = 23
const as long sym_and = 24, sym_neq = 25, sym_lss = 26, sym_leq = 27, sym_gtr = 28
const as long sym_geq = 29, sym_neg = 30, sym_not = 31, sym_whtspc = 32

const as long left_assoc = 1, right_assoc = 0

' Instructions for the virtual machine
const as long op_halt = 0, op_push_int = 1, op_add = 2, op_sub = 3, op_mul = 4, op_div = 5
const as long op_prt_str = 6, op_prt_int = 7, op_prt_nl = 8, op_jmp = 9, op_jz = 10
const as long op_push_int_var = 11, op_stor = 12, op_mod = 13, op_or = 14, op_and = 15
const as long op_neq = 16, op_equal = 17, op_lss = 18, op_leq = 19, op_gtr = 20, op_geq = 21
const as long op_neg = 22, op_not = 23

dim as string code ' SCRIPT CODE BUFFER

int win=0, winstyle=WS_SYSMENU
win = SetWindow("TOY 3",0,0,640,680,0, winstyle)

'open src file
main()


'>>> MSG LOOP >
Wait()
'<<<<<<<<<<<<<

'/////////////////////////////////////////////////////////////
Function WndProc (byval hwnd as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback
Select hwnd
'>>>>>>>>>>>>>>>>>>>>>>>>>

Case win
'>>>>>>>>>>>>>>>>>>>>
    Select wMsg

        CASE WM_DESTROY
        PostQuitMessage(0)
        ExitProcess 0

    End select

End Select

Return DefWindowProc hwnd,wMsg,wParam,lParam
End FUNCTION
'/////////////////////////////////////////////////////////////

 


sub main()
    'print "enter filename (^C to quit): "
    'dim as string filename = rtrim(input())
'open file


INT hsize=0
string filename
string dir=""
string sep=chr(0)
'filter = "All Files"+sep+"*.*"+sep"Text files"+sep+"*.txt"+ sep
string filter = "All files "+sep+"*.*"+sep+"SB files "+sep+"*.bas"
string title="Open File... "
int hwnd=0
filename = FileDialog(dir,filter,title,0,0,"bas")
IF filename = "" Then Return
'SendMessage edit1,WM_SETTEXT,0,strptr(fName)
' tx =  GetFile fName

    init_sym_tab()
    init_code()
    init_lex(filename)
    parse()
    list_code()
    interpret()
    press_a_key()
end sub


sub init_lex(filename as string)
    '// MAKE SURE CODE BUFFER ENDS IN EMPTY STRING
    getfile(filename, code)
    code = code & chr(13) & chr(10)
    cur_line_num = 0
    
    key_words_tab( 1).sym = sym_and
    key_words_tab( 2).sym = sym_do
    key_words_tab( 3).sym = sym_else
    key_words_tab( 4).sym = sym_end
    key_words_tab( 5).sym = sym_halt
    key_words_tab( 6).sym = sym_if
    key_words_tab( 7).sym = sym_integer_var
    key_words_tab( 8).sym = sym_mod
    key_words_tab( 9).sym = sym_not
    key_words_tab(10).sym = sym_or
    key_words_tab(11).sym = sym_print
    key_words_tab(12).sym = sym_then
    key_words_tab(13).sym = sym_while
    
    key_words_tab( 1).keyword = "and"
    key_words_tab( 2).keyword = "do"
    key_words_tab( 3).keyword = "else"
    key_words_tab( 4).keyword = "end"
    key_words_tab( 5).keyword = "halt"
    key_words_tab( 6).keyword = "if"
    key_words_tab( 7).keyword = "integer"
    key_words_tab( 8).keyword = "mod"
    key_words_tab( 9).keyword = "not"
    key_words_tab(10).keyword = "or"
    key_words_tab(11).keyword = "print"
    key_words_tab(12).keyword = "then"
    key_words_tab(13).keyword = "while"

    next_char()
end sub

sub next_line() ' read the next line of input from the source file
    cur_line = ""
    cur_ch = "" ' empty cur_ch means end-of-file
    cur_line = get_line()
    if cur_line = "" then exit sub
    cur_line = cur_line & chr(10) '// LF
    cur_line_num = cur_line_num + 1
    'print cur_line '// CONTAINS LF
     ty=ty+15
    TextOn(win, 20, ty, cur_line)
    cur_col = 1
end sub

sub next_char() ' get the next char
    cur_ch = ""
    cur_col = cur_col + 1
    if cur_col > len(cur_line) then next_line()
    
    if cur_col <= len(cur_line) then
        cur_ch = mid(cur_line, cur_col, 1)
    end if
end sub

sub skip_white_space()
    ' apparently BASIC doesn't do short circuiting of long expressions
    ' pick off the empty string first, since asc of an empty string causes an error
    byte c
    do
        c = asc(cur_ch)
        select case c
            case " ", 9, 10
                next_char()
            case else
                exit do
        end select
    end do
end sub

sub next_sym() ' determine the next symbol
    byte c

    token = ""
    skip_white_space()
    error_line = cur_line_num
    error_col = cur_col
    c = asc(cur_ch)
    select case c '// O2 SPECIFIC!
        case ""
            sym = sym_eoi
        case "+"
            sym = sym_plus
            next_char()
        case "-"
            sym = sym_minus
            next_char()
        case "*"
            sym = sym_multiply
            next_char()
        case "/"
            sym = sym_divide
            next_char()
        case ","
            sym = sym_comma
            next_char()
        case "("
            sym = sym_lparen
            next_char()
        case ")"
            sym = sym_rparen
            next_char()
        case "="
            sym = sym_equal
            next_char()
        case "<"
            sym = sym_lss
            next_char()
            if cur_ch = ">" then
                sym = sym_neq
                next_char()
            elseif cur_ch = "=" then
                sym = sym_leq
                next_char()
            end if
        case ">"
            sym = sym_gtr
            next_char()
            if cur_ch = "=" then
                sym = sym_geq
                next_char()
            end if
        case 34 ' a double quote
            get_string()
        case else
            if is_numeric() then
                get_digits()
            elseif is_alpha() then
                get_ident()
            else
                error_msg("unrecognized character: " & cur_ch & " asc = " & str(c))
            end if
    end select
end sub

sub get_string()
    dim as long start_line
    dim as string DQ = chr(34)
    
    sym = sym_string_const
    token = ""
    start_line = error_line
    next_char()
    while cur_ch <> DQ
        if cur_ch = "" then
            sym = sym_eoi
            error_msg("eof found in string")
        end if
        if error_line > start_line then
            error_msg("string must be on one line")
        end if
        token = token & cur_ch
        next_char()
    wend
    if cur_ch = DQ then next_char()
end sub

sub get_digits()
    sym = sym_integer_const
    token = ""
    while is_numeric()
        token = token & cur_ch
        next_char()
    wend
end sub

sub get_ident()
    token = ""
    while is_alpha() or is_numeric() or cur_ch = "_"
        token = token & cur_ch
        next_char()
    wend
    sym = search_key_words()
end sub

' look for a key word - return either the matching sym or sym_ident
function search_key_words() as long
    dim as long i

    for i = 1 to MAX_KEYWORDS
        if token = key_words_tab(i).keyword then
            return key_words_tab(i).sym
        end if
    next
    
    return sym_ident
end function

'------ Symbol table ---------------------------------------------------

sub init_sym_tab()
    data_index = 1
    sym_tab_used = 0
end sub

function get_data_size() as long
    return data_index
end function

' internal routine
function find_sym_tab(ident as string) as long
    dim as long i
    for i = 1 to sym_tab_used
        if ident = sym_tab(i).ident then return i
    next
    
    return 0
end function

sub insert_sym_tab()
    if sym_tab_used >= MAX_SYMTAB then
        error_msg("Symbol table exhausted")
    end if
    
    if find_sym_tab(token) > 0 then
        error_msg(token & " has already been defined")
    end if
    sym_tab_used = sym_tab_used + 1
    sym_tab(sym_tab_used).ident = token
    sym_tab(sym_tab_used).data_index = data_index
    data_index = data_index + 1
end sub

' see if an ident exists in the symbol table - long return
function is_in_sym_tab(byref address as long) as long
    dim as long i
    
    i = find_sym_tab(token)
    if i = 0 then return false

    address = sym_tab(i).data_index
    return true
end function

'------ virtual machine -------------------------------------------------------------

' code generator

sub init_code()
    code_index = 1
end sub

sub set_data_size(size_to_set as long)
    data_size = size_to_set
end sub

function get_cur_loc() as long
    return code_index
end function

sub emit_at(location as long, operand as long)
    code_arr(location) = operand
end sub

sub emit(opcode as long)
    if code_index >= MAX_CODE then
        error_msg("code array exhausted: " & str(code_index))
    end if
    code_arr(code_index) = opcode
    code_index = code_index + 1
end sub

function emit2(opcode as long, operand as long) as long
    dim as long location = code_index
    emit(opcode)
    emit(operand)
    return location
end function

sub patch_jmp_to_current(fix_addr as long)
    ' skip over opcode
    emit_at(fix_addr + 1, code_index)
end sub

' code lister
sub list_code()
    dim as long i
    dim as long last_code

    dim as long operand
    dim as string st
    dim as long tmp
    dim as long tmp2

    'print cr "Code listing..."
    TextOn( win,0, 0, "Code listing...")
    last_code = code_index
    i = 1
    do
        select case code_arr(i)
            case op_halt
                'print i " halt" cr
            case op_push_int
                'print i " push-int " code_arr(i + 1) cr
                i = i + 1
            case op_push_int_var
                'print i " push-int-var " code_arr(i + 1) cr
                i = i + 1
            case op_stor
                'print i " store " code_arr(i + 1) cr
                i = i + 1
            case op_jmp
                'print i " jmp " code_arr(i + 1) cr
                i = i + 1
            case op_jz
                'print i " jz " code_arr(i + 1) cr
                i = i + 1
            case op_add:' print i " add" cr
            case op_sub:' print i " sub" cr
            case op_mul:' print i " mul" cr
            case op_div:' print i " div" cr
            case op_mod: 'print i " mod" cr
            case op_or: 'print i " or" cr
            case op_and: 'print i " and" cr
            case op_neq: 'print i " neq" cr
            case op_equal: 'print i " equal" cr
            case op_lss: 'print i " lss" cr
            case op_leq: 'print i " leq" cr
            case op_gtr:' print i " gtr" cr
            case op_geq:' print i " geq" cr
            case op_neg: 'print i " neg" cr
            case op_not:' print i " not" cr
            case op_prt_nl: 'print i " print-nl" cr
            case op_prt_str
                st = ""
                operand = code_arr(i + 1)
                tmp = operand
                tmp2 = i
                i = i + 1
                while operand > 0
                    i = i + 1
                    st = st & chr(code_arr(i))
                    operand = operand - 1
                wend
                'print tmp2 " print-str " tmp " " st cr
            case op_prt_int
                'print i " print-int" cr
            case else
                error_msg("unexpected opcode " & str(code_arr(i)) & " at position " & str(i))
        end select
        i = i + 1
        if i >= last_code then exit do
    end do
    'print cr
end sub

' virtual machine interpreter

sub interpret()
    dim as long last_code
    dim as long pc
    dim as long sp
    dim as long halted
    dim as long stack(MAX_STACK)
    
    dim as long opcode
    dim as long operand
    dim as string st
    
    'print "Running... code_index: " code_index cr
    ty=ty+15
    TextOn( win,20,ty,"Running... code_index: " + code_index )
    last_code = code_index - 1
    halted = false
    pc = 1
    sp = data_size
    do
        opcode = 0
        operand = 0
        st = ""
        
        if pc > last_code then
            error_msg("pc: (" & str(pc) & ") > last_code: (" & str(last_code) & ")")
        end if
        if sp < 0 then
            error_msg("stack underflow")
        end if
        
        opcode = code_arr(pc)
        pc = pc + 1
        
        select case opcode
            case op_push_int
                sp = sp + 1
                stack(sp) = code_arr(pc)
                pc = pc + 1
            case op_push_int_var
                sp = sp + 1
                stack(sp) = stack(code_arr(pc))
                pc = pc + 1
            case op_jz
                if stack(sp) = 0 then
                    pc = code_arr(pc)
                else
                    pc = pc + 1
                end if
                sp = sp - 1
            case op_stor
                stack(code_arr(pc)) = stack(sp)
                sp = sp - 1
                pc = pc + 1
            case op_jmp
                pc = code_arr(pc)
            case op_add
                sp = sp - 1
                stack(sp) = stack(sp) + stack(sp + 1)
            case op_sub
                sp = sp - 1
                stack(sp) = stack(sp) - stack(sp + 1)
            case op_mul
                sp = sp - 1
                stack(sp) = stack(sp) * stack(sp + 1)
            case op_div
                sp = sp - 1
                if stack(sp + 1) = 0 then
                    error_msg("divide by zero")
                end if
                stack(sp) = stack(sp) \ stack(sp + 1)
            case op_mod
                sp = sp - 1
                if stack(sp + 1) = 0 then
                    error_msg("divide by zero")
                end if
                stack(sp) = mod(stack(sp), stack(sp + 1))
            case op_or
                sp = sp - 1
                stack(sp) = stack(sp) or stack(sp + 1)
            case op_and
                sp = sp - 1
                stack(sp) = stack(sp) and stack(sp + 1)
            case op_neq
                sp = sp - 1
                stack(sp) = stack(sp) <> stack(sp + 1)
            case op_equal
                sp = sp - 1
                stack(sp) = stack(sp) = stack(sp + 1)
            case op_lss
                sp = sp - 1
                stack(sp) = stack(sp) < stack(sp + 1)
            case op_leq
                sp = sp - 1
                stack(sp) = stack(sp) <= stack(sp + 1)
            case op_gtr
                sp = sp - 1
                stack(sp) = stack(sp) > stack(sp + 1)
            case op_geq
                sp = sp - 1
                stack(sp) = stack(sp) >= stack(sp + 1)
            case op_neg
                stack(sp) = -stack(sp)
            case op_not
                stack(sp) = not stack(sp)
            case op_prt_str
                operand = code_arr(pc)
                pc = pc + 1
                st = ""
                while operand > 0
                    st = st & chr(code_arr(pc))
                    pc = pc + 1
                    operand = operand - 1
                wend
                'print st
            case op_prt_int
                'print stack(sp) / print results
                ty=ty+15
                TextOn( win,10,ty,str(stack[sp])+" ...is prime")
                sp = sp - 1
            case op_prt_nl
                'print cr
            case op_halt
                halted = true
                exit do
            case else
                error_msg("Unknown opcode " & str(opcode))
        end select
        if halted then exit do
    end do
    print "Finished..." cr
end sub

' parser ----------------------------------------------------------------------

sub emit_op(symbol as long)
    select case symbol
        case sym_or: emit(op_or)
        case sym_and: emit(op_and)
        case sym_equal: emit(op_equal)
        case sym_neq: emit(op_neq)
        case sym_lss: emit(op_lss)
        case sym_leq: emit(op_leq)
        case sym_gtr: emit(op_gtr)
        case sym_geq: emit(op_geq)
        case sym_plus: emit(op_add)
        case sym_minus: emit(op_sub)
        case sym_multiply: emit(op_mul)
        case sym_divide: emit(op_div)
        case sym_mod: emit(op_mod)
        case sym_neg: emit(op_neg)
        case sym_not: emit(op_not)
    end select
end sub

sub expect(symbol as long)
    if symbol = sym then
        next_sym()
    else
        error_msg("unexpected token - expected: " & str(symbol) & " got: " & str(sym))
    end if
end sub

function is_binary_operator(symbol as long) as long
    select case symbol
        case sym_or, sym_and
        case sym_equal, sym_neq
        case sym_lss, sym_leq, sym_gtr, sym_geq
        case sym_plus, sym_minus
        case sym_multiply, sym_divide, sym_mod
            
        case else
            return false
    end select
    return true
end function

function is_relational_operator(symbol as long) as long
    select case symbol
        case sym_equal, sym_neq
        case sym_lss, sym_leq, sym_gtr, sym_geq
            
        case else
            return false
    end select
    return true
end function

function unary_prec(symbol as long) as long
    select case symbol
        case sym_neg, sym_not
            return 70
        case else
            return 0
    end select
end function

function binary_prec(symbol as long) as long
    select case symbol
        case sym_multiply, sym_divide, sym_mod
            return 60
            
        case sym_plus, sym_minus
            return 50
            
        case sym_lss, sym_leq, sym_gtr, sym_geq
            return 40
            
        case sym_equal, sym_neq
            return 30
            
        case sym_or
            return 20
            
        case sym_and
            return 10
            
        case else
            return 0
    end select
end function

function associativity(symbol as long) as long
    return left_assoc
end function

sub primary()
    dim as long op
    dim as long address
    select case sym
        case sym_integer_const
            emit2(op_push_int, val(token))
            next_sym()
        case sym_ident
            if not is_in_sym_tab(address) then
                error_msg("primary: '" & token & "' has not been defined")
            end if
            emit2(op_push_int_var, address)
            next_sym()
        case sym_lparen
            next_sym()
            expr(0)
            if sym <> sym_rparen then
                error_msg("expecting ')'")
            end if
            next_sym()
        case sym_minus, sym_not
            op = sym
            if sym = sym_minus then
                op = sym_neg
            end if
            next_sym()
            expr(unary_prec(op))
            emit_op(op)
        case else
            error_msg("expecting number")
    end select
end sub

sub expr(p as long)
    dim as long op
    dim as long tmp
    
    primary()
    while is_binary_operator(sym) and binary_prec(sym) >= p
        op = sym
        next_sym()
        tmp = 0
        if associativity(op) = left_assoc then tmp = 1
        expr(binary_prec(op) + tmp)
        emit_op(op)
        if is_relational_operator(op) and is_relational_operator(sym) then
            error_msg("consecutive relational operators not allowed")
        end if
    wend
end sub

' ident = expr
sub assign_stmt()
    dim address as long

    if not is_in_sym_tab(address) then
        error_msg("assign: '" & token & "' has not been defined")
    end if
    
    expect(sym_ident)
    expect(sym_equal)
    expr(0)
    emit2(op_stor, address)
end sub

' if expr then stmt_seq (else stmt_seq) end if
sub if_stmt()
    dim as long fix1
    dim as long fix2
    
    fix2 = -1
    expect(sym_if)
    expr(0)
    fix1 = emit2(op_jz, 0)
    expect(sym_then)
    stmt_seq()
    if sym = sym_else then
        fix2 = emit2(op_jmp, 0)
        patch_jmp_to_current(fix1)
        expect(sym_else)
        stmt_seq()
    else
        patch_jmp_to_current(fix1)
    end if
    expect(sym_end)
    expect(sym_if)
    if fix2 <> -1 then
        patch_jmp_to_current(fix2)
    end if
end sub

sub halt_stmt()
    emit(op_halt)
    next_sym()
end sub

' while expr do stmts end while
sub while_stmt()
    dim as long top
    dim as long fix1
    
    expect(sym_while)
    top = get_cur_loc()
    expr(0)
    fix1 = emit2(op_jz, 0)
    expect(sym_do)
    stmt_seq()
    emit2(op_jmp, top)
    patch_jmp_to_current(fix1)
    expect(sym_end)
    expect(sym_while)
end sub

sub do_string()
    dim as long i
    
    for i = 1 to len(token)
        emit(asc(mid(token, i, 1)))
    next
    next_sym()
end sub

' print expr|string {, expr|string}
sub print_stmt()
    do
        next_sym()
        if sym = sym_string_const then
            emit2(op_prt_str, len(token))
            do_string()
        elseif sym = sym_integer_const or sym = sym_ident then
            expr(0)
            emit(op_prt_int)
        else
            error_msg("expecting string or integer")
        end if
        if sym <> sym_comma then exit do
    end do
    emit(op_prt_nl)
end sub

' {print | halt | while | assign | if}
sub stmt_seq()
    while sym <> sym_eoi and sym <> sym_end and sym <> sym_else
        select case sym
            case sym_print: print_stmt()
            case sym_halt: halt_stmt()
            case sym_if: if_stmt()
            case sym_while: while_stmt()
            case sym_ident: assign_stmt()
            case else: error_msg("unrecognized statement: (" & str(sym) & ") " & token)
        end select
    wend
end sub

' {integer ident {, ident}}
sub variable_decl()
    dim address as long
    while sym = sym_integer_var
        expect(sym_integer_var)
        do
            if is_in_sym_tab(address) then
                error_msg("'" & token & "' has already been defined")
            end if
            insert_sym_tab()
            expect(sym_ident)
            if sym <> sym_comma then exit do
            expect(sym_comma)
        end do
    wend
end sub

' {variable_decl} stmt_seq
sub parse()
    next_sym()
    variable_decl()
    stmt_seq()
    if sym <> sym_eoi then
        error_msg("a statement was expected")
    end if
    emit(op_halt)
    set_data_size(get_data_size())
end sub

'------ other stuff ---------------------------------------------------

sub error_msg(msg as string)
    print "line=" error_line "; col=" error_col " << " msg cr
    press_a_key()
end sub

'-------------- utilities -----------------------------------------------

function is_alpha() as long
    byte c = asc(cur_ch)
    select case c
        case "a" to "z", "A" to "Z"
            return true
    end select
    return false
end function

'//// ML: NOT USED
'//function is_print(ch as string) as long
'//    dim as long asc_ch = asc(ch)
'//    return ch <> "" and asc_ch >= 32 and asc_ch <= 126
'//end function

function is_numeric() as long
    byte c = asc(cur_ch)
    select case c
        case "0" to "9"
            return true
    end select
    return false
end function

sub press_a_key()
    print cr "Press any key to continue..."
    'waitkey
end sub

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

function get_line() as string '// PARSE CODE BUFFER INTO SUCCESSIVE LINES
    static as long head = 1
    static as string crlf = chr(13) & chr(10)
    dim as long tail
    dim as string ret

    tail = instr(head, code, crlf)
    ret = mid(code, head, tail - head)
    head = tail + 2

    return ret
end function


Sub TextOn( int wnd,sys x, y, string txt)
'INT ww,hh
hdc=GetDC(wnd)
'GetSize(wnd,0,0,ww,hh)
TextOut hdc,x,y,txt,Len(txt)
'BitBlt(hDCmem, 0, 0, ww, hh, hdc, 0, 0, SRCCOPY)
ReleaseDC(wnd,Hdc)
End Sub

 

Views: 43 | Added by: Zlatko | Rating: 0.0/0
Total comments: 0
Name *:
Email *:
Code *:
Log In

Search

Calendar
«  February 2016  »
SuMoTuWeThFrSa
 123456
78910111213
14151617181920
21222324252627
2829

Entries archive

Site friends
  • Official Blog
  • uCoz Community
  • FAQ
  • Textbook

  • Copyright MyCorp © 2017Free web hostinguCoz