Squares

General FreeBASIC programming questions.
Richard
Posts: 2999
Joined: Jan 15, 2007 20:44
Location: Australia

Postby Richard » Nov 13, 2011 22:28

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 t
End Function

'---------------------------------------------------------------------------
' exercise atn2
Dim As Double x, y, theta
Print "    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; y
Next theta
Print atn2(+1e-8, +1e-8)
Print atn2(-1e-8, -1e-8)

'---------------------------------------------------------------------------
Sleep
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Nov 14, 2011 0:50

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 t
End Function

function 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

Postby albert » Nov 14, 2011 19:14

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

Postby dodicat » Nov 14, 2011 22:51

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 col
end 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),,b
end sub


dim as double looper, starthere,endhere,stepper
starthere=2980.4
endhere=-456.22
stepper=-.007
screen 19,32
dim as integer percentage
dim  as bar b
b=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 looper
print "DONE"
sleep

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

Postby albert » Nov 15, 2011 0:18

@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

Postby dafhi » Nov 15, 2011 1:17

@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

Postby albert » Nov 15, 2011 2:20

@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 string
declare function eval_funct(byval funct as string) as ubyte
declare function prep_formula(byval eq as string) as string
declare sub Prep_Array( byval eq as string)

redim shared as string function_array(1)

'===============================================================================
'test functions
'===============================================================================
dim as string eq
eq = "(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)
print
print eq

eq = filter_spaces(eq)'must call filter_spaces() to remove white_space.
eq = prep_formula(eq) 'must call prep_formula before using the formula

print
print eq
print

Prep_Array(eq)
print string(80,"=");

for a as integer = lbound(function_array(0)) to ubound(function_array(0)) step 1
    print function_array(a)
next

SLEEP
END

'===============================================================================
'===============================================================================
'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 eq
end 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 eq

end 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

Postby dodicat » Nov 15, 2011 12:03

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_space
dim l as integer=len(s)
dim px as double=16+x
dim py as double=y
dim z as integer=0
dim 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)
#endmacro
for 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_space
case else
    draw string image,(px,py),mid$(s,n,1),c
    spaces(char_space)
end select
next n
end sub

screen 19,32
dim s as string="Next line"
'  | in the string flips to a new line
drawstring(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

Postby dafhi » Nov 15, 2011 20:38

@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.

[EDIT] had a look. Loving the elegance of your snippets.
albert
Posts: 5635
Joined: Sep 28, 2006 2:41
Location: California, USA

Postby albert » Nov 19, 2011 5:55

@Dodicat

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

I made it user adjustable so you don't need all three..
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

Postby Richard » Nov 19, 2011 7:24

@ 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

Postby dodicat » Nov 19, 2011 11:18

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.
Good luck with your venture.
albert
Posts: 5635
Joined: Sep 28, 2006 2:41
Location: California, USA

Postby albert » Nov 19, 2011 20:35

@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

Postby albert » Nov 19, 2011 23:30

@Dodicat

I'm having problems loading different FileTypes *.EXE etc...

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

Postby dodicat » Nov 20, 2011 0:40

albert wrote:@Dodicat

I'm having problems loading different FileTypes *.EXE etc...

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 Sub

Sub UnLoad_VBS() Destructor
    SAFE_RELEASE(VBS)
    dhUninitialize True
End Sub
Function eval(s As String) As String
    Dim value As Zstring Ptr
    dhGetValue "%s",@value,VBS,".Eval %s",s
    Return *value
End Function

Print eval("sin(.5)*cos(-3)+tan(.008)+atn(4/3)")
Print Sin(.5)*Cos(-3)+Tan(.008)+Atn(4/3)
Sleep

Return to “General”

Who is online

Users browsing this forum: No registered users and 1 guest