## Squares

General FreeBASIC programming questions.
dodicat
Posts: 5891
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

I am inspired to simulate.
Note that colour as double works quite well.(First time I have tried it)
Some boxes are filled.

Code: Select all

`Dim Shared As Long lim=50Dim Shared As Long copy 'for the graphical destructorcopy=limDim As Ulong black=Rgb(0,0,0),white=Rgb(255,255,255)Screen 19,32,,64Dim Shared As Integer xres,yresScreeninfo xres,yresType box    As Double Ptr p =New Double[8]             'all the spatial information    Declare Sub move                           'advance    Declare Sub Draw()                         'drawing method    Declare Destructor                         'Goodbye, thanks for the memoryEnd TypeSub box.draw()    If p[5] Then Line(p[0],p[1])-(p[0]+p[2],p[1]+p[3]),p[4],bf Else _    Line(p[0],p[1])-(p[0]+p[2],p[1]+p[3]),p[4],bEnd SubSub box.move    p[0]+=p[6]    p[1]+=p[7]    If p[0]<0 Or p[0]>xres-p[2] Then p[6]=-p[6]    If p[1]<0 Or p[1]>yres-p[3] Then p[7]=-p[7]End SubDestructor boxlim-=1#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)Var x=map(copy,0,lim,100,700)Var y=map(100,700,x,100,500)Circle(x,y),20,Rgb(200,0,0),,,,fCircle(x,600-y),20,Rgb(200,0,0),,,,fsleep 10Delete [] pEnd Destructor#define range(f,l) Int(Rnd*((l+1)-(f))+(f))Dim As box b(1 To lim)randomize 1'set upFor n As Long=1 To lim    With b(n)        If n=1 Then .p[0]=0 Else .p[0]=range(100,700)           'x        If n=1 Then .p[1]=0 Else .p[1]=range(100,500)           'y        If n=1 Then .p[2]=xres Else .p[2]=10+Rnd*80             'width        If n=1 Then .p[3]=yres Else .p[3]=10+Rnd*80             'height        If n=1 Then .p[4]=Rgba(0,0,0,1) Else .p[4]=Rnd*range(black,white)         If n=1 Then .p[5]=1 else.p[5]=iif(rnd>.5,1,0)            'filler                    .p[6]=iif(rnd>.5,.2,-.2)                     'dx                    .p[7]=iif(rnd>.5,.2,-.2)                     'dy    End WithNext nDo    Screenlock    For n As Long=1 To lim        With b(n)  'b(1) is the fader            .move            .draw        End With    Next    Screenunlock    Sleep 1,1Loop Until Inkey=Chr(27)  `
Posts: 1417
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Squares

I was actually working on collision detection, but got distracted. Working on it now...
dodicat wrote:Note that colour as double works quite well.(First time I have tried it)
Hmm, I have to check that...
dodicat
Posts: 5891
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

Yes, tested double over 10 million colours.

Code: Select all

`for n as long=1 to 10000000    dim as ulong u=rgba(rnd*255,rnd*255,rnd*255,rnd*255)    dim as double d=u    if d<> u then print dnextprint "done"   `

Although single is 4 bytes (same as ulong), it fails.
Posts: 1417
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Squares

Your code is certainly more compact, but all the p[..] from the topic "how many rectangles can I squeeze in a bit" makes it hard to read.
dafhi
Posts: 1241
Joined: Jun 04, 2005 9:51

### Re: Squares

this part is intiguing though. not sure how to incorporate it

Code: Select all

`Type box    As Double Ptr p =New Double[8]             'all the spatial information    Declare Sub move                           'advance    Declare Sub Draw()                         'drawing method    Declare Destructor                         'Goodbye, thanks for the memoryEnd Type`
albert
Posts: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@odicat

My new algorithm is 6 times slower than my fastest multiplier.. So its no good!!

Code: Select all

`Declare Function mul_loop_7( num1 as string , num2 as string ) as stringDeclare Function           minus(num1 as String , num2 as String) As StringDeclare Function              plus( num1 as String , num2 as String ) As Stringscreen 19dim as double time1 , time2 , time3 , time4do        dim as string num1    for a as longint = 1 to 100000        num1+= str(int(rnd*10))    next    if left(num1,1) = "0" then mid(num1,1,1) = str(int(rnd*9)+1)        dim as string num2    for a as longint = 1 to 100000        num2+= str(int(rnd*10))    next    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)        if num2 > num1 then swap num1,num2        dim as string number1 =  plus( num1 , mid(num2,2) )    dim as string number2 =  left(num2,1) + string(len(num2)-1,"0")        'dim as ulongint ans7 = ( val(number1) * val(number2) ) + ( val(num1) * val(right(num2,len(num2)-1)) ) - ( val(num2)  * val(right(num2,len(num2)-1)) ) + (val(right(num2,len(num2)-1))^2)    time1=timer        dim as string my_answer = mul_loop_7( number1 , number2 )         my_answer = plus( my_answer , mul_loop_7( num1 , right(num2 , len(num2)-1)) )        my_answer = minus( my_answer , mul_loop_7( num2 , right(num2 , len(num2)-1)) )        my_answer = plus( my_answer , mul_loop_7( right(num2,len(num2)-1) , right(num2,len(num2)-1) ) )    time2 = timer        time3 = timer        dim as string answer = mul_loop_7( num1,num2)    time4 = timer        dim as string difference = minus( answer , my_answer)        print    print "n1  = " ; num1    print "n2  = " ; num2    print    print "ans   = " ; val(num1) * val(num2)    print "answer = " ; answer    print "my ans = " ; my_answer    'print "ans    = " ; ans7    print    print "difference = " ; difference    print    print "time new algorithm = " ; time2-time1    print "time mul_loop_7    = " ; time4-time3        sleep        if inkey = chr(27) then exit do    loopsleepend'==============================================================================='==============================================================================='==============================================================================='===============================================================================function mul_loop_7( num1 as string , num2 as string ) as string       dim as string number1 = num1    dim as string number2 = num2       'make numbers equal multiple of 7 bytes    dim as string str1    dim as longint dec1    do        str1 = str(len(number1)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number1 = "0" + number1    loop until dec1 = 0    do        str1 = str(len(number2)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number2 = "0" + number2    loop until dec1 = 0           'convert the numeric strings to use pointers    'convert number1    dim as string n1 = string(len(number1)*8,chr(0))    dim as ulongint ptr ulp1 = cptr(ulongint ptr,strptr(n1))    dim as longint valu1    dim as longint len_1 = 0    for a as longint = 0 to len(number1)-1 step 7        valu1  = (number1[a     ]-48)*1e6        valu1+= (number1[a+1]-48)*1e5        valu1+= (number1[a+2]-48)*1e4        valu1+= (number1[a+3]-48)*1e3        valu1+= (number1[a+4]-48)*1e2        valu1+= (number1[a+5]-48)*1e1        valu1+= (number1[a+6]-48)'*1        *ulp1 = valu1        ulp1+=1        len_1+=8    next    number1 = left(n1,len_1)    n1=""       'convert the numeric strings to use pointers    'convert number2    dim as string n2 = string(len(number2)*8,chr(0))    dim as ulongint ptr ulp2 = cptr(ulongint ptr,strptr(n2))    dim as longint valu2    dim as longint len_2 = 0    for a as longint = 0 to len(number2)-1 step 7        valu2 =  (number2[a     ]-48)*1e6        valu2+= (number2[a+1]-48)*1e5        valu2+= (number2[a+2]-48)*1e4        valu2+= (number2[a+3]-48)*1e3        valu2+= (number2[a+4]-48)*1e2        valu2+= (number2[a+5]-48)*1e1        valu2+= (number2[a+6]-48)'*1        *ulp2 = valu2        ulp2+=1        len_2+=8    next    number2 = left(n2,len_2)    n2=""       'create accumulator    dim as string answer = string( len(number1) + len(number2) , chr(0) )    dim as ulongint outblocks = ( len(answer) \ 8 )    dim as ulongint ptr outplace = cptr(ulongint ptr , strptr(answer)) + (outblocks - 1 )    dim as ulongint stops = ( (len(number1)\8) + (len(number2)\8) )    dim as ulongint value = 0    dim as longint hold = -1    dim as longint locat = 0    dim as longint vals = 0    dim as ulongint high1 = ( len(number1)  \ 8 ) - 1    dim as ulongint high2 = ( len(number2)  \ 8 ) - 1    dim as longint ptr num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1    dim as longint ptr num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2    do        hold+=1        vals = hold        locat = 0        if vals > high2 then vals = high2 : locat = (hold - high2)        num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1 - locat        num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2 - vals        do            value+= *( num1_ptr ) * *( num2_ptr )            num1_ptr-=1            num2_ptr+=1            if num1_ptr = cptr( ulongint ptr , strptr(number1) ) - 1 then goto done            if num2_ptr > cptr( ulongint ptr , strptr(number2) ) + high2  then goto done        loop        Done:        *outplace = value mod 1e7         outplace-= 1         value = value \ 1e7    loop until hold = stops-2        *outplace = value mod 1e7           'convert answer back to ascii   dim as string outtext=""   outplace = cptr( ulongint ptr , strptr(answer) )   for a as ulongint = 1 to outblocks step 1       value = *outplace       outplace+=1       outtext+= right("0000000" + str(value),7)    next         outtext = ltrim(outtext,"0")      return outtext   end function'==============================================================================='==============================================================================='Dodicats plus & Minus functions'==============================================================================='===============================================================================    Function plus(_num1 As String,_num2 As String) As String        Dim  ADDQmod(0 To 19) As Ubyte        Dim  ADDbool(0 To 19) As Ubyte        For z As Integer=0 To 19            ADDQmod(z)=(z Mod 10+48)            ADDbool(z)=(-(10<=z))        Next z        Var _flag=0,n_=0        Dim As Ubyte addup=Any,addcarry=Any        #macro finish()        answer=Ltrim(answer,"0")        If _flag=1 Then Swap _num2,_num1        Return answer        #endmacro        If Len(_num2)>Len(_num1) Then            Swap _num2,_num1            _flag=1        End If        Var diff=Len(_num1)-Len(_num2)        Var answer="0"+_num1        addcarry=0        For n_=Len(_num1)-1 To diff Step -1            addup=_num2[n_-diff]+_num1[n_]-96            answer[n_+1]=ADDQmod(addup+addcarry)            addcarry=ADDbool(addup+addcarry)        Next n_        If addcarry=0 Then            finish()        End If        If n_=-1 Then            answer[0]=addcarry+48            finish()            Endif            For n_=n_ To 0 Step -1                addup=_num1[n_]-48                answer[n_+1]=ADDQmod(addup+addcarry)                addcarry=ADDbool(addup+addcarry)                If addcarry=0 Then Exit For            Next n_            answer[0]=addcarry+48            finish()        End Function'==============================================================================='===============================================================================Function minus(NUM1 As String,NUM2 As String) As String     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2    Dim As Byte swapflag               Dim As Long lenf,lens    Dim sign As String * 1    'Dim As String part1,part2    Dim bigger As Byte     'set up tables    Dim As Ubyte Qmod(0 To 19)    Dim bool(0 To 19) As Ubyte    For z As Integer=0 To 19        Qmod(z)=cubyte(z Mod 10+48)        bool(z)=cubyte(-(10>z))    Next z    lenf=Len(NUM1)    lens=Len(NUM2)    #macro compare(numbers)        If Lens>lenf Then bigger= -1:Goto fin        If Lens<lenf Then bigger =0:Goto fin        If NUM2>NUM1 Then            bigger=-1        Else            bigger= 0        End If        fin:    #endmacro    compare(numbers)    If bigger Then        sign="-"        Swap NUM2,NUM1        Swap lens,lenf        swapflag=1    Endif    'lenf=Len(NUM1)    'lens=Len(NUM2)    Dim diff As Long=lenf-lens-Sgn(lenf-lens)    Dim As String one,two,three    three=NUM1    two=String(lenf-lens,"0")+NUM2    one=NUM1    Dim As Long n2    Dim As Ubyte takeaway,subtractcarry    Dim As Ubyte ten=10    'Dim z As Long    subtractcarry=0    Do         For n2=lenf-1 To diff Step -1           takeaway= one[n2]-two[n2]+ten-subtractcarry           three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n2        If subtractcarry=0 Then Exit Do        If n2=-1 Then Exit Do        For n2=n2 To 0 Step -1            takeaway= one[n2]-two[n2]+ten-subtractcarry            three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)            Next n2        Exit Do    Loop       three=Ltrim(three,"0")    If three="" Then Return "0"    If swapflag=1 Then Swap NUM1,NUM2       Return sign+three   End Function'==============================================================================='===============================================================================`
srvaldez
Posts: 2019
Joined: Sep 25, 2005 21:54

### The Mechanical Universe

I really enjoyed this series of videos broadcasted in USA by PBS, it's a nice mix of history, science and fun animations, you can watch the 52 episodes on youtube https://www.youtube.com/playlist?list=P ... dk-XGtA5cZ
“The Mechanical Universe,” is a critically-acclaimed series of 52 thirty-minute videos covering the basic topics of an introductory university physics course.

Each program in the series opens and closes with Caltech Professor David Goodstein providing philosophical, historical and often humorous insight into the subject at hand while lecturing to his freshman physics class. The series contains hundreds of computer animation segments, created by Dr. James F. Blinn, as the primary tool of instruction. Dynamic location footage and historical re-creations are also used to stress the fact that science is a human endeavor.

The series was originally produced as a broadcast telecourse in 1985 by Caltech and Intelecom, Inc. with program funding from the Annenberg/CPB Project.

The online version of "The Mechanical Universe" is sponsored by the Information Science and Technology initiative at Caltech. http://ist.caltech.edu
dodicat
Posts: 5891
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: five cubes in squares.

doodle.
Another 30 squares injected.

Code: Select all

` Type Point    As Single x,y,z    Declare Static Function rotate(As Point,As Point,As Point,As Point=Type<Point>(1,1,1)) As Point    Declare Static Function perspective(As Point,As Point=Type(400,300,900)) As PointEnd TypeFunction dot(v1 As Point,v2 As Point) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)    Dim As Single d1=Sqr(v1.x*v1.x + v1.y*v1.y+ v1.z*v1.z),d2=Sqr(v2.x*v2.x + v2.y*v2.y +v2.z*v2.z)    Dim As Single v1x=v1.x/d1,v1y=v1.y/d1,v1z=v1.z/d1 'normalize    Dim As Single v2x=v2.x/d2,v2y=v2.y/d2,v2z=v2.z/d2 'normalize    Return (v1x*v2x+v1y*v2y+v1z*v2z) End FunctionFunction point.Rotate(c As Point,p As Point,angle As Point,scale As Point) As Point    Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)    Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z    Return Type<Point>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_    (scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_    (scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z)',p.col)End FunctionFunction point.perspective(p As Point,eyepoint As Point) As Point    Dim As Single   w=1+(p.z/eyepoint.z)    Return Type<Point>((p.x-eyepoint.x)/w+eyepoint.x,_    (p.y-eyepoint.y)/w+eyepoint.y,_    (p.z-eyepoint.z)/w+eyepoint.z)End Function  Type plane    As Point p(1 To 4)    Declare Sub Draw(As Ulong)    Declare Static Sub fill(() As Point,As Ulong,As Long,As Long)End TypeSub plane.fill(a() As Point, c As Ulong,min As Long,max As Long)    'translation of a c snippet    Static As Long i,j,k,dy,dx, x,y,temp    Static As Long NewX (1 To Ubound(a))    Static As Single Grad(1 To Ubound(a))    For i=1 To Ubound(a) - 1         dy=a(i+1).y-a(i).y        dx=a(i+1).x-a(i).x        If(dy=0) Then Grad(i)=1        If(dx=0) Then Grad(i)=0        If ((dy <> 0) And (dx <> 0)) Then            Grad(i) = dx/dy        End If    Next i    For y=min To max        k = 1        For i=1 To Ubound(a) - 1            If( ((a(i).y<=y) Andalso (a(i+1).y>y)) Or ((a(i).y>y) _            Andalso (a(i+1).y<=y))) Then            NewX(k)= Int(a(i).x+ Grad(i)*(y-a(i).y))            k +=1        End If    Next i    For j = 1 To k-2        For i = 1 To k-2            If NewX(i) > NewX(i+1) Then                temp = NewX(i)                NewX(i) = NewX(i+1)                NewX(i+1) = temp            End If        Next i    Next j    For i = 1 To k - 2 Step 2        Line (NewX(i),y)-(NewX(i+1)+1,y), c    Next iNext yEnd SubSub plane.draw(clr As Ulong )    Static As Single miny=1e6,maxy=-1e6    Static As Point V1(1 To  Ubound(p)+1)    Dim As Long n    For n =1 To Ubound(p)        If miny>p(n).y Then miny=p(n).y        If maxy<p(n).y Then maxy=p(n).y        V1(n)=p(n)     Next    v1(Ubound(v1))=p(Lbound(p))    plane.fill(v1(),clr,miny,maxy)End SubType cube    As plane f(1 To 6)    As Point centre    As Point norm(1 To 6) 'normals    As Ulong clr(1 To 6)    As Point aspect    As Point d 'increment speed    Declare Constructor()    Declare Sub translate(v As Point,s As Double)    Declare Sub turn(As Point)    Declare Function rotate(As Point,As Point) As cube    Declare Static Sub bsort(() As cube)    Declare Sub DrawEnd TypeConstructor cube()Dim As Double pi=4*Atn(1)Static As Point g(1 To ...,1 To ...)={{(-1,-1,-1),(1,-1,-1),(1,1,-1),(-1,1,-1)},_'front                                     {(1,-1,-1),(1,-1,1),(1,1,1),(1,1,-1)},_ 'right                                     {(-1,-1,1),(1,-1,1),(1,1,1),(-1,1,1)},_'back                                     {(-1,-1,-1),(-1,-1,1),(-1,1,1),(-1,1,-1)},_'left                                     {(1,1,-1),(1,1,1),(-1,1,1),(-1,1,-1)},_'top                                     {(1,-1,-1),(1,-1,1),(-1,-1,1),(-1,-1,-1)}}'baseFor n As Long=1 To 6    clr(n)=Rgb(Rnd*255,Rnd*255,Rnd*255) 'set a default colour    For m As Long=1 To 4        f(n).p(m)= g(n,m)  'set to g()     Next mNext nnorm(1)=Type(0,0,-1) 'face normalsnorm(2)=Type(1,0,0)norm(3)=Type(0,0,1)norm(4)=Type(-1,0,0)norm(5)=Type(0,1,0)norm(6)=Type(0,-1,0)centre=Type(0,0,0)'set some defaultsaspect=Type(Rnd*2*pi,Rnd*2*pi,Rnd*2*pi) For n As Long=1 To 6    norm(n)=point.rotate(centre,norm(n),aspect)    For m As Long=1 To 4        f(n).p(m)=point.rotate(centre,f(n).p(m),aspect)    NextNextd.x=(Rnd-Rnd)/50d.y=(Rnd-Rnd)/50d.z=(Rnd-Rnd)/50End ConstructorSub cube.turn(p As Point)    Dim As cube tmp=This    For n As Long=1 To 6        For m As Long=1 To 4            tmp.f(n).p(m)=point.rotate(centre,this.f(n).p(m),p)            tmp.f(n).p(m)=point.perspective(tmp.f(n).p(m))        Next    Next    For n As Long=1 To 6        tmp.norm(n)=point.rotate(centre,this.norm(n),p)'normals turn also    Next    tmp.drawEnd SubFunction cube.rotate(c As Point,ang As Point) As cube    Dim As cube tmp=This    For n As Long=1 To 6        For m As Long=1 To 4            tmp.f(n).p(m)=point.rotate(c,this.f(n).p(m),ang)        Next    Next    For n As Long=1 To 6        tmp.norm(n)=point.rotate(c,this.norm(n),ang)    Next    tmp.centre=point.rotate(c,this.centre,ang)    Return tmpEnd FunctionSub cube.translate(v As Point,s As Double)    For n As Long=1 To 6        norm(n).x*=s        norm(n).y*=s        norm(n).z*=s        For m As Long=1 To 4            f(n).p(m).x*=s            f(n).p(m).y*=s            f(n).p(m).z*=s        Next m    Next n    For n As Long=1 To 6        norm(n).x=norm(n).x+v.x        norm(n).y=norm(n).y+v.y        norm(n).z=norm(n).z+v.z        For m As Long=1 To 4            f(n).p(m).x= f(n).p(m).x+v.x             f(n).p(m).y= f(n).p(m).y+v.y            f(n).p(m).z= f(n).p(m).z+v.z        Next m    Next n    centre.x+=v.x    centre.y+=v.y    centre.z+=v.zEnd SubSub cube.draw    Static As Ubyte Ptr col    For n As Long=1 To 5        For m As Long=n+1 To 6            If norm(n).z<norm(m).z Then                Swap f(n),f(m)                Swap norm(n),norm(m)                Swap clr(n),clr(m)            End If        Next m    Next n   #define map_(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)    For n As Long=1 To 6          col=Cptr(Ubyte Ptr,@clr(n))      Var cx=norm(n).x-centre.x,cy=norm(n).y-centre.y,cz=norm(n).z-centre.z      Var dt=dot(Type(cx,cy,cz),Type(0,1,0))      dt=map_(1,-1,dt,.3,1)        f(n).draw(Rgb(dt*col[2],dt*col[1],dt*col[0]))    Next nEnd SubSub cube.bsort(c() As cube)    For n As Long=Lbound(c) To Ubound(c)-1        For m As Long=n+1 To Ubound(c)            If c(n).centre.z<c(m).centre.z Then Swap c(n),c(m)        Next    NextEnd SubFunction Regulate(Byval MyFps As Long,Byref fps As Long) As Long    Static As Double timervalue,lastsleeptime,t3,frames    Var t=Timer    frames+=1    If (t-t3)>=1 Then t3=t:fps=frames:frames=0    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000    If sleeptime<1 Then sleeptime=1    lastsleeptime=sleeptime    timervalue=T    Return sleeptimeEnd FunctionDim As cube c(1 To 5)c(1).translate(Type(200,100,0),40)c(2).translate(Type(600,100,0),40)c(3).translate(Type(600,500,0),40)c(4).translate(Type(200,500,0),40)c(5).translate(Type(400,300,0),80)Dim As Double pi2=8*Atn(1)Dim As Double pi=4*Atn(1) For n As Long=Lbound(c) To Ubound(c)         c(n)=c(n).rotate(Type(400,300,0),Type(0,pi/2,0))'flip 90         NextDim As cube tmp(Lbound(c) To Ubound(c))Dim As Point a'fix y and za.y=-pi/7a.z=pi/2Dim As Long fpsScreen 19,32Color ,Rgb(0,0,100)#define fmod(x,y) y*frac(x/y)Do    Screenlock    Cls    a.x+=.01:a.x=fmod(a.x,pi2)    Draw String (20,20),"FPS = " &fps    For n As Long=Lbound(c) To Ubound(c)        tmp(n)=c(n).rotate(Type(400,300,0),a)    Next    cube.bsort(tmp())    For n As Long=Lbound(tmp) To Ubound(tmp)        c(n).aspect.x+=c(n).d.x: c(n).aspect.x=fmod(c(n).aspect.x,pi2)'turning angles        c(n).aspect.y+=c(n).d.y: c(n).aspect.y=fmod(c(n).aspect.y,pi2)        c(n).aspect.z+=c(n).d.z: c(n).aspect.z=fmod(c(n).aspect.z,pi2)        tmp(n).turn(Type(tmp(n).aspect.x,tmp(n).aspect.y,tmp(n).aspect.z))    Next    Screenunlock    Sleep regulate(90,fps),1Loop Until Inkey=Chr(27)Sleep   `
Posts: 1417
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: five cubes in squares.

dodicat wrote:doodle.
Another 30 squares injected.

Cool, I do see some artefacts. Short horizontal lines in the wrong place, sometimes.
dodicat
Posts: 5891
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: pseudo polymorphism

The methods in the code can handle three different shapes.
cube, tetrahedron and square (plate).

I did have a try at oop polymorphism for this but got bogged down.
Most of examples of polymorphism have little methods/constructors e.t.c. which say "hello I am here".
But I got bogged down actually doing a real task in each, so I gave up.
anyway:

Code: Select all

`'======  globals ====type temp as point ptr 'advance noticeConst pi=4*Atn(1)dim shared lightsource as tempDim Shared As integer xres,yresScreen 20,32,,64  'or 19 or 17Color Rgb(0,200,0),Rgb(0,0,55)Screeninfo xres,yres'====================Enum    cube    tetra    squareEnd EnumType Point    As Single x,y,z    Declare Static Function rotate(As Point,As Point,As Point,As Point=Type<Point>(1,1,1)) As Point    Declare Static Function perspective(As Point,As Point=Type(xres\2,yres\2,1000)) As Point    Declare Function dot(As Point) As Single    declare sub normalize()End TypeFunction point.dot(v2 As Point) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)    Dim As Single d1=Sqr(x*x + y*y+ z*z),d2=Sqr(v2.x*v2.x + v2.y*v2.y +v2.z*v2.z)    Dim As Single v1x=x/d1,v1y=y/d1,v1z=z/d1 'normalize    Dim As Single v2x=v2.x/d2,v2y=v2.y/d2,v2z=v2.z/d2 'normalize    Return (v1x*v2x+v1y*v2y+v1z*v2z) End FunctionFunction point.Rotate(c As Point,p As Point,angle As Point,scale As Point) As Point    Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)    Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z    Return Type<Point>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_    (scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_    (scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z)',p.col)End FunctionFunction point.perspective(p As Point,eyepoint As Point) As Point    Dim As Single   w=1+(p.z/eyepoint.z)    Return Type<Point>((p.x-eyepoint.x)/w+eyepoint.x,_    (p.y-eyepoint.y)/w+eyepoint.y,_    (p.z-eyepoint.z)/w+eyepoint.z)End Function  Type plane    As Point p(Any)    Declare Sub Draw(As Ulong)    Declare Static Sub fill(() As Point,As Ulong,As Long,As Long)End TypeSub plane.fill(a() As Point, c As Ulong,min As Long,max As Long)    Static As Long i,j,k,dy,dx, x,y    Static As Long NewX (1 To Ubound(a))    Static As Single Grad(1 To Ubound(a))    For i=1 To Ubound(a) - 1         dy=a(i+1).y-a(i).y        dx=a(i+1).x-a(i).x        If(dy=0) Then Grad(i)=1        If(dx=0) Then Grad(i)=0        If ((dy <> 0) And (dx <> 0)) Then            Grad(i) = dx/dy        End If    Next i    For y=min To max        k = 1        For i=1 To Ubound(a) - 1            If( ((a(i).y<=y) Andalso (a(i+1).y>y)) Or ((a(i).y>y) _            Andalso (a(i+1).y<=y))) Then            NewX(k)= Int(a(i).x+ Grad(i)*(y-a(i).y))            k +=1        End If    Next i    For j = 1 To k-2        For i = 1 To k-2            If NewX(i) > NewX(i+1) Then Swap  NewX(i),NewX(i+1)        Next i    Next j    For i = 1 To k - 2 Step 2        Line (NewX(i),y)-(NewX(i+1)+1,y), c    Next iNext yEnd SubSub plane.draw(clr As Ulong )    Static As Long miny=1e6,maxy=-1e6    Redim As Point V1(1 To  Ubound(p)+1)    Dim As Long n    For n =1 To Ubound(p)        If miny>p(n).y Then miny=p(n).y        If maxy<p(n).y Then maxy=p(n).y        V1(n)=p(n)     Next    v1(Ubound(v1))=p(Lbound(p))    plane.fill(v1(),clr,miny,maxy)End SubType shape    As plane f(Any) 'faces    As Point centre    As Point norm(Any) 'normals    As Ulong clr(Any)    As Point aspect    As Point d 'increment speed    Declare Sub Construct(As Long)    Declare Sub translate(v As Point,s As Double)    Declare Sub turn(As Point) 'turn about it's centroid    Declare Function rotate(As Point,As Point) As shape 'roatate about a chosen point    Declare Static Sub bsort(() As shape)'bubblesort (fast enough for a small number of things)    Declare Sub DrawEnd TypeSub shape.construct(flag As Long)    Static As Point g(1 To ...,1 To ...)= _  'cube    {{(-1,-1,-1),(1,-1,-1),(1,1,-1),(-1,1,-1)},_'front    {(1,-1,-1),(1,-1,1),(1,1,1),(1,1,-1)},_ 'right    {(-1,-1,1),(1,-1,1),(1,1,1),(-1,1,1)},_'back    {(-1,-1,-1),(-1,-1,1),(-1,1,1),(-1,1,-1)},_'left    {(1,1,-1),(1,1,1),(-1,1,1),(-1,1,-1)},_   'top    {(1,-1,-1),(1,-1,1),(-1,-1,1),(-1,-1,-1)}}'base        Static As Point t(1 To ...,1 To ...)= _   'tetra                                                 {{(-1,-1/Sqr(3),-1/Sqr(6)),(1,-1/Sqr(3),-1/Sqr(6)),(0,2/Sqr(3),-1/Sqr(6))}, _ 'b    {(-1,-1/Sqr(3),-1/Sqr(6)),(1,-1/Sqr(3),-1/Sqr(6)),(0,0,3/Sqr(6))},_           'f    {(1,-1/Sqr(3),-1/Sqr(6)),(0,2/Sqr(3),-1/Sqr(6)),(0,0,3/Sqr(6))}, _            'r    {(-1,-1/Sqr(3),-1/Sqr(6)),(0,2/Sqr(3),-1/Sqr(6)),(0,0,3/Sqr(6))}}             'l          Static As Point s(1 To ...,1 To ...)= _  'square    {{(-1,-1,0),(1,-1,0),(1,1,0),(-1,1,0)}}  '==================   seperate the three shapes  =============      If flag=cube Then        Redim f(1 To 6)        Redim norm(1 To 6)        Redim clr(1 To 6)        For n As Long=1 To 6            Redim (f(n).p)(1 To 4)'faces vertices        Next        norm(1)=Type(0,0,-1) 'face normals to cube        norm(2)=Type(1,0,0)        norm(3)=Type(0,0,1)        norm(4)=Type(-1,0,0)        norm(5)=Type(0,1,0)        norm(6)=Type(0,-1,0)        centre=Type(0,0,0)    End If        If flag=tetra Then        Redim f(1 To 4)        Redim norm(1 To 4)        Redim clr(1 To 4)        For n As Long=1 To 4            Redim (f(n).p)(1 To 3)'faces vertices        Next        norm(1)=Type(0, 0,-0.4082483) 'normals to tetra faces        norm(2)=Type(0,-0.3849002, 0.1360828)        norm(3)=Type(0.3333333, 0.1924501, 0.1360828)        norm(4)=Type(-0.3333333, 0.1924501, 0.1360828)        centre=Type(0,0,0)    End If        If flag=square Then        Redim f(1 To 1)        Redim norm(1 To 1)        Redim clr(1 To 1)        For n As Long=1 To Ubound(f)            Redim (f(n).p)(1 To 4)'        Next         norm(1)=Type(0,0,1)        centre=Type(0,0,0)    End If        For n As Long=1 To Ubound(f)        clr(n)=Rgb(Rnd*255,Rnd*255,Rnd*255) 'set a default colour        For m As Long=1 To Ubound(f(n).p)            If flag=cube Then f(n).p(m)= g(n,m)   'set to g()             If flag=tetra Then f(n).p(m)= t(n,m)  'set to t()            If flag=square Then f(n).p(m)= s(n,m) 'set to s()        Next m    Next n    '======================= each shape defined =========    'set some defaults starting aspects    aspect=Type(Rnd*2*pi,Rnd*2*pi,Rnd*2*pi)     For n As Long=1 To Ubound(f)        norm(n)=point.rotate(centre,norm(n),aspect)        For m As Long=1 To Ubound(f(n).p)            f(n).p(m)=point.rotate(centre,f(n).p(m),aspect)        Next    Next    'speeds    d.x=(Rnd-Rnd)/50    d.y=(Rnd-Rnd)/50    d.z=(Rnd-Rnd)/50End SubSub shape.turn(p As Point)    Dim As shape tmp=This    For n As Long=1 To Ubound(f)        For m As Long=1 To Ubound(f(n).p)            tmp.f(n).p(m)=point.rotate(centre,this.f(n).p(m),p)            tmp.f(n).p(m)=point.perspective(tmp.f(n).p(m))        Next    Next    For n As Long=1 To Ubound(f)        tmp.norm(n)=point.rotate(centre,this.norm(n),p)'normals turn also    Next    tmp.drawEnd SubFunction shape.rotate(c As Point,ang As Point) As shape    Dim As shape tmp=This    For n As Long=1 To Ubound(f)        For m As Long=1 To Ubound(f(n).p)            tmp.f(n).p(m)=point.rotate(c,this.f(n).p(m),ang)        Next    Next    For n As Long=1 To Ubound(f)        tmp.norm(n)=point.rotate(c,this.norm(n),ang)    Next    tmp.centre=point.rotate(c,this.centre,ang)    Return tmpEnd FunctionSub shape.translate(v As Point,s As Double)    For n As Long=1 To Ubound(f)        norm(n).x*=s        norm(n).y*=s        norm(n).z*=s        For m As Long=1 To Ubound(f(n).p)            f(n).p(m).x*=s            f(n).p(m).y*=s            f(n).p(m).z*=s        Next m    Next n    For n As Long=1 To Ubound(f)        norm(n).x=norm(n).x+v.x        norm(n).y=norm(n).y+v.y        norm(n).z=norm(n).z+v.z        For m As Long=1 To Ubound(f(n).p)            f(n).p(m).x= f(n).p(m).x+v.x             f(n).p(m).y= f(n).p(m).y+v.y            f(n).p(m).z= f(n).p(m).z+v.z        Next m    Next n    centre.x+=v.x    centre.y+=v.y    centre.z+=v.zEnd SubSub shape.draw    Static As Ubyte Ptr col    For n As Long=1 To Ubound(f)-1        For m As Long=n+1 To Ubound(f)            If norm(n).z<norm(m).z Then                Swap f(n),f(m)                Swap norm(n),norm(m)                Swap clr(n),clr(m)            End If        Next m    Next n    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)    For n As Long=1 To Ubound(f)        col=Cptr(Ubyte Ptr,@clr(n))        Dim As Single cx=norm(n).x-centre.x,cy=norm(n).y-centre.y,cz=norm(n).z-centre.z        Dim As Point k=Type<Point>(cx,cy,cz)        Dim As Single dt=k.dot(*lightsource)        dt=map(1,-1,dt,.3,1)        f(n).draw(Rgba(dt*col[2],dt*col[1],dt*col[0],col[3]))    Next nEnd SubSub shape.bsort(c() As shape)    For n As Long=Lbound(c) To Ubound(c)-1        For m As Long=n+1 To Ubound(c)            If c(n).centre.z<c(m).centre.z Then Swap c(n),c(m)        Next    NextEnd SubFunction Regulate(Byval MyFps As Long,Byref fps As Long) As Long    Static As Double timervalue,lastsleeptime,t3,frames    Var t=Timer    frames+=1    If (t-t3)>=1 Then t3=t:fps=frames:frames=0    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000    If sleeptime<1 Then sleeptime=1    lastsleeptime=sleeptime    timervalue=T    Return sleeptimeEnd Function'====================  create and run ==============Randomize 10Dim As shape c(1 To 8)c(1).construct(cube)c(2).construct(cube)c(3).construct(cube)c(4).construct(cube)c(5).construct(cube)c(6).construct(tetra)c(7).construct(tetra)c(Ubound(c)).construct(square)c(Ubound(c)).clr(1)=Rgba(255,0,0,100)'set colourdim as single cx=xres\2,cy=yres\2c(1).translate(Type(cx-.5*cx,cy-.6*cy,0),cx/10) 'cubec(2).translate(Type(cx+.5*cx,cy-.6*cy,0),cx/10) 'cubec(3).translate(Type(cx+.5*cx,cy+.6*cy,0),cx/10) 'cubec(4).translate(Type(cx-.5*cx,cy+.6*cy,0),cx/10) 'cubec(5).translate(Type(cx,cy,0),cx/5)              'cubec(6).translate(Type(cx,cy-.65*cy,0),cx/10)      'tetrac(7).translate(Type(cx,cy+.65*cy,0),cx/10)      'tetrac(8).translate(Type(cx,cy+1.2*cy,0),cx/5)       'squareDim As Double pi2=2*piFor n As Long=Lbound(c) To Ubound(c)    c(n)=c(n).rotate(Type(xres\2,yres\2,0),Type(0,pi/2,0)) 'flip 90 NextDim As shape tmp(Lbound(c) To Ubound(c))Dim As Point a'fix y and za.y=-pi/9a.z=pi/2lightsource=new point*lightsource=type(0,1,0)Dim As Long fps#define fmod(x,y) y*frac(x/y)Dim As String keyDo    key=Inkey     If key=Chr(255)+"P" Then a.y-=.05   'down    If key=Chr(255)+"H" Then a.y+=.05   'up     If key=Chr(255)+"K" Then a.z-=.05   'right    If key=Chr(255)+"M" Then a.z+=.05   'left    If key=" " Then a.z=pi/2:a.y=-pi/9  'reset      Screenlock    Cls    a.x+=.01:a.x=fmod(a.x,pi2)    Draw String (20,20),"Cubes tetrahedrons and a plate. use arrow and space keys"    Draw String (20,50),"FPS = " &fps        For n As Long=Lbound(c) To Ubound(c)        tmp(n)=c(n).rotate(Type(xres\2,yres\2,0),a)    Next        shape.bsort(tmp())        For n As Long=Lbound(tmp) To Ubound(tmp)        c(n).aspect.x+=c(n).d.x: c(n).aspect.x=fmod(c(n).aspect.x,pi2)'turning angles mod 2pi        c(n).aspect.y+=c(n).d.y: c(n).aspect.y=fmod(c(n).aspect.y,pi2)        c(n).aspect.z+=c(n).d.z: c(n).aspect.z=fmod(c(n).aspect.z,pi2)        tmp(n).turn(Type(tmp(n).aspect.x,tmp(n).aspect.y,tmp(n).aspect.z))    Next    Screenunlock    Sleep regulate(90,fps),1Loop Until key=Chr(27)Sleepdelete lightsource   `
srvaldez
Posts: 2019
Joined: Sep 25, 2005 21:54

### Re: Squares

hi dodicat, here's a way to solve a sudoku game in under 60 seconds https://www.youtube.com/watch?v=zyXYzh7OmY4
dodicat
Posts: 5891
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

Thanks srvaldez.
I think he/she had done one earlier.
1 6 8 9 5 3 2 7 4
2 5 9 4 7 6 1 8 3
7 4 3 1 2 8 6 9 5
9 1 7 8 4 2 3 5 6
8 2 6 3 9 5 4 1 7
5 3 4 7 6 1 8 2 9
3 7 2 6 8 9 5 4 1
4 8 1 5 3 7 9 6 2
6 9 5 2 1 4 7 3 8
Richard
Posts: 2948
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@ Albert.
Here are new Pack() and Unpack() routines that convert between ASCII strings of decimal digits and packed binary data in arrays of Ulong. They convert data in blocks of 9 digits, so are a bit faster than the earlier versions.

There are some strange exceptions during the Unpack where expansion is handled by using the 64 bit HiLo as a carry. That was interesting code to write as it can generate a compound carry.

I allocate at least one extra leading zero array element because it was needed during debugging and does not slow things down.

I tried indexing the arrays through pointers, but there is little to gain since the inner loop multiply-accumulate dominates during the conversion. It could be twice the speed in assembly code, but it would then not cross platforms. Who needs speed anyway.

Code: Select all

`'=======================================================================' Convert between ASCII decimal strings and packed 32 bit integer arrays'=======================================================================Declare Sub pack( Byref ascii As String, pk() As Ulong )    ' ASCII decimal to Ulong binaryDeclare Sub unpack( pk() As Ulong, Byref ascii As String )  ' Ulong binary to ASCII decimal' following routines are used during testing olyDeclare Sub hex_dump(  b() As Ulong )                        ' hexdump Ulong binary arrayDeclare Sub hex_load( Byref hext As String, b() As Ulong )   ' Hex string into binary arrayDeclare Function random_digits( Byval n As Integer ) As String  ' make random decimal test string'=======================================================================' On 2012 technology ...  "<\$fbc>" -exx -w pedantic "<\$file>"'   decimal ascii,     pack         unpack'-----------------------------------------------'       10 digits,   2.40 usec,   8.10 usec'       30 digits,   2.70 usec,   9.30 usec'      100 digits,   4.80 usec,   19.0 usec'      300 digits,   16.6 usec,   54.5 usec'    1,000 digits,   126. usec,   239. usec'-----------------------------------------------'    3,000 digits,   1.02 msec,   1.44 msec'   10,000 digits,   11.6 msec,   14.0 msec'   30,000 digits,   97.9 msec,   115. msec'-----------------------------------------------'  100,000 digits,   1.087 sec,   1.376 sec'  200,000 digits,   4.328 sec,   5.175 sec'  250,000 digits,   6.761 sec,   8.036 sec'  500,000 digits,   27.06 sec,   33.60 sec' 1000,000 digits,   108.2 sec,   143.9 sec'=======================================================================' Test pack and unpack'=======================================================================Dim As Integer n = 30000    ' length of dec test stringDim As String a, cRedim As Ulong b( 0 To 1 )  ' will be redimmed laterDim As Double startime, stoptime, dt1, dt2  ' times in secondsa = random_digits( n )startime = Timerpack( a, b() )              ' test packstoptime = Timerdt1 = stoptime - startimePrint " Packed."startime = Timerunpack( b(), c )            ' test unpackstoptime = Timerdt2 = stoptime - startimePrint " Unpacked"'-----------------------------------------------If n <= 6000 Then    Print a    Print cEnd If'-----------------------------------------------PrintIf a = c Then    Print n; " digits,  no error detected."Else    Print n; " digits,  W A R N I N G   conversion error."End If'-----------------------------------------------' scale times to SI prefixesPrintIf ( dt1 < 1 ) And ( dt2 < 1 ) Then    If ( dt1 < 0.001 ) And ( dt2 < 0.001 ) Then        Print Using "dec to bin ####.# usec "; dt1 * 1e6        Print Using "bin to dec ####.# usec "; dt2 * 1e6    Else        Print Using "dec to bin ####.### msec "; dt1 * 1000        Print Using "bin to dec ####.### msec "; dt2 * 1000    End IfElse    Print Using "dec to bin ####.### sec "; dt1    Print Using "bin to dec ####.### sec "; dt2End IfPrint Sleep'=======================================================================' test the hex load and hex_dump'=======================================================================n = 4Dim As String txt = "1" + String( n, "0" )Print txt; " hex"hex_load( txt, b() )hex_dump( b() )unpack( b(), a )Print " dec val = "; an = Len( a )pack( a, b() )hex_dump( b() )'=======================================================================Sleep'======================================================================='=======================================================================' Pack a base ten ASCII decimal string into binary Ulong integer array'   the result array will be redimensioned, so must declare by; Redim as Ulong acc() '=======================================================================Sub pack( Byref d As String, acc() As Ulong )   ' ASCII decimal to Ulong binary    #define billion 1000000000ull    Dim As Integer len_d = Len( d )  ' original length    ' lengthen input string by up to 8 digits to make 9 digit blocks    Dim As Integer n = len_d Mod 9    If n Then d = String( 9 - n, "0" ) + d    n = Len( d ) \ 9  ' number of input blocks    '---------------------------------------------------------------    ' Log10( 2 ) = 0.301029995664 digits per bit    ' 32 * Log10( 2 ) = 9.6329598612474 decimal digits per 32 bit block    ' 0.9342922766870705 Ulongs needed per 9 digits    '---------------------------------------------------------------    Dim As Integer m = 1 + n * 0.9342923    Redim As Ulong acc( 0 To m )    ' sufficient accumulator array    Dim As Integer k = 1  ' increasing size of active acc array    For j As Integer = 0 To Len( d ) - 5 Step 9     ' take blocks of 9 digits        '-----------------------------------------------        ' Convert 9 digits to a binary number in carry        Dim As Ulongint carry = d[ j ] - Asc( "0" ) ' 64 bit Unsigned Integer        For i As Integer = j + 1 To j + 8            carry = d[ i ] - Asc( "0" ) + ( carry * 10 )        Next i        '-----------------------------------------------        ' Multiply the acc array by a billion and add the next 9 digits        For i As Integer = 0 To k            Dim As Ulongint product = ( Culngint( acc( i ) ) * billion ) + carry             acc( i ) = product And &hFFFFFFFFull ' sum is low order 32 bits            carry = product Shr 32 ' carry is the high order 32 bits        Next i        '-----------------------------------------------        If carry Then   ' need to extend accumulator            k += 1            acc( k ) = carry        End If        '-----------------------------------------------    Next j  ' accumulator b() contains result in packed binary    '---------------------------------------------------------------    d = Right( d, len_d )    ' restore original lengthEnd Sub'=======================================================================' Unpack binary in Ulong array into base ten ASCII decimal string'=======================================================================Sub unpack( b() As Ulong, Byref c As String ) ' Ulong binary to ASCII decimal    #define billion 1000000000ull    Dim As Integer len_b = Ubound( b ) ' upper element of binary array    Dim As Integer n = 1 + Int( ( Len_b ) * 1.070328873472 ) ' 9 digit block count    Dim As Ulong acc( 0 To n )  ' array to accumulate and build base 1e9    '---------------------------------------------------------------    Dim As Ulongint HiLo    ' allocates a 64 bit arithmetic register in memory    Dim As Ulong Ptr Lo = Cptr( Ulong Ptr, @HiLo )  ' *Lo is the lower 32 bits    Dim As Ulong Ptr Hi = Lo + 1    ' *Hi is the upper 32 bits of hilo    '---------------------------------------------------------------    ' convert packed binary 32 bit Ulong array to base 1e9 in acc    Dim As Integer i, j, k = 1  ' loop counters    For j = Len_b To 0 Step -1  ' the blocks to convert are added by inserting        *lo = b( j )            '   them into register LSB of acc, clears *hi        '-------------------------------------------        For i = 0 To k      ' the active part of the base 1e9 acc            *hi += acc( i ) ' multiply acc() by 2^32 by adding it to high side            acc( i ) = Culng( hilo Mod billion ) ' MOD, keep it safe            hilo \= billion ' DIV, carry is now in hilo        Next i          ' on exit from MACC, if carry        '-------------------------------------------        Do While hilo   '   indicates need to extend active part of acc            k += 1            acc( k ) = Culng( hilo Mod billion )            hilo = hilo \ billion        Loop    ' hilo becomes zero at end of each MACC pass        '-------------------------------------------    Next j      ' acc now contains result blocks in base 10^9    ' Print k; " blocks needed, "; n; " blocks allocated."    '---------------------------------------------------------------    ' unpack and return acc as decimal ASCII string    c = ""    For i = 0 To k        c = Right( "000000000" + Str( acc( i ) ), 9 ) + c    Next i    '---------------------------------------------------------------    c =  Ltrim( c, "0" )End Sub'=======================================================================' Put a Hex string into a Ulong integer array'=======================================================================Sub hex_load( Byref x As String, b() As Ulong ) ' reverse hexdump    ' lengthen input string by up to 7 hex symbols to make multiple of 8    Dim As Integer len_x = Len( x ) ' original length    Dim As Integer n = len_x Mod 8      ' number of symbols    If n Then x = String( 8 - n, "0" ) + x  ' prefix with zeros    '-----------------------------------------------    n = Len( x ) \ 8    ' number of input blocks, plus one spare    Redim As Ulong b( 0 To n )    ' sufficient array    '-----------------------------------------------    Dim As Integer i, k = 0    For i = Len( x ) To 4 Step - 8        b( k ) = Valint( "&h" + Mid( x, i - 7, 8 ) )        k += 1    Next iEnd Sub    ' b( ) now contains the hex string'=======================================================================' Dump a packed binary Ulong integer array to Hex on screen'=======================================================================Sub hex_dump( b() As Ulong )   ' Ulong binary array to hex_dump    For i As Integer = Ubound( b ) To 0 Step -1        Print Hex( b( i ), 8 );        If i Then Print Chr( 250 );     ' dot separators 249 or 250    Next i    PrintEnd Sub'=======================================================================' make a random decimal test string with a non-zero leading digit'=======================================================================Function random_digits( Byval n As Integer ) As String    Dim As String x = String( n, "x" )    Randomize    x[ 0 ] = Asc( "1" ) + Int( 9 * Rnd )    ' avoid leading zero    For i As Integer = 1 To Len( x ) - 1        x[ i ] = Asc( "0" ) + Int( 10 * Rnd )   ' digits 0 to 9 only    Next i    Return xEnd Function'=======================================================================' End of file'=======================================================================`
albert
Posts: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard

Hi Richard!

I was thinking, if you convert to binary then you can step by 32 bits..without a sub-carry.
Richard
Posts: 2948
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

Albert wrote:I was thinking, if you convert to binary then you can step by 32 bits..without a sub-carry.
There are many possibilities. Go ahead and see what you can do.

The resized array can be referenced by pointers as 8, 16 or 32 bit unsigned integers. Because the array gets an extra zero most significant element you can also reference it as 64 bit Uintegers.

Use something like this to make the different span pointers into b().
Dim As Ulong Ptr b_ptr = Cptr( Ulong Ptr, @b( 0 ) )