## Simple 3D Starfield build 2020-09-03

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

### Re: Simple 3D Starfield build 2020-09-01

Thanks dafhi.
This is a very primitive field with a quick gas cloud. (static)

Code: Select all

`'nebulaConst back=Rgb(0,0,0)Const f=0.03Dim Shared As Integer xres,yres,mx,my#macro setP(z)p(0)=zp(1)=Point(x,y-1,i)p(2)=Point(x+1,y,i)p(3)=Point(x,y+1,i)p(4)=Point(x-1,y,i)#endmacro#macro setCr+=Cast(Ubyte Ptr,@p(n))[2]g+=Cast(Ubyte Ptr,@p(n))[1]b+=Cast(Ubyte Ptr,@p(n))[0]a+=Cast(Ubyte Ptr,@p(n))[3]#endmacroSub inc(i As Long,Byref col As Ulong)    Static As Long k=1    Var r=Cast(Ubyte Ptr,@col)[2]    Var g=Cast(Ubyte Ptr,@col)[1]    Var b=Cast(Ubyte Ptr,@col)[0]    Var a=Cast(Ubyte Ptr,@col)[3]    Select Case i    Case 0        If r>255 Or r<0 Then k=-k        r+=k        col= Rgba(r,g,b,a)       Case 1        If g>255 Or g<0 Then k=-k        g+=k        col= Rgba(r,g,b,a)    Case 2        If b>255 Or b<0 Then k=-k        b+=k        col= Rgba(r,g,b,a)    Case 3        If a>255 Or a<0 Then k=-k        a+=k        col= Rgba(r,g,b,a)       End SelectEnd SubSub merge(Byref c As Ulong,x As Long,y As Long,i As Any Ptr)    Static As Long p(0 To 4)    Var r=0,g=0,b=0,a=0,z=0    setP(c)    For n As Long=0 To 4        If p(n)<>back Then            setC            z+=1        End If    Next    If z Then c=Rgba(r\z,g\z,b\z,a\z)End SubSub filter(i As Any Ptr,n As Long)    Dim As Integer ix,iy    Imageinfo i,ix,iy    Dim As Long p(0 To 4)    Dim As Long k,x,y,r,g,b,a    For k =1 To n        For x =1 To ix-2            For y =1 To iy-2                r=0:g=0:b=0:a=0                setP(Point(x,y,i))                For n As Long=0 To 4                    setC                Next                Pset i,(x,y),Rgba(r\5,g\5,b\5,a\5)                            Next y        Next x    Next kEnd SubSub nebula(c As Ulong,x As Long,y As Long,lim As Long,i As Any Ptr)    #define Intrange(f,l) Int(Rnd*((l+1)-(f)))+(f)    #define offscreenx(n) n<10 Or n> (xres -10 )    #define offscreeny(n) n<10 Or n> (yres -10)    #macro increment    Select Case k    Case 1:inc(0,c)    Case 2:inc(1,c)    Case 3:inc(2,c)    Case 4:inc(3,c)    End Select    count+=1    #endmacro        Dim As Long count    Do        Var k=intrange(1,4)        Select Case k        Case 1            Var k=intrange(1,4)            increment            If offscreeny((y-1))Then y=intrange(10,760)            If Rnd<f Then  merge(c,x,y-1,i)            Pset i,(x,y-1),c            y=y-1        Case 2             Var k=intrange(1,4)             increment            If offscreenx((x+1)) Then x=intrange(10,1000)            If Rnd<f Then merge(c,x+1,y,i)            Pset i,(x+1,y),c            x=x+1        Case 3             Var k=intrange(1,4)            increment            If offscreeny((y+1)) Then y=intrange(10,760)            If Rnd<f Then  merge(c,x,y+1,i)            Pset i,(x,y+1),c            y=y+1        Case 4             Var k=intrange(1,4)            increment            If offscreenx((x-1)) Then x=intrange(10,1000)            If Rnd<f Then  merge(c,x-1,y,i)            Pset i,(x-1,y),c            x=x-1        End Select    Loop Until count > limEnd Sub'  end nebula#define lim 2000#define Irange(f,l) Int(Rnd*((l+1)-(f)))+(f)#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)#define startrange Type(irange(-xres,xres*2),irange(-yres,yres*2),irange(0,10000))Type Point    As Single x,y,zEnd TypeType Line    As Point p(1 To 2)    Declare Function perspective() As Line    Declare Sub advance(As Single)    Declare Sub Draw    Declare Constructor(As Point)End TypeConstructor Line(x As Point)p(1)=x:p(2)=p(1)p(2).z=p(1).z+50End ConstructorFunction perspective(p As Point,eyepoint As Point) As Point    Dim As Single   w=1+(p.z/eyepoint.z)    Return Type((p.x-eyepoint.x)/w+eyepoint.x,_    (p.y-eyepoint.y)/w+eyepoint.y,_    (p.z-eyepoint.z)/w+eyepoint.z)End FunctionFunction line.perspective() As Line    Dim As Line x=Any    x.p(1)=..perspective(this.p(1),Type<Point>(mx,my,1000))    x.p(2)=..perspective(this.p(2),Type<Point>(mx,my,1000))    Return xEnd FunctionSub line.advance(dz As Single)    p(1).z-=dz    p(2).z-=dzEnd SubSub line.draw    Static As Single max,min    If min>p(1).z Then min=p(1).z    If max<p(1).z Then max=p(1).z    Dim As Ubyte u=map(min,max,p(1).z,255,100)    Line(p(1).x,p(1).y)-(p(2).x,p(2).y),Rgba(255,255,255,u)End SubFunction Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long    Static As Double timervalue,_lastsleeptime,t3,frames    Var t=Timer    frames+=1    If (t-t3)>=1 Then t3=t:fps=frames:frames=0    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000    If sleeptime<1 Then sleeptime=1    _lastsleeptime=sleeptime    timervalue=T    Return sleeptimeEnd Function'--------------------------Dim As Line L(1 To lim)=AnyRandomizeScreeninfo xres,yresScreenres .9*xres,.9*yres,32,,64width .9*xres\8,.9*yres\16Screeninfo xres,yresDim As Any Ptr i=Imagecreate(xres,yres,back)Dim As Ulong c=Rgba(100,100,100,100)nebula(c,xres\2,yres\2,2000000,i)filter(i,4)For n As Long=1 To lim     L(n)=Line(startrange)Nextmx=xres\2:my=yres\2Dim As Long fpsDo    Screenlock    Cls    Put(0,0),i,Pset    Draw String (1,1),"Framerate "&fps    For n As Long=1 To lim        L(n).advance(16)        Var tmp=L(n).perspective()        tmp.draw        If L(n).p(1).z<-950 Then  L(n)=Line(startrange)    Next n    Screenunlock    Sleep regulate(80,fps)Loop Until Inkey=Chr(27)Imagedestroy i `
UEZ
Posts: 635
Joined: May 05, 2017 19:59
Location: Germany

### Re: Simple 3D Starfield build 2020-09-01

dodicat wrote:This is a very primitive field with a quick gas cloud. (static)

This looks also very beautiful - it is more discreet in the background. I like it.

Thanks for sharing it. :-)
dafhi
Posts: 1361
Joined: Jun 04, 2005 9:51

### Re: Simple 3D Starfield build 2020-09-03

my defocus aadot doesn't play nicely with the other kids
[update: yes it does]

clevv new nebula .. without filter, technique becomes apparent