Hi Rollie~rolliebollocks wrote:@Richard
Thanks. That'll be tomorrow's challenge. That's exactly what I was a after. All the interior slices of a sphere. The equation which represents them all.
@Dodicat
Keep this Breshenham gun handy for when the vamps are stalking. It draws a stake for Cross sake!
The turning circle is no problem with my rotate3d sub.
Just use the sub regular_polygon, which I've adapted, I've got 50 sides to a polygon which is near enough a circle, although I think 60 sides is the recommended dose for those with keen eyes, but you can fiddle with it.
I've made the circle a disk 15 pixels wide to slow it a bit for your machine, also gave it a little perspective (0 is no perspective)
Great Circles are important in navigation, being the shortest distance across the planet from one place to another, although ship's navigators use spherical trigonometry rather than spherical co-ordinates.
I'll try the bresenham gun with Richard's new thickline macro, it should spit out pure venom.
Code: Select all
'ROTATING CIRCLE
dim as integer xres,yres
screeninfo xres,yres
screenres xres,yres,32
declare sub regular_polygon(n as integer,centreX as double,centreY as double,col() as uinteger,t as double=1,size as double=100,offset as double=0,im as any pointer=0)
declare Sub mv(m1() As Double,m2() As Double,ans() As Double) 'MATRIX x VECTOR
declare Sub rotate3d(Byval pivot_x As Double,_ 'x pivot for rotation
Byval pivot_y As Double,_ 'y pivot for rotation
Byval pivot_z As Double,_ 'z pivot for rotation
Byval first_x As Double,_ 'x for line,or centre for circle
Byval first_y As Double,_ 'y for line,or centre for circle
Byval first_z As Double,_ 'z for line or circle
Byval second_x As Double, _'x for line,or radius for circle
Byval second_y As Double, _'y for line,or aspect for circle
Byval second_z As Double,_ 'z for line, first arc position circle
Byval second_arc As Double,_ 'second arc position circle,0 line
Byval angleX As Double, _ 'angle to rotate round x axis
Byval angleY As Double,_ 'angle to rotate round y axis
Byval angleZ As Double,_ 'angle to rotate round z axis
Byval magnifier As Double,_ '1=no magnifacation
Byval dilator As Double,_ 'times distance from pivot(1=no dilation)
Byval colour As Integer,_ 'color for line or circle
Byval thickness As Double,_ 'thickness line or circle
Byref shape As String,_ 'line/circle/circlefill/box/boxfill/linepoint[set],circlepoint[set]"
Byref mode As String,_ '2d or 3d
Byval perspective As Double=0,_ 'add some 3d perspective 0 to 1 approx
image As Any Pointer=0) 'write to an image if required
' **************** STUFF ***************************
dim shared as double px,py,pz,xc,yc,ax,ay,az,p
dim as uinteger colour(1 to 3)
p=1 'PERSPECTIVE
colour(1)=100
colour(2)=200
colour(3)=0
xc=xres/2
yc=yres/2
px=xc 'pivot position
py=yc
pz=0
do
screenlock
cls
ax=ax+1.1
ay=ay+.9
az=az+1
'regular_polygon(num of sides,x centre,y centre,colour,thickness,radius)
regular_polygon(50,xc,yc,colour(),15,.4*yres)
screenunlock
if ax>360 then ax=0
if ay>360 then ay=0
if az>360 then az=0
loop until inkey=chr(27)
sleep
' **************************************************************
sub regular_polygon(n as integer,centreX as double,centreY as double,col() as uinteger,t as double=1,size as double=100,offset as double=0,im as any pointer=0)
dim pi as double=4*atn(1)
dim as double x1,y1,x2,y2
#define rad *pi/180
offset=offset rad 'can rotate the polygon by degrees
dim slug as double=2*pi/n
dim as double dist=size
dim as double ex=1,ey=1 'can convolute the polygon
for z as double=0+offset to 2*pi+offset step slug
for k as double =0 to t step .1
x1=centrex+ex*(dist-k)*cos(z)
y1=centrey+ey*(dist-k)*sin(z)
x2=centrex+ex*(dist-k)*cos(z+slug)
y2=centrey+ey*(dist-k)*sin(z+slug)
'line im,(x1,y1)-(x2,y2),rgba(col(1),col(2),col(3),col(4))
rotate3d(px,py,pz,x1,y1,0,x2,y2,0,.0,ax,ay,az,1,1,rgb(col(1),col(2),col(3)),1,"line","3d",p)
next k
next z
end sub
Sub mv(m1() As Double,m2() As Double,ans() As Double) 'MATRIX x VECTOR
Dim s As Double
For i As Integer=1 To 3
s=0
For k As Integer = 1 To 3
s=s+m1(i,k)*m2(k)
Next k
ans(i)=s
Next i
End Sub
Dim Shared np(1 To 6) As Double
Sub rotate3d(Byval pivot_x As Double,_ 'x pivot for rotation
Byval pivot_y As Double,_ 'y pivot for rotation
Byval pivot_z As Double,_ 'z pivot for rotation
Byval first_x As Double,_ 'x for line,or centre for circle
Byval first_y As Double,_ 'y for line,or centre for circle
Byval first_z As Double,_ 'z for line or circle
Byval second_x As Double, _'x for line,or radius for circle
Byval second_y As Double, _'y for line,or aspect for circle
Byval second_z As Double,_ 'z for line, first arc position circle
Byval second_arc As Double,_ 'second arc position circle,0 line
Byval angleX As Double, _ 'angle to rotate round x axis
Byval angleY As Double,_ 'angle to rotate round y axis
Byval angleZ As Double,_ 'angle to rotate round z axis
Byval magnifier As Double,_ '1=no magnifacation
Byval dilator As Double,_ 'times distance from pivot(1=no dilation)
Byval colour As Integer,_ 'color for line or circle
Byval thickness As Double,_ 'thickness line or circle
Byref shape As String,_ 'line/circle/circlefill/box/boxfill/linepoint[set],circlepoint[set]"
Byref mode As String,_ '2d or 3d
Byval perspective As Double=0,_ 'add some 3d perspective 0 to 1 approx
image As Any Pointer=0) 'write to an image if required
shape=Lcase$(shape)
mode=Lcase$(mode)
Dim th As Double
th=thickness
Dim As Double zval,pp 'used in get_perspective
Dim sx As Double=second_x
Dim p As Double = 4*Atn(1) '(pi)
Dim angleX_degrees As Double
Dim angleY_degrees As Double
Dim angleZ_degrees As Double
#Macro thickline(t)
Dim As Double s,h,c
Dim As Uinteger prime=rgb(255,255,255)
h=Sqr(((np(1))-(np(4)))^2+((np(2))-(np(5)))^2)
s=((np(5))-np(2))/h
c=(np(1)-(np(4)))/h
Line image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),prime
Line image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),prime
Line image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),prime
Line image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),prime
Paint image,((np(4)+np(1))/2, (np(5)+np(2))/2),prime,prime
Line image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),colour
Line image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colour
Line image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),colour
Line image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colour
Paint image,((np(4)+np(1))/2, (np(5)+np(2))/2), colour, colour
#EndMacro
#macro thickcircle(t)
Dim As Uinteger prime=rgb(255,255,255)
Dim As Double xp1,xp2,yp1,yp2
Dim arc1 As Double=second_z*p/180
Dim arc2 As Double=second_arc*p/180
arc1=2*p+(arc1-(anglez_degrees))
arc2=2*p+(arc2-(anglez_degrees))
sx=sx*magnifier
If arc1=arc2 Then
Circle image,(np(4),np(5)),sx,prime,,,second_y
Circle image,(np(4),np(5)),sx-t,prime,,,second_y
Paint image,(np(4),np(5)+sx-t/2),prime,prime
Paint image,(np(4)+sx-t/2,np(5)),prime,prime
Circle image,(np(4),np(5)),sx,colour,,,second_y
Circle image,(np(4),np(5)),sx-t,colour,,,second_y
Paint image,(np(4),np(5)+sx-t/2),colour,colour
Paint image,(np(4)+sx-t/2,np(5)),colour,colour
End If
if arc1<>arc2 Then
xp1=np(4)+(sx-t/2)*Cos(.5*(arc2+arc1))
yp1=np(5)-(sx-t/2)*Sin(.5*(arc2+arc1))
Circle image,(np(4),np(5)),sx,prime,arc1,arc2,second_y
Circle image,(np(4),np(5)),sx-t,prime,arc1,arc2,second_y
Line image,(np(4)+sx*Cos(arc1),np(5)-sx*Sin(arc1))-(np(4)+(sx-t)*Cos(arc1),np(5)-(sx-t)*Sin(arc1)),prime
Line image,(np(4)+sx*Cos(arc2),np(5)-sx*Sin(arc2))-(np(4)+(sx-t)*Cos(arc2),np(5)-(sx-t)*Sin(arc2)),prime
'pset(xp1,yp1),rgb(255,255,255)
Paint image,(xp1,yp1),prime,prime
Circle image,(np(4),np(5)),sx,colour,arc1,arc2,second_y
Circle image,(np(4),np(5)),sx-t,colour,arc1,arc2,second_y
Line image,(np(4)+sx*Cos(arc1),np(5)-sx*Sin(arc1))-(np(4)+(sx-t)*Cos(arc1),np(5)-(sx-t)*Sin(arc1)),colour
Line image,(np(4)+sx*Cos(arc2),np(5)-sx*Sin(arc2))-(np(4)+(sx-t)*Cos(arc2),np(5)-(sx-t)*Sin(arc2)),colour
'pset(xp1,yp1),rgb(255,255,255)
Paint image,(xp1,yp1),colour,colour
End If
#endmacro
#macro get_perspective(np3,np6)
For n As Integer=3 To 6 Step 3
zval =np(n) 'for perspective
pp=perspective*((zval+1000)/1000-1)
pp=(1-pp)
If n=3 Then
np(n-2)=np(n-2)-pivot_x
np(n-1)=np(n-1)-pivot_y
np(n-2)=np(n-2)*pp
np(n-1)=np(n-1)*pp
np(n-2)=np(n-2)+pivot_x
np(n-1)=np(n-1)+pivot_y
Endif
If n=6 Then
np(n-2)=np(n-2)-pivot_x
np(n-1)=np(n-1)-pivot_y
np(n-2)=np(n-2)*pp
np(n-1)=np(n-1)*pp
np(n-2)=np(n-2)+pivot_x
np(n-1)=np(n-1)+pivot_y
Endif
Next n
sx=(pp)*sx
#endmacro
Dim pivot_vector(1 To 3) As Double
Dim line_vector(1 To 3) As Double
magnifier=dilator*magnifier
If shape="circle" Then
angleX=angleX Mod 360:angleY=angleY Mod 360:angleZ=angleZ Mod 360
End If
angleX_degrees=(2*p/360)*angleX
angleY_degrees=(2*p/360)*angleY
angleZ_degrees=(2*p/360)*angleZ
pivot_vector(1)=first_x-pivot_x
pivot_vector(2)=first_y-pivot_y
pivot_vector(3)=first_z-pivot_z
pivot_vector(1)=dilator*pivot_vector(1)
pivot_vector(2)=dilator*pivot_vector(2)
pivot_vector(3)=dilator*pivot_vector(3)
Dim Rx(1 To 3,1 To 3) As Double
Dim Ry(1 To 3,1 To 3) As Double
Dim Rz(1 To 3,1 To 3) As Double
'rotat1on matrices about the three axix
If mode="3d" Then
Rx(1,1)=1:Rx(1,2)=0:Rx(1,3)=0
Rx(2,1)=0:Rx(2,2)=Cos(angleX_degrees):Rx(2,3)=-Sin(angleX_degrees)
Rx(3,1)=0:Rx(3,2)=Sin(angleX_degrees):Rx(3,3)=Cos(angleX_degrees)
Ry(1,1)=Cos(angleY_degrees):Ry(1,2)=0:Ry(1,3)=Sin(angleY_degrees)
Ry(2,1)=0:Ry(2,2)=1:Ry(2,3)=0
Ry(3,1)=-Sin(angleY_degrees):Ry(3,2)=0:Ry(3,3)=Cos(angleY_degrees)
Endif
Rz(1,1)=Cos(angleZ_degrees):Rz(1,2)=-Sin(angleZ_degrees):Rz(1,3)=0
Rz(2,1)=Sin(angleZ_degrees):Rz(2,2)=Cos(angleZ_degrees):Rz(2,3)=0
Rz(3,1)=0:Rz(3,2)=0:Rz(3,3)=1
line_vector(1)=magnifier*(second_x-first_x)'*pp 'get the vector
line_vector(2)=magnifier*(second_y-first_y)'*pp 'get the vector
line_vector(3)=magnifier*(second_z-first_z)'*pp
Dim new_pos(1 To 3) As Double
Dim temp1(1 To 3) As Double
Dim temp2(1 To 3) As Double
If mode="3d" Then
mv Rx(),pivot_vector(),temp1()
mv Ry(),temp1(),temp2()
mv Rz(),temp2(),new_pos()
Endif
If mode="2d" Then
mv Rz(),pivot_vector(),new_pos()
Endif
new_pos(1)=new_pos(1)+pivot_x
new_pos(2)=new_pos(2)+pivot_y
new_pos(3)=new_pos(3)+pivot_z
Dim new_one(1 To 3) As Double 'To hold the turned value
If mode="3d" Then
mv Rx(),line_vector(),temp1() 'rotate
mv Ry(),temp1(),temp2()
mv Rz(),temp2(),new_one()
Endif
If mode="2d" Then
mv Rz(),line_vector(),new_one()
Endif
new_one(1)=new_one(1)+first_x 'translate
new_one(2)=new_one(2)+first_y
new_one(3)=new_one(3)+first_z
Dim xx As Double
Dim yy As Double
Dim zz As Double
xx=first_x-new_pos(1)
yy=first_y-new_pos(2)
zz=first_z-new_pos(3)
np(1)=new_one(1)-xx
np(2)=new_one(2)-yy
np(3)=new_one(3)-zz
np(4)=first_x-xx
np(5)=first_y-yy
np(6)= first_z-zz
If perspective <> 0 Then
get_perspective(np(3),np(6))
End If
Select Case shape
Case "line"
If th<2 Then
Line image,(np(4),np(5))-(np(1),np(2)),colour
Else
thickline(th)
End If
Case "circle"
Dim arc1 As Double=second_z*p/180
Dim arc2 As Double=second_arc*p/180
If arc1=arc2 Then
If th<=2 Then
Circle image,(np(4),np(5)),magnifier*sx,colour,,,second_y
Else
thickcircle(th)
End If
Endif
If arc1<>arc2 Then
If th<=2 Then
Circle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_y
Else
thickcircle(th)
End If
End If
Case "circlefill"
Dim As Double xp1,xp2,yp1,yp2
Dim As Uinteger prime=rgb(255,255,255)
Dim arc1 As Double=second_z*p/180
Dim arc2 As Double=second_arc*p/180
If arc1=arc2 Then Circle image,(np(4),np(5)),magnifier*sx,colour,,,second_y,F
If arc1<>arc2 Then
xp1=np(4)+magnifier*sx*Cos(.5*(arc2+arc1))*3/4
yp1=np(5)-magnifier*sx*Sin(.5*(arc2+arc1))*3/4
Circle image,(np(4),np(5)),magnifier*sx,prime,arc1,arc2,second_y
Line image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),prime
Line image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),prime
Paint image,(xp1,yp1),prime,prime
Circle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_y
Line image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),colour
Line image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),colour
Paint image,(xp1,yp1),colour,colour
End If
Case"box"
Line image,(np(4),np(5))-(np(1),np(2)),colour,b
Case "boxfill"
Line image,(np(4),np(5))-(np(1),np(2)),colour,bf
Case "linepoint","circlepoint"
'nothing drawn
Case "linepointset","circlepointset"
If shape="linepointset" Then
Pset image,(np(1),np(2)),colour
Pset image,(np(4),np(5)),colour
Endif
If shape="circlepointset" Then
Pset image,(np(4),np(5)),colour
End If
Case Else
Print "unknown rotation shape"
End Select
End Sub
'END OF ROTATOR