Dry Christmas.

General discussion for topics related to the FreeBASIC project or its community.
Post Reply
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Dry Christmas.

Post by dodicat »

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)
        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: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Dry Christmas.

Post by Roland Chastain »

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

Re: Dry Christmas.

Post by jj2007 »

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

Re: Dry Christmas.

Post by Xusinboy Bekchanov »

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

Re: Dry Christmas.

Post by deltarho[1859] »

dodicat wrote:No liquor for me this Christmas
No doubt that will not be the case during Hogmanay. Image

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

Re: Dry Christmas.

Post by MrSwiss »

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: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Dry Christmas.

Post by grindstone »

@dodicat: Nice work!

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

Re: Dry Christmas.

Post by UEZ »

@all: Merry Christmas

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

Re: Dry Christmas.

Post by Lost Zergling »

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

Re: Dry Christmas.

Post by badidea »

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: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Dry Christmas.

Post by BasicCoder2 »

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
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Dry Christmas.

Post by badidea »

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: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Dry Christmas.

Post by Roland Chastain »

badidea wrote:Yes, 3d would be better, but for now, I converted it to a snowflake generator:
Beautiful. Thank you for sharing.
dafhi
Posts: 1641
Joined: Jun 04, 2005 9:51

Re: Dry Christmas.

Post by dafhi »

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

happy 20_20 folk!

Post by Tourist Trap »

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 :)
Post Reply