## Squares

General FreeBASIC programming questions.
albert
Posts: 5533
Joined: Sep 28, 2006 2:41
Location: California, USA
@Dodicat

I've finished the parser sortof , I've put all your trig things in.
This code has real long inputs and takes 476 second on my machine.

I've got to find a way to optimise it more.

Code: Select all

`'==============================================================================='trig functions by Dodicat from Scotland (From Freebasic Forum)'==============================================================================='cosecantsdeclare function acosech(n as double) as double declare function  cosech(n as double) as double declare function  acosec(n as double) as double declare function   cosec(n as double) as double 'secantsdeclare function   asech(n as double) as double declare function    sech(n as double) as double declare function    asec(n as double) as double declare function     sec(n as double) as double 'cotangents        declare function   acoth(n as double) as double declare function    coth(n as double) as double declare function    acot(n as double) as double declare function     cot(n as double) as double 'tangents        declare function   atanh(n as double) as double declare function    tanh(n as double) as double declare function    atan(n as double) as double 'declare function     tan(n as double) as double 'builtin'cosines        declare function   acosh(n as double) as double declare function    cosh(n as double) as double 'declare function    acos(n as double) as double 'builtin'declare function     cos(n as double) as double 'builtin'sines        declare function   asinh(n as double) as double declare function    sinh(n as double) as double 'declare function    asin(n as double) as double  'builtin'declare function     sin(n as double) as double  'builtin'===============================================================================''===============================================================================declare function        Setup(byval str1  as string) as string   'calls SpaceOut() , Prep_Formula()declare function     SpaceOut(byval eq    as string) as string   'called by SetUp takes out spacesdeclare function   eval_funct(byval funct as string) as ubyte    'called by prep_formula returns CHR() for function namedeclare function prep_formula(byval eq    as string) as string   'replaces function names with CHR() returned by eval_funct()declare function   VarReplace(byval eq    as string) as string   'replaces variable names in string with valuesdeclare function      ParseEq(byval eq    as string) as double   'recursive descent parser'==============================================================================='set up graphics screen'===============================================================================dim as integer xres,yresscreen 19screeninfo xres,yresscreenres xres,yres'==============================================================================='set up radius and get screen centers'===============================================================================dim as double xctr=xres/2dim as double yctr=yres/2 dim as integer radius = 125'==============================================================================='===============================================================================dim as double deg1dim as double deg1_start =  0dim as double deg1_end   =360dim as double deg1_inc   =  1dim as double d1dim as double r1         =atn(1)/45dim as double c1dim as double s1dim as double deg2dim as double deg2_start =  0dim as double deg2_end   =360dim as double deg2_inc   =  1dim as double d2dim as double r2         =atn(1)/45dim as double c2dim as double s2'==============================================================================='==============================================================================='dimension string for ParseEq functiondim shared as string eq'==============================================================================='==============================================================================='dimension user variables and values arrays;'both must have the same number of dimensions , Values() is filled in during looping.'dimensions allowed are (0 to 16) which equate to chr(239) to chr(255)dim shared as string*1   chars(0 to 7) ' function replaces this with a chardim shared as double    values(0 to 7)dim shared as string variables(0 to 7)'when assigning variable names,'make sure to put ones with other ones substrings first.variables(0)="r1"variables(1)="d1"variables(2)="c1"variables(3)="s1"variables(4)="r2"variables(5)="d2"variables(6)="c2"variables(7)="s2"Values(0)=r1'Values(1)=d1'Values(2)=c1'Values(3)=s1Values(4)=r2'Values(5)=d2'Values(6)=c2'Values(7)=s2'==============================================================================='==============================================================================='dimension and assign input stringsdim as string input_x1 = "(c1*cos(cos(d2*r2)*s2/c1)*cos(d2*r2*(c1*c2)/s1)*cos(s1*d2*r2)*c2*s1*2.7) + (.1*c1*cos(cos(d2*r2)*s2/c1)*cos(d2*r2*(c1*c2)/s1)*cos(s1*d2*r2)*c2*s1*2.7)/1.5"dim as string input_x2 = "(c1*cos(cos(d2*r2)*s2/c1)*cos(d2*r2*(c1*c2)/s1)*cos(s1*d2*r2)*c2*s1*2.7) + (.1*c1*cos(cos(d2*r2)*s2/c1)*cos(d2*r2*(c1*c2)/s1)*cos(s1*d2*r2)*c2*s1*2.7)/1.5"dim as string input_y1 = "(s1*sin(sin(d2*r2)*c2/s1)*sin(d2*r2*(s1*s2)/c1)*sin(c1*d2*r2)*c2*s1*2.7) + (.1*s1*sin(sin(d2*r2)*c2/s1)*sin(d2*r2*(s1*s2)/c1)*sin(c1*d2*r2)*c2*s1*2.7)/1.5"dim as string input_y2 = "(s1*sin(sin(d2*r2)*c2/s1)*sin(d2*r2*(s1*s2)/c1)*sin(c1*d2*r2)*c2*s1*2.7) + (.1*s1*sin(sin(d2*r2)*c2/s1)*sin(d2*r2*(s1*s2)/c1)*sin(c1*d2*r2)*c2*s1*2.7)/1.5"dim as string input_z1 = "c2+s2"'dimension final outputsdim as double out_x1dim as double out_x2dim as double out_y1dim as double out_y2dim as double out_z1'Call SetUp( str ) to trim white space and turn input string into single chr() function calls ie..( "acotan" = chr(??) )input_x1 = SetUp(input_x1)input_x2 = SetUp(input_x2)input_y1 = SetUp(input_y1)input_y2 = SetUp(input_y2)input_z1 = SetUp(input_z1)'==============================================================================='do double 360 loop'===============================================================================dim as double t1, t2t1=timer        for d1 = deg1_start to deg1_end step deg1_inc                'd1=deg1        c1=cos(d1*r1)        s1=sin(d1*r1)                    'Values(0)=r1        Values(1)=d1        Values(2)=c1        Values(3)=s1                for d2= deg2_start to deg2_end step deg2_inc                    'd2=deg2            c2=cos(d2*r2)            s2=sin(d2*r2)                        'Values(4)=r2            Values(5)=d2            Values(6)=c2            Values(7)=s2                        eq = input_x1 : eq = VarReplace(eq) : out_x1 = radius * ParseEq(eq)            eq = input_y1 : eq = VarReplace(eq) : out_y1 = radius * ParseEq(eq)                        eq = input_x2 : eq = VarReplace(eq) : out_x2 = radius * ParseEq(eq)            eq = input_y2 : eq = VarReplace(eq) : out_y2 = radius * ParseEq(eq)                        eq = input_z1 : eq = VarReplace(eq) : out_z1 = radius * ParseEq(eq)                        pset( xctr + out_x1 + out_x2 , yctr + out_y1 + out_y2 ),9                    next            nextt2=timerprint "Elapsed time = " ; (t2-t1)sleep END'==============================================================================='==============================================================================='==============================================================================='FUNCTIONS and SUBS BELOW HERE...'==============================================================================='==============================================================================='===============================================================================function Setup(byval str1 as string) as string    dim as string inputs    inputs = Lcase(str1)    inputs = SpaceOut(inputs)      'extract white space    Inputs = Prep_Formula(inputs)  'change all function calls and operators to single ubyte character.    return inputsend function'==============================================================================='===============================================================================function SpaceOut(byval eq as string ) as string    dim as string parse, parse_l , parse_r    dim as integer spaces    spaces=instr(1,eq," ")    do while spaces<>0        parse_l = left( eq, spaces - 1 )        parse_r =  mid( eq, spaces + 1 )         parse = parse_l + parse_r        eq = parse        spaces=instr(1,eq," ")    loop    return eqend function'==============================================================================='===============================================================================function eval_funct(byval funct as string) as ubyte    select case funct        case "+"      :return 200+0        case "-"      :return 200+1        case "*"      :return 200+2        case "\"      :return 200+3        case "/"      :return 200+3        case "^"      :return 200+4                case "log"    :return 200+5                case "acosech":return 200+6        case "cosech" :return 200+7        case "acosec" :return 200+8        case "cosec"  :return 200+9                case "asech"  :return 200+10        case "sech"   :return 200+11        case "asec"   :return 200+12        case "sec"    :return 200+13                case "acotanh":return 200+14        case "cotanh" :return 200+15        case "acotan" :return 200+16        case "cotan"  :return 200+17                case "atanh"  :return 200+18        case "tanh"   :return 200+19        case "atan"   :return 200+20        case "tan"    :return 200+21                case "acosh"  :return 200+22        case "cosh"   :return 200+23        case "acos"   :return 200+24        case "cos"    :return 200+25                case "asinh"  :return 200+26        case "sinh"   :return 200+27        case "asin"   :return 200+28        case "sin"    :return 200+29                case "xor"    :return 200+30        case "or"     :return 200+31        case "and"    :return 200+32        case "not"    :return 200+33                case "imp"    :return 200+34        case "eqv"    :return 200+35                case "mod"    :return 200+36                case "("      :return 200+37        case ")"      :return 200+38                case else             return asc(funct)    end select    end function'==============================================================================='===============================================================================function prep_formula(byval eq as string) as string    '===============================================================================    '===============================================================================    '===============================================================================    'get trancendental functions    'search in order of to avoid substring occurance (acotan) before (tan) etc...    '                                                (acosech) befor (cos) etc..     '===============================================================================    '===============================================================================    '===============================================================================    dim as string str1 = eq    dim as integer funct_loc     'log        funct_loc = instr(1,str1,"log")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("log")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"log")    loop    '===============================================================================    'cosecants    '===============================================================================    'acosech     funct_loc = instr(1,str1,"acosech")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acosech")) + mid(str1,funct_loc+7)        funct_loc = instr(1,str1,"acosech")    loop    'cosech      funct_loc = instr(1,str1,"cosech")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("cosech")) + mid(str1,funct_loc+6)        funct_loc = instr(1,str1,"cosech")    loop    'acosec      funct_loc = instr(1,str1,"acosec")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acosec")) + mid(str1,funct_loc+6)        funct_loc = instr(1,str1,"acosec")    loop    'cosec       funct_loc = instr(1,str1,"cosec")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("cosec")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"cosec")    loop    '===============================================================================    'secants    '===============================================================================    'asech       funct_loc = instr(1,str1,"asech")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("asech")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"asech")    loop    'sech        funct_loc = instr(1,str1,"sech")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("sech")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"sech")    loop    'asec        funct_loc = instr(1,str1,"asec")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("asec")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"asec")    loop    'sec         funct_loc = instr(1,str1,"sec")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("sec")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"sec")    loop    '===============================================================================    'cotangents    '===============================================================================    'acoth     funct_loc = instr(1,str1,"acoth")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acoth")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"acoth")    loop    'cotanh      funct_loc = instr(1,str1,"coth")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("coth")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"coth")    loop    'acotan      funct_loc = instr(1,str1,"acot")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acot")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"acot")    loop    'cotan       funct_loc = instr(1,str1,"cot")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("cot")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"cot")    loop    '===============================================================================    'tangents    '===============================================================================    'atanh       funct_loc = instr(1,str1,"atanh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("atanh")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"atanh")    loop    'tanh        funct_loc = instr(1,str1,"tanh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("tanh")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"tanh")    loop    'atan        funct_loc = instr(1,str1,"atan")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("atan")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"atan")    loop    'tan         funct_loc = instr(1,str1,"tan")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("tan")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"tan")    loop    '===============================================================================    'cosines    '===============================================================================    'acosh       funct_loc = instr(1,str1,"acosh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acosh")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"acosh")    loop    'cosh        funct_loc = instr(1,str1,"cosh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("cosh")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"cosh")    loop    'acos        funct_loc = instr(1,str1,"acos")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acos")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"acos")    loop    'cos         funct_loc = instr(1,str1,"cos")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("cos")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"cos")    loop    '===============================================================================    'sines    '===============================================================================    'asinh     funct_loc = instr(1,str1,"asinh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("asinh")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"asinh")    loop    'sinh        funct_loc = instr(1,str1,"sinh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("sinh")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"sinh")    loop    'asin        funct_loc = instr(1,str1,"asin")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("asin")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"asin")    loop    'sin         funct_loc = instr(1,str1,"sin")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("sin")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"sin")    loop    '===============================================================================    '===============================================================================    'end of trancendentals    '===============================================================================    '===============================================================================    '===============================================================================    'regular math symbols    '===============================================================================    '+ PLUS         funct_loc = instr(1,str1,"+")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("+")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"+")    loop    '- MINUS         funct_loc = instr(1,str1,"-")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("-")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"-")    loop    '* MULTIPLY         funct_loc = instr(1,str1,"*")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("*")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"*")    loop    '\ FLOAT DIVIDE         funct_loc = instr(1,str1,"/")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("/")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"/")    loop    '/ INTEGER DIVIDE  , integer divide is replaced with float divide in ParseEq()     funct_loc = instr(1,str1,"\")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("\")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"\")    loop    '^ EXPONENT        funct_loc = instr(1,str1,"^")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("^")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"^")    loop    '===============================================================================    'regular logic    '===============================================================================    'XOR        funct_loc = instr(1,str1,"xor")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("xor")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"xor")    loop    'OR        funct_loc = instr(1,str1,"or")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("or")) + mid(str1,funct_loc+2)        funct_loc = instr(1,str1,"or")    loop    'AND        funct_loc = instr(1,str1,"and")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("and")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"and")    loop    'NOT        funct_loc = instr(1,str1,"not")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("not")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"not")    loop    'IMP        funct_loc = instr(1,str1,"imp")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("imp")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"imp")    loop    'EQV        funct_loc = instr(1,str1,"eqv")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("eqv")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"eqv")    loop    'MOD        funct_loc = instr(1,str1,"mod")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("mod")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"mod")    loop    '===============================================================================    'parenthesis    '===============================================================================    '(        funct_loc = instr(1,str1,"(")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("(")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"(")    loop    ')        funct_loc = instr(1,str1,")")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct(")")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,")")    loop    '===============================================================================    'USER VARIABLES in Variables() array    '===============================================================================    dim as integer inc    for inc = lbound(Variables) to ubound(Variables)        chars(inc)=chr(239+inc)        funct_loc = instr( 1 , str1 , Variables(inc) )        do while funct_loc<>0            if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(239+inc) + mid(str1,funct_loc+len(Variables(inc)))            funct_loc = instr( 1 , str1 , Variables(inc) )        loop    next    return str1end function'==============================================================================='==============================================================================='==============================================================================='===============================================================================function VarReplace(byval eq as string) as string    dim as string str1 = eq    dim as integer inc , funct_loc    dim as double value    for inc = lbound(Chars) to ubound(Chars)        value = Values(inc)        funct_loc = instr( 1 , str1 , Chars(inc) )        do while funct_loc<>0            str1 = left(str1,funct_loc-1) + str(value) + mid(str1,funct_loc+1)            funct_loc = instr( 1 , str1 , Chars(inc) )        loop    next    return str1end function'==============================================================================='==============================================================================='recursive descent parser'==============================================================================='===============================================================================function ParseEq(byval eq as string) as double    dim as integer indx, tempc, op , curLow=29, curInd, numOfOps=0, numOfPar=1        'get rid of parantheses if they include the whole equation 'ex (234+434*(23+1)) ->  234+434*(23+1)     if eq[0]=237 and eq[len(eq)-1]=238 then        for indx = 1 to len(eq)-1                        if eq[indx]=238 or eq[indx]=237 then numOfPar+=(237-eq[indx])*2+1                        if numOfPar=0 and indx<>len(eq)-1 then exit for            if numOfPar=0 and indx=len(eq)-1 then eq=mid\$(eq,2,len(eq)-2)        next    end if            'find the lowest operator    for indx = 0 to len(eq)-1                 'skip stuff inside parantheses in the operation count        if eq[indx]=237 then '(             numOfPar=1            for tempc = indx+1 to len(eq)-1                if eq[tempc]=238 or eq[tempc]=237 then numOfPar+=(237-eq[tempc])*2+1                            indx=tempc+1                if numOfPar=0 then exit for                            next            if indx=len(eq) then exit for 'equation end has been reached                    end if                op=eq[indx]        if op >=200 and op<=236 then numOfOps+=1        if op >=239 and op<=255 then numOfOps+=1                if op = 200 then curLow=-1 : curInd=indx ' +        if op = 201 then curlow= 1 : curInd=indx ' -                       if op = 202 then if abs(curlow)>1 then curlow= -2 : curInd=indx ' *        if op = 203 then if abs(curlow)>1 then curlow=  2 : curInd=indx ' / \                if op = 204 then if abs(curlow)>2 then curLow= 03 : curInd=indx ' ^                if op = 205 then if abs(curlow)>3 then curLow= 04 : curInd=indx 'log                if op = 206 then if abs(curlow)>3 then curLow= 05 : curInd=indx 'acosech        if op = 207 then if abs(curlow)>3 then curLow= 06 : curInd=indx 'cosech        if op = 208 then if abs(curlow)>3 then curLow= 07 : curInd=indx 'acosec        if op = 209 then if abs(curlow)>3 then curLow= 08 : curInd=indx 'cosec                if op = 210 then if abs(curlow)>3 then curLow= 09 : curInd=indx 'asech        if op = 211 then if abs(curlow)>3 then curLow= 10 : curInd=indx 'sech        if op = 212 then if abs(curlow)>3 then curLow= 11 : curInd=indx 'asec        if op = 213 then if abs(curlow)>3 then curLow= 12 : curInd=indx 'sec                if op = 214 then if abs(curlow)>3 then curLow= 13 : curInd=indx 'acoth        if op = 215 then if abs(curlow)>3 then curLow= 14 : curInd=indx 'coth        if op = 216 then if abs(curlow)>3 then curLow= 15 : curInd=indx 'acot        if op = 217 then if abs(curlow)>3 then curLow= 16 : curInd=indx 'cot                if op = 218 then if abs(curlow)>3 then curLow= 17 : curInd=indx 'atanh        if op = 219 then if abs(curlow)>3 then curLow= 18 : curInd=indx 'tanh        if op = 220 then if abs(curlow)>3 then curLow= 19 : curInd=indx 'atan        if op = 221 then if abs(curlow)>3 then curLow= 20 : curInd=indx 'tan                if op = 222 then if abs(curlow)>3 then curLow= 21 : curInd=indx 'acosh        if op = 223 then if abs(curlow)>3 then curLow= 22 : curInd=indx 'cosh        if op = 224 then if abs(curlow)>3 then curLow= 23 : curInd=indx 'acos        if op = 225 then if abs(curlow)>3 then curLow= 24 : curInd=indx 'cos                if op = 226 then if abs(curlow)>3 then curLow= 25 : curInd=indx 'asinh        if op = 227 then if abs(curlow)>3 then curLow= 26 : curInd=indx 'sinh        if op = 228 then if abs(curlow)>3 then curLow= 27 : curInd=indx 'asin        if op = 229 then if abs(curlow)>3 then curLow= 28 : curInd=indx 'sin        next        if numOfOps=0 then return val(eq)'single number, no equation to evaluate!        if curLow=-1 then return ParseEq(left\$(eq,curInd)) + ParseEq(right\$(eq,len(eq)-curInd-1))    if curLow= 1 then return ParseEq(left\$(eq,curInd)) - ParseEq(right\$(eq,len(eq)-curInd-1))    if curLow=-2 then return ParseEq(left\$(eq,curInd)) * ParseEq(right\$(eq,len(eq)-curInd-1))    if curLow= 2 then return ParseEq(left\$(eq,curInd)) / ParseEq(right\$(eq,len(eq)-curInd-1))    if curLow= 3 then return ParseEq(left\$(eq,curInd)) ^ ParseEq(right\$(eq,len(eq)-curInd-1))            if curLow= 04 then return log(     ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )        'cosecants    if curLow= 05 then return acosech( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 06 then return  cosech( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 07 then return  acosec( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 08 then return   cosec( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )        'secants    if curLow= 09 then return   asech( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 10 then return    sech( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 11 then return    asec( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 12 then return     sec( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )        'cotangents    if curLow= 13 then return   acoth( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 14 then return    coth( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 15 then return    acot( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 16 then return     cot( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )        'tangents    if curLow= 17 then return   atanh( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 18 then return    tanh( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 19 then return    atan( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 20 then return     tan( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )        'cosines    if curLow= 21 then return   acosh( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 22 then return    cosh( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 23 then return    acos( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 24 then return     cos( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )        'sines    if curLow= 25 then return   asinh( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 26 then return    sinh( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 27 then return    asin( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    if curLow= 28 then return     sin( ParseEq(left\$(eq,curInd)+right\$(eq,len(eq)-curInd-1)) )    end function'==============================================================================='==============================================================================='==============================================================================='begin Dodicats TRIG functions '(Dodicat from scottland) on http://www.freebasic.net/forum/'==============================================================================='cosecants'===============================================================================Function acosech(n as double) As Double    dim x as double = n    return Log((Sgn(x) * Sqr(x * x + 1) +1) / x)End FunctionFunction cosech(n as double) As Double    dim x as double = n    return 2 / (Exp(x) - Exp(-x))End FunctionFunction acosec(n as double) As Double    dim x as double = n    return Atn(x / Sqr(x * x - 1)) + (Sgn(x) - 1) * (2 * Atn(1))End FunctionFunction cosec(n as double) As Double    dim x as double = n    return 1 / Sin(x)End Function'==============================================================================='secants'===============================================================================Function asech(n as double) As Double    dim x as double = n    return Log((Sqr(-x * x + 1) + 1) / x)End FunctionFunction sech(n as double) As Double    dim x as double = n    return 2 / (Exp(x) + Exp(-x))End FunctionFunction asec(n as double) As Double     dim x as double = n    return Atn(x / Sqr(x * x - 1)) + Sgn((x) -1) * (2 * Atn(1))End FunctionFunction sec(n as double) As Double    dim x as double = n    return 1 / Cos(x)End Function'===============================================================================' cotangents'===============================================================================Function acoth(n as double) As Double    dim x as double = n    return Log((x + 1) / (x - 1)) / 2End FunctionFunction coth(n as double) As Double    dim x as double = n    return (Exp(x) + Exp(-x)) / (Exp(x) - Exp(-x))End FunctionFunction acot(n as double) As Double    dim x as double = n    return Atn(x) + 2 * Atn(1)End FunctionFunction cot(n as double) As Double    dim x as double = n    return 1 / Tan(x)End Function'===============================================================================' tangents'===============================================================================Function atanh(n as double) As Double    dim x as double = n    return Log((1 + x) / (1 - x)) / 2 End FunctionFunction tanh(n as double) As Double    dim x as double = n    return (Exp(x) - Exp(-x)) / (Exp(x) + Exp(-x))End FunctionFunction atan(n as double) As Double    dim x as double = n    return Atn(x)End Function    'Function TAN(n as double) As Double'    dim x as double = n'    TAN = tan(x)'End Function    '===============================================================================' cosines'===============================================================================Function acosh(n as double) As Double    dim x as double = n    return Log(x + Sqr(x * x - 1))End FunctionFunction cosh(n as double) As Double    dim x as double = n    return (Exp(x) + Exp(-x)) / 2End Function'Function Acos(n as double) As Double'    dim x as double = n'    ACOS = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1) 'End Function'Function cos(n as double) As Double'    dim x as double = n'    COS = cos(x)'End Function'===============================================================================' sines'===============================================================================Function asinh(n as double) As Double    dim x as double = n    return Log(x + Sqr(x * x + 1))End FunctionFunction sinh(n as double) As Double    dim x as double = n    return (Exp(x) - Exp(-x)) / 2 End Function'Function asin(n as double) As Double'   dim x as double = n'    asin = Atn(x / Sqr(-x * x + 1))'End Function'Function Sin(byval x as doubele ) as double'    dim x as double = n'    sin=sin(x)'End Function'==============================================================================='others'==============================================================================='Function logN(n as double,Byval n As Double) As Double'    logN = Log(x) / Log(n)'End Function'Function haversine(n as double) As Double'    haversine = (Sin(x/2))^2'End Function'==============================================================================='END TRANCENDENTALS'===============================================================================`
dodicat
Posts: 6234
Joined: Jan 10, 2006 20:30
Location: Scotland
Hi Albert

577 seconds here.

But that is a good parser, I tried it out with some stinking functions, and stinking functions inside functions and it returns the correct value.

Maybe, here in squares sometimes, we think that you come up with some way out ideas now and then, but you always cough up the goods.

Some day one of your way out ideas will be a real prize winner.

@ dafhi
Thanks dafhi, I grabbed your code this time before it vanished again, which it has.

What we need now is a sort of sort,to sort to sort out all these sorts.

Your coding is much more sophisticated than mine, and I enjoy reading through it, if I'm fast off the mark to get it.
It is very cool.

Thanks for the optimized combsort in the other thread.
podvornyak
Posts: 148
Joined: Nov 12, 2007 11:46
Location: Russia
albert wrote:I've finished the parser

test2.asm:8254: Error: invalid use of operator "EQ"
told to me... ^_^
albert
Posts: 5533
Joined: Sep 28, 2006 2:41
Location: California, USA
@Podvornyak

lines 112 , 113 , 114 ,115 , 116 Are the formulas that you can alter.

If you use a variable name that contains a function call;
like var(1) = "cos1" the Prep_Formula() with replace the "cos" part with the function COS() character.
So you have to look through the Eval_Funct() and create variable names that don't have any other functions inside them.

chars(0 to ?) 16 is max as string*1
values(0 to ?) 16 is max as double
variables(0 to ?) 16 is max as string

All three have to be dimensioned to the same number.

Once you got that then you need to call formula = SetUp(formula)
Setup() will go thru the formula calling the other functions and return a string , where all the operators ,parenthesis, functions ,var names are replaced by a single chr(200+).

After that you need to update Variables( ?? ) = ? during the looping.
"eq" is the sting thats passed ByVal to VarReplace() , which changes the variable chr(?) to a double value.

formula = setup(formula)
do
Values(?) = double
eq = formula
eq = VarReplace(eq)
double = ParseEq(eq)
loop

Neither the parser or any of the functions do error checking for mismatched parenthesis.
podvornyak
Posts: 148
Joined: Nov 12, 2007 11:46
Location: Russia
albert wrote:@Podvornyak
lines 112 , 113 , 114 ,115 , 116, ..., ...
I'm not good in english. I've change name of variables eq to eq1. Is it harmless? Or i've done something wrong?

Ubuntu 10.04 64
Result 119.*********

Code: Select all

`'==============================================================================='trig functions by Dodicat from Scotland (From Freebasic Forum)'==============================================================================='cosecantsdeclare function acosech(n as double) as doubledeclare function  cosech(n as double) as doubledeclare function  acosec(n as double) as doubledeclare function   cosec(n as double) as double'secantsdeclare function   asech(n as double) as doubledeclare function    sech(n as double) as doubledeclare function    asec(n as double) as doubledeclare function     sec(n as double) as double'cotangents       declare function   acoth(n as double) as doubledeclare function    coth(n as double) as doubledeclare function    acot(n as double) as doubledeclare function     cot(n as double) as double'tangents       declare function   atanh(n as double) as doubledeclare function    tanh(n as double) as doubledeclare function    atan(n as double) as double'declare function     tan(n as double) as double 'builtin'cosines       declare function   acosh(n as double) as doubledeclare function    cosh(n as double) as double'declare function    acos(n as double) as double 'builtin'declare function     cos(n as double) as double 'builtin'sines       declare function   asinh(n as double) as doubledeclare function    sinh(n as double) as double'declare function    asin(n as double) as double  'builtin'declare function     sin(n as double) as double  'builtin'===============================================================================''===============================================================================declare function        Setup(byval str1  as string) as string   'calls SpaceOut() , Prep_Formula()declare function     SpaceOut(byval eq1    as string) as string   'called by SetUp takes out spacesdeclare function   eval_funct(byval funct as string) as ubyte    'called by prep_formula returns CHR() for function namedeclare function prep_formula(byval eq1    as string) as string   'replaces function names with CHR() returned by eval_funct()declare function   VarReplace(byval eq1    as string) as string   'replaces variable names in string with valuesdeclare function      ParseEq(byval eq1    as string) as double   'recursive descent parser'==============================================================================='set up graphics screen'===============================================================================dim as integer xres,yresscreen 19screeninfo xres,yresscreenres xres,yres'==============================================================================='set up radius and get screen centers'===============================================================================dim as double xctr=xres/2dim as double yctr=yres/2dim as integer radius = 125'==============================================================================='===============================================================================dim as double deg1dim as double deg1_start =  0dim as double deg1_end   =360dim as double deg1_inc   =  1dim as double d1dim as double r1         =atn(1)/45dim as double c1dim as double s1dim as double deg2dim as double deg2_start =  0dim as double deg2_end   =360dim as double deg2_inc   =  1dim as double d2dim as double r2         =atn(1)/45dim as double c2dim as double s2'==============================================================================='==============================================================================='dimension string for ParseEq functiondim shared as string eq1'==============================================================================='==============================================================================='dimension user variables and values arrays;'both must have the same number of dimensions , Values() is filled in during looping.'dimensions allowed are (0 to 16) which equate to chr(239) to chr(255)dim shared as string*1   chars(0 to 7) ' function replaces this with a chardim shared as double    values(0 to 7)dim shared as string variables(0 to 7)'when assigning variable names,'make sure to put ones with other ones substrings first.variables(0)="r1"variables(1)="d1"variables(2)="c1"variables(3)="s1"variables(4)="r2"variables(5)="d2"variables(6)="c2"variables(7)="s2"Values(0)=r1'Values(1)=d1'Values(2)=c1'Values(3)=s1Values(4)=r2'Values(5)=d2'Values(6)=c2'Values(7)=s2'==============================================================================='==============================================================================='dimension and assign input stringsdim as string input_x1 = "(c1*cos(cos(d2*r2)*s2/c1)*cos(d2*r2*(c1*c2)/s1)*cos(s1*d2*r2)*c2*s1*2.7) + (.1*c1*cos(cos(d2*r2)*s2/c1)*cos(d2*r2*(c1*c2)/s1)*cos(s1*d2*r2)*c2*s1*2.7)/1.5"dim as string input_x2 = "(c1*cos(cos(d2*r2)*s2/c1)*cos(d2*r2*(c1*c2)/s1)*cos(s1*d2*r2)*c2*s1*2.7) + (.1*c1*cos(cos(d2*r2)*s2/c1)*cos(d2*r2*(c1*c2)/s1)*cos(s1*d2*r2)*c2*s1*2.7)/1.5"dim as string input_y1 = "(s1*sin(sin(d2*r2)*c2/s1)*sin(d2*r2*(s1*s2)/c1)*sin(c1*d2*r2)*c2*s1*2.7) + (.1*s1*sin(sin(d2*r2)*c2/s1)*sin(d2*r2*(s1*s2)/c1)*sin(c1*d2*r2)*c2*s1*2.7)/1.5"dim as string input_y2 = "(s1*sin(sin(d2*r2)*c2/s1)*sin(d2*r2*(s1*s2)/c1)*sin(c1*d2*r2)*c2*s1*2.7) + (.1*s1*sin(sin(d2*r2)*c2/s1)*sin(d2*r2*(s1*s2)/c1)*sin(c1*d2*r2)*c2*s1*2.7)/1.5"dim as string input_z1 = "c2+s2"'dimension final outputsdim as double out_x1dim as double out_x2dim as double out_y1dim as double out_y2dim as double out_z1'Call SetUp( str ) to trim white space and turn input string into single chr() function calls ie..( "acotan" = chr(??) )input_x1 = SetUp(input_x1)input_x2 = SetUp(input_x2)input_y1 = SetUp(input_y1)input_y2 = SetUp(input_y2)input_z1 = SetUp(input_z1)'==============================================================================='do double 360 loop'===============================================================================dim as double t1, t2t1=timer       for d1 = deg1_start to deg1_end step deg1_inc               'd1=deg1        c1=cos(d1*r1)        s1=sin(d1*r1)                   'Values(0)=r1        Values(1)=d1        Values(2)=c1        Values(3)=s1               for d2= deg2_start to deg2_end step deg2_inc                   'd2=deg2            c2=cos(d2*r2)            s2=sin(d2*r2)                       'Values(4)=r2            Values(5)=d2            Values(6)=c2            Values(7)=s2                       eq1 = input_x1 : eq1 = VarReplace(eq1) : out_x1 = radius * ParseEq(eq1)            eq1 = input_y1 : eq1 = VarReplace(eq1) : out_y1 = radius * ParseEq(eq1)                       eq1 = input_x2 : eq1 = VarReplace(eq1) : out_x2 = radius * ParseEq(eq1)            eq1 = input_y2 : eq1 = VarReplace(eq1) : out_y2 = radius * ParseEq(eq1)                       eq1 = input_z1 : eq1 = VarReplace(eq1) : out_z1 = radius * ParseEq(eq1)                       pset( xctr + out_x1 + out_x2 , yctr + out_y1 + out_y2 ),9                   next           nextt2=timerprint "Elapsed time = " ; (t2-t1)sleepEND'==============================================================================='==============================================================================='==============================================================================='FUNCTIONS and SUBS BELOW HERE...'==============================================================================='==============================================================================='===============================================================================function Setup(byval str1 as string) as string    dim as string inputs    inputs = Lcase(str1)    inputs = SpaceOut(inputs)      'extract white space    Inputs = Prep_Formula(inputs)  'change all function calls and operators to single ubyte character.    return inputsend function'==============================================================================='===============================================================================function SpaceOut(byval eq1 as string ) as string    dim as string parse, parse_l , parse_r    dim as integer spaces    spaces=instr(1,eq1," ")    do while spaces<>0        parse_l = left( eq1, spaces - 1 )        parse_r =  mid( eq1, spaces + 1 )        parse = parse_l + parse_r        eq1 = parse        spaces=instr(1,eq1," ")    loop    return eq1end function'==============================================================================='===============================================================================function eval_funct(byval funct as string) as ubyte    select case funct        case "+"      :return 200+0        case "-"      :return 200+1        case "*"      :return 200+2        case ""      :return 200+3        case "/"      :return 200+3        case "^"      :return 200+4               case "log"    :return 200+5               case "acosech":return 200+6        case "cosech" :return 200+7        case "acosec" :return 200+8        case "cosec"  :return 200+9               case "asech"  :return 200+10        case "sech"   :return 200+11        case "asec"   :return 200+12        case "sec"    :return 200+13               case "acotanh":return 200+14        case "cotanh" :return 200+15        case "acotan" :return 200+16        case "cotan"  :return 200+17               case "atanh"  :return 200+18        case "tanh"   :return 200+19        case "atan"   :return 200+20        case "tan"    :return 200+21               case "acosh"  :return 200+22        case "cosh"   :return 200+23        case "acos"   :return 200+24        case "cos"    :return 200+25               case "asinh"  :return 200+26        case "sinh"   :return 200+27        case "asin"   :return 200+28        case "sin"    :return 200+29               case "xor"    :return 200+30        case "or"     :return 200+31        case "and"    :return 200+32        case "not"    :return 200+33               case "imp"    :return 200+34        case "eqv"    :return 200+35               case "mod"    :return 200+36               case "("      :return 200+37        case ")"      :return 200+38               case else            return asc(funct)    end select   end function'==============================================================================='===============================================================================function prep_formula(byval eq1 as string) as string    '===============================================================================    '===============================================================================    '===============================================================================    'get trancendental functions    'search in order of to avoid substring occurance (acotan) before (tan) etc...    '                                                (acosech) befor (cos) etc..    '===============================================================================    '===============================================================================    '===============================================================================    dim as string str1 = eq1    dim as integer funct_loc    'log       funct_loc = instr(1,str1,"log")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("log")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"log")    loop    '===============================================================================    'cosecants    '===============================================================================    'acosech     funct_loc = instr(1,str1,"acosech")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acosech")) + mid(str1,funct_loc+7)        funct_loc = instr(1,str1,"acosech")    loop    'cosech     funct_loc = instr(1,str1,"cosech")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("cosech")) + mid(str1,funct_loc+6)        funct_loc = instr(1,str1,"cosech")    loop    'acosec     funct_loc = instr(1,str1,"acosec")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acosec")) + mid(str1,funct_loc+6)        funct_loc = instr(1,str1,"acosec")    loop    'cosec      funct_loc = instr(1,str1,"cosec")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("cosec")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"cosec")    loop    '===============================================================================    'secants    '===============================================================================    'asech      funct_loc = instr(1,str1,"asech")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("asech")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"asech")    loop    'sech        funct_loc = instr(1,str1,"sech")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("sech")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"sech")    loop    'asec        funct_loc = instr(1,str1,"asec")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("asec")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"asec")    loop    'sec        funct_loc = instr(1,str1,"sec")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("sec")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"sec")    loop    '===============================================================================    'cotangents    '===============================================================================    'acoth     funct_loc = instr(1,str1,"acoth")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acoth")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"acoth")    loop    'cotanh     funct_loc = instr(1,str1,"coth")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("coth")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"coth")    loop    'acotan     funct_loc = instr(1,str1,"acot")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acot")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"acot")    loop    'cotan      funct_loc = instr(1,str1,"cot")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("cot")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"cot")    loop    '===============================================================================    'tangents    '===============================================================================    'atanh      funct_loc = instr(1,str1,"atanh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("atanh")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"atanh")    loop    'tanh        funct_loc = instr(1,str1,"tanh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("tanh")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"tanh")    loop    'atan        funct_loc = instr(1,str1,"atan")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("atan")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"atan")    loop    'tan        funct_loc = instr(1,str1,"tan")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("tan")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"tan")    loop    '===============================================================================    'cosines    '===============================================================================    'acosh      funct_loc = instr(1,str1,"acosh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acosh")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"acosh")    loop    'cosh        funct_loc = instr(1,str1,"cosh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("cosh")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"cosh")    loop    'acos        funct_loc = instr(1,str1,"acos")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("acos")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"acos")    loop    'cos        funct_loc = instr(1,str1,"cos")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("cos")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"cos")    loop    '===============================================================================    'sines    '===============================================================================    'asinh     funct_loc = instr(1,str1,"asinh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("asinh")) + mid(str1,funct_loc+5)        funct_loc = instr(1,str1,"asinh")    loop    'sinh        funct_loc = instr(1,str1,"sinh")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("sinh")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"sinh")    loop    'asin        funct_loc = instr(1,str1,"asin")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("asin")) + mid(str1,funct_loc+4)        funct_loc = instr(1,str1,"asin")    loop    'sin        funct_loc = instr(1,str1,"sin")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("sin")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"sin")    loop    '===============================================================================    '===============================================================================    'end of trancendentals    '===============================================================================    '===============================================================================    '===============================================================================    'regular math symbols    '===============================================================================    '+ PLUS        funct_loc = instr(1,str1,"+")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("+")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"+")    loop    '- MINUS        funct_loc = instr(1,str1,"-")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("-")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"-")    loop    '* MULTIPLY        funct_loc = instr(1,str1,"*")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("*")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"*")    loop    '\ FLOAT DIVIDE        funct_loc = instr(1,str1,"/")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("/")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"/")    loop    '/ INTEGER DIVIDE  , integer divide is replaced with float divide in ParseEq()     funct_loc = instr(1,str1,"")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"")    loop    '^ EXPONENT        funct_loc = instr(1,str1,"^")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("^")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"^")    loop    '===============================================================================    'regular logic    '===============================================================================    'XOR        funct_loc = instr(1,str1,"xor")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("xor")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"xor")    loop    'OR        funct_loc = instr(1,str1,"or")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("or")) + mid(str1,funct_loc+2)        funct_loc = instr(1,str1,"or")    loop    'AND        funct_loc = instr(1,str1,"and")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("and")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"and")    loop    'NOT        funct_loc = instr(1,str1,"not")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("not")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"not")    loop    'IMP        funct_loc = instr(1,str1,"imp")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("imp")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"imp")    loop    'EQV        funct_loc = instr(1,str1,"eqv")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("eqv")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"eqv")    loop    'MOD        funct_loc = instr(1,str1,"mod")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("mod")) + mid(str1,funct_loc+3)        funct_loc = instr(1,str1,"mod")    loop    '===============================================================================    'parenthesis    '===============================================================================    '(        funct_loc = instr(1,str1,"(")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct("(")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,"(")    loop    ')        funct_loc = instr(1,str1,")")    do while funct_loc<>0        if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(eval_funct(")")) + mid(str1,funct_loc+1)        funct_loc = instr(1,str1,")")    loop    '===============================================================================    'USER VARIABLES in Variables() array    '===============================================================================    dim as integer inc    for inc = lbound(Variables) to ubound(Variables)        chars(inc)=chr(239+inc)        funct_loc = instr( 1 , str1 , Variables(inc) )        do while funct_loc<>0            if funct_loc<>0 then str1 = left(str1,funct_loc-1) + chr(239+inc) + mid(str1,funct_loc+len(Variables(inc)))            funct_loc = instr( 1 , str1 , Variables(inc) )        loop    next    return str1end function'==============================================================================='==============================================================================='==============================================================================='===============================================================================function VarReplace(byval eq1 as string) as string    dim as string str1 = eq1    dim as integer inc , funct_loc    dim as double value    for inc = lbound(Chars) to ubound(Chars)        value = Values(inc)        funct_loc = instr( 1 , str1 , Chars(inc) )        do while funct_loc<>0            str1 = left(str1,funct_loc-1) + str(value) + mid(str1,funct_loc+1)            funct_loc = instr( 1 , str1 , Chars(inc) )        loop    next    return str1end function'==============================================================================='==============================================================================='recursive descent parser'==============================================================================='===============================================================================function ParseEq(byval eq1 as string) as double    dim as integer indx, tempc, op , curLow=29, curInd, numOfOps=0, numOfPar=1       'get rid of parantheses if they include the whole equation 'ex (234+434*(23+1)) ->  234+434*(23+1)    if eq1[0]=237 and eq1[len(eq1)-1]=238 then        for indx = 1 to len(eq1)-1                       if eq1[indx]=238 or eq1[indx]=237 then numOfPar+=(237-eq1[indx])*2+1                       if numOfPar=0 and indx<>len(eq1)-1 then exit for            if numOfPar=0 and indx=len(eq1)-1 then eq1=mid\$(eq1,2,len(eq1)-2)        next    end if           'find the lowest operator    for indx = 0 to len(eq1)-1               'skip stuff inside parantheses in the operation count        if eq1[indx]=237 then '(            numOfPar=1            for tempc = indx+1 to len(eq1)-1                if eq1[tempc]=238 or eq1[tempc]=237 then numOfPar+=(237-eq1[tempc])*2+1                           indx=tempc+1                if numOfPar=0 then exit for                           next            if indx=len(eq1) then exit for 'equation end has been reached                   end if               op=eq1[indx]        if op >=200 and op<=236 then numOfOps+=1        if op >=239 and op<=255 then numOfOps+=1               if op = 200 then curLow=-1 : curInd=indx ' +        if op = 201 then curlow= 1 : curInd=indx ' -                      if op = 202 then if abs(curlow)>1 then curlow= -2 : curInd=indx ' *        if op = 203 then if abs(curlow)>1 then curlow=  2 : curInd=indx ' / \               if op = 204 then if abs(curlow)>2 then curLow= 03 : curInd=indx ' ^               if op = 205 then if abs(curlow)>3 then curLow= 04 : curInd=indx 'log               if op = 206 then if abs(curlow)>3 then curLow= 05 : curInd=indx 'acosech        if op = 207 then if abs(curlow)>3 then curLow= 06 : curInd=indx 'cosech        if op = 208 then if abs(curlow)>3 then curLow= 07 : curInd=indx 'acosec        if op = 209 then if abs(curlow)>3 then curLow= 08 : curInd=indx 'cosec               if op = 210 then if abs(curlow)>3 then curLow= 09 : curInd=indx 'asech        if op = 211 then if abs(curlow)>3 then curLow= 10 : curInd=indx 'sech        if op = 212 then if abs(curlow)>3 then curLow= 11 : curInd=indx 'asec        if op = 213 then if abs(curlow)>3 then curLow= 12 : curInd=indx 'sec               if op = 214 then if abs(curlow)>3 then curLow= 13 : curInd=indx 'acoth        if op = 215 then if abs(curlow)>3 then curLow= 14 : curInd=indx 'coth        if op = 216 then if abs(curlow)>3 then curLow= 15 : curInd=indx 'acot        if op = 217 then if abs(curlow)>3 then curLow= 16 : curInd=indx 'cot               if op = 218 then if abs(curlow)>3 then curLow= 17 : curInd=indx 'atanh        if op = 219 then if abs(curlow)>3 then curLow= 18 : curInd=indx 'tanh        if op = 220 then if abs(curlow)>3 then curLow= 19 : curInd=indx 'atan        if op = 221 then if abs(curlow)>3 then curLow= 20 : curInd=indx 'tan               if op = 222 then if abs(curlow)>3 then curLow= 21 : curInd=indx 'acosh        if op = 223 then if abs(curlow)>3 then curLow= 22 : curInd=indx 'cosh        if op = 224 then if abs(curlow)>3 then curLow= 23 : curInd=indx 'acos        if op = 225 then if abs(curlow)>3 then curLow= 24 : curInd=indx 'cos               if op = 226 then if abs(curlow)>3 then curLow= 25 : curInd=indx 'asinh        if op = 227 then if abs(curlow)>3 then curLow= 26 : curInd=indx 'sinh        if op = 228 then if abs(curlow)>3 then curLow= 27 : curInd=indx 'asin        if op = 229 then if abs(curlow)>3 then curLow= 28 : curInd=indx 'sin       next       if numOfOps=0 then return val(eq1)'single number, no equation to evaluate!       if curLow=-1 then return ParseEq(left\$(eq1,curInd)) + ParseEq(right\$(eq1,len(eq1)-curInd-1))    if curLow= 1 then return ParseEq(left\$(eq1,curInd)) - ParseEq(right\$(eq1,len(eq1)-curInd-1))    if curLow=-2 then return ParseEq(left\$(eq1,curInd)) * ParseEq(right\$(eq1,len(eq1)-curInd-1))    if curLow= 2 then return ParseEq(left\$(eq1,curInd)) / ParseEq(right\$(eq1,len(eq1)-curInd-1))    if curLow= 3 then return ParseEq(left\$(eq1,curInd)) ^ ParseEq(right\$(eq1,len(eq1)-curInd-1))          if curLow= 04 then return log(     ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )       'cosecants    if curLow= 05 then return acosech( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 06 then return  cosech( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 07 then return  acosec( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 08 then return   cosec( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )       'secants    if curLow= 09 then return   asech( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 10 then return    sech( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 11 then return    asec( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 12 then return     sec( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )       'cotangents    if curLow= 13 then return   acoth( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 14 then return    coth( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 15 then return    acot( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 16 then return     cot( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )       'tangents    if curLow= 17 then return   atanh( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 18 then return    tanh( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 19 then return    atan( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 20 then return     tan( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )       'cosines    if curLow= 21 then return   acosh( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 22 then return    cosh( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 23 then return    acos( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 24 then return     cos( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )       'sines    if curLow= 25 then return   asinh( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 26 then return    sinh( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 27 then return    asin( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )    if curLow= 28 then return     sin( ParseEq(left\$(eq1,curInd)+right\$(eq1,len(eq1)-curInd-1)) )   end function'==============================================================================='==============================================================================='==============================================================================='begin Dodicats TRIG functions'(Dodicat from scottland) on http://www.freebasic.net/forum/'==============================================================================='cosecants'===============================================================================Function acosech(n as double) As Double    dim x as double = n    return Log((Sgn(x) * Sqr(x * x + 1) +1) / x)End FunctionFunction cosech(n as double) As Double    dim x as double = n    return 2 / (Exp(x) - Exp(-x))End FunctionFunction acosec(n as double) As Double    dim x as double = n    return Atn(x / Sqr(x * x - 1)) + (Sgn(x) - 1) * (2 * Atn(1))End FunctionFunction cosec(n as double) As Double    dim x as double = n    return 1 / Sin(x)End Function'==============================================================================='secants'===============================================================================Function asech(n as double) As Double    dim x as double = n    return Log((Sqr(-x * x + 1) + 1) / x)End FunctionFunction sech(n as double) As Double    dim x as double = n    return 2 / (Exp(x) + Exp(-x))End FunctionFunction asec(n as double) As Double    dim x as double = n    return Atn(x / Sqr(x * x - 1)) + Sgn((x) -1) * (2 * Atn(1))End FunctionFunction sec(n as double) As Double    dim x as double = n    return 1 / Cos(x)End Function'===============================================================================' cotangents'===============================================================================Function acoth(n as double) As Double    dim x as double = n    return Log((x + 1) / (x - 1)) / 2End FunctionFunction coth(n as double) As Double    dim x as double = n    return (Exp(x) + Exp(-x)) / (Exp(x) - Exp(-x))End FunctionFunction acot(n as double) As Double    dim x as double = n    return Atn(x) + 2 * Atn(1)End FunctionFunction cot(n as double) As Double    dim x as double = n    return 1 / Tan(x)End Function'===============================================================================' tangents'===============================================================================Function atanh(n as double) As Double    dim x as double = n    return Log((1 + x) / (1 - x)) / 2End FunctionFunction tanh(n as double) As Double    dim x as double = n    return (Exp(x) - Exp(-x)) / (Exp(x) + Exp(-x))End FunctionFunction atan(n as double) As Double    dim x as double = n    return Atn(x)End Function   'Function TAN(n as double) As Double'    dim x as double = n'    TAN = tan(x)'End Function   '===============================================================================' cosines'===============================================================================Function acosh(n as double) As Double    dim x as double = n    return Log(x + Sqr(x * x - 1))End FunctionFunction cosh(n as double) As Double    dim x as double = n    return (Exp(x) + Exp(-x)) / 2End Function'Function Acos(n as double) As Double'    dim x as double = n'    ACOS = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)'End Function'Function cos(n as double) As Double'    dim x as double = n'    COS = cos(x)'End Function'===============================================================================' sines'===============================================================================Function asinh(n as double) As Double    dim x as double = n    return Log(x + Sqr(x * x + 1))End FunctionFunction sinh(n as double) As Double    dim x as double = n    return (Exp(x) - Exp(-x)) / 2End Function'Function asin(n as double) As Double'   dim x as double = n'    asin = Atn(x / Sqr(-x * x + 1))'End Function'Function Sin(byval x as doubele ) as double'    dim x as double = n'    sin=sin(x)'End Function'==============================================================================='others'==============================================================================='Function logN(n as double,Byval n As Double) As Double'    logN = Log(x) / Log(n)'End Function'Function haversine(n as double) As Double'    haversine = (Sin(x/2))^2'End Function'==============================================================================='END TRANCENDENTALS'===============================================================================`
albert
Posts: 5533
Joined: Sep 28, 2006 2:41
Location: California, USA
@podvornyak

If you change EQ or eq to eq1 or EQ1 then you need to change it all accros the board thruought all functions where its passed or referenced.

If your using FBIDE then Just a replace eq , eq1 should work.
It should work fine then. If you use FBEdit , i'm not sure but i think a global search and replace would be the same or similar.

I'm still working on the whole thing , I want to put it into
"Trigonometry_Designer_GL_V2" my current program i'm working on.

I'm thinking of taking out the operators (+-/\*^) and parenthesis from being replaced by a chr(). right now it replaces all the trig and normal functions and parenthesis with a single character chr(200+).

So if you want to change a something you have to recode all the (sortof enums) in eval_funct() and match them with changes in ParseEq().

The parenthesis in ParseEQ() are also encoded in eval_funct() ,i think as 237,238.. User variables start at 239 and can go to 255. I might change that to start at a lower value to allow more than 16 user variables.

But the prog i'm going to use it in ( Trigonometry_Designer_GL_v2 ) will only allow for x1,y1, x2,y2 , z1. which is how i got the whole thing set up already. just yet to add ATAN2(?,?) and Dodicats HaverSine() functions.
albert
Posts: 5533
Joined: Sep 28, 2006 2:41
Location: California, USA
@podvornyak

After looking at your above post of the code, It looks like all occurrences of eq are replaced with eq1 and it should work fine.

I looked in all functions and it seems to be eq1 all the way through.

My own computer and Dodicat's didn't show any errors. and Dodicat has as least two computers , running both Windows and Linux???

The only thing i could imagine as a possible error would be to change a variable name to something that has another function inside it:
like Variable(?) = "cosine1" where both "cos" and "sin" are other functions. it would replace cosine with chr(?)ine and "ine"would throw an error
albert
Posts: 5533
Joined: Sep 28, 2006 2:41
Location: California, USA
@podvornyak

Sorry!!!
I copied and pasted your posted code of my code and it ran fine in Windows7 64 bit.

But like i posted, it takes 400+ seconds on a 2Ghz Dual-Core to complete the whole thing with the real long formulas in x1,y1,x2,y2.
Which is what i was doing is benchmarking the ParsaeEq() function against Dodicats previously posted Parser.

I can't imagine where your error is coming from.
You are more experienced than me in coding and i have used your OpenGL and MultiKey() code in my programs.
podvornyak
Posts: 148
Joined: Nov 12, 2007 11:46
Location: Russia
albert wrote:I can't imagine where your error is coming
Asm Operator "EQ"
Description: the "EQ" operator compares the first and second operands and returns a value of 0 (false) if the two operands are not equal or a value of 1 (true) if the two operands are equal.
albert wrote:You are more experienced than me in coding

Nope... More theory experienced. Anyway... Try to avoid two char variable names in future. I'm already naming my functions and variables with full names because of this. More time for keyboarding but more insurance and self-speaking code... Like this:

Code: Select all

`...engine.video.width = 320with engine    .video.height = 240    with .video        .bit = 16    end with    .startend with....with engine.video    .begin    ...    .finishend with...`

Also more typing experience. :D
albert
Posts: 5533
Joined: Sep 28, 2006 2:41
Location: California, USA
Is that what the problem was the 2 letter EQ was geting mixed up with an Assembly instruction??

When you name your variables it searches and replaces them, with INSTR() , which can screw up if you have a variable named "cosine" and one named "sine" and sine comes first in the variable name array().

Its supposed to fill a GL list or array with all the points and then go to GL mode and do your multikey rotating stuff.
podvornyak
Posts: 148
Joined: Nov 12, 2007 11:46
Location: Russia
albert wrote:Is that what the problem was the 2 letter EQ was geting mixed up with an Assembly instruction??
It is.
up.. Finally i've figure out what do u mean when ask about spheres in dna sample. I think so... To display OpenGL point as circle, not as rectangle - glEnable GL_POINT_SMOOTH. I've reinstall system and i've jump on to 0.23 fbc. That problem appear on all my doodles. Actually it was something wrong with my system - all points drawing as circles.
dodicat
Posts: 6234
Joined: Jan 10, 2006 20:30
Location: Scotland
Higg's Bosun

Code: Select all

`Screen 19,32Dim As Integer xres,yresScreeninfo xres,yresType v3    As Single x,yEnd TypeOperator +(a As v3,b As v3) As v3Return Type(a.x+b.x,a.y+b.y)End OperatorOperator * (a As v3,b As Single) As v3Return Type(b*a.x,b*a.y)End Operator#define rr(f,l) (Rnd*(l-f)+f)#define distance(p1,p2) sqr( (p1.x-p2.x)*(p1.x-p2.x)+(p1.y-p2.y)*(p1.y-p2.y))#define length(p1) sqr( (p1.x)*(p1.x)+(p1.y)*(p1.y))#define normalize(p1) type<v3>( p1.x/(length(p1)),p1.y/(length(p1))) #macro rotate(pivot,p,a,scale1,scale2)var rotx=scale1*(Cos(a*.0174533)*(p.x-pivot.x)-Sin(a*.0174533)*(p.y-pivot.y))+pivot.xvar roty=scale2*(Sin(a*.0174533)*(p.x-pivot.x)+Cos(a*.0174533)*(p.y-pivot.y))+pivot.y#endmacro#macro check_boundary(v)If v.x>xres Then: vel(n).x=-vel(n).x:start(n)=Type(xres,v.y):t(n)=0:End IfIf v.x<0 Then: vel(n).x=-vel(n).x:start(n)=Type(0,v.y):t(n)=0:End IfIf v.y>yres Then: vel(n).y=-vel(n).y:start(n)=Type(v.x,yres):t(n)=0:End IfIf v.y<0 Then: vel(n).y=-vel(n).y:start(n)=Type(v.x,0):t(n)=0:End If#endmacroDim As Integer z, num=10500Dim Shared As v3 a(num),ca(num),start(num),vel(num),temp,gravity=Type(0,.01)Dim Shared As Single t(num),rad(num)Dim Shared As Uinteger colour(num)Dim As v3 pivot=Type(xres/2,.8*yres)Dim As Single ang,dist,k=1,yk=1For n As Integer=1 To Ubound(a)    z=255*(n-1)/(Ubound(a)-1)    a(n)=Type(rr(0,xres),rr((.8*yres),yres))    rad(n)=rr(2,7)    start(n)=a(n)    ca(n)=a(n)    vel(n)=Type(rr(-1,1),rr(-1,1))    vel(n)=normalize(vel(n))    colour(n)=Rgb(z,100,0)Next nDo    ang=ang+.1    pivot.x=pivot.x+1*k    If pivot.x>xres Then k=-k    If pivot.x<0 Then k=-k        pivot.y=pivot.y+1*yk    If pivot.y>yres Then yk=-yk    If pivot.y<0 Then yk=-yk        Screenlock    Cls        For n As Integer=1 To Ubound(a)        t(n)=t(n)+1        dist=distance(a(n),pivot)        If dist < xres/2 Then            rotate(pivot,ca(n),ang,1,1)            temp=Type(rotx,roty)            start(n)=temp            t(n)=0        End If        check_boundary(ca(n))        ca(n)=start(n)+vel(n)*t(n)+gravity*(.5*t(n)*t(n))        Circle(ca(n).x,ca(n).y),rad(n),colour(n),,,,f    Next n    Locate 1,1    Print length(vel(77))    Screenunlock    Sleep 1,1Loop Until Inkey=Chr(27)Sleep`
albert
Posts: 5533
Joined: Sep 28, 2006 2:41
Location: California, USA
@Dodicat

How long di it take you to come up with that??
Thats way cool. some complex coding..

I've been studying Assmebly language and reading all the Intel/AMD TECHNICAL DOCS.

Some Intel opcodes AMD doesn't have and AMD has some opcodes that Intel doesn't.
So writing an assembler for both, i guess you just got to skip the non-both opcodes.
dafhi
Posts: 1329
Joined: Jun 04, 2005 9:51
looks great dodi
D.J.Peters
Posts: 8019
Joined: May 28, 2005 3:28
Contact:
for dodicat and albert
your old example without the MS script engine
the part of gfx are the same

you have 26 vars from "a-z" or "A-Z"

e.g. SetVar("B",value) is the same as SetVar("b",value)

Joshy

Code: Select all

`type float as single ' or double declare sub Unary        (byref Result as float)declare sub Parenthesized(byref Result as float)declare sub Exponent     (byref Result as float)declare sub MulDiv       (byref Result as float)declare sub AddSub       (byref result as float)declare sub GetTokenenum TokenTypes  EOL  DELIMETER  NUMBER   ' integer or float  IDENT    ' function or varend enumdim shared as string  Expression,Token,Chardim shared as integer LenExpression,TokenType,CurrentPos,CharAdim shared as float Vars(25)sub sError(sErr as string)  print "Error: " & sErr & " !"  beep:sleep:endend sub' SetVar("A",123.456)sub SetVar(nam as string,value as float)  nam = trim(nam)  if len(nam)<>1 then     serror("name of var '" & nam & "' has more then one letter ('A'...'Z')")  else      dim as integer index = asc(ucase(nam))-65    if (index<0) or (index>25) then      serror("var name '" & nam & "' is out of range (A...Z)")    else      Vars(index)=value    end if  end if  end sub' value = GetVar("R")function GetVar(v as string) as float  dim as integer index = asc(v)-65  if (index<0) or (index>25) then    serror("GetVar '" & v & "' is out of range (A...Z)")  else    return Vars(index)  end ifend function' 0-9function IsDigit() as integer  dim as integer aChar=asc(Char)  return ((aChar>47) and (aChar<58))end function' a-z,A-Zfunction IsAlpha() as integer  dim as integer aChar=asc(Char)  return ((aChar>64) and (aChar<91))end function' " ", TABfunction IsWhite() as integer  dim as integer aChar=asc(Char)  return ((aChar=32) or (aChar=9))end function' -+/*^()function IsDelimeter() as integer  dim as integer aChar=asc(Char)  if aChar=9 then return 1  return (instr("-+/*^()",Char)>0)end function' math function IsFunction() as integer  return (instr("ABS,ATN,COS,RND,SIN,TAN",Token)>0)end function' "A"..."Z" ?function IsVar() as integer  if len(Token)<>1 then return 0  dim as integer aChar=asc(token)  return ((aChar>64) and (aChar<91))end functionsub GetChar  CurrentPos+=1  if CurrentPos>lenExpression then    char="":return  end if  Char=mid(Expression,CurrentPos,1)end subsub GetToken()  GetChar  if Char="" then    Token     = ""    TokenType = EOL    return  end if    if IsDelimeter() then    Token     = Char    TokenType = DELIMETER    return  end if  if IsDigit() then    Token = ""    while IsDelimeter()=0 and Char<>""      Token = Token & Char : GetChar    wend    TokenType = NUMBER    CurrentPos-=1    return  end if    if IsAlpha() then    Token = ""    while IsAlpha() and Char<>""      Token = Token & Char : GetChar    wend    TokenType = IDENT    CurrentPos-=1    return  end ifend sub' priority 1 (higest in math)sub Parenthesized(byref Result as float)  if (Token ="(") and (TokenType = DELIMETER) then    GetToken()    AddSub(Result)    if( Token <> ")") then      serror("unbalanced round brackets")    end if    GetToken()  else    select case TokenType    case NUMBER : Result = val(Token) : GetToken    case IDENT      if IsVar() then        Result = GetVar(Token) : GetToken      elseif IsFunction() then        dim as string Func = Token        dim as float res  = result        GetToken:Parenthesized(res)        select case Func        case "ABS":result=abs(res)        case "ATN":result=atn(res)        case "COS":result=cos(res)        case "RND":result=rnd(res)        case "SIN":result=sin(res)        case "TAN":result=tan(res)        case else : serror("ident '" & func & "' isn't a function")        end select      else        serror("ident '" & token & "' isn't a var or function")      end if    end select  end ifend sub' priority 2sub Unary(byref Result as float)  dim as string Op  if (TokenType=DELIMETER) then    if ((Token="+") or (Token="-")) then      Op = Token : GetToken()    end if    end if  Parenthesized(Result)  if (Op="-") then Result = -Resultend sub' priority 3sub Exponent(byref Result as float)  Unary(Result)  if (Token="^") then    GetToken()    dim as float Temp    Exponent(Temp)    result ^= temp  end ifend sub' priority 4sub MulDiv(byref Result as float)  dim as string Op  dim as float Temp  Exponent(Result)  Op=Token  while Op = "*" or Op = "/"    GetToken()    Exponent(Temp)    if op="*" then      result*=temp    elseif op="/" then       result/=temp    else      sError("wrong operator '" & Op & "' /,* are ecxepted")      end if    'DoMath(Op,Result,Temp)    Op = Token  wendend sub' priority 5 (lowest in math)sub AddSub(byref Result as float)  MulDiv(result)  dim as string Op=Token  dim as float Temp  while Op = "+" or Op = "-"    GetToken()    MulDiv(Temp)    if op="-" then      result-=temp    elseif op="+" then       result+=temp    else      sError("wrong operator '" & Op & "' +,- are ecxepted")      end if    'DoMath(Op,Result,Temp)    Op = Token  wendend subfunction Solver(e as string) as float  dim as float result  e=trim(e)  LenExpression=len(e)  ' no expression at all  if LenExpression<1 then return 0  e=ucase(e)  Expression=e ' make expression global  CurrentPos=0 ' read read pointer  GetToken()  ' start with lowest priority  AddSub(result)  return resultend function 'progressType bar    As Integer x,y,l,d,percent    As Uinteger colEnd TypeDim As Integer percentage#define progress(value,lower,upper) 100*(value-lower)/(upper-lower)Sub progressbar(b As bar)    Line(b.x+1,b.y+1)-( (b.l*b.percent/100+b.x),b.y+b.d-1),b.col,bf    Line(b.x,b.y)-(b.x+b.l,b.y+b.d),,bEnd SubDim  As bar bb=Type<bar>(100,300,600,20,0,Rgb(0,0,200))  Dim Shared As Integer xres,yresScreen 20,32Screeninfo xres,yresType vector3d    As Single x,y,zEnd Type#define vct type<vector3d>#define distance(p1,p2) sqr((p1.x-p2.x)*(p1.x-p2.x)+(p1.y-p2.y)*(p1.y-p2.y))#macro incircle(cx,cy,radius,x,y)(cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius#endmacroDim Shared As vector3d eyepointDim Shared Rx(1 To 3,1 To 3) As SingleDim Shared Ry(1 To 3,1 To 3) As SingleDim Shared Rz(1 To 3,1 To 3) As SingleDim Shared pivot_vector(1 To 3) As SingleDim Shared new_pos(1 To 3) As SingleDim Shared temp1(1 To 3) As SingleDim Shared temp2(1 To 3) As SingleOperator + (v1 As vector3d,v2 As vector3d) As vector3d  Return Type<vector3d>(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)End OperatorOperator -(v1 As vector3d,v2 As vector3d) As vector3d  Return Type<vector3d>(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)End OperatorOperator * (f As Single,v1 As vector3d) As vector3d  Return Type<vector3d>(f*v1.x,f*v1.y,f*v1.z)End OperatorFunction r(first As Double, last As Double) As Double  Function = Rnd * (last - first) + firstEnd FunctionFunction apply_perspective(p As vector3d) As vector3d  Dim As Single w=(p.z*(-1)/300+1)*.75  Return vct((p.x-eyepoint.x)/w+eyepoint.x,(p.y-eyepoint.y)/w+eyepoint.y,(p.z-eyepoint.z)/w+eyepoint.z)End FunctionSub framecounter  Static As Double t1=0  static as integer frames  frames+=1  If frames mod 16=0 Then    dim as double t2 = Timer    dim as integer fps = 16/(t2-t1)    Windowtitle "Frames per second = " & fps    t1=t2  End IfEnd Sub    #macro mv(m1,v,ans)    For i As Integer=1 To 3        s=0        For k As Integer = 1 To 3            s=s+m1(i,k)*v(k)        Next k        ans(i)=s    Next i    #endmacro    #define cr 0.0174532925199433Function rotatepoint3d( _  Byval pivot As vector3d,_   Byval pt As vector3d,_   Byval angle As vector3d,_  Byval dilator As Single=1) As vector3d   Dim angle_radians As vector3d=Type<vector3d>(cr*angle.x,cr*angle.y,cr*angle.z)       Dim s As Single    pivot_vector(1)=(pt.x-pivot.x)*dilator    pivot_vector(2)=(pt.y-pivot.y)*dilator    pivot_vector(3)=(pt.z-pivot.z)*dilator       'rotat1on matrices about the three axix    Rx(1,1)=1:Rx(1,2)=0:Rx(1,3)=0    Rx(2,1)=0:Rx(2,2)=Cos(angle_radians.x):Rx(2,3)=-Sin(angle_radians.x)    Rx(3,1)=0:Rx(3,2)=Sin(angle_radians.x):Rx(3,3)=Cos(angle_radians.x)       Ry(1,1)=Cos(angle_radians.y):Ry(1,2)=0:Ry(1,3)=Sin(angle_radians.y)    Ry(2,1)=0:Ry(2,2)=1:Ry(2,3)=0    Ry(3,1)=-Sin(angle_radians.y):Ry(3,2)=0:Ry(3,3)=Cos(angle_radians.y)       Rz(1,1)=Cos(angle_radians.z):Rz(1,2)=-Sin(angle_radians.z):Rz(1,3)=0    Rz(2,1)=Sin(angle_radians.z):Rz(2,2)=Cos(angle_radians.z):Rz(2,3)=0    Rz(3,1)=0:Rz(3,2)=0:Rz(3,3)=1       mv (Rx,pivot_vector,temp1)               mv (Ry,temp1,temp2)    mv (Rz,temp2,new_pos)       new_pos(1)=new_pos(1)+pivot.x    new_pos(2)=new_pos(2)+pivot.y    new_pos(3)=new_pos(3)+pivot.z       Return Type<vector3d>(new_pos(1),new_pos(2),new_pos(3))End FunctionSub blow(a() As vector3d,mag As Single)    For z As Integer=1 To Ubound(a)        a(z)=mag*a(z)    Next zEnd SubSub translate(a() As vector3d,pt As vector3d)    For z As Integer=1 To Ubound(a)        a(z)=a(z)+vct(pt.x,pt.y,pt.z)    Next zEnd SubFunction vertex(piv As vector3d,p1 As vector3d,ang As vector3d,dil As Single,col As Uinteger) As Single    var _temp1=rotatepoint3d(piv,p1,ang,dil)    _temp1=apply_perspective(_temp1)    'Circle(_temp1.x,_temp1.y),(20*Abs(dil)+Abs(_temp1.z/2)*1*dil),col,,,,f    pset (_temp1.x,_temp1.y),col    Return _temp1.zEnd FunctionSub set_perspective(x As Single,y As Single,z As Single,minz As Single,maxz As Single)    eyepoint=vct(x,y,z)End Sub#macro combsort(array,comp)Scope    var size=Ubound(array),switch=0,j=0    Dim As Single void=size    Do        void=void/1.3: If void<1 Then void=1        switch=0        For i As Integer =1 To size-void            j=i+void            If comp(i)>comp(j) Then                Swap array(i),array(j): switch=1                Swap comp(i),comp(j)                Swap col(i),col(j)            End If        Next    Loop Until  switch =0 And void=1End Scope#endmacroRedim Shared As vector3d e(0)Dim count As IntegerRedim Shared As Uinteger col(0)dim as single functdim as single distdim as vector3d pt,cent=type<vector3d>(0,0)dim as string formula,workerworker="(sin(x)+cos(6-x)*sin(-y)+cos(6-y)-2*cos(x^2))/d"locate 3,3print "Example function sin(x)*cos(y)"print "You can also use d as a variable, which is distance from origin"print "E.G. (sin(2*d)/(2*d))*5"input "Enter a function or press [enter]",formulaif formula="" then formula=workerFor x As Single=-5 To 5 Step .101  setvar("x",x)  For y As Single=-5 To 5 Step .101    setvar("y",y)    pt=type<vector3d>(x,y)    dist=distance(pt,cent)    setvar("d",dist)    count=count+1    Redim Preserve e(count)    Redim Preserve col(count)    col(count)=Rgb(255*(x+5)/10,155*(y+5)/10,50)    funct=Solver(formula)    e(count)=Type<vector3d>(x,y,funct)  Next y  percentage=progress(x,-5,5)  b.percent=percentage  progressbar(b)Next xblow(e(),80)translate(e(),vct(xres/2,yres/2,0))set_perspective(xres/2,yres/2,0,-100,100)Dim As Single dilation=.2Dim As vector3d piv,angpiv=eyepointDim As String iDim As Single zeds(1 to Ubound(e)),_mwDim As Uinteger colourDim As Integer mx,my,mwDim As Single startdilation=.2dilation=startdilationdim as any pointer im=imagecreate(xres,yres)paint im,(0,0),rgb(255,255,255)Do    framecounter    i=Inkey    if i= chr(255) + "K"  then ang.x=ang.x+5    if i= chr(255) + "M"  then ang.x=ang.x-5    if i= chr(255) + "P"  then ang.y=ang.y-5    if i= chr(255) + "H"  then ang.y=ang.y+5    'ang.y=ang.y+.7    'ang.x=ang.x+.5    'ang.z=ang.z+.25    Screenlock    'Cls    put(0,0),im,pset    draw string (20,20), "Use up/down keys and mouse wheel",rgb(0,0,0)    draw string(20,50), "z= " & formula,rgb(0,0,0)    Getmouse mx,my,mw    _mw=mw/100    combsort(e,zeds)    dilation=startdilation+_mw    For z As Integer=1 To Ubound(e)        zeds(z)=vertex(piv,e(z),ang,dilation,col(z))    Next z    Screenunlock    Sleep 10Loop Until i=Chr(27)imagedestroy imSleep`