## Dry Christmas.

For other topics related to the FreeBASIC project or its community.
dodicat
Posts: 6241
Joined: Jan 10, 2006 20:30
Location: Scotland

### Dry Christmas.

Merry Christmas all.
No liquor for me this Christmas, I am driving later on.
Just an old an old Crookes bottle I found.

Code: Select all

`Const pi=4*Atn(1)Type V3    As Single x,y,z    As Ulong col    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)End TypeType d2    As Single mx,my    As Single mw,dyEnd Type#define A_R( c ) ( ( c ) Shr 16 And 255 )#define A_G( c ) ( ( c ) Shr  8 And 255 )#define A_B( c ) ( ( c )        And 255 )Sub throughview(b As d2,a As Single=2.9)    Static  As Ulong _colour(81,81),clr    Static As Long result    #macro rotate(pivotx,pivoty,px,py,a,scale)    Var Newx=scale*((px-pivotx))+pivotx    Var Newy=scale*((py-pivoty))+pivoty    #endmacro    #macro incircle(cx,cy,r,mx,my,a)    If a<=1 Then        result=a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= r*r*a*a    Else        result=a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= (r)*(r)    End If    #endmacro    If b.mw=0 Then b.mw=1    b.mw=Abs(b.mw)    For x As Long=b.mx-40 To b.mx+40        For y As Long=b.my-40 To b.my+40            incircle(b.mx,b.my,40,x,y,a)            If result Then                clr=Point(x,y)                _colour(x-b.mx+40,y-b.my+40)=Rgb(A_R(clr)*.98,A_G(clr)*.98,A_B(clr)*.98)            End If        Next y    Next x    Static As Single dil    For x As Long=b.mx-40 To b.mx+40        For y As Long=b.my-40 To b.my+40            incircle(b.mx,b.my,40,x,y,a)             If result Then                 rotate(b.mx,b.my,x,y,0,dil)                Var dist=Sqr((b.mx-newx)*(b.mx-newx)+(b.my-newy)*(b.my-newy))                dil=(b.mw+(.5-b.mw)*dist/(40*b.mw))                Line(NewX-dil/2,NewY-dil/2)-(NewX+dil/2,NewY+dil/2),_colour(x-b.mx+40,y-b.my+40),BF            End If        Next y    Next xEnd SubDim As d2 b(1 To 10),b2(1 To 5)#define Intrange(f,l) Int(Rnd*(((l)+1)-(f))+(f))Randomize 2For n As Long=1 To Ubound(b)    If n<6 Then        b2(n)=Type(intrange(350,660),intrange(480,510),1.5,0)     End If    b(n)=Type(intrange(350,670),intrange(250,600),1.5,0)NextType float As V3Type angle3D 'FLOATS for angles    As Single sx,sy,sz    As Single cx,cy,cz    Declare Static Function construct(As Single,As Single,As Single) As Angle3DEnd TypeFunction Angle3D.construct(x As Single,y As Single,z As Single) As Angle3D    Return   Type (Sin(x),Sin(y),Sin(z), _    Cos(x),Cos(y),Cos(z))End FunctionFunction 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 resEnd FunctionFunction Rotate(c As V3,p As V3,a As Angle3D,scale As float=Type(1,1,1)) As V3    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z    Return Type<V3>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_    (scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_    (scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z,p.col)End FunctionFunction perspective(p As V3,eyepoint As V3) As V3    Dim As Single   w=1+(p.z/eyepoint.z)    Return Type<V3>((p.x-eyepoint.x)/w+eyepoint.x,_    (p.y-eyepoint.y)/w+eyepoint.y,_    (p.z-eyepoint.z)/w+eyepoint.z,p.col)End Function Sub Qsort(array() As V3,begin As Long,Finish As Ulong)    Dim As Long i=begin,j=finish    Dim As V3 x =array(((I+J)\2))    While I <= J        While array(I).z > X .z:I+=1:Wend            While array(J).z < X .z:J-=1:Wend                If I<=J Then Swap array(I),array(J): I+=1:J-=1            Wend            If J >begin Then Qsort(array(),begin,J)            If I <Finish Then Qsort(array(),I,Finish)        End Sub                Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long            Static As Double timervalue,_lastsleeptime,t3,frames            frames+=1            If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0            Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000            If sleeptime<1 Then sleeptime=1            _lastsleeptime=sleeptime            timervalue=Timer            Return sleeptime        End Function                Function inpolygon(p1() As v3,Byval p2 As v3) As Integer            #macro Winder(L1,L2,p)            -Sgn((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))            #endmacro            Dim As Integer index,nextindex,k=Ubound(p1)+1,wn            For n As Integer=1 To Ubound(p1)                index=n Mod k:nextindex=(n+1) Mod k                If nextindex=0 Then nextindex=1                If p1(index).y<=p2.y Then                    If p1(nextindex).y>p2.y Andalso  Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1                Else                    If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1                End If            Next n            Return wn        End Function                Function onbox(ctr As V3,l As Integer,h As Integer,d As Integer,p As V3) As Integer            Dim As Integer a,b,c=1            Dim As Integer ax,ay,az,at            ax=(p.x>ctr.x-l And p.x<ctr.x+l)            ay=(p.y>ctr.y-h And p.y<ctr.y+h)            az=(p.z>ctr.z-d And p.z<ctr.z+d)            at=(ax And ay And az)=0            Return at        End Function                Sub AddABox(a() As V3,bx As V3,l As Integer,h As Integer,d As Integer,col As Ulong)            Dim As Integer counter=Ubound(a),c=0'-1            For x As Integer=bx.x-l-c To bx.x +l +c Step 1                For y As Integer=bx.y-h-c To bx.y +h +c Step 1                    For z As Integer=bx.z-d-c To bx.z +d +c Step 1                        If onbox(bx,l,h,d,Type<V3>(x,y,z)) Then                            counter+=1                            Redim Preserve a(Lbound(a) To counter)                            a(counter)=Type<V3>(x,y,z,col)                        End If                    Next z                Next y            Next x        End Sub                Sub addavane(a() As V3,pt As V3,col As Ulong=0,p() As v3)            Dim As Long xx=Pt.x,yy=Pt.y,zz=Pt.z,r=Abs(pt.x-p(2).x),counter=Ubound(a)-1            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                    If inpolygon(p(),Type(x,y)) Then                        counter+=1                        Redim Preserve a(Lbound(a) To counter)                        a(counter)=Type<V3>(x,y,zz,col)                    End If                Next y            Next x        End Sub                Sub createPolygon(p() As v3,x As Long,y As Long,w As Long,Byref cx As Single,Byref cy As Single)            Dim As angle3d ang=angle3d.construct(0,0,pi/4)            Redim p(1 To 4)            p(1)=Type(x,y)            p(2)=Type(x+w,y)            p(3)=Type(x+w,y+w)            p(4)=Type(x,y+w)            For n As Long=1 To 4                Dim As v3 tmp=rotate(Type(x+w/2,y+w/2,0),p(n),ang)                p(n)=tmp            Next n            cx=x+w/2            cy=y+w/2        End Sub                Sub thickline(x1 As Single,_            y1 As Single,_            x2 As Single,_            y2 As Single,_            thickness As Single,_            colour As Ulong)            If thickness<2 Then                Line(x1,y1)-(x2,y2),colour            Else                               Var h=Sqr((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1))  'hypotenuse                Var s=(y1-y2)/h                             'sine                Var c=(x2-x1)/h                             'cosine                Dim As Ulong prime=Rgb(253,254,255)                For n As Integer=1 To 2                    Line (x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),prime                    Line (x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),prime                    Line (x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),prime                    Line (x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),prime                    Paint((x1+x2)/2,(y1+y2)/2),prime,prime                    prime=colour                Next n            End If        End Sub                Sub bottle            Var edge=Rgba(0,20*.5,155*.5,255)            Circle(512,585),168,Rgba(0,20*.3,155*.3,100),,,.1,f            Circle(512,585),168,edge,,,.1            Line(680,587)-(680,300-8),edge            Line(345,587)-(345,300-3),edge            Circle(1024\2,768\2),190,edge,.46,1.2            Circle(1024\2,768\2),190,edge,.46+1.46,1.2+1.46            Line(447,204)-(447,100),edge            Line(581,206)-(581,100),edge            Line(447,100)-(581,100),edge            Paint(1024\2,768\2),Rgba(0,20*.5,155*.5,100),edge            Circle(447,100),10,edge,,,,f            Circle(581,100),10,edge,,,,f            thickline(516,190,512,80+20,120,Rgb(50,25,0))            thickline(512,80+20,512,80,120,Rgb(100,50,0))            thickline(440,85,584,80,12,Rgb(0,0,0))            thickline(447+5,100,581-8,100,10,Rgb(40,10,00))            thickline(544,188,540,103,64,Rgb(46,20,00))            thickline(542,94,542,93,64,Rgb(90,40,0))            Line(512,567)-(500,580),edge            Line(512,567)-(524,580),edge            Line(500,580)-(524,580),edge            Paint(512,570),Rgb(50,25,0),edge            line(512,601)-(1024,620),edge            line(679,565)-(1024,560),edge            paint(860,580),rgb(0,30,0),edge            Circle(1024\2,768\2),190,rgb(50,50,50),.46+1.66,1.2+1.46            Line(345,587)-(345,300-3),rgb(50,50,50)            Line(447,204)-(447,110),rgb(50,50,50)        End Sub                Redim As v3 a(0)        Dim As v3 p()        Dim As Single cx,cy        createpolygon(p(),280,250,100,cx,cy)        addavane(a(),Type(cx,cy,1),Rgb(200,200,200),p()) 'vane 1        addavane(a(),Type(cx,cy,-1),Rgb(10,10,10),p())        createpolygon(p(),420,250,100,cx,cy)        addavane(a(),Type(cx,cy,1),Rgb(10,10,10),p())        addavane(a(),Type(cx,cy,-1),Rgb(200,200,200),p()) 'vane 2        addabox(a(),Type(400,300,0),10,5,5,Rgb(90,0,0))'the red joint                Dim As angle3D  ang= angle3D.construct(0,pi/2,0)        For n As Long=Lbound(a) To Ubound(a)            Dim As v3 tmp=rotate(Type(400,300,0),a(n),ang)'roatate vane 1 and vane 2            a(n)=tmp        Next        createpolygon(p(),280,250,100,cx,cy)        addavane(a(),Type(cx,cy,1),Rgb(200,200,200),p()) 'vane 3        addavane(a(),Type(cx,cy,-1),Rgb(10,10,10),p())        createpolygon(p(),420,250,100,cx,cy)        addavane(a(),Type(cx,cy,1),Rgb(10,10,10),p())    'vane 4        addavane(a(),Type(cx,cy,-1),Rgb(200,200,200),p())        addabox(a(),Type(400,300,0),10,5,5,Rgb(90,0,0))'the red joint        addabox(a(),Type(400,300,0),0,245,0,Rgb(140,140,140))'the vertical spindle                Redim As V3 rot(Lbound(a) To Ubound(a)) 'working array        ang=angle3D.construct(pi/2,pi/2,0)   'flip all points by pi/2 on y axis                For n As Long=Lbound(a) To Ubound(a)            rot(n)=rotate(Type(400,300,0),a(n),ang)            a(n)=rot(n)        Next n        '=============================                 Screen 20,32,,64        Dim As Any Ptr i=Imagecreate(1024,768)            Line i,(0,500)-(1024,768),Rgb(0,50,0),bf            Color ,Rgb(0,20,155)            Dim As v3 aa            aa.z=pi/2 'initial angles            aa.y=-pi/7            Dim As Long mx,my,fps,rd            Dim As Single dt            Dim As String key            Dim As Ulong colour            aa.y=-.248            Do                                key=Inkey                aa.x+=.06  'the orbiting speed                ang=Angle3D.construct(aa.x,aa.y,aa.z)'get the six rotate components (sines, coses  ...)                Screenlock                Cls                Put(0,0),i,trans                             For n As Long=Lbound(a) To Ubound(a)                    rot(n)=rotate(Type(400,300,0),a(n),ang,Type(1,1,1))                    rot(n)=perspective(rot(n),Type(400,300,1000))                Next                qsort(rot(),Lbound(rot),Ubound(rot))                For n As Long=Lbound(rot) To Ubound(rot)                    'dot products                    dt= -dot(Type(rot(n).x-400,rot(n).y-300,rot(n).z),Type(400,0,-500))                    If rot(n).col=Rgb(200,200,200) Then                        rd=map(-1,1,dt,255,100)                        colour=Rgb(rd,rd,rd)                    Else                        colour=rot(n).col                    End If                    Circle(rot(n).x+(1024\2-400),rot(n).y+(768\2-300-40)),map(-500,500,rot(n).z,2,1),colour,,,,f                Next                For n As Long=1 To Ubound(b)                    If n<6 Then                        throughview b2(n) ,.5                      End If                    throughview b(n)                Next                bottle                Screenunlock                Sleep regulate(40,fps),1            Loop Until key=Chr(27)            Sleep            imagedestroy i               `
Roland Chastain
Posts: 858
Joined: Nov 24, 2011 19:49
Location: France
Contact:

### Re: Dry Christmas.

Very nice. Successfully tested under Linux 64. Merry Christmas!
jj2007
Posts: 1336
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

### Re: Dry Christmas.

Nice code, dodicat! Happy Christmas, Merry Coding and a bug-free 2020 to all of you ;-)
Xusinboy Bekchanov
Posts: 158
Joined: Jul 26, 2018 18:28

### Re: Dry Christmas.

Good work! Merry Christmas and happy holidays to all!
deltarho[1859]
Posts: 2253
Joined: Jan 02, 2017 0:34
Location: UK

### Re: Dry Christmas.

dodicat wrote:No liquor for me this Christmas

No doubt that will not be the case during Hogmanay.

Happy New Year to all.
MrSwiss
Posts: 3372
Joined: Jun 02, 2013 9:27
Location: Switzerland

### Re: Dry Christmas.

The best of the year is yet to start (today 3 PM, CET):
Spengler Cup Davos (93rd edition), the oldest club tournament in the world (Ice-Hockey).
Televised all over the world (or via stream).

... details here ...

Happy new year to all.
grindstone
Posts: 689
Joined: May 05, 2015 5:35
Location: Germany

### Re: Dry Christmas.

@dodicat: Nice work!

Merry Christmas and a happy new year to all active and passive users of the forum!
UEZ
Posts: 420
Joined: May 05, 2017 19:59
Location: Germany

### Re: Dry Christmas.

@all: Merry Christmas

@dodicat: thanks for the Crookes Bottle - very cool coded!
Lost Zergling
Posts: 279
Joined: Dec 02, 2011 22:51
Location: France

### Re: Dry Christmas.

Good end of year celebrations. :-)
Posts: 1902
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Dry Christmas.

I was trying to draw a Christmas tree, but I am done tweaking.

Code: Select all

`const as single M_PI = 3.141592654type sgl2d   as single x, y   declare constructor   declare constructor(x as single, y as single)end typeconstructor sgl2dend constructorconstructor sgl2d(x as single, y as single)   this.x = x : this.y = yend constructorconst SCR_W = 800, SCR_H = 600screenres SCR_W, SCR_H, 32function tline(startPos as sgl2d, length as single, angle as single, c as ulong) as sgl2d   dim as integer x1 = startPos.x   dim as integer y1 = startPos.y   dim as integer x2 = startPos.x + length * cos(angle)   dim as integer y2 = startPos.y + length * sin(angle)   line(x1, (SCR_H - 1) - y1)-(x2, (SCR_H - 1) - y2), c   return sgl2d(x2, y2)end functiontype tree_type   private:   dim as integer branchDepth = 0   dim as integer maxBranchDepth = 5   dim as single branchAngle = M_PI * 0.2   dim as single mainBranchFactor = 0.7   dim as single sideBranchFactor = 0.4   dim as ulong c = rgba(150, 75, 0, 255)   public:   declare sub setProperties(maxBranchDepth as integer, branchAngle as single, mainBranchFactor as single, sideBranchFactor as single, c as ulong)   declare sub drawBranch(startPos as sgl2d, length as single, angle as single)end typesub tree_type.setProperties(maxBranchDepth as integer, branchAngle as single, mainBranchFactor as single, sideBranchFactor as single, c as ulong)   this.maxBranchDepth = maxBranchDepth   this.branchAngle = branchAngle   this.mainBranchFactor = mainBranchFactor   this.sideBranchFactor = sideBranchFactor   this.c = cend subsub tree_type.drawBranch(startPos as sgl2d, length as single, angle as single)   branchDepth += 1   dim as sgl2d endPos = tline(startPos, length, angle, c)   if branchDepth < maxBranchDepth then      drawBranch(endPos, length * mainBranchFactor, angle)      drawBranch(endPos, length * sideBranchFactor, angle + branchAngle)      drawBranch(endPos, length * sideBranchFactor, angle - branchAngle)   end if   branchDepth -= 1end subdim as tree_type treedim as sgl2d startPosstartPos = sgl2d(SCR_W * 0.2, SCR_H * 0.1)tree.setProperties(8, M_PI * 0.1, 0.9, 0.5, rgba(150, 125, 0, 255))tree.drawBranch(startPos, 90, M_PI * 0.5)startPos = sgl2d(SCR_W * 0.4, SCR_H * 0.1)tree.setProperties(11, M_PI * 0.40, 0.9, 0.4, rgba(150, 175, 0, 255))tree.drawBranch(startPos, 60, M_PI * 0.5)startPos = sgl2d(SCR_W * 0.6, SCR_H * 0.1)tree.setProperties(10, M_PI * 0.2, 0.7, 0.4, rgba(150, 100, 0, 255))tree.drawBranch(startPos, 150, M_PI * 0.5)startPos = sgl2d(SCR_W * 0.8, SCR_H * 0.1)tree.setProperties(8, M_PI * 0.1, 0.2, 0.7, rgba(150, 150, 0, 255))tree.drawBranch(startPos, 100, M_PI * 0.5)sleep`
BasicCoder2
Posts: 3478
Joined: Jan 01, 2009 7:03

### Re: Dry Christmas.

Maybe someone can do a 3d version adding baubles on the way?
Maybe shade branches according to the direction they are growing?

Code: Select all

`const as single M_PI = 3.141592654type sgl2d   as single x, y   declare constructor   declare constructor(x as single, y as single)end typeconstructor sgl2dend constructorconstructor sgl2d(x as single, y as single)   this.x = x : this.y = yend constructorconst SCR_W = 800, SCR_H = 600screenres SCR_W, SCR_H, 32color rgb(255,255,255),rgb(0,0,0)function tline(startPos as sgl2d, length as single, angle as single, c as ulong) as sgl2d   dim as integer x1 = startPos.x   dim as integer y1 = startPos.y   dim as integer x2 = startPos.x + length * cos(angle)   dim as integer y2 = startPos.y + length * sin(angle)   line(x1, (SCR_H - 1) - y1)-(x2, (SCR_H - 1) - y2), c   return sgl2d(x2, y2)end functiontype tree_type   private:   dim as integer branchDepth = 0   dim as integer maxBranchDepth = 5   dim as single branchAngle = M_PI * 0.2   dim as single mainBranchFactor = 0.7   dim as single sideBranchFactor = 0.4   dim as ulong c = rgba(150, 75, 0, 255)   public:   declare sub setProperties(maxBranchDepth as integer, branchAngle as single, mainBranchFactor as single, sideBranchFactor as single, c as ulong)   declare sub drawBranch(startPos as sgl2d, length as single, angle as single)end typesub tree_type.setProperties(maxBranchDepth as integer, branchAngle as single, mainBranchFactor as single, sideBranchFactor as single, c as ulong)   this.maxBranchDepth = maxBranchDepth   this.branchAngle = branchAngle   this.mainBranchFactor = mainBranchFactor   this.sideBranchFactor = sideBranchFactor   this.c = cend subsub tree_type.drawBranch(startPos as sgl2d, length as single, angle as single)   branchDepth += 1   dim as sgl2d endPos = tline(startPos, length, angle, c)   if branchDepth < maxBranchDepth then      drawBranch(endPos, length * mainBranchFactor, angle)      drawBranch(endPos, length * sideBranchFactor, angle + branchAngle)      drawBranch(endPos, length * sideBranchFactor, angle - branchAngle)   end if   branchDepth -= 1end subdim as tree_type treedim as sgl2d startPosstartPos = sgl2d(SCR_W * 0.4, SCR_H * 0.1)tree.setProperties(11, M_PI * 0.40, 0.9, 0.4, rgba(150, 175, 0, 255))tree.drawBranch(startPos, 30, M_PI * 0.5)tree.setProperties(11, M_PI * 0.40, 0.9, 0.4, rgba(160, 185, 0, 255))tree.drawBranch(startPos, 25, M_PI * 0.5)tree.setProperties(11, M_PI * 0.40, 0.9, 0.4, rgba(100, 135, 0, 255))tree.drawBranch(startPos, 5, M_PI * 0.5)dim as integer x,yfor i as integer = 0 to 500    x = int(rnd(1)*135)+255    y = int(rnd(1)*176)+336    if point(x,y)<>rgb(0,0,0) then        circle(x,y),3,rgb( int(Rnd(1)*256) ,int(rnd(1)*256) ,int(Rnd(1)*256) ),,,,f    end ifnext isleep`
Posts: 1902
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Dry Christmas.

BasicCoder2 wrote:Maybe someone can do a 3d version adding baubles on the way?
Maybe shade branches according to the direction they are growing?

Yes, 3d would be better, but for now, I converted it to a snowflake generator:

Code: Select all

`const as single M_PI = 3.141592654type sgl2d   as single x, y   declare constructor   declare constructor(x as single, y as single)end typeconstructor sgl2dend constructorconstructor sgl2d(x as single, y as single)   this.x = x : this.y = yend constructorconst SCR_W = 800, SCR_H = 600screenres SCR_W, SCR_H, 32function tline(startPos as sgl2d, length as single, angle as single, c as ulong) as sgl2d   dim as integer x1 = startPos.x   dim as integer y1 = startPos.y   dim as integer x2 = startPos.x + length * cos(angle)   dim as integer y2 = startPos.y + length * sin(angle)   line(x1, (SCR_H - 1) - y1)-(x2, (SCR_H - 1) - y2), c   return sgl2d(x2, y2)end functionunion rgba_union   value as ulong   type      as ubyte b, g, r, a   end typeend unionsub clearScreen()   dim as integer w, h, pitch, xi, yi   ScreenInfo w, h, , , pitch   line(0, 0) - (w-1, h-1), 0, bfend subtype tree_type   private:   dim as integer branchDepth = 0   dim as integer maxBranchDepth = 5   dim as single branchAngle = M_PI * 0.2   dim as single mainBranchFactor = 0.7   dim as single sideBranchFactor = 0.4   dim as ulong c = rgba(150, 75, 0, 255)   public:   declare sub setProperties(maxBranchDepth as integer, branchAngle as single, mainBranchFactor as single, sideBranchFactor as single, c as ulong)   declare sub drawBranch(startPos as sgl2d, length as single, angle as single)end typesub tree_type.setProperties(maxBranchDepth as integer, branchAngle as single, mainBranchFactor as single, sideBranchFactor as single, c as ulong)   this.maxBranchDepth = maxBranchDepth   this.branchAngle = branchAngle   this.mainBranchFactor = mainBranchFactor   this.sideBranchFactor = sideBranchFactor   this.c = cend subsub tree_type.drawBranch(startPos as sgl2d, length as single, angle as single)   branchDepth += 1   dim as rgba_union uc   uc.value = c   uc.r -= branchDepth * 20   uc.g -= branchDepth * 20   uc.b -= branchDepth * 20   dim as sgl2d endPos = tline(startPos, length, angle, uc.value)   if branchDepth < maxBranchDepth then      drawBranch(endPos, length * mainBranchFactor, angle)      drawBranch(endPos, length * sideBranchFactor, angle + branchAngle)      drawBranch(endPos, length * sideBranchFactor, angle - branchAngle)   end if   branchDepth -= 1end subdim as tree_type treedim as sgl2d startPos'~ startPos = sgl2d(SCR_W * 0.2, SCR_H * 0.1)'~ tree.setProperties(8, M_PI * 0.1, 0.9, 0.5, rgba(150, 125, 0, 255))'~ tree.drawBranch(startPos, 90, M_PI * 0.5)'~ startPos = sgl2d(SCR_W * 0.4, SCR_H * 0.1)'~ tree.setProperties(11, M_PI * 0.40, 0.9, 0.4, rgba(150, 175, 0, 255))'~ tree.drawBranch(startPos, 60, M_PI * 0.5)'~ startPos = sgl2d(SCR_W * 0.6, SCR_H * 0.1)'~ tree.setProperties(10, M_PI * 0.2, 0.7, 0.4, rgba(150, 100, 0, 255))'~ tree.drawBranch(startPos, 150, M_PI * 0.5)'~ startPos = sgl2d(SCR_W * 0.8, SCR_H * 0.1)'~ tree.setProperties(8, M_PI * 0.1, 0.2, 0.7, rgba(150, 150, 0, 255))'~ tree.drawBranch(startPos, 100, M_PI * 0.5)randomize timerdim as string keydo   clearScreen()   dim as single branchAngle = M_PI * (0.2 + rnd * 0.6)   dim as single mainBranchFactor = (0.2 + rnd * 0.6)   dim as single sideBranchFactor = 1 - mainBranchFactor   dim as single angle = rnd * M_PI   screenlock   for i as integer = 0 to 5      startPos = sgl2d(SCR_W * 0.5, SCR_H * 0.5)      tree.setProperties(9, branchAngle, mainBranchFactor, sideBranchFactor, rgba(255, 255, 255, 255))      tree.drawBranch(startPos, 100, 2 * M_PI * i / 6 + angle)   next   locate 1, 1: print "press escape to exit";   screenunlock   sleep 500loop until inkey = chr(27)`
Roland Chastain
Posts: 858
Joined: Nov 24, 2011 19:49
Location: France
Contact:

### Re: Dry Christmas.

badidea wrote:Yes, 3d would be better, but for now, I converted it to a snowflake generator:

Beautiful. Thank you for sharing.
dafhi
Posts: 1329
Joined: Jun 04, 2005 9:51

### Re: Dry Christmas.

love the snowflake especially but this whole thread is great.
Tourist Trap
Posts: 2817
Joined: Jun 02, 2015 16:24

### happy 20_20 folk!

It's about Christmas, so maybe not too a bad place to wish everyone here a happy 20_20 new (dry?) year.
Can't wander around here too much unfortunately! Happy anyway to pass a head and listen to the breeze of the fb forum. Don't know if chineese have or not definitely settled down around. The forum is up so I guess not yet :)