love it.
I changed the loop end to 358. 360 in these formulas result in a duplicate of points at 0
Squares
Re: Squares
Here's formula 5 "Egg Noodle"
And "Dumbell"
Code: Select all
if WhichFormula = 5 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*c1*c2/1.25
y1=radius*s1*c2/1.25
z1=radius*atan2(c1,s1)/1.25
MacroHSV(y1,x1,z1)
End If
Code: Select all
if WhichFormula = 6 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*atn(s1*c1/c2/c2)/1.25
y1=radius*atn(s1*c2*s2*4 )/1.25
z1=radius*(atan2(c1*c2,c2*s2))/1.25
MacroHSV(y1,x1,z1)
End If
Re: Squares
I forgot:
and main:
Code: Select all
MacroHSV(y1,x1,z1)
End If
#EndMacro
const num_formulas = 6
Code: Select all
if (morph>1) then
if (cloud(index_a)->modify=0) then
curr_formula += 1
If curr_formula > num_formulas Then curr_formula = 0
cloud(index_a)->modify=1
cloud(index_a)->modify_vertex=cloud(index_a)->first_cloud_vertex
cloud(index_a)->modify_count=0
Re: Squares
Heres what I got for formulas so far.. total of 8
=====================================================================================
What I've noticed is that the farther the z axis the bigger it gets instead of smaller on the far z.
Is there a quick fix for that ??? maybe a var switch..
Code: Select all
#Macro Formulas()
if WhichFormula = 0 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad1*c1)
s2=sin(deg2*rad1*c1)
x1=radius*c1
y1=radius*s1
x2=radius*c2*cos(deg2*rad1*c1/s1)
y2=radius*s2*sin(deg2*rad1*s1/c1)
z1=radius*c1*s2*atn(deg2*rad1*c2/s2)
MacroHSV(y1+y2,x1+x2,z1)
end If
if WhichFormula = 1 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad1*c1)
s2=sin(deg2*rad1*c1)
x1=radius*c1
y1=radius*s1
x2=radius*c2*cos(deg2*rad1*c1*.1)*atn(deg2^2*rad1*c2^2)*cos(log(deg2))
y2=radius*s2*sin(deg2*rad1*s1*.1)*atn(deg2^2*rad1*s2^2)*sin(log(deg2))
z1=radius*c1*s2*cos(deg2*rad1*c2*s2)
MacroHSV(y1+y2,x1+x2,z1)
end If
if WhichFormula = 2 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad1*c1)
s2=sin(deg2*rad1*c1)
x1=radius*c1*cos(deg2*rad1*c2*.1)*atn(deg2*rad1*c2^2)
y1=radius*s1*sin(deg2*rad1*s2*.1)*atn(deg2*rad1*s2^2)
x2=radius*c2*cos(deg2*rad1*c1*.1)*atn(deg2*rad1*c2^2)
y2=radius*s2*sin(deg2*rad1*s1*.1)*atn(deg2*rad1*s2^2)
z1=radius*c1+s2*cos(deg1*deg2*rad1)
MacroHSV(y1+y2,x1+x2,z1)
end If
if WhichFormula = 3 then
rad2 = atn(1) / 22.5
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*c1
y1=radius*s1
x2=radius*s2*log(deg2*rad1*s2)*atn(deg2*rad1*s2/s1)*atn(deg2*rad2*c1*s1*c2)*sin(deg2/(s1*c1*s1*c1)*rad1*rad1)
y2=radius*c2*log(deg2*rad1*c2)*atn(deg2*rad1*c2/c1)*atn(deg2*rad2*c1*s1*c2)*sin(deg2/(s1*c1*s1*c1)*rad1*rad1)
z1=radius*c2+s1
MacroHSV(y1+y2,x1+x2,z1)
End If
if WhichFormula = 4 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*atan2( tan(c2+c2),tan(c1+c1)/2 )/2
y1=radius*atan2( tan(s2+s2),tan(s1+s1)/2 )/2
z1=radius*(cos(c1+s1))
MacroHSV(y1,x1,z1)
End If
if WhichFormula = 5 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*c1*c2/1.25
y1=radius*s1*c2/1.25
z1=radius*atan2(c1,s1)/1.25
MacroHSV(y1,x1,z1)
End If
if WhichFormula = 6 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*atn(s1*c1/c2/c2)/1.5
y1=radius*atn(s1*c2*s2*4 )/1.5
z1=radius*(atan2(c1*c2,c2*s2))/1.5
MacroHSV(y1,x1,z1)
End If
if WhichFormula = 7 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*cos(deg2*c1+c2)
y1=radius*sin(deg2*s1+s2)
z1=radius*cos(deg1*c1+s1)
MacroHSV(y1,x1,z1)
End If
if WhichFormula = 8 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*atn(c1+c2/s1)/2
y1=radius*atn(s1+s2/c1)/2
z1=radius*atan2(tan(c1*c2)/c1,tan(s1*s2)/c1)/2
MacroHSV(y1,x1,z1)
End If
#EndMacro
What I've noticed is that the farther the z axis the bigger it gets instead of smaller on the far z.
Is there a quick fix for that ??? maybe a var switch..
Re: Squares
I changed the end of line 174 from SHR 8 to SHR 4 ,
it makes a candy colored bullseye on each formula..
it makes a candy colored bullseye on each formula..
Code: Select all
const MaxFormula=9 ' modify this if you add or subract formulas
#Macro Formulas()
if WhichFormula = 0 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad1*c1)
s2=sin(deg2*rad1*c1)
x1=radius*c1
y1=radius*s1
x2=radius*c2*cos(deg2*rad1*c1/s1)
y2=radius*s2*sin(deg2*rad1*s1/c1)
z1=radius*c1*s2*atn(deg2*rad1*c2/s2)
MacroHSV(y1+y2,x1+x2,z1)
end If
if WhichFormula = 1 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad1*c1)
s2=sin(deg2*rad1*c1)
x1=radius*c1
y1=radius*s1
x2=radius*c2*cos(deg2*rad1*c1*.1)*atn(deg2^2*rad1*c2^2)*cos(log(deg2))
y2=radius*s2*sin(deg2*rad1*s1*.1)*atn(deg2^2*rad1*s2^2)*sin(log(deg2))
z1=radius*c1*s2*cos(deg2*rad1*c2*s2)
MacroHSV(y1+y2,x1+x2,z1)
end If
if WhichFormula = 2 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad1*c1)
s2=sin(deg2*rad1*c1)
x1=radius*c1*cos(deg2*rad1*c2*.1)*atn(deg2*rad1*c2^2)
y1=radius*s1*sin(deg2*rad1*s2*.1)*atn(deg2*rad1*s2^2)
x2=radius*c2*cos(deg2*rad1*c1*.1)*atn(deg2*rad1*c2^2)
y2=radius*s2*sin(deg2*rad1*s1*.1)*atn(deg2*rad1*s2^2)
z1=radius*c1+s2*cos(deg1*deg2*rad1)
MacroHSV(y1+y2,x1+x2,z1)
end If
if WhichFormula = 3 then
rad2 = atn(1) / 22.5
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*c1
y1=radius*s1
x2=radius*s2*log(deg2*rad1*s2)*atn(deg2*rad1*s2/s1)*atn(deg2*rad2*c1*s1*c2)*sin(deg2/(s1*c1*s1*c1)*rad1*rad1)
y2=radius*c2*log(deg2*rad1*c2)*atn(deg2*rad1*c2/c1)*atn(deg2*rad2*c1*s1*c2)*sin(deg2/(s1*c1*s1*c1)*rad1*rad1)
z1=radius*c2+s1
MacroHSV(y1+y2,x1+x2,z1)
End If
if WhichFormula = 4 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*atan2( tan(c2+c2),tan(c1+c1)/2 )/2
y1=radius*atan2( tan(s2+s2),tan(s1+s1)/2 )/2
z1=radius*(cos(c1+s1))
MacroHSV(y1,x1,z1)
End If
if WhichFormula = 5 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*c1*c2/1.25
y1=radius*s1*c2/1.25
z1=radius*atan2(c1,s1)/1.25
MacroHSV(y1,x1,z1)
End If
if WhichFormula = 6 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*atn(s1*c1/c2/c2)/1.5
y1=radius*atn(s1*c2*s2*4 )/1.5
z1=radius*(atan2(c1*c2,c2*s2))/1.5
MacroHSV(y1,x1,z1)
End If
if WhichFormula = 7 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*cos(deg2*c1+c2)
y1=radius*sin(deg2*s1+s2)
z1=radius*cos(deg1*c1+s1)
MacroHSV(y1,x1,z1)
End If
if WhichFormula = 8 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*atn(c1+c2/s1)/2
y1=radius*atn(s1+s2/c1)/2
z1=radius*atan2(tan(c1*c2)/c1,tan(s1*s2)/c1)/2
MacroHSV(y1,x1,z1)
End If
if WhichFormula = 9 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*cos(c1+c2^2/s1)*1.25
y1=radius*sin(s1+s2^2/c1)*1.25
z1=radius*c2+s1
MacroHSV(y1,x1,z1)
End If
#EndMacro
' =========================================
#Ifndef UnionARGB
Union UnionARGB
Type
As UByte B
As UByte G
As UByte R
As UByte A
End Type
As UInteger ARGB
End Union
#EndIf
Type HSVTYPE
Val8 As UByte
Sat8 As UByte
'' Red Yellow Green Cyan Blue Magenta Red
'' 0 255 510 765 1020 1275 1530
Hue16 As Short
End Type
#Macro zHSV2RGB(pCompA,pCompB,pMeas_)
If mHue < pMeas_ Then
pCompA = mValue
pCompB = mValue - mSatu * (pMeas_ - mHue) / 255&
Else
pCompA = mValue - mSatu * (mHue - pMeas_) / 255&
pCompB = mValue
End If
#EndMacro
Function HSVTYPE_To_UARGB(ByRef pSrc As HSVTYPE) As UnionARGB
Dim As Integer HueDiv = pSrc.Hue16 / 1530&
Dim As Integer mHue = pSrc.Hue16 - 1530& * HueDiv
Dim As Integer mValue = pSrc.Val8
Dim As Integer mSatu = pSrc.Sat8
mSatu *= mValue
mSatu /= 255&
Dim As UnionARGB uARGB=Any
If mHue < 511& Then
uARGB.B = mValue - mSatu
zHSV2RGB(uARGB.R, uARGB.G, 255&)
ElseIf mHue < 1021& Then
uARGB.R = mValue - mSatu
zHSV2RGB(uARGB.G, uARGB.B, 765&)
Else
uARGB.G = mValue - mSatu
zHSV2RGB(uARGB.B, uARGB.R, 1275&)
End If
Return uARGB
End Function
#Macro Alpha256(ret,back, fore, am, a256)
ret=((_
(fore And &Hff00ff) * a256 + _
(back And &Hff00ff) * am + &H800080) And &Hff00ff00 Or (_
(fore And &H00ff00) * a256 + _
(back And &H00ff00) * am + &H008000) And &H00ff0000) Shr 4 'albert CHANGED from SHR 8 to SHR 4
#EndMacro
' ========================================
Const pi=3.14159265
function cs(byval deg as single)as single
function=cos(deg/180.0*pi)
end function
function sn(byval deg as single)as single
function=sin(deg/180.0*pi)
end function
type gfx_buffer
wwidth as integer
height as integer
pixels as uinteger ptr
end type
function create_gfx_buffer(byval wwidth as integer,_
byval height as integer)as gfx_buffer ptr
dim as gfx_buffer ptr buffer=new gfx_buffer
buffer->wwidth=wwidth
buffer->height=height
buffer->pixels=new uinteger[wwidth*height]
function=buffer
end function
function create_gfx_display(byval wwidth as integer,_
byval height as integer)as gfx_buffer ptr
screenres wwidth,height,32,2,8
ScreenSet 0,1
dim as gfx_buffer ptr buffer=new gfx_buffer
buffer->wwidth=wwidth
buffer->height=height
buffer->pixels=screenptr()
function=buffer
end function
sub set_pixel(byval buffer as gfx_buffer ptr,_
byval x as integer,_
byval y as integer,_
byval argb as uinteger)
if (y>=0)and(y<buffer->height)and(x>=0)and(x<buffer->wwidth) then
buffer->pixels[x+y*buffer->wwidth]=argb
end if
end sub
function get_pixel(byval buffer as gfx_buffer ptr,_
byval x as integer,_
byval y as integer)as uinteger
dim as uinteger argb
if (y>=0)and(y<buffer->height)and(x>=0)and(x<buffer->wwidth) then
argb=buffer->pixels[x+y*buffer->wwidth]
end if
function=argb
end function
sub clear_gfx_buffer(byval buffer as gfx_buffer ptr,_
byval argb as uinteger=0)
asm
mov eax,dword ptr[buffer]
mov edi,dword ptr[eax+offsetof(gfx_buffer,pixels)]
mov ecx,dword ptr[eax+offsetof(gfx_buffer,wwidth)]
imul ecx,dword ptr[eax+offsetof(gfx_buffer,height)]
mov eax,dword ptr[argb]
rep stosd
end asm
end sub
sub draw_gfx_buffer(byval dst as gfx_buffer ptr,_
byval src as gfx_buffer ptr,_
byval dst_x as integer,_
byval dst_y as integer)
dim as integer x_start=dst_x,x_end=dst_x+src->wwidth-1
if x_start<0 then x_start=0
if x_end>=dst->wwidth then x_end=dst->wwidth-1
dim as integer y_start=dst_y,y_end=dst_y+src->height-1
if y_start<0 then y_start=0
if y_end>=dst->height then y_end=dst->height-1
dim as uinteger ptr p_start=dst->pixels+x_start+y_start*dst->wwidth
dim as uinteger ptr source=src->pixels+(x_start-dst_x)+(y_start-dst_y)*src->wwidth
while y_start<=y_end
asm
mov edi,dword ptr[p_start]
mov esi,dword ptr[source]
mov ecx,dword ptr[x_end]
sub ecx,dword ptr[x_start]
inc ecx
rep movsd
end asm
source+=src->wwidth
p_start+=dst->wwidth
y_start+=1
wend
end sub
Type rotation_axis '' added by dafhi
x as single
y as single
z as Single
ux0 as Single=1.0
uy0 as single
uz0 as single
ux1 as single
uy1 as Single=1.0
uz1 as single
ux2 as single
uy2 as single
uz2 as Single=1.0
Declare Sub scale_to(ByRef dest As rotation_axis, ByVal scalar As Single = 1.0)
End Type
Sub rotation_axis.scale_to(ByRef dest As rotation_axis, ByVal scalar As Single)
dest.x = x
dest.y = y
dest.z = z
dest.ux0 = ux0 * scalar
dest.uy0 = uy0 * scalar
dest.uz0 = uz0 * scalar
dest.ux1 = ux1 * scalar
dest.uy1 = uy1 * scalar
dest.uz1 = uz1 * scalar
dest.ux2 = ux2 * scalar
dest.uy2 = uy2 * scalar
dest.uz2 = uz2 * scalar
End Sub
Type cloud_vertex
x as single
y as single
z as Single
col_ As UnionARGB '' added by dafhi
next_cloud_vertex as cloud_vertex ptr
end Type
Type vertex_cloud
axis As rotation_axis '' added by dafhi
As single color_scale
As Single hueMul
As Single hueBase
As Single valMul
As Single valBase
As Single satMul
As Single satBase
first_cloud_vertex as cloud_vertex ptr
modify_vertex as cloud_vertex ptr
modify_count as integer
modify as integer
end type
function create_vertex_cloud()as vertex_cloud ptr
dim as vertex_cloud ptr cloud=new vertex_cloud
function=cloud
end function
sub add_cloud_vertex(byval cloud as vertex_cloud ptr,_
byval x as single,_
byval y as single,_
byval z as Single,_
ByVal col_ As UnionARGB)
dim as cloud_vertex ptr vertex=new cloud_vertex
vertex->next_cloud_vertex=cloud->first_cloud_vertex
cloud->first_cloud_vertex=vertex
vertex->x=x
vertex->y=y
vertex->z=z
vertex->col_ = col_ '' added by dafhi
end sub
Sub draw_morph_clouds(byval buffer as gfx_buffer ptr,_
byval cloud0 as vertex_cloud ptr,_
byval cloud1 as vertex_cloud ptr,_
byval morph as Single,_
ByRef axis As rotation_axis) '' added by dafhi
dim as cloud_vertex ptr vertex0=cloud0->first_cloud_vertex
dim as cloud_vertex ptr vertex1=cloud1->first_cloud_vertex
dim as Integer ww=buffer->wwidth,cx=ww*.5
dim as Integer cy=buffer->height shr 1
Dim As Integer y1 = -cy, x1 = -cx
Dim As Integer y2 = y1 + buffer->height
Dim As Integer x2 = x1 + buffer->wwidth
Dim As Integer a256 = morph * 256, a256m = 256 - a256
While vertex0<>0
Dim as single mx=vertex0->x + (vertex1->x-vertex0->x)*morph
Dim as single my=vertex0->y + (vertex1->y-vertex0->y)*morph
Dim as single mz=vertex0->z + (vertex1->z-vertex0->z)*morph
dim as single rz=(axis.z+axis.ux2*mx+axis.uy2*my+axis.uz2*mz)
If rz>0.1 Then
rz = ww/rz
Dim as Integer y=-rz*(axis.y+axis.ux1*mx+axis.uy1*my+axis.uz1*mz)
If (y>=y1) Then
If (y< y2) Then
y += cy
dim as Integer x=rz*(axis.x+axis.ux0*mx+axis.uy0*my+axis.uz0*mz)
If (x>=x1) Then
If (x< x2) Then
x += cx
Alpha256( buffer->pixels[x+y*buffer->wwidth],_
vertex0->col_.argb,_
vertex1->col_.argb,_
a256m, a256 )
EndIf
EndIf
EndIf
EndIf
End If
vertex1=vertex1->next_cloud_vertex
vertex0=vertex0->next_cloud_vertex
Wend
End Sub
Sub draw_vertex_cloud(byval buffer as gfx_buffer ptr,_
byval cloud as vertex_cloud Ptr,_
ByRef axis As rotation_axis)
dim as cloud_vertex ptr vertex=cloud->first_cloud_vertex
dim as single ww=buffer->wwidth,cx=ww*.5
dim as single cy=buffer->height shr 1
while vertex<>0
dim as single rz=(axis.z+axis.ux2*vertex->x+axis.uy2*vertex->y+axis.uz2*vertex->z)
if rz>0.0 Then
rz=ww/rz
dim as single ry=axis.y+axis.ux1*vertex->x+axis.uy1*vertex->y+axis.uz1*vertex->z
dim as Integer y=cy-rz*ry
if (y>=0) Then
if(y<buffer->height) Then
dim as single rx=axis.x+axis.ux0*vertex->x+axis.uy0*vertex->y+axis.uz0*vertex->z
dim as Integer x=cx+rz*rx
If(x>=0) Then
If(x<buffer->wwidth) Then
buffer->pixels[x+y*buffer->wwidth]=vertex->col_.argb
EndIf
EndIf
EndIf
EndIf
EndIf
vertex=vertex->next_cloud_vertex
wend
end Sub
#Macro rot_turn_dims(a,b,c)
dim csa as single=cs((a))
dim sna as single=sn((a))
dim csb as single=cs((b))
dim snb as single=sn((b))
dim csc as single=cs((c))
dim snc as single=sn((c))
dim x as single
dim y as single
dim z as single
#EndMacro
Sub rotate_axis(ByRef axis As rotation_axis,_
byval b as single,_
byval a as single,_
byval c as single)
rot_turn_dims(a,b,-c)
x=axis.ux0*csa+axis.ux2*sna
z=axis.ux2*csa-axis.ux0*sna
axis.ux2=z*csb+axis.ux1*snb
y=axis.ux1*csb-z*snb
axis.ux0=x*csc+y*snc
axis.ux1=y*csc-x*snc
x=axis.uy0*csa+axis.uy2*sna
z=axis.uy2*csa-axis.uy0*sna
axis.uy2=z*csb+axis.uy1*snb
y=axis.uy1*csb-z*snb
axis.uy0=x*csc+y*snc
axis.uy1=y*csc-x*snc
x=axis.uz0*csa+axis.uz2*sna
z=axis.uz2*csa-axis.uz0*sna
axis.uz2=z*csb+axis.uz1*snb
y=axis.uz1*csb-z*snb
axis.uz0=x*csc+y*snc
axis.uz1=y*csc-x*snc
End Sub
Sub rotate_vertex_cloud(byval cloud as vertex_cloud pointer,_
byval b as single,_
byval a as single,_
byval c as single)
rotate_axis(cloud->axis,b,a,c)
End Sub
Sub turn_axis(ByRef axis As rotation_axis,_
byval b as single,_
byval a as single,_
byval c as single)
rot_turn_dims(-a,-b,c)
x=axis.ux0*csa+axis.uz0*sna
z=axis.uz0*csa-axis.ux0*sna
axis.uz0=z*csb+axis.uy0*snb
y=axis.uy0*csb-z*snb
axis.ux0=x*csc+y*snc
axis.uy0=y*csc-x*snc
x=axis.ux1*csa+axis.uz1*sna
z=axis.uz1*csa-axis.ux1*sna
axis.uz1=z*csb+axis.uy1*snb
y=axis.uy1*csb-z*snb
axis.ux1=x*csc+y*snc
axis.uy1=y*csc-x*snc
x=axis.ux2*csa+axis.uz2*sna
z=axis.uz2*csa-axis.ux2*sna
axis.uz2=z*csb+axis.uy2*snb
y=axis.uy2*csb-z*snb
axis.ux2=x*csc+y*snc
axis.uy2=y*csc-x*snc
End Sub
sub turn_vertex_cloud(byval cloud as vertex_cloud pointer,_
byval b as single,_
byval a as single,_
byval c as single)
turn_axis(cloud->axis,b,a,c)
End sub
Sub create_cloud_choice(ByVal cloud As vertex_cloud Ptr, ByVal WhichFormula As Integer)'as vertex_cloud ptr
Const TwoPi = 8 * Atn(1)
#Macro MacroHSV(x_,y_,z_)
Dim As Integer x = (x_)
Dim As Integer y = (y_)
Dim As Integer z = (z_)
Dim As Single sx = cloud->color_scale*x
Dim As Single sy = cloud->color_scale*y
Dim As Single sz = cloud->color_scale*z
Dim As Single dist = Sqr(sx*sx + sy*sy + sz*sz)
tHSV.Hue16 = 210 * Sin(dist*cloud->hueMul + cloud->hueBase)
tHSV.Val8 = 185 + 70 * Sin(dist*cloud->valMul + cloud->valBase)
tHSV.Sat8 = 155 + 100 * Sin(dist*cloud->satMul - cloud->satBase)
Dim As integer hide_point
#Macro Constrain(val_, max)
If val_ < -(max) Then hide_point = 1
If val_ > max Then hide_point = 1
#EndMacro
Constrain(x, xyz_limit)
Constrain(y, xyz_limit)
Constrain(z, xyz_limit)
If hide_point = 1 Then
Dim As Single a_ = Rnd * TwoPi
Dim As Single u = 2*(Rnd-0.5) ''http://demonstrations.wolfram.com/RandomPointsOnASphere/
Dim As Single z = u
u *= u
u = 1 - u
u = Sqr(u) * sphere_shell
y = Sin(a_)*u
x = Cos(a_)*u
z *= sphere_shell
tHSV.Val8 = 0
EndIf
cloud->modify_vertex->x=x
cloud->modify_vertex->y=y
cloud->modify_vertex->z=z
cloud->modify_vertex->col_=HSVTYPE_To_UARGB(tHSV)
cloud->modify_vertex=cloud->modify_vertex->next_cloud_vertex
Next
#EndMacro
If cloud->modify_count = 0 Then
cloud->color_scale = 0.0003 * (0.5 + Rnd)
cloud->hueMul = 2.5 + Rnd * 4
cloud->hueBase = Rnd * 2*pi
cloud->valMul = 6 + Rnd * 17
cloud->valBase = Rnd * 2*pi
cloud->satMul = 18 + Rnd * 15
cloud->satBase = Rnd * 2*pi
End If
Dim As HSVTYPE tHSV
dim as single xctr = 0' 640/2
dim as single yctr = 0' 480/2
dim as single radius = 150
Dim As Single xyz_limit = radius * 20
Dim As Single sphere_shell = radius * 2
dim as single deg1,deg2
dim as single c1,c2
dim as single s1,s2
dim as single x1,x2
dim as single y1,y2
dim as single z1
dim as single rad1 = atn(1) / 45
dim as single rad2 = atn(1) / 45
Dim As Integer inside_stop = 358
#Macro trig_slice()
for deg1=cloud->modify_count to cloud->modify_count+34 step 2
c1=cos(deg1*rad1)
s1=sin(deg1*rad1)
Formulas()
next
cloud->modify_count+=36
if cloud->modify_count=360 then cloud->modify=3
#EndMacro
If cloud->first_cloud_vertex = 0 Then
Dim As UnionARGB col_
for deg1 = 0 to 358 step 2
for deg2 = 0 to inside_stop step 2
add_cloud_vertex(cloud,0, 0 , 0, col_)
Next
Next
cloud->modify_vertex=cloud->first_cloud_vertex
For I As Integer = 1 To 10
trig_slice()
Next
Exit Sub
EndIf
trig_slice()
End Sub
Sub main
dim as integer xres,yres
screeninfo xres,yres
dim as gfx_buffer ptr display=create_gfx_display(xres,yres)
dim as vertex_cloud ptr cloud(0 to 1)
cloud(0)=create_vertex_cloud(): create_cloud_choice(cloud(0), 0)
cloud(1)=create_vertex_cloud(): create_cloud_choice(cloud(1), 1)
dim as gfx_buffer ptr buffer(0 to 1)
for i as integer=0 to 1
buffer(i)=create_gfx_buffer((display->wwidth) shr 1,(display->height) shr 1)
Next
Dim As rotation_axis axis: axis.z = 1000
Dim As rotation_axis axis_final
dim as integer index_a=0
dim as integer index_b=1
Dim As Single rot_speed = 0.5
Dim As Single move_speed = 1
dim as single x_dir = 0
Dim as single x_lim_r = +((xres/2)-300)
Dim as single x_lim_l = -((xres/2)-300)
dim as single y_dir = 0
Dim as single y_lim_u = +((yres/2)-200)
Dim as single y_lim_d = -((yres/2)-200)
Dim As Single seconds_per_morph = 1
Dim As Single wait_time = 5
Dim As Single morph_speed = 1 / (seconds_per_morph * 100)
Dim As Single morph_trig = 100 * (seconds_per_morph + wait_time) * morph_speed
Dim As Single morph
Dim As Single scale_val = 0.5
Dim As Integer curr_formula = 1
#Macro while_vtime()
Dim As double t_ = Timer
While t<t_
t+=0.01
#EndMacro
dim as double t=Timer
while inkey$<>chr(27)
clear_gfx_buffer(display)
Dim As Single morph_ = morph: If morph_ > 1 Then morph_ = 1
axis.scale_to(axis_final,scale_val)
draw_morph_clouds(display,cloud(index_a),cloud(index_b),morph_,axis_final)
Flip
while_vtime()
morph += morph_speed
rotate_axis(axis,.5,.5,.5)
turn_axis(axis,.1,.1,.1)
if x_dir = 0 then axis.x+=move_speed : If axis.x >= x_lim_r Then x_dir = 1
if x_dir = 1 then axis.x-=move_speed : If axis.x <= x_lim_l Then x_dir = 0
if y_dir = 0 then axis.y+=move_speed : If axis.y >= y_lim_u Then y_dir = 1
if y_dir = 1 then axis.y-=move_speed : If axis.y <= y_lim_d Then y_dir = 0
Wend
if (morph>1) then
if (cloud(index_a)->modify=0) then
curr_formula += 1
If curr_formula > MaxFormula Then curr_formula = 0
cloud(index_a)->modify=1
cloud(index_a)->modify_vertex=cloud(index_a)->first_cloud_vertex
cloud(index_a)->modify_count=0
end if
if (cloud(index_a)->modify=1) then
create_cloud_choice(cloud(index_a), curr_formula)
end if
end if
If morph >= morph_trig Then
cloud(index_a)->modify=0
swap index_b, index_a
morph -= morph_trig
End If
Sleep 1,1
Wend
end sub
main
END
Re: Squares
I changed Dim As rotation_axis axis: axis.z = 500
and the object appears closer. is that what you mean? Actually, it isn't. You mean point z. I'm working on a new "barebones" plotter, switching around some things. I think it'll fix what you're talking about. But keep in mind that if the axis is rotated a certain way, yes, positive z will move "toward" the viewer
and the object appears closer. is that what you mean? Actually, it isn't. You mean point z. I'm working on a new "barebones" plotter, switching around some things. I think it'll fix what you're talking about. But keep in mind that if the axis is rotated a certain way, yes, positive z will move "toward" the viewer
Re: Squares
@Dafhi
On the "cube" #7 and the "Temple" #4
The far back z axis spreads out farther than the front , but it only appears to do it every so many iterations.
On the "cube" #7 and the "Temple" #4
The far back z axis spreads out farther than the front , but it only appears to do it every so many iterations.
Re: Squares
I redid formula #9
Now it makes a cube instead of a chair leg protector..
Code: Select all
if WhichFormula = 9 then
for deg2 = 0 to inside_stop step 2
c2=cos(deg2*rad2)
s2=sin(deg2*rad2)
x1=radius*cos(deg2*rad2+(c1+c2)/tan(s1))*1.25
y1=radius*sin(deg2*rad2+(s1+s2)/tan(c1))*1.25
z1=radius*c2+s1
MacroHSV(y1,x1,z1)
End If
Re: Squares
Ah. I think it's a trick your brain is playing. Mine does the same. If you slowed the rotation, it would give our brains time to "aha."
Re: Squares
I got almost 500 formulas,
but some go way out to the sides , way off the screen.. And they are all 2d..
So I have to write 3D , z axis formulas for the ones that look cool.
but some go way out to the sides , way off the screen.. And they are all 2d..
So I have to write 3D , z axis formulas for the ones that look cool.
Re: Squares
excellent. I'm seeing progress on my new framework. dodicat's macro knowledge and Stonemonkey's super-clean code helps me simplify my own style
Code: Select all
#Ifndef FALSE
Const FALSE = 0
Const TRUE = not FALSE
#EndIf
type tFPUMODE '' http://www.freebasic.net/forum/viewtopic.php?f=3&t=20669#p181983
'' 0=nearest
'' 1=round down
'' 2=round up
'' 3=truncate
as integer original
declare sub set_rounding_mode(byval mode as integer)
declare sub restore:declare constructor:declare destructor
End Type
constructor tFPUMODE: dim as integer ori: asm fstcw [ori]
original=ori: set_rounding_mode 1: End Constructor
destructor tFPUMODE: restore
End Destructor
sub tFPUMODE.restore: set_rounding_mode(original): End Sub
Sub tFPUMODE.set_rounding_mode(byval mode as integer)
dim As integer ori: asm fstcw [ori]
mode=ori and &hf3ff or (mode and 3)shl 10: asm fldcw [mode]
end Sub
Type tFPS_Limiter
As String report
As Single target = 50.0, report_every = 1.0
As Single fps_low_limit = 0.05, sFPS,sSPF,secs_per_frame,target_prev
As Double time_delta,time_old,time_new,time_sum,fps_trig_next
As integer new_report,Frame_,fTurbo, Turbo = 1 '' Experimental .. for FPS > 999
Declare sub Tick(target_fps As Single = 0.0)
Declare Sub DecPlaces(pInput As Single, Places As UByte =1)
End Type
#Macro tImage_LimFPS_Init()
If target_fps = 0 Then: target_fps = target
Else: target = target_fps: EndIf
If target <> target_prev Then target_prev = target: secs_per_frame = 1 / target
If time_new = 0 Then time_new = Timer: fps_trig_next = time_new + secs_per_frame/2: Frame_ = -1
#EndMacro
#Macro FPS_CALC()
Frame_ += 1:time_sum += time_delta:new_report = 0
If time_sum >= report_every Then
sSPF = time_sum / Frame_:sFPS = Frame_ / time_sum
DecPlaces( Int(sFPS*10 + 0.5) / 10, 1 )
Frame_ = 0: time_sum = 0: new_report = 1: EndIf
#EndMacro
Sub tFPS_Limiter.DecPlaces(pInput As Single, Places As UByte)
If Places > 5 Then Places = 5
report = Str( pInput )
For I As Integer = 0 To Len(report)-1
If report[I] = 46 Then report = Left(report,I+Places+1): Exit For
Next: report = Left( report + " ", 6 ): End Sub
Sub tFPS_Limiter.Tick(target_fps As Single)
tImage_LimFPS_Init()
time_old = time_new: time_new = Timer
time_delta = time_new - time_old
FPS_CALC()
If target_fps > fps_low_limit Then
If time_new < fps_trig_next Then
Sleep 1000 * (fps_trig_next - time_new): fps_trig_next += secs_per_frame
Else: If fTurbo = Turbo Then Sleep 1,1: fTurbo = 0
fTurbo += 1: fps_trig_next = secs_per_frame * Int(1.0+time_new / secs_per_frame)
End If
Else: Sleep 1,1 '' low fps target, just sleep 1
EndIf: Locate 1,1 ''print pos
End Sub
#Ifndef UnionARGB
Union UnionARGB
Type
As UByte B
As UByte G
As UByte R
As UByte A
End Type
As UInteger ARGB
End Union
#EndIf
Type HSVTYPE
Val8 As UByte
Sat8 As UByte
'' Red Yellow Green Cyan Blue Magenta Red
'' 0 255 510 765 1020 1275 1530
Hue16 As Short
End Type
#Macro zHSV2RGB(pCompA,pCompB,pMeas_)
If mHue < pMeas_ Then
pCompA = mValue
pCompB = mValue - mSatu * (pMeas_ - mHue) / 255&
Else
pCompA = mValue - mSatu * (mHue - pMeas_) / 255&
pCompB = mValue
End If
#EndMacro
Function HSVTYPE_To_UARGB(ByRef pSrc As HSVTYPE) As UnionARGB
Dim As Integer HueDiv = pSrc.Hue16 / 1530&
Dim As Integer mHue = pSrc.Hue16 - 1530& * HueDiv
Dim As Integer mValue = pSrc.Val8
Dim As Integer mSatu = pSrc.Sat8
mSatu *= mValue
mSatu /= 255&
Dim As UnionARGB uARGB=Any
If mHue < 511& Then
uARGB.B = mValue - mSatu
zHSV2RGB(uARGB.R, uARGB.G, 255&)
ElseIf mHue < 1021& Then
uARGB.R = mValue - mSatu
zHSV2RGB(uARGB.G, uARGB.B, 765&)
Else
uARGB.G = mValue - mSatu
zHSV2RGB(uARGB.B, uARGB.R, 1275&)
End If
Return uARGB
End Function
#Macro Alpha256(ret,back, fore, am, a256)
ret=((_
(fore And &Hff00ff) * a256 + _
(back And &Hff00ff) * am + &H800080) And &Hff00ff00 Or (_
(fore And &H00ff00) * a256 + _
(back And &H00ff00) * am + &H008000) And &H00ff0000) Shr 8
#EndMacro
Type draw_rect
As Integer x,y,w,h
End Type
Type gfx_buffer
wwidth as integer
height as Integer
pixels as uinteger Ptr
z_max As Integer
bins As String
PtTo As String
End type
function create_gfx_buffer(byval wwidth as integer,_
byval height as integer)as gfx_buffer ptr
dim as gfx_buffer ptr buffer=new gfx_buffer
buffer->wwidth=wwidth
buffer->height=height
buffer->pixels=new uinteger[wwidth*height]
function=buffer
end function
function create_gfx_display(byval wwidth as integer,_
byval height as Integer,_
ByVal z_bins As UShort=5000)as gfx_buffer ptr
screenres wwidth,height,32,2,8
ScreenSet 0,1
dim as gfx_buffer ptr buffer=new gfx_buffer
buffer->z_max=z_bins: z_bins*=4
buffer->PtTo=string(z_bins,0)
buffer->bins=buffer->PtTo
buffer->wwidth=wwidth
buffer->height=height
buffer->pixels=screenptr()
function=buffer
End function
sub set_pixel(byval buffer as gfx_buffer ptr,_
byval x as integer,_
byval y as integer,_
byval argb as uinteger)
if (y>=0)and(y<buffer->height)and(x>=0)and(x<buffer->wwidth) then
buffer->pixels[x+y*buffer->wwidth]=argb
end if
end sub
function get_pixel(byval buffer as gfx_buffer ptr,_
byval x as integer,_
byval y as integer)as uinteger
dim as uinteger argb
if (y>=0)and(y<buffer->height)and(x>=0)and(x<buffer->wwidth) then
argb=buffer->pixels[x+y*buffer->wwidth]
end if
function=argb
end function
sub clear_gfx_buffer(byval buffer as gfx_buffer ptr,_
byval argb as uinteger=0)
asm
mov eax,dword ptr[buffer]
mov edi,dword ptr[eax+offsetof(gfx_buffer,pixels)]
mov ecx,dword ptr[eax+offsetof(gfx_buffer,wwidth)]
imul ecx,dword ptr[eax+offsetof(gfx_buffer,height)]
mov eax,dword ptr[argb]
rep stosd
end asm
end sub
sub draw_gfx_buffer(byval dst as gfx_buffer ptr,_
byval src as gfx_buffer ptr,_
byval dst_x as integer,_
byval dst_y as integer)
dim as integer x_start=dst_x,x_end=dst_x+src->wwidth-1
if x_start<0 then x_start=0
if x_end>=dst->wwidth then x_end=dst->wwidth-1
dim as integer y_start=dst_y,y_end=dst_y+src->height-1
if y_start<0 then y_start=0
if y_end>=dst->height then y_end=dst->height-1
dim as uinteger ptr p_start=dst->pixels+x_start+y_start*dst->wwidth
dim as uinteger ptr source=src->pixels+(x_start-dst_x)+(y_start-dst_y)*src->wwidth
while y_start<=y_end
asm
mov edi,dword ptr[p_start]
mov esi,dword ptr[source]
mov ecx,dword ptr[x_end]
sub ecx,dword ptr[x_start]
inc ecx
rep movsd
end asm
source+=src->wwidth
p_start+=dst->wwidth
y_start+=1
wend
end sub
' ----------------- Vec3D stuffs by dafhi ----------------- '
' '
Type vector3d
As Single x,y,z
End Type
Type rotation_axis
As Single x,y,z
As vector3d v0=(1,0,0),v1=(0,1,0),v2=(0,0,1)
Declare Sub scale_to(ByRef dest As rotation_axis, ByVal scalar As Single = 1.0)
End Type
Sub rotation_axis.scale_to(ByRef dest As rotation_axis, ByVal scalar As Single)
#Macro scaleto_(dst,src)
dst.x = src.x * scalar
dst.y = src.y * scalar
dst.z = src.z * scalar
#EndMacro
dest.x = x
dest.y = y
dest.z = z
scaleto_(dest.v0,v0)
scaleto_(dest.v1,v1)
scaleto_(dest.v2,v2)
End Sub
#Macro CpyPos(dst,src)
dst.x=src.x
dst.y=src.y
dst.z=src.z
#EndMacro
#Macro CpyDot(dst,src,dot)
CpyPos(dst,src)
(dst.v0)dot = (src.v0)dot
(dst.v1)dot = (src.v1)dot
(dst.v2)dot = (src.v2)dot
#EndMacro
#Macro RotC(dsta,dstb,srca,srcb)
temp = cosa_*srca - sina_*srcb
dstb = cosa_*srcb + sina_*srca
dsta = temp
#EndMacro
#Macro RotC_(a_,dst,src,dota,dotb)
Scope
Dim As Single a = (a_), temp = Any
Dim As Single cosa_ = Cos(a), sina_ = Sin(a)
RotC( (dst.v0)dota, (dst.v0)dotb, (src.v0)dota, (src.v0)dotb )
RotC( (dst.v1)dota, (dst.v1)dotb, (src.v1)dota, (src.v1)dotb )
RotC( (dst.v2)dota, (dst.v2)dotb, (src.v2)dota, (src.v2)dotb )
End Scope
#EndMacro
#Macro xRot(dst,a_)
RotC_(a_,dst,dst,.y,.z)
#EndMacro
#Macro xRotC(dst,src,a_)
CpyDot(dst,src,.x)
RotC_(a_,dst,src,.y,.z)
#EndMacro
#Macro yRot(dst,a_)
RotC_(a_,dst,dst,.z,.x)
#EndMacro
#Macro yRotC(dst,src,a_)
CpyDot(dst,src,.y)
RotC_(a_,dst,src,.z,.x)
#EndMacro
#Macro zRot(dst,a_)
RotC_(a_,dst,dst,.x,.y)
#EndMacro
#Macro zRotC(dst,src,a_)
CpyDot(dst,src,.z)
RotC_(a_,dst,src,.x,.y)
#EndMacro
' '
' ---------------------------- '
Type cloud_vertex
as single x, y, z
Color As UnionARGB
pixel_offset As UInteger
next_cloud_vertex as cloud_vertex Ptr
prev_cloud_vertex as cloud_vertex Ptr
z_sort_vertex As cloud_vertex Ptr
z_sort As Integer
End Type
Type vertex_cloud
axis As rotation_axis
first_cloud_vertex as cloud_vertex ptr
last_cloud_vertex as cloud_vertex Ptr
vertex_count As UInteger
End type
function create_vertex_cloud()as vertex_cloud ptr
dim as vertex_cloud ptr cloud=new vertex_cloud
function=cloud
end function
sub add_cloud_vertex(byval cloud as vertex_cloud ptr,_
byval x as single,_
byval y as single,_
byval z as Single,_
ByVal Color_ As UInteger)
dim as cloud_vertex ptr vertex=new cloud_vertex
Dim As cloud_vertex ptr next_vertex=cloud->first_cloud_vertex
vertex->next_cloud_vertex=next_vertex
cloud->first_cloud_vertex=vertex
If next_vertex<>0 Then
next_vertex->prev_cloud_vertex = vertex
Else
cloud->last_cloud_vertex=vertex
EndIf
cloud->vertex_count+=1
vertex->x=x
vertex->y=y
vertex->z=z
vertex->color.ARGB = Color_
End sub
Sub draw_vertex_cloud(byval buffer as gfx_buffer ptr,_
byval cloud as vertex_cloud Ptr,_
ByRef axis As rotation_axis,_
ByRef rect As draw_rect,_
ByVal Alpha As UInteger=256,_
ByVal ZSORT As Integer=FALSE,_
ByVal zoom As Single=1.0,_
ByVal perspective_distortion As Single=1.0)
#Macro loop_start()
While vertex<>0
dim as single rz_=(axis.z + axis.v2.z*vertex->z + axis.v0.z*vertex->x + axis.v1.z*vertex->y)
If rz_>0.1 Then
Dim As Single rz=zoom/rz_
Dim as Integer y=rz*(axis.y + axis.v1.y*vertex->y + axis.v2.y*vertex->z + axis.v0.y*vertex->x)
If (y>=y1) Then
If (y< y2) Then
dim as Integer x=rz*(axis.x + axis.v0.x*vertex->x + axis.v1.x*vertex->y + axis.v2.x*vertex->z)
If (x>=x1) Then
If (x< x2) Then
y+=cy:x+=cx
#EndMacro
#Macro loop_end()
EndIf
EndIf
EndIf
EndIf
End If
vertex=vertex->next_cloud_vertex
Wend
#EndMacro
If rect.w=0 Then rect.w=buffer->wwidth
If rect.h=0 Then rect.h=buffer->height
Dim As Integer x1=rect.x,x2=x1+rect.w
Dim As Integer y1=rect.y,y2=y1+rect.h
Dim As Integer cx=(x1+x2) Shr 1
Dim As Integer cy=(y1+y2) Shr 1
If x1<0 Then x1=0
If y1<0 Then y1=0
If x2>=buffer->wwidth Then x2=buffer->wwidth-1
If y2>=buffer->height Then y2=buffer->height-1
x1-=cx: x2-=cx
y1-=cy: y2-=cy
cx+=0.5:cy+=0.5
If Alpha>256 Then Alpha=256
Dim As UInteger iAlpha=256-Alpha
Dim As Single sv_axis_z=cloud->axis.z
perspective_distortion=rect.w/perspective_distortion
axis.z*=perspective_distortion
zoom*=perspective_distortion
Dim As Integer ZFOUND
dim as cloud_vertex ptr vertex=cloud->first_cloud_vertex
Dim As cloud_vertex Ptr z_sort=vertex
Dim As unionARGB Ptr uARGB = buffer->pixels
#Macro PlotOne(v,pixel)
Alpha256( pixel.ARGB, pixel.ARGB,v->color.ARGB, iAlpha, Alpha )
#EndMacro
If ZSORT Then
loop_start()
If rz_ > buffer->z_max Then rz_ = buffer->z_max
z_sort->z_sort=rz_
z_sort->z_sort_vertex=vertex
z_sort=z_sort->next_cloud_vertex
vertex->pixel_offset=x+y*buffer->wwidth
loop_end()
If z_sort=0 Then
z_sort=cloud->last_cloud_vertex
ZFOUND = TRUE
ElseIf z_sort<>cloud->first_cloud_vertex Then
z_sort=z_sort->prev_cloud_vertex
ZFOUND = TRUE
EndIf
If ZFOUND Then
Dim As cloud_vertex ptr last = z_sort
Dim As Integer x, offset
Dim As Integer min=last->z_sort, max=last->z_sort
Dim As UInteger ptr bins=@buffer->bins[0]
bins[last->z_sort] += 1
last=last->prev_cloud_vertex
While last<>0
If last->z_sort > max Then
max = last->z_sort
ElseIf last->z_sort < min Then
min = last->z_sort
EndIf
bins[last->z_sort]+=1
last=last->prev_cloud_vertex
Wend
Dim As UInteger Ptr PtTo=@buffer->PtTo[0]
For x = min To max
If bins[x]>0 Then
PtTo[x]=offset
offset+=bins[x]
bins[x]=0
End If
Next
Dim As cloud_vertex ptr vref(cloud->vertex_count-1)
dim as integer i: last=z_sort
While last<>0
vref(PtTo[last->z_sort])=last->z_sort_vertex
PtTo[last->z_sort]+=1
last=last->prev_cloud_vertex
i+=1
Wend
While I>0: I-=1
Dim As cloud_vertex Ptr v=vref(I)
PlotOne(v,uARGB[v->pixel_offset])
Wend
End If
Else '' no z-sort
loop_start()
PlotOne(vertex,uARGB[x+y*buffer->wwidth])
loop_end()
End If
cloud->axis.z=sv_axis_z
End Sub
Sub Main
dim as tFPUMode tFPU '' auto: round-mode down
'' rounding mode:
'' 0=nearest
'' 1=round down
'' 2=round up
'' 3=truncate
#Macro define_object()
dim as single c1,c2,s1,s2,deg1,deg2
dim as single x1,y1,x2,y2,z1
dim as single radius = 0.13
dim as single rad = atn(1) / 45
dim as single yctr = display->height
dim as single xctr = display->wwidth
for deg1 = 0 to 359.9 step 3
c1=cos(deg1*rad)
s1=sin(deg1*rad)
for deg2 = 0 to 359.9 step 3
c2=cos(deg2*rad*c1)
s2=sin(deg2*rad*c1)
x1=c1*atan2(deg1,sqr(deg2))
y1=s1*atan2(deg1,sqr(deg2))
x2=c2*atan2(rad,c2*sqr(deg2))*atan2(deg1,sqr(deg2))
y2=s2*atan2(rad,s2*sqr(deg2))*atan2(deg1,sqr(deg2))
z1=c1*s1*atan2(c2,s2)*atan2(c1,s1)
Dim As UInteger col_=rgb(255,255,z1)
x2+=x1: y2+=y1: z1*=radius
x2*=radius: y2*=radius
add_cloud_vertex( cloud, x2,y2,z1,col_ )
add_cloud_vertex( cloud,-x2,y2,z1,col_ )
next
next
#EndMacro
Dim As gfx_buffer Ptr display = create_gfx_display(480,360)
Dim As draw_rect rect_L=(0,0,display->wwidth Shr 1,display->height)
Dim As draw_rect rect_R=rect_L
rect_R.x = rect_L.w
Dim As rotation_axis axis_L,axis_R
Dim as vertex_cloud ptr cloud = create_vertex_cloud()
define_object()
Dim As Single stereo=0.03
Dim As Single rotation_speed = 0.1
Dim As Single x_rot = 0.011 * rotation_speed
Dim As Single y_rot = 0.0123 * rotation_speed
Dim As Single z_rot = 0.013 * rotation_speed
cloud->axis.z = 3
Dim As Integer Alpha=35
Dim As Integer bool_zsort=TRUE
Dim As Single scalar=1.0
Dim As Single zoom=2.0
Dim As Single persp_distort=1
Dim As Single rot_start=200
xRot(cloud->axis,x_rot*rot_start)
yRot(cloud->axis,y_rot*rot_start)
zRot(cloud->axis,z_rot*rot_start)
Dim As tFPS_Limiter tFPS
dim as double t=Timer
while inkey$<>chr(27)
tFPS.Tick 60
clear_gfx_buffer(display)
cloud->axis.scale_to(axis_L,rect_L.w*scalar)
yRotC(axis_R,axis_L,stereo)
draw_vertex_cloud(display,cloud,axis_L,rect_L,ALpha,bool_zsort,zoom,persp_distort)
draw_vertex_cloud(display,cloud,axis_R,rect_R,Alpha,bool_zsort,zoom,persp_distort)
Locate 1,1:? "FPS: ";tFPS.report
Flip
Dim As double t_ = Timer
While t<t_
t+=0.01
xRot(cloud->axis,x_rot)
yRot(cloud->axis,y_rot)
zRot(cloud->axis,z_rot)
Wend
Wend
End Sub
Main
Last edited by dafhi on Jul 08, 2013 17:00, edited 2 times in total.
Re: Squares
Hi Albert.
Here are four geometric shapes, just kept 8 bit colour and made them beefy.
Here are four geometric shapes, just kept 8 bit colour and made them beefy.
Code: Select all
Type vector3d
As Single x,y,z
End Type
'assignment macro
#define vct Type<vector3d>
'macros
#define Intrange(f,l) Int(Rnd*((l+1)-(f))+(f))
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#macro insphere(cx,cy,cz,radius,x,y,z)
(cx-x)*(cx-x) +(cy-y)*(cy-y)+(cz-z)*(cz-z)<= radius*radius
#endmacro
#macro combsort(array,begin,finish,dot)
Scope
Var size=(finish),switch=0,j=0
Dim As Single void=size
Do
void=void/1.3: If void<1 Then void=1
switch=0
For i As Integer =(begin) To size-void
j=i+void
If array(i)dot<array(j)dot Then
Swap array(i),array(j): switch=1
End If
Next
Loop Until switch =0 And void=1
End Scope
#endmacro
Operator -(v1 As vector3d,v2 As vector3d) As vector3d
Return Type<vector3d>(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
Operator + (v1 As vector3d,v2 As vector3d) As vector3d
Return Type<vector3d>(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator * (f As Single,v1 As vector3d) As vector3d
Return Type<vector3d>(f*v1.x,f*v1.y,f*v1.z)
End Operator
Function length(v1 As vector3d) As Single
Return Sqr(v1.x*v1.x+v1.y*v1.y+v1.z*v1.z)
End Function
Function rotate3d(Byval pivot As vector3d,Byval pt As vector3d,Byval Angle As vector3d, Byval scale As vector3d=Type<vector3d>(1,1,1)) As vector3d
#define cr 0.0174532925199433
Angle=Type<vector3d>(Angle.x*cr,Angle.y*cr,Angle.z*cr)
#macro Rotate(a1,a2,b1,b2,d)
temp=Type<vector3d>((a1)*Cos(Angle.d)+(a2)*Sin(Angle.d),(b1)*Cos(Angle.d)+(b2)*Sin(Angle.d))
#endmacro
Dim As vector3d p=Type<vector3d>(pt.x-pivot.x,pt.y-pivot.y,pt.z-pivot.z)
Dim As vector3d rot,temp
Rotate(p.y,-p.z,p.z,p.y,x)'X
rot.y=temp.x:rot.z=temp.y
p.y = rot.y:p.z = rot.z
Rotate(p.z,-p.x,p.x,p.z,y)'Y
rot.z=temp.x:rot.x=temp.y
p.x=rot.x
Rotate(p.x,-p.y,p.y,p.x,z)'Z
rot.x=temp.x:rot.y=temp.y
Return Type<vector3d>((scale.x*rot.x+pivot.x),(scale.y*rot.y+pivot.y),(scale.z*rot.z+pivot.z))
End Function
Function apply_perspective(p As vector3d,eyepoint As vector3d) As vector3d
Dim As Single w=1+(p.z/eyepoint.z)
If w=0 Then w=1e-20
Return Type<vector3d>((p.x-eyepoint.x)/w+eyepoint.x,(p.y-eyepoint.y)/w+eyepoint.y,(p.z-eyepoint.z)/w+eyepoint.z)
End Function
'====================== End of rotator and perspective getter ======================================
Dim Shared As Integer xres,yres
screen 20,,,1 'fullscreen
Screeninfo xres,yres
'two main arrays
Dim Shared As vector3d rotated()
Redim Shared As vector3d array()
'extra subs to regulate speed
Function framecounter() As Integer
Var t1=Timer,t2=t1
Static As Double t3,frames,answer
frames=frames+1
If (t2-t3)>=1 Then
t3=t2
answer=frames
frames=0
End If
Return answer
End Function
Function regulate(MyFps As Integer,Byref fps As Integer) As Integer
fps=framecounter
Static As Double timervalue
Static As Double delta,lastsleeptime,sleeptime
Var k=1/myfps
If Abs(fps-myfps)>1 Then
If fps<Myfps Then delta=delta-k Else delta=delta+k
End If
sleeptime=lastsleeptime+((1/myfps)-(Timer-timervalue))*(2000)+delta
If sleeptime<1 Then sleeptime=1
lastsleeptime=sleeptime
timervalue=Timer
Return sleeptime
End Function
'four shapes
Function create1(number As Integer) As Integer
Redim array(0)
Dim As Integer count,stepper=10
For x As Integer=xres/2-number To xres/2+number Step stepper
For y As Integer=yres/2-number To yres/2+number Step stepper
For z As Integer=-number To number Step stepper
count=count+1
Redim Preserve array(1 To count)
array(Ubound(array))=vct(x,y,z)
Next z
Next y
Next x
Redim rotated(Lbound(array) To Ubound(array))
Return 0
End Function
Function create2(number As Integer=80) As Integer
Redim array(0)
Dim As Integer count2,stepper=15
For x As Integer=xres/2-number To xres/2+number Step stepper
For y As Integer=yres/2-number To yres/2+number Step stepper
For z As Integer=-number To number Step stepper
If insphere((xres/2),(yres/2),0,number,x,y,z) Then
count2=count2+1
Redim Preserve array(1 To count2)
array(count2)=vct(x,y,z)
End If
Next z
Next y
Next x
Redim rotated(Lbound(array) To Ubound(array))
Return 0
End Function
Function create3(number As Integer) As Integer
Redim array(0)
Dim As Integer count2,stepper=15,z2,acc
For x As Integer=xres/2-3*number To xres/2+3*number Step stepper/10
acc=acc+1
For y As Integer=yres/2-number To yres/2+number Step stepper
Var piv=vct(x,yres/2,0)
Var rot=rotate3d(piv,vct(x,y,0),vct(acc,0,0),vct(1,1,1))
count2=count2+1
Redim Preserve array(1 To count2)
array(count2)=rot
Next y
Next x
Redim rotated(Lbound(array) To Ubound(array))
Return 0
End Function
Function create4(number As Integer) As Integer
Redim array(0)
Dim As Integer count,stepper=15
For z As Integer=-1.5*number To 1.5*number Step stepper
For d As Integer=0 To 360 Step 2
count=count+1
Var piv=vct(xres/2,yres/2,0)
Var pt=vct(yres/2+200,xres/2,z)
Var rot=rotate3d(piv,pt,vct(0,0,d),vct(1,1,1))
Redim Preserve array(1 To count)
array(count)=rot
Next d
Next z
Redim rotated(Lbound(array) To Ubound(array))
Return 0
End Function
'variables
Dim As vector3d centre=vct(xres/2,yres/2,0)
Dim As vector3d eyepoint=vct(xres/2,yres/2,600)
Dim As vector3d angle
Dim As Integer fps
Dim As vector3d disp=vct(xres/2,yres/2,0)
Dim As Integer k,flag=1,xflag,border=.2*xres
Dim As Single sx=1,kx=2,ky=1.9,kz=1.5
dim as integer clr
create1(80)
clr=15
Do
k=k+1
If xflag Then
sx=sx+.05
End If
'sequence
If k=480 Then xflag=1
If k =500 Then create2(100):flag=2:clr=IntRange(12,18)
If k =980 Then xflag=1
If k=1000 Then create3(100):flag=3:clr=IntRange(12,18)
If k=480 Then xflag=1
If k=1500 Then create4(80):flag=4:clr=IntRange(12,16)
If k=1980 Then xflag=1
If k=2000 Then create1(80):flag=1:k=0:clr=15
If sx>2 Then xflag=0:sx=1
Var sleepover=regulate(60,fps)
angle=angle+vct(.2,2,.1)
With angle
If .x>=360 Then .x=0
If .y>=360 Then .y=0
If .x>=360 Then .z=0
End With
disp=disp+vct(kx,ky,0)
If disp.x<border Then kx=-kx
If disp.x>xres-border Then kx=-kx
If disp.y<border Then ky=-ky
If disp.y>yres-border Then ky=-ky
Screenlock
Cls
For n As Integer=1 To Ubound(rotated)
rotated(n)=rotate3d(centre,(array(n)),angle,vct(sx,sx,sx))
Next n
combsort(rotated,1,Ubound(rotated),.z)
For n As Integer=1 To Ubound(rotated)
Var dist=length(rotated(n)-centre)
rotated(n)=apply_perspective(rotated(n),eyepoint)
rotated(n)=rotated(n)+(disp-centre)
Select Case As Const flag
Case 1
Var col=map(0,200,dist,1,15)
Var radius=map(-400,400,rotated(n).z,10,1)
Circle (rotated(n).x,rotated(n).y),radius,col,,,,f
Case 2
Var col=map(0,200,dist,1,clr)
Var radius=map(-200,200,rotated(n).z,7,1)
Circle (rotated(n).x,rotated(n).y),radius,col,,,,f
Case 3
Var col=map(0,200,dist,1,clr)
Var radius=map(-400,400,rotated(n).z,15,4)
Circle (rotated(n).x,rotated(n).y),radius,col,,,,f
Case 4
Var col=map(0,200,dist,1,clr)
Var radius=map(-400,400,rotated(n).z,12,4)
Circle (rotated(n).x,rotated(n).y),radius,col,,,,f
End Select
Next n
Draw String(20,20),"Frames per second = " & fps
Screenunlock
Sleep sleepover,1
Loop Until Len(Inkey)
Sleep Re: Squares
@Dodicat
That's pretty good coding!!!
Thanks !!
Runs real fast , in the rotating.. I saved it for future use, thanks..
That's pretty good coding!!!
Thanks !!
Runs real fast , in the rotating.. I saved it for future use, thanks..
Re: Squares
@Dodicat
StoneMonkey wrote a real fast rotator and then Dafhi added a bunch of floating point color stuff and it slowed the rotator down to where it wouldn't run on StoneMonkey's laptop.
But with my changing the SHR 8 to SHR 4 , it turned it to good "EYE CANDY" , for fast computers anyways.
StoneMonkey wrote a real fast rotator and then Dafhi added a bunch of floating point color stuff and it slowed the rotator down to where it wouldn't run on StoneMonkey's laptop.
But with my changing the SHR 8 to SHR 4 , it turned it to good "EYE CANDY" , for fast computers anyways.
Re: Squares
What slowed his laptop down was the trig calc. This is what prompted discussion of spreading calculation over several frames.
Dodicat, your cube and sphere look really cool with a radius about half size
Dodicat, your cube and sphere look really cool with a radius about half size