Squares

General FreeBASIC programming questions.
Richard
Posts: 2999
Joined: Jan 15, 2007 20:44
Location: Australia
This is my old QB4.5 Atn2(y,x) code, rewritten in FB.
It is really only 3 or 4 IF statements.

Code: Select all

`'-------------------------------------------------------------------------'---- Four Quadrant Arctangent function ----'-------------------------------------------------------------------------' if inputs are (y, x)      then zero angle is along the x axis'  and angles are positive anticlockwise ie mathematically correct'-------------------------------------------------------------------------' if inputs are reversed to (x, y)  then zero angle is along the y axis'  which is North, angles are positive clockwise ie geographically correct'---------------------------------------------------------------------------Const As Double pi = 4 * Atn(1)Const As Double TwoPi = 8 * Atn(1)' four quadrant arctan(y,x)Function atn2 (Byval y As Double, Byval x As Double) As Double    Dim As Double t    If x = 0 Then t = Sgn(y) * pi / 2 Else t = Atn(y / x) ' arctan = 2 quadrants    If x < 0 Then t = t + pi     ' Range is { -PiOn2 < t < 3*PiOn2 } 4 quadrants    If t > pi Then t = t - TwoPi ' Use if range { -Pi < t < +Pi } is needed    If (x * x + y * y) < 1e-12 Then t = 1/Int(x*x)  ' trip on a zero length vector    Return tEnd Function'---------------------------------------------------------------------------' exercise atn2Dim As Double x, y, thetaPrint "    theta   atn2(y,x)     x        y"For theta = -Pi+1e-12 To Pi+2e-12 Step Pi/16    x = Cos(theta)    y = Sin(theta)    Print Using "   ##.####  ##.####     ##.####  ##.####"; theta; atn2(y,x); x; yNext thetaPrint atn2(+1e-8, +1e-8)Print atn2(-1e-8, -1e-8)'---------------------------------------------------------------------------Sleep`
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland
Richard wrote:This is my old QB4.5 Atn2(y,x) code, rewritten in FB.
It is really only 3 or 4 IF statements.

Oh, all right folks, I was wrong, I didn't realize that atan2 was quadrant based.
For being wrong, I applied penance to Dodicat and got him to rectify things.
Here's Dodicat's pain compared with Richard's QB4.5 days.

Code: Select all

`Function atn2 (Byval y As Double, Byval x As Double) As Double   dim As Double TwoPi = 8 * Atn(1)   dim As Double pi = 4 * Atn(1)    Dim As Double t    If x = 0 Then t = Sgn(y) * pi / 2 Else t = Atn(y / x) ' arctan = 2 quadrants    If x < 0 Then t = t + pi     ' Range is { -PiOn2 < t < 3*PiOn2 } 4 quadrants    If t > pi Then t = t - TwoPi ' Use if range { -Pi < t < +Pi } is needed    If (x * x + y * y) < 1e-12 Then t = 1/Int(x*x)  ' trip on a zero length vector    Return tEnd Functionfunction atan(x as double,y as double) as double    dim as double pi=4*atn(1):var k=0   if sgn(y)=1 or sgn(y)=0 then k=0:else:k=1:end if        k=k*sgn(x)    if x=0 and y=0 then return 0 '***    if sgn(x)=0 and sgn(y)=-1 then return pi    return (atn(x/y))+k*pi  end function     for x as double=-7 to 7      for y as double=7 to -7 step -1          print x,y,(atan(x,y)-atn2(x,y))      next y  next x  sleep  `
albert
Posts: 5635
Joined: Sep 28, 2006 2:41
Location: California, USA
Thanks guys!!!

With the formula parsing project..
I think the fastest way is to PRE-Parse the formulas..

Since the formulas and "static numbers" don't change during execution, just the value of variables change.

Theres no need to check for white-space each iteration..
Theres no need to parse the formulas each iteration.
===============================================

I want to preparse the formulas and set up an array of ececution orders and then each iteration just plug in the variable values.
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland
Hi Albert
that Atan2 thing is hard for a parser, for the function name contains a number (2), and the function requires two parameters and worst of all, a comma.

How are your trig things with just atn?

I might have a go at writing a quick parser, there are so many about already, but I'll try something different.

Here's a progress bar for loopers in the squares thread

Code: Select all

`type bar    as integer x,y,l,d,percent    as uinteger colend type#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 double looper, starthere,endhere,stepperstarthere=2980.4endhere=-456.22stepper=-.007screen 19,32dim as integer percentagedim  as bar bb=type<bar>(100,100,600,20,0,rgb(0,0,200))for looper=starthere to endhere step stepper  percentage=progress(looper,starthere,endhere)  b.percent=percentage  progressbar(b)  locate 1,1  print percentage;" %"next looperprint "DONE"sleep    `
albert
Posts: 5635
Joined: Sep 28, 2006 2:41
Location: California, USA
@Dodicat

Step_1: Take out the white-space...
Step_2: pick out matching parentisis "(" ,")"

so if you have something like :

Code: Select all

`input:         cos(d1*r1*s1)+log(tan(c1*c2)+d1*r1)*cos(sin(atn(d2*r2*c1)+s2))parsed:array(1)=cos(d1*r1*s1)+log(          +d1*r1)*cos(                     )array(2)=                  tan(c1*c2)            sin(             +s2) array(3)=                                            atn(d2*r2*c1)`

I can imagine what i want to do but for some reason i can't write the code for it..

I'm having problems picking out the nested parenthesis...
dafhi
Posts: 1335
Joined: Jun 04, 2005 9:51
@dodicat

I had a neat idea. I'm creating text databases for a game thing, like so:

Code: Select all

`+------------------+-------------+--------|                  |      |      | Base  |                  |      |      +--------|                  |      |      |      ||                  |      |      |      ||                  |      |      |      ||                  |      |      |      ||    Name          | Cool | Mana | Cast |+------------------+-------------+-------| Firebolt         |      | 50   | 8    |+------------------+------+------+------+| Snowball         |      | 1    |      |+------------------+------+------+---- `

But creating it in a text editor can be tedius. So I am beginning to develop a "paint program" for text.

I thought of 3 necessary things so far:

1. A line function, ie draw whatever character from (x1,y1) to (y2,y2)
2 and 3. Rect Copy and Move functions

I'll share when I'm done
albert
Posts: 5635
Joined: Sep 28, 2006 2:41
Location: California, USA

alberts-parser

@Dodicat & Richard

I figured out the above thing of picking out matching parenthesis..

My parser so far.. I put Dodicats TRIG calls into it..

Code: Select all

`declare function filter_spaces(byval eq as string) as stringdeclare function eval_funct(byval funct as string) as ubytedeclare function prep_formula(byval eq as string) as stringdeclare sub Prep_Array( byval eq as string)redim shared as string function_array(1)'==============================================================================='test functions'===============================================================================dim as string eqeq = "(cos(10  ^(2*2)) /tan(log(20))+(  90*4)*cotan(cos(22*45)*45)+ sin(22*(cos(100)*10)*log(1+9))*88  +244)"eq=lcase(eq)printprint eqeq = filter_spaces(eq)'must call filter_spaces() to remove white_space.eq = prep_formula(eq) 'must call prep_formula before using the formulaprintprint eqprintPrep_Array(eq) print string(80,"=");for a as integer = lbound(function_array(0)) to ubound(function_array(0)) step 1    print function_array(a)nextSLEEPEND'==============================================================================='==============================================================================='BEGIN FUNCTIONS AND SUBS'==============================================================================='===============================================================================Function filter_spaces(byval eq as string) as string    dim as integer spaces    do        spaces=instr(1,eq," ")        for c as integer = 0 to len(eq)-1             if eq[c]=32 then eq=left\$(eq,c) + right\$(eq,len(eq)-(c+1))                next c    loop until spaces=0    return eqend function'==============================================================================='===============================================================================function eval_funct(byval funct as string) as ubyte    select case funct        case "log"    :return 200+0                case "acosech":return 200+1        case "cosech" :return 200+2        case "acosec" :return 200+3        case "cosec"  :return 200+4                case "asech"  :return 200+5        case "sech"   :return 200+6        case "asec"   :return 200+7        case "sec"    :return 200+8                case "acotanh":return 200+9        case "cotanh" :return 200+10        case "acotan" :return 200+11        case "cotan"  :return 200+12                case "atanh"  :return 200+13        case "tanh"   :return 200+14        case "atan"   :return 200+15        case "tan"    :return 200+16                case "acosh"  :return 200+17        case "cosh"   :return 200+18        case "acos"   :return 200+19        case "cos"    :return 200+20                case "asinh"  :return 200+21        case "sinh"   :return 200+22        case "asin"   :return 200+23        case "sin"    :return 200+24                case "+"      :return 200+25        case "-"      :return 200+26        case "*"      :return 200+27        case "\"      :return 200+28        case "/"      :return 200+29        case "^"      :return 200+30                case "xor"    :return 200+31        case "or"     :return 200+32        case "and"    :return 200+33        case "not"    :return 200+34                case "imp"    :return 200+35        case "eqv"    :return 200+36                case "mod"    :return 200+37                case "("      :return 200+38        case ")"      :return 200+39            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 integer funct_loc     'log        funct_loc = instr(1,eq,"log")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("log")) + mid(eq,funct_loc+3)        funct_loc = instr(1,eq,"log")    loop        '===============================================================================    'cosecants    '===============================================================================    'acosech     funct_loc = instr(1,eq,"acosech")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("acosech")) + mid(eq,funct_loc+7)        funct_loc = instr(1,eq,"acosech")    loop    'cosech      funct_loc = instr(1,eq,"cosech")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("cosech")) + mid(eq,funct_loc+6)        funct_loc = instr(1,eq,"cosech")    loop    'acosec      funct_loc = instr(1,eq,"acosec")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("acosec")) + mid(eq,funct_loc+6)        funct_loc = instr(1,eq,"acosec")    loop    'cosec       funct_loc = instr(1,eq,"cosec")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("cosec")) + mid(eq,funct_loc+5)        funct_loc = instr(1,eq,"cosec")    loop        '===============================================================================    'secants    '===============================================================================    'asech       funct_loc = instr(1,eq,"asech")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("asech")) + mid(eq,funct_loc+5)        funct_loc = instr(1,eq,"asech")    loop    'sech        funct_loc = instr(1,eq,"sech")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("sech")) + mid(eq,funct_loc+4)        funct_loc = instr(1,eq,"sech")    loop    'asec        funct_loc = instr(1,eq,"asec")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("asec")) + mid(eq,funct_loc+4)        funct_loc = instr(1,eq,"asec")    loop    'sec         funct_loc = instr(1,eq,"sec")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("sec")) + mid(eq,funct_loc+3)        funct_loc = instr(1,eq,"sec")    loop        '===============================================================================    'cotangents    '===============================================================================    'acotanh     funct_loc = instr(1,eq,"acotanh")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("acotanh")) + mid(eq,funct_loc+7)        funct_loc = instr(1,eq,"acotanh")    loop    'cotanh      funct_loc = instr(1,eq,"cotanh")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("cotanh")) + mid(eq,funct_loc+6)        funct_loc = instr(1,eq,"cotanh")    loop    'acotan      funct_loc = instr(1,eq,"acotan")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("acotan")) + mid(eq,funct_loc+6)        funct_loc = instr(1,eq,"acotan")    loop    'cotan       funct_loc = instr(1,eq,"cotan")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("cotan")) + mid(eq,funct_loc+5)        funct_loc = instr(1,eq,"cotan")    loop        '===============================================================================    'tangents    '===============================================================================    'atanh       funct_loc = instr(1,eq,"atanh")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("atanh")) + mid(eq,funct_loc+5)        funct_loc = instr(1,eq,"atanh")    loop    'tanh        funct_loc = instr(1,eq,"tanh")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("tanh")) + mid(eq,funct_loc+4)        funct_loc = instr(1,eq,"tanh")    loop    'atan        funct_loc = instr(1,eq,"atan")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("atan")) + mid(eq,funct_loc+4)        funct_loc = instr(1,eq,"atan")    loop    'tan         funct_loc = instr(1,eq,"tan")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("tan")) + mid(eq,funct_loc+3)        funct_loc = instr(1,eq,"tan")    loop        '===============================================================================    'cosines    '===============================================================================    'acosh       funct_loc = instr(1,eq,"acosh")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("acosh")) + mid(eq,funct_loc+5)        funct_loc = instr(1,eq,"acosh")    loop    'cosh        funct_loc = instr(1,eq,"cosh")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("cosh")) + mid(eq,funct_loc+4)        funct_loc = instr(1,eq,"cosh")    loop    'acos        funct_loc = instr(1,eq,"acos")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("acos")) + mid(eq,funct_loc+4)        funct_loc = instr(1,eq,"acos")    loop    'cos         funct_loc = instr(1,eq,"cos")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("cos")) + mid(eq,funct_loc+3)        funct_loc = instr(1,eq,"cos")    loop        '===============================================================================    'sines    '===============================================================================    'asinh     funct_loc = instr(1,eq,"asinh")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("asinh")) + mid(eq,funct_loc+5)        funct_loc = instr(1,eq,"asinh")    loop    'sinh        funct_loc = instr(1,eq,"sinh")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("sinh")) + mid(eq,funct_loc+4)        funct_loc = instr(1,eq,"sinh")    loop    'asin        funct_loc = instr(1,eq,"asin")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("asin")) + mid(eq,funct_loc+4)        funct_loc = instr(1,eq,"asin")    loop    'sin         funct_loc = instr(1,eq,"sin")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("sin")) + mid(eq,funct_loc+3)        funct_loc = instr(1,eq,"sin")    loop    '===============================================================================    '===============================================================================    'end of trancendentals    '===============================================================================    '===============================================================================        '===============================================================================    'regular math symbols    '===============================================================================    '+ PLUS         funct_loc = instr(1,eq,"+")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("+")) + mid(eq,funct_loc+1)        funct_loc = instr(1,eq,"+")    loop    '- MINUS         funct_loc = instr(1,eq,"-")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("-")) + mid(eq,funct_loc+1)        funct_loc = instr(1,eq,"-")    loop    '* MULTIPLY         funct_loc = instr(1,eq,"*")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("*")) + mid(eq,funct_loc+1)        funct_loc = instr(1,eq,"*")    loop    '\ FLOAT DIVIDE         funct_loc = instr(1,eq,"\")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("\")) + mid(eq,funct_loc+1)        funct_loc = instr(1,eq,"\")    loop    '/ INTEGER DIVIDE         funct_loc = instr(1,eq,"/")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("/")) + mid(eq,funct_loc+1)        funct_loc = instr(1,eq,"/")    loop    '^ EXPONENT        funct_loc = instr(1,eq,"^")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("^")) + mid(eq,funct_loc+1)        funct_loc = instr(1,eq,"^")    loop        '===============================================================================    'regular logic    '===============================================================================    'XOR        funct_loc = instr(1,eq,"xor")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("xor")) + mid(eq,funct_loc+3)        funct_loc = instr(1,eq,"xor")    loop    'OR        funct_loc = instr(1,eq,"or")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("or")) + mid(eq,funct_loc+2)        funct_loc = instr(1,eq,"or")    loop    'AND        funct_loc = instr(1,eq,"and")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("and")) + mid(eq,funct_loc+3)        funct_loc = instr(1,eq,"and")    loop    'NOT        funct_loc = instr(1,eq,"not")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("not")) + mid(eq,funct_loc+3)        funct_loc = instr(1,eq,"not")    loop    'IMP        funct_loc = instr(1,eq,"imp")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("imp")) + mid(eq,funct_loc+3)        funct_loc = instr(1,eq,"imp")    loop    'EQV        funct_loc = instr(1,eq,"eqv")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("eqv")) + mid(eq,funct_loc+3)        funct_loc = instr(1,eq,"eqv")    loop    'MOD        funct_loc = instr(1,eq,"mod")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("mod")) + mid(eq,funct_loc+3)        funct_loc = instr(1,eq,"mod")    loop    '===============================================================================    'parenthesis    '===============================================================================    '(        funct_loc = instr(1,eq,"(")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct("(")) + mid(eq,funct_loc+1)        funct_loc = instr(1,eq,"(")    loop    ')        funct_loc = instr(1,eq,")")    do while funct_loc<>0        if funct_loc<>0 then eq = left(eq,funct_loc-1) + chr(eval_funct(")")) + mid(eq,funct_loc+1)        funct_loc = instr(1,eq,")")    loop    '===============================================================================    'function END    '===============================================================================        return eqend function'==============================================================================='===============================================================================sub Prep_Array( byval eq as string)        redim as string function_array( 0 to len(eq) )        'fill array elements     for a as integer = lbound(function_array(0)) to ubound(function_array(0)) step 1        function_array(a)=string(len(eq),"_")    next    function_array(0)=string(len(eq)," ")        dim as ubyte char    dim as integer indx    dim as integer l_p=lbound(function_array(0))    dim as integer r_p=lbound(function_array(0))    dim as integer elements=0    for indx = 0 to (len(eq)-1) step 1                char = eq[indx]                if char = 238 then l_p+=1        if char = 239 then l_p-=1:r_p=l_p+1                if char=238 then                        if l_p>elements then elements=l_p            function_array(l_p)[indx]=char                elseif char=239 then                        if r_p>elements then elements=r_p            function_array(r_p)[indx]=char                else            function_array(lbound(function_array(0)))[indx]=char        end if        next        'shrink array to smallest possible    for indx = 1 to ubound(function_array(0)) step 1        char=instr(1,function_array(indx), chr(238) )        if char=0 then exit for    next    redim preserve function_array(indx-1)        'setup parse levels    l_p=0    r_p=0    dim as string innards    for a as integer = ubound(function_array(0)) to 1 step -1                l_p = instr( r_p+1, function_array(a), chr(238) )        r_p = instr( l_p+1, function_array(a), chr(239) )                do while (r_p<>0) and (l_p<>0)                        innards = mid(function_array(0), (l_p+1), ((r_p-l_p)-1) )                        mid(function_array(a), (l_p+1), ((r_p-l_p)-1) ) = innards            mid(function_array(0), (l_p+1), ((r_p-l_p)-1) ) = string(len(innards)," ")                        l_p = instr( r_p+1, function_array(a), chr(238) )            r_p = instr( l_p+1, function_array(a), chr(239) )                    loop        l_p=0        r_p=0    next    end sub`

I got it working so far so good!!
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland
Hi dafhi
I have a little draw string thingy, not reallly from (x1,y1) to (x2,y2), (You say (y2,y2)?
But defined by the angle you want the characters to follow.
The | denotes a new line if you wish.
You can fiddle with spacing in the parameters.
To go from (x1,y1) to (x2,y2), it would be easy enough to obtain the angle and adjust the text spacing to fill the route.

Code: Select all

`sub drawstring(x as double,_               y as double,_               s as string,_               c as uinteger,_               angle as double=0,_               char_space as double=1,_               word_space as double=1,_               line_space as double=1,_               image as any pointer=0)           char_space=3*char_space:word_space=3*word_spacedim l as integer=len(s)dim px as double=16+xdim py as double=ydim z as integer=0dim pi as double=4*atn(1)dim sp as double=6#macro spaces(pixels)px=px+(pixels+sp)*cos(angle*pi/180)py=py-(pixels+sp)*sin(angle*pi/180)#endmacrofor n as integer=1 to l    select case mid\$(s,n,1)    case " " spaces(word_space)case "|" z=z+1 px=x+16+z*16*sin(angle*pi/180)*line_space py=y+z*16*cos(angle*pi/180)*line_spacecase else    draw string image,(px,py),mid\$(s,n,1),c    spaces(char_space)end selectnext nend subscreen 19,32dim s as string="Next line"'  | in the string flips to a new linedrawstring(10,10,"This is my string|"+s,rgb(255,255,255),-45,2,1,1)sleep`
dafhi
Posts: 1335
Joined: Jun 04, 2005 9:51
@dodicat. oops, i meant x2,y2 :)

doesn't surprise me one bit you've already got something like that. I will have a look. project code is expanding rapidly.

I make it sound like I'm the Borg.

albert
Posts: 5635
Joined: Sep 28, 2006 2:41
Location: California, USA
@Dodicat

I went off on a tangent and ported my FNXBasic Cyphers.. Cyph256 / Cyph512 / Cyph1024

It promts for input block size and output block size at startup..

Now back to the Parser thingy..

I want to preparse the formula into instruction orders.
There no need to parse it each time thru the double looping..
It takes several minutes to run if the 5 formulas are long (more than 50 bytes)

Maybe i can put the formulka into an array with function call and location to put the result each time.. ?????

===============================================

@Richard

My VARI_CYPH_FB_V1 is on the Projects page.
Can you hack the output if its singly or multiply cyphered ????

How could you make it " PUBLIC KEY ". It might have commercial potential???
Richard
Posts: 2999
Joined: Jan 15, 2007 20:44
Location: Australia
@ Albert.
If I was to break your cipher, you would simply scramble it a bit more then resubmit it for cryptanalysis all over again. I'm not going to waste my time.

I cannot use or trust any cipher system that has not been examined and tested for three years by a competent and trusted group of mathematicians. I have enough real encrypted messages left to break this year without also taking on your pet system. As you claim your cipher may now have commercial potential, my employer would need to charge you the minimum upfront fee of AU\$25k before accepting your cryptanalysis request. That is probably the best way to test your confidence in your cipher, your sincerity, and it's potential commercial future.
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland
Hi Albert
Got a bit sidetracked myself.
I started on a parser, but soon got back to the string search and select case, which is what they all do, so it would most likely be as slow as the rest.
The data types string and double are so far removed in a compiler. The older interpreters have eval (BBC basic) and val(ZX80) inbuilt to parse expressions.
I've tried two identical exe files running each other, binary files, no sucess yet.

I don't think that I would like to work for Richard's outfit.
AU\$25k upfront smacks of a con job, and a group of trusted mathematicians? .
One can only wonder.
There was a program on telly a few days ago about "Fritz", Eddy Chapman, a double agent during WW2.
He was a London underworld guy who got a job in the German army as a spy.
He was sent to blow up a factory in London, but getting back home, he got himself a job as a British spy, so he ended up a double agent.
He saved countless British lives, he assisted the British cryptoligists in the Bletchley labs, not by any mathematical skills, but by sending out half cryptic messages to entice the Germans to respond over the airwaves.
On one occasion, while back in London, he got involved in some racing dog scam (during the war), and some Toffy nosed British Officer pulled him up and reprimanded him, Fritz told him to p*** off, and that he was in the German army, and not the British.

I'd feel much more comfortable in Fritz's camp than Richards, I think that you would also Albert.
albert
Posts: 5635
Joined: Sep 28, 2006 2:41
Location: California, USA
@Dodicat

I fixed the "Load Cypher" button sub..It was hangin up on the EOF chr or something...
So i set it to GET #1,,char upto filelength-2.. I worked with that..

Originally i had it set to " LINE INPUT #1 , FileData "

Now you can load any file i think...and then either cypher or decypher it.

I'm thinking about putting the config insize/outsize into the key, after testing it with several configurations, its hard to remember which key goes with what output.

Maybe creating a directory heirarchy on a memory stick. of key types
1-1 , to 256-4
albert
Posts: 5635
Joined: Sep 28, 2006 2:41
Location: California, USA
@Dodicat

It seems to load a *.exe you need to input WCHR( ubyte filepos ).

Are *.EXE's generated to be Unicode format ??
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland
albert wrote:@Dodicat

It seems to load a *.exe you need to input WCHR( ubyte filepos ).

Are *.EXE's generated to be Unicode format ??

I'm not sure Albert.
But hey, got a bit of an eval with unicode going here:

Code: Select all

`#define UNICODE#include Once "disphelper/disphelper.bi"Dim Shared As IDISPATCH Ptr VBS'________________________________Sub Load_VBS() Constructor    dhInitialize(TRUE)    dhToggleExceptions(TRUE)    dhCreateObject "MSScriptControl.ScriptControl",NULL,@VBS    dhPutValue VBS,".Language %s","VBScript"End SubSub UnLoad_VBS() Destructor    SAFE_RELEASE(VBS)    dhUninitialize TrueEnd SubFunction eval(s As String) As String    Dim value As Zstring Ptr    dhGetValue "%s",@value,VBS,".Eval %s",s    Return *valueEnd FunctionPrint eval("sin(.5)*cos(-3)+tan(.008)+atn(4/3)")Print Sin(.5)*Cos(-3)+Tan(.008)+Atn(4/3)Sleep`