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.

Postby dodicat » Dec 25, 2019 19:31

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

Re: Dry Christmas.

Postby Roland Chastain » Dec 25, 2019 22:43

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.

Postby jj2007 » Dec 26, 2019 0:07

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.

Postby Xusinboy Bekchanov » Dec 26, 2019 1:52

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

Re: Dry Christmas.

Postby deltarho[1859] » Dec 26, 2019 10:40

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: 3369
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Dry Christmas.

Postby MrSwiss » Dec 26, 2019 13:15

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.

Postby grindstone » Dec 26, 2019 13:48

@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.

Postby UEZ » Dec 26, 2019 16:51

@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.

Postby Lost Zergling » Dec 27, 2019 21:38

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

Re: Dry Christmas.

Postby badidea » Dec 27, 2019 23:48

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.

Postby BasicCoder2 » Dec 28, 2019 0:15

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

Re: Dry Christmas.

Postby badidea » Dec 28, 2019 1:06

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.

Postby Roland Chastain » Dec 28, 2019 20:06

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.

Postby dafhi » Dec 28, 2019 22:52

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

happy 20_20 folk!

Postby Tourist Trap » Jan 03, 2020 17:50

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

Return to “Community Discussion”

Who is online

Users browsing this forum: MSN [Bot] and 2 guests