Squares

General FreeBASIC programming questions.
srvaldez
Posts: 1370
Joined: Sep 25, 2005 21:54

Re: Squares

Postby srvaldez » Sep 20, 2017 23:40

interesting ascii art using prime numbers https://www.mapleprimes.com/maplesoftbl ... -Post-Ever

Code: Select all

111111111111111111111111111111111111111111111111111111111111111111111111111111
188080083800008080888868388888080000888838380000888880560308038836086800505881
180386808388863800363008800866600506086608688008308306008388005380858080060881
100883000888860811888006568808808008086030868858500000055800883885838856066001
180868538588811111111111111886358888008088860683668860880008850008086086530881
180888880801111111111111111118088088868806808088500083568586508888808880888861
180800858881111111111111111111165006805800855800080880038680608888080835808801
180868808881111111111111111111118306008568386880886888066086080880868880086001
108080880831111111111111111111111880088888568808888088888588801111111888330881
186886600811111110811111111111111183880086088888611006885380111111111118888081
133800833311111080081111111111111118600085081111111111111111111111111118038081
108058508611118885881111111111111111111111111111111111111180860111111118880881
158080800001118860681111111111111111111111111111111111111188886881111111808831
188860086008088886881111111111111111111111111111111111111118868861111111868801
188880880588600500811111111111111111111111111111111111111118886081111111600601
105886880888360860111111111111111111111111111111111111111111800836111111600681
100066008888830681111111111111111111111111111111111111111111088081111113808301
188588030056386881111111111111111111111111111111111111111118508881111108638881
108088580835860881111111111111111111111111111111111111111100888011111888600801
138800036806888061111111111111111111111111111111111111111630888111118880860831
160866888088811111111111111111111111111111111111111111188680880111180808838681
180080865111111111111111811111111111111681111111111110886600551111686588888881
180888800111806865888800511118088800358858611111111118088888601118086080008881
186008056118880838008600111108050080888088801111111111885888011150806086808881
180508880011868063808888111308858538868888888111118111118080811586880880088851
156008880851180888080881180800880880088806888811118311116888681580800000508881
180508688088111365060611188883568600565860056111850511188538856100888505830801
138868008008011111130811080886830580868080083118605111868800858368868808656881
188888888883885611118116806008858838600680881508801188688868556808058888860001
188888680860883588188110300688680580608808118085111888088058668655685880506081
130608888868680608881158085868888000080631185081110860880806868680003585808881
180880008885888806081150805830888088068111060111080880008300855066886808088881
180858888000008888011188558080380603811103111138803060850580308060053880868881
186668600088860511111885088058080881111868880885880808885000688306688888080001
185038080885880588588008038508858886088088808888008055800886008080338688868061
111111111111111111111111111111111111111111111111111111111111111111111111111111
albert
Posts: 4039
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Oct 04, 2017 0:02

( !!~~OFF TOPIC~~!! )

Dodicat , I was reading a real good book on the Roman Empire , called "The first man of Rome"

It goes into details of Rome history from about 100 B.C. to 150 A.D.
It says the Roman army chased many Germans across the English channel into England and they formed Scottland.

Somewhere else i read that when the Germans got into England there were Indian tribes called "Picts" and the Germans wiped them all out and raped all the women, so there are no more Picts.

I was wondering if all the Scottish are all , blonds and redheads , like ancient Germany??
My father had red hair and black eyebrows as a child , but his hair it turned jet black when he was about 40 or so. but the hair on his arms stayed copper colored, his beard and mustache also turned black.

My ancestors were Indians from India and Kashmir that immigrated to Scandanavia and were chased out by Romans in 800 A.D. to the Highlands.
When you mate Indians and Scandanavians you get lots of freckles , like if you mate Indians and Scott's you get green and sometime orange eyes like in Canada.
My indian ancestors were Reddy's / Reddi's , my Highlander ancestors added two t's to the name so now its Reddi with tuddi's and tutti's
( tuddi means to chop and tutti means to beat )


Are the Scott's all blond and redheads??
albert
Posts: 4039
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Oct 12, 2017 0:59

@Richard
@Dodicat

Why do Germans draw a line across the 7

The 7 is a person bent over , it means "get lucky".
So its either:
1) no one gets lucky in Germany.
2) In Germany , you have to stand on a step to get lucky.
3) drawing the line through the seven , adds 4 points of intersection , to count all the points to seven.

??
It's got to be one of the 3
MrSwiss
Posts: 2113
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Squares

Postby MrSwiss » Oct 12, 2017 1:24

albert wrote:It's got to be one of the 3
No, it isn't any of the 3. It's to differentiate better, between 1 and 7, specially when *hand writing* is the case.

Btw: not only the Germans do it, it's just more common, to Europe I think.
caseih
Posts: 1064
Joined: Feb 26, 2007 5:32

Re: Squares

Postby caseih » Oct 12, 2017 5:32

I've crossed my sevens for as long as I can remember and I'm Canadian. Not sure where I picked it up.

Most Europeans I know write their ones with a little mark that makes them confusingly like a very sloppy seven, but since sevens are crossed it's not too hard to differentiate.
grindstone
Posts: 359
Joined: May 05, 2015 5:35
Location: Germany

Re: Squares

Postby grindstone » Oct 12, 2017 17:08

1) no one gets lucky in Germany.
2) In Germany , you have to stand on a step to get lucky.
From a logic point of view this would mean that in Germany noone stands on a step. <grin>
BasicCoder2
Posts: 2932
Joined: Jan 01, 2009 7:03

Re: Squares

Postby BasicCoder2 » Oct 12, 2017 20:40

dodicat
Posts: 4490
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Oct 12, 2017 22:52

albert wrote:@Richard
@Dodicat

Why do Germans draw a line across the 7

The 7 is a person bent over , it means "get lucky".
So its either:
1) no one gets lucky in Germany.
2) In Germany , you have to stand on a step to get lucky.
3) drawing the line through the seven , adds 4 points of intersection , to count all the points to seven.

??
It's got to be one of the 3


Well Albert, my mother is German.
She writes in the old German script.
Just a time warp with her, she left Germany in 1947, and missed out the change in German writing style.
I'll ask her tomorrow about the number 7, but I am sure it is crossed in the old script.
St_W
Posts: 1169
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Squares

Postby St_W » Oct 13, 2017 0:44

caseih wrote:I've crossed my sevens for as long as I can remember [...]
In Austria we also do that: https://www.bmb.gv.at/ministerium/rs/19 ... _15139.pdf
albert
Posts: 4039
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Oct 14, 2017 0:44

I think it means "You don't get lucky in Germany" , The Germans were raped by Rome , Indians , Napolean's army, and Israelis..
But Germans are all like 6 foot tall and taller, so it could mean "you got to step up on a foot stool to get lucky" ?? (HAHA!!)

Hitlers army wiped out 300,000 Reddi's in Germany , Austria and Poland in WWII , all my ancestorial Indian relatives.
( maybe they were all half Jewish and possessed the books?? )

The Jews that were killed in WWII were all the households that possessed books that contained German Govt. Secrets...
Some Jews wrote books with govt secrets encrypted in them.
the SS went door to door and searched for books and compiled a list of households and gave list to the Army to round up houses ,
Only Hitler and the SS knew the secret,
They couldn't tell Germans or Jews or the German Govt why they were rounding up Jews...
After countless querries Hitler finally came out in public and just said that "the Jews were inferior"..
( They were inferior at encrypting the books secret messages.)

My father was in the 82nd Air Bourne in the U.S. Army and they conqured Berlin and interrogated the SS guards...
They also photocopied all the govt secrets and sent them back to the U.S.
The SS gaurds told my dad and officials about the secret books, and only Hitler and the SS knew why the Jews were being rounded up..

The Holocaust was a big multi-national espionage ring..

I tried to explain what my dad told me about WWII in the "Circles" topic and they locked the topic, they though i was anti-Jew and i'm not..
I live happily in a city thats mostly Jewish and get along with everyone alright..
albert
Posts: 4039
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Oct 23, 2017 18:20

@Dodicat

I figured out the 7 finally i think..

Snake
Exit
Vessel
Enter
N up&down

So the Germans draw a line for the basket top.

I was thinking it was snake enter vagina enter up&down. ( person bent over )
dodicat
Posts: 4490
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Oct 23, 2017 23:30

Hi Albert.
Are you doing any FB projects?
Are you still using Linux.
There are so many using it now, I am thinking of setting up a Linux box.
To tell the truth, I get fed up using this 64 bit Win 10 every day.
I can't dual boot, I don't have an installation disk for Win 10 in case of a hiccup.
integer
Posts: 355
Joined: Feb 01, 2007 16:54
Location: usa

Re: Squares

Postby integer » Oct 24, 2017 16:44

dodicat wrote:Hi Albert.
Are you doing any FB projects?
Are you still using Linux.
There are so many using it now, I am thinking of setting up a Linux box.
To tell the truth, I get fed up using this 64 bit Win 10 every day.
I can't dual boot, I don't have an installation disk for Win 10 in case of a hiccup.

the bloody emphasis is mine.
@dodicat
do you know if the 32 bit win 10 is less aggravating?
A Win 10 system will crash land at my castle this winter.
Any comments appreciated.
dodicat
Posts: 4490
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Nov 07, 2017 22:40

Hi integer.
Don't know about the 32 bit OS.
But you should still be able to run 16 bit apps on it (QB e.t.c.)

Anyway, squares is way too quiet these days.

Binary stars are ten a penny.
Binary planets are as yet an unknown entity, so this is purely a guess as to what they are like in the cosmos.

Code: Select all




Screen 20,32
Color ,Rgb(0,0,25)
Dim Shared As Integer xres,yres
Screeninfo xres,yres
#define shade(c,n)  rgb(Cptr(Ubyte Ptr,@c)[2]*n,Cptr(Ubyte Ptr,@c)[1]*n,Cptr(Ubyte Ptr,@c)[0]*n)
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
'<><><><><><><><><><><> Quick SORT <><><><><><><><><><>
#define up <,>
#define down >,<
#macro SetQsort(datatype,fname,b1,b2,dot)
Sub fname(array() As datatype,begin As Long,Finish As Ulong)
    Dim As Long i=begin,j=finish
    Dim As datatype x =array(((I+J)\2))
    While  I <= J
        While array(I)dot b1 X dot:I+=1:Wend
            While array(J)dot b2 X dot:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
            Wend
            If J > begin Then fname(array(),begin,J)
            If I < Finish Then fname(array(),I,Finish)
        End Sub
        #endmacro     
        '<><><>
        Function Blur(Byref tim As Uinteger Pointer,rad As Integer=2) As Uinteger Pointer
            Type p2
                As Integer x,y
                As Uinteger col
            End Type
            #macro ppoint(_x,_y,colour)
            pixel=row+pitch*(_y)+4*(_x)
            (colour)=*pixel
            #endmacro
            #macro ppset(_x,_y,colour)
            pixel2=row2+pitch2*(_y)+4*(_x)
            *pixel2=(colour)
            #endmacro
            #macro average()
            ar=0:ag=0:ab=0:inc=0
            xmin=x:If xmin>rad Then xmin=rad
            xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
            ymin=y:If ymin>rad Then ymin=rad
            ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
            For y1 As Integer=-ymin To 0
                For x1 As Integer=-xmin To 0
                    inc=inc+1
                    ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
                    ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
                    ab=ab+(NewPoints(x+x1,y+y1).col And 255)
                Next x1
            Next y1
            #endmacro
            Dim As Integer _x,_y
            Imageinfo tim,_x,_y
            Dim  As Uinteger Pointer im=Imagecreate(_x,_y)
            Dim As Integer pitch,pitch2
            Dim  As Any Pointer row,row2
            Dim As Uinteger Pointer pixel,pixel2
            Dim As Uinteger col
            Imageinfo tim,,,,pitch,row
            Dim As p2 NewPoints(_x,_y)
           
            Dim As Uinteger averagecolour
            Dim As Integer ar,ag,ab
            Dim As Integer xmin,xmax,ymin,ymax,inc
            Imageinfo im,,,,pitch2,row2
            For y As Integer=0 To _y-1
                For x As Integer=0 To _x-1
                    ppoint((x),(y),col)
                    NewPoints(x,y)=Type<p2>(x,y,col)
                    average()
                    NewPoints(x,y).col=Rgb(ar/(inc),ag/(inc),ab/(inc))
                    ppset((NewPoints(x,y).x),(NewPoints(x,y).y),NewPoints(x,y).col)
                Next x
            Next y
            Function= im
        End Function
       
        Type V3
            As Single x,y,z
            As Ulong col
        End Type
       
        Type _float
            As Single x,y,Z
        End Type
       
        Type sphere As V3
      ' =========  set up image ========
        Dim Shared As v3 eyepoint
        eyepoint=Type(xres/2,yres/2,800)
        Dim Shared As Any Ptr im,bck
        im=Imagecreate (xres/12,yres/12,0)
         bck=Imagecreate (xres,yres,0)
        Redim  As V3 a(0)
        Dim As Ulong Clr
        Randomize 2
        for n as long=1 to 500
            print bin(7,4);
        next
        get(0,0)-(xres/12-1,yres/12-1),im
       cls
        im=Blur(im,1)
    #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
       for x as long=0 to 200
           dim as long xx=rnd*xres,yy =rnd*yres
         if incircle(xx,yy,160,(xres/2),(yres/2))=0 then
               pset bck,(xx,yy)
               end if
           next

       '========== done ===========
       
        Function dot(v1 As v3,v2 As v3) Byref As const Single
            Static As Single res
            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
            Res= (v1x*v2x+v1y*v2y+v1z*v2z)
            Return res
        End Function
       
        Sub RotateArray(wa() As V3,result() As V3,angle As _float,centre As V3,flag As Long=0,s As Single=1)
            static As Single dx,dy,dz,w
            static as single SinAX,SinAY,SinAZ,CosAX,CosAY,CosAZ
             SinAX=Sin(angle.x)
             SinAY=Sin(angle.y)
             SinAZ=Sin(angle.z)
             CosAX=Cos(angle.x)
             CosAY=Cos(angle.y)
             CosAZ=Cos(angle.z)
         
            For z As Long=Lbound(wa) To Ubound(wa)
                dx=wa(z).x-centre.x
                dy=wa(z).y-centre.y
                dz=wa(z).z-centre.z
                Result(z).x=(((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz))+centre.x
                result(z).y=(((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz))+centre.y
                result(z).z=(((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz))+centre.z
                #macro perspective()
                w = 1 + (result(z).z/eyepoint.z)
                result(z).x = s*(result(z).x-eyepoint.x)/w+eyepoint.x
                result(z).y = s*(result(z).y-eyepoint.y)/w+eyepoint.y
                result(z).z = s*(result(z).z-eyepoint.z)/w+eyepoint.z
                #EndMacro
                If flag Then: perspective():End If
                result(z).col=wa(z).col
            Next z
        End Sub
       
        'if a point lies on a sphere
        Function onsphere(S As sphere,P As V3,x As Single,y As Single) As Long
            Return Sqr(x*(S.x-P.x)*(S.x-P.x)+y*(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z)) <= S.col Andalso _
            Sqr(x*(S.x-P.x)*(S.x-P.x)+y*(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z)) > (S.col)-2.5
        End Function
       
        Sub addasphere(a() As V3,pt As V3,rad As Long,col As Ulong=0,x1 As Single,y1 As Single,flag As Integer=0)
            Dim As Long xx=Pt.x,yy=Pt.y,zz=Pt.z,r=rad,counter=Ubound(a)-1
            Dim As Long minx= xx-r-1,maxx=xx+r+1
            Dim As Long miny= yy-r-1,maxy=yy+r+1
            Dim As Single ddx,ddy,ddz
            Dim As sphere sp=Type<sphere>(xx,yy,zz,r)
            #define h sin(counter)
            For x As Long= xx-r-1 To xx+r+1 Step 2
                For y As Long=yy-r-1 To yy+r+1 Step 2
                    For z As Long=zz-r-1 To zz+r+1 Step 2
                        If onsphere(sp,Type<V3>(x,y,z),x1,y1) Then
                            counter+=1
                            Redim Preserve a(Lbound(a) To counter)
                            If flag Then
                                Var xpos=map((minx),(maxx),x,0,xres/12)
                                Var ypos=map((miny),(maxy),y,0,yres/12)
                                col=Point(xpos,ypos,im)
                            End If
                           
                            a(counter)=Type<V3>(x+ddx+h,y+ddy+h,z+ddz+h,col)
                        End If
                    Next z
                Next y
            Next x
        End Sub
       
        Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
            Static As Double timervalue,_lastsleeptime,t3,frames,sleeptime
            dim as double t=Timer
            frames+=1
            If (t-t3)>=1 Then t3=t:fps=frames:frames=0
            sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
            If sleeptime<1 Then sleeptime=1
            _lastsleeptime=sleeptime
            timervalue=T
            Return sleeptime
        End Function
       
        AddAsphere(a(),Type<V3>(xres/2,yres/2,0),150,Rgb(255,255,0),1,1,1)
       
        SetQsort(V3,QsortZ,down,.z) 'Set Up the quicksort for UDT V3, on z
       
        Redim As V3 b(Lbound(a) To Ubound(a)) 'feeder array
       
       
        Dim As Single pi=4*Atn(1)
        'RotateArray(a(),b(),Type<_float>(0,0,-pi/3.5),Type(xres/2,yres/2,0))
         RotateArray(a(),b(),Type<_float>(0,0,-pi/2),Type(xres/2,yres/2,0))
        For n As Long=Lbound(a) To Ubound(a)
             'a(n)=b(n)
        Next
        dim as long fps
        Dim As v3 Axis
        Dim As Ulong colour
        Dim As Ubyte rd,gr,bl
        Dim As Ubyte Ptr cc
        Dim As v3 Ectr=Type(xres/2,yres/2,0)
        Dim As Single min=3,max=-3,dt,ang,rad
        dim as long mx,my,mw,mb
        Do
            min=3
            max=-3
            ang+=.025
            getmouse mx,my,mw,mb
            Axis=type(mx-512,my-384,mw*5)
            RotateArray(a(),b(),Type<_float>(0,ang,0),Type(xres/2,yres/2,0),1,1)
            Screenlock
            Cls
            put(0,0),bck,pset
           
            Draw String(10,10),"FPS =" & fps
            draw string(10,30),"Mouse & wheel"
            QsortZ(b(),Lbound(b),Ubound(b))
           
            For n As Long=Lbound(b) To Ubound(b)
                If b(n).z<0  Then
                    rad=map(-400,400,b(n).z,2.5,1)
                     dt= dot(type(Ectr.x-b(n).x,Ectr.y-b(n).y,Ectr.z-b(n).z),Axis)
                    If dt >0 Then
                        rad=2
                        colour=shade(b(n).col,.11)
                    Else
                        If min>dt Then min=dt
                        If max<dt Then max=dt
                        cc=Cptr(Ubyte Ptr,@b(n).col)
                        rd=map(min,max,dt,255,cc[2])
                        gr=map(min,max,dt,255,cc[1])
                        bl=map(min,max,dt,255,cc[0])
                        colour=Rgb(rd,gr,bl)
                    End If
                  if mb=1 then  colour=shade(colour,.5)
                    Circle(b(n).x,b(n).y),rad,colour,,,,f
                End If
            Next n
           
            Screenunlock
            Sleep regulate(25,fps),1
        Loop Until inkey=chr(27)
        imagedestroy (im)
        imagedestroy (bck)
       
        Sleep
         
dafhi
Posts: 965
Joined: Jun 04, 2005 9:51

Re: Squares

Postby dafhi » Nov 09, 2017 2:05

that put a smile on my face. one of these days i'll get into texture mapping.

depth of field effect inspired by a recent vid
Last edited by dafhi on Nov 15, 2017 3:33, edited 2 times in total.

Return to “General”

Who is online

Users browsing this forum: No registered users and 5 guests