## 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 Type

Type d2
As Single mx,my
As Single mw,dy
End 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 x
End Sub

Dim As d2 b(1 To 10),b2(1 To 5)
#define Intrange(f,l) Int(Rnd*(((l)+1)-(f))+(f))
Randomize 2
For 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)
Next

Type float As V3

Type 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 Angle3D
End Type

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

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

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

Function 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)
createpolygon(p(),420,250,100,cx,cy)

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)
createpolygon(p(),420,250,100,cx,cy)

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: 157
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: 3369
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.141592654

type sgl2d
as single x, y
declare constructor
declare constructor(x as single, y as single)
end type

constructor sgl2d
end constructor

constructor sgl2d(x as single, y as single)
this.x = x : this.y = y
end constructor

const SCR_W = 800, SCR_H = 600

screenres SCR_W, SCR_H, 32

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 function

type 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 type

sub 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 = c
end sub

sub 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 -= 1
end sub

dim as tree_type tree
dim 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)

sleep
BasicCoder2
Posts: 3477
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.141592654

type sgl2d
as single x, y
declare constructor
declare constructor(x as single, y as single)
end type

constructor sgl2d
end constructor

constructor sgl2d(x as single, y as single)
this.x = x : this.y = y
end constructor

const SCR_W = 800, SCR_H = 600

screenres SCR_W, SCR_H, 32
color 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 function

type 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 type

sub 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 = c
end sub

sub 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 -= 1
end sub

dim as tree_type tree
dim as sgl2d startPos

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, 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,y

for 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 if
next i

sleep
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.141592654

type sgl2d
as single x, y
declare constructor
declare constructor(x as single, y as single)
end type

constructor sgl2d
end constructor

constructor sgl2d(x as single, y as single)
this.x = x : this.y = y
end constructor

const SCR_W = 800, SCR_H = 600

screenres SCR_W, SCR_H, 32

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 function

union rgba_union
value as ulong
type
as ubyte b, g, r, a
end type
end union

sub clearScreen()
dim as integer w, h, pitch, xi, yi
ScreenInfo w, h, , , pitch
line(0, 0) - (w-1, h-1), 0, bf
end sub

type 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 type

sub 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 = c
end sub

sub 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 -= 1
end sub

dim as tree_type tree
dim 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 timer
dim as string key
do
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 500
loop 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 :)