## Squares

General FreeBASIC programming questions.
dodicat
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
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!

Hi Rollie~
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
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

rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
@BasicScience

Eclpzer's routine is a sub-pixel rendering deal which processes a string I think and twists the color blending in loop. I was thinking of doing something slightly more modest.
dodicat
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
@ BasicScience
Kinda re-did your rotating square with the rotator.

Code: Select all

'ROTATING and diminishing square

Dim As Integer xres,yres
'screeninfo xres,yres
xres=640
yres=640
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,stepsize=1,dil=2
Dim As Uinteger colour(1 To 3)
p=0  'PERSPECTIVE
colour(1)=0
colour(2)=255
colour(3)=255
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-2
dil=dil-.02
'regular_polygon(num of sides,x centre,y centre,colour,thickness,radius)
regular_polygon(4,xc,yc,colour(),0,.4*yres)
'screenunlock

sleep 10
'If ax>360 Then ax=0
'If ay>360 Then ay=0
If az<-360 Then az=0
Loop Until dil<.1'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
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 stepsize
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,dil,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

BasicScience
Posts: 489
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:
@ Dodicat,

Cool, I like the rotating square. I hope the code was pasted together from existing parts... or I wasted a lot of your time!

For the version I posted, I used to draw these by hand with a straight-edge as a kid (once a geek, always a geek). If you increase the sleep time in the do loop, it's easy to see the graphical rule to follow.

@ Rollie,

Eclipzer's routine uses a distance formula to may rounded caps on the ends of the think line. The standard rectangle define by the think line is filled by recursive calls to pset, rather than paint flood.
dodicat
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
BasicScience wrote:@ Dodicat,
I hope the code was pasted together from existing parts... or I wasted a lot of your time!

NAH, it's just a 3d rotator I made up a while back, it'll rotate just about anything,
I often use it to see the debris , derelict, flotsam and jetsam which has gathered up at Lagrangian points.

Code: Select all

'DEBRIS at a lagrangian point

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,stepsize=1,dil=1,z1,z2
dim shared as double angx,angy,angz
Dim As Uinteger colour(1 To 3)
p=.5  'PERSPECTIVE
#macro info(zz)
select case zz
case 1
z1=0:z2=0
p=.5:angx=ax:angy=ay:angz=az
colour(1)=0:colour(2)=155:colour(3)=0
xc=xres/2:yc=yres/2:px=xc :py=yc:pz=500
case 2
z1=0:z2=0
p=.5:angx=ax:angy=ay:angz=az
colour(1)=200:colour(2)=155:colour(3)=0
xc=xres/3:yc=yres/2:px=xc :py=yc:pz=300
case 3
z1=0:z2=0
p=.2:angx=2*ax:angy=ay:angz=az
colour(1)=200:colour(2)=0:colour(3)=0
xc=.75*xres:yc=yres/3:px=xc :py=yc:pz=100
case 4
z1=100:z2=100
p=.3:angx=2*ax:angy=ay:angz=az
colour(1)=200:colour(2)=0:colour(3)=0
xc=.75*xres:yc=yres/3:px=xc :py=yc:pz=100
case 5
z1=0:z2=0
p=.2:angx=ax:angy=2*ay:angz=5*az
colour(1)=200:colour(2)=0:colour(3)=200
xc=.75*xres:yc=.7*yres:px=xc :py=yc:pz=00
case 6
z1=150:z2=100
p=.3:angx=2*ax:angy=ay:angz=az
colour(1)=00:colour(2)=0:colour(3)=200
xc=.5*xres:yc=yres/3:px=xc :py=yc:pz=100
end select
#endmacro

Do
screenlock
Cls
ax=ax+1.1
ay=ay+.9
az=az+1
'dil=dil-.02
'regular_polygon(num of sides,x centre,y centre,colour,thickness,radius)
info(1)
regular_polygon(6,xc,yc,colour(),yres/14,yres/14)
info(2)
regular_polygon(3,xc,yc,colour(),yres/14,yres/14)
info(3)
regular_polygon(4,xc,yc,colour(),yres/100,yres/10)
info (4)
regular_polygon(4,xc,yc,colour(),yres/100,yres/10)
info(5)
regular_polygon(8,xc,yc,colour(),yres/50,yres/10)
info(6)
regular_polygon(4,xc,yc,colour(),yres/80,yres/10)
screenunlock

sleep 1,1
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
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 stepsize
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,z1,x2,y2,z2,.0,angx,angy,angz,1,dil,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

rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
This is a "rough draft". I call it The Echo Mirror.

http://www.imakegames.com/rolliebollocks/Echo%20Mirror.zip
Last edited by rolliebollocks on Aug 20, 2010 22:52, edited 1 time in total.
counting_pine
Posts: 6229
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs
(Try a %20 in the link;)

That's incredible. Quick - take it to a major film company and sell it as a "broken computer" effect for millions.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
@cp

When the internet attains self-awareness, all of our screens will look like that.

Here is the regress going the opposite direction... Ball of Mirrors

http://www.imakegames.com/rolliebollocks/Ball%20of%20Mirrors.zip

Anyway, the Pixel Scanner from my lib is great for doing mirror tricks, and can be converted into a 3d Image buffer and rotated. That gives me an idea. You can also do particle effects with the buffer, and then export it to an fb.image. I've only scratched the surface of weird crap you can do with my lib.
dodicat
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
rolliebollocks wrote:This is a "rough draft". I call it [i]The Echo Mirror.

Hi Rollie
The echo mirror crashed after a bit on my old machine, but the ball of mirrors ran fine.
Here's a rough attempt at drawing something on the surface of a sphere.

Code: Select all

'ROTATING TETRA WITH BACKDROP
#include "fbgfx.bi"
dim shared as integer xres,yres
xres=1024
yres=768
screenres xres,yres,32,1,fb.GFX_ALPHA_PRIMITIVES
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 Function r(first As Double, last As Double) As Double
declare sub drawstars(starx as double,stary as double,size as double,col as uinteger)
declare sub drawpolygon(x() as double,y() as double,colour as uinteger,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
Dim Shared np(1 To 6) As Double
' **************** STUFF ***************************
dim shared as double px,py,pz,xc,yc,ax,ay,az,pv,gradient
dim shared as double ex,ey,Ppi
dim shared as uinteger colour(1 to 4)
dim as double pi=4*atn(1)
'dim as integer infoflag
dim shared image as any pointer
image=imagecreate(xres,yres,rgb(0,0,0))
dim shared as integer count,bandflag,cc
#macro init(zz)
pv=.9  'PERSPECTIVE
ex=1:ey=1:Ppi=1
xc=.7*xres
yc=.5*yres
px=xc 'pivot position
py=yc
pz=0
#endmacro
#macro colourinfo(zz)
Select Case zz
Case 1
colour(4)=255
case(2)
colour(4)=255
case 3
colour(4)=200
Case 4
colour(4)=10
case(5)
colour(4)=10
case 6
'colour(4)=10
colour(4)=10

End Select
#endmacro

#macro bander(zz)
select case zz
case 1
colourinfo(1)
if count mod 2 =0 then
colourinfo(2)
end if
if count mod 30=0 then
colourinfo(3)
end if

case 2
colourinfo(4)
if count mod 2 =0 then
colourinfo(5)
end if
if count mod 20=0 then
colourinfo(6)
end if
end select
#endmacro

#macro galaxy(zz)
dim as double x7,y7,s7
dim as uinteger c7
for z as integer=1 to 50
x7=r(0,xres)
y7=r(0,yres)
s7=r(1,2)
c7=rgb(r(200,255),r(100,200),r(100,200))
drawstars(x7,y7,s7,c7)
next z
#endmacro
'dim c as integer
#macro back(ground)
init(0)
galaxy(0)
'colourinfo(1)
do
screenlock
ax=ax+1.1*.1
ay=ay+1.15*.1
az=az+1.2*.1
'regular_polygon(num of sides,x centre,y centre,colour,thickness,radius)
bandflag=1
regular_polygon(150,xc,yc,colour(),4,.5*yres,87,image)
screenunlock
if ax>360 then ax=0
if ay>360 then ay=0
if az>360 then az=0
loop until ay>180'inkey=chr(27)

ax=0:ay=0:az=0:bandflag=2:ey=1:yc=.1*yres:xc=.1*xres
px=xc 'pivot position
py=yc
pz=0
do
cc=cc+1
screenlock
ax=ax+1:ay=ay+1:az=az+1
regular_polygon(40,xc,yc,colour(),40,40,0,image)
screenunlock
if ax>360 then ax=0
if ay>360 then ay=0
if az>360 then az=0
loop until cc>300
#endmacro
back(ground)
'print "done"
'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
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
count=0
for z as double=0+offset to 1*pi+offset step slug
count=count+1
bander(bandflag)
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,rgba(col(1),col(2),col(3),col(4)),1,"line","3d",pv,im)
next k

next z
end sub
sub drawpolygon(x() as double,y() as double,colour as uinteger,im as any pointer=0)
dim k as integer=ubound(x)+1
dim as integer index,nextindex
dim as double xc,yc
for n as integer=1 to ubound(x)'+1
xc=xc+x(n):yc=yc+y(n)
index=n mod k:nextindex=(n+1) mod k
if nextindex=0 then nextindex=1
line im,(x(index),y(index))-(x(nextindex),y(nextindex)),colour
next
xc=xc/ubound(x):yc=yc/ubound(y)
paint im,(xc,yc),colour,colour
end sub
sub drawstars(starx as double,stary as double,size as double,col as uinteger)
dim as double xstar(8),ystar(8)
dim l as double=4*size
Xstar(1)=starX : Ystar(1)=starY-l
Xstar(2)=starX+size:Ystar(2)=starY-size
Xstar(3)=starX+l:Ystar(3)=starY
Xstar(4)=starX+size:Ystar(4)=starY+size
Xstar(5)=starX:Ystar(5)=starY+l
Xstar(6)=starX-size:Ystar(6)=starY+size
Xstar(7)=starX-l:Ystar(7)=starY
Xstar(8)=starX-size:Ystar(8)=starY-size

drawpolygon(Xstar(),Ystar(),col,image)
end sub

Function r(first As Double, last As Double) As Double
Function = Rnd * (last - first) + first
End Function

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

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
Type pivot
x As Double
y As Double
z As Double
End Type

Type vertex
x As Double
y As Double
z As Double
End Type
type length
d As Double
End Type
type angle
x As Double
y As Double
z As Double
End Type
type colour
r As Uinteger
g As Uinteger
b As Uinteger
End Type
Dim p As pivot
Dim v As vertex
Dim ang As angle
Dim l As length
Dim Shared c As colour
p.x=xres/2'500
p.y=(.55*yres)'450
p.z=200
v.x=xres/2'500
v.y=.6*yres'500
v.z=0
l.d=xres/7'150
ang.z=1
ang.x=2
ang.y=3
c.r=255:c.g=50:c.b=0

Sub tetra(p As pivot,v As vertex,l As length,an As angle)
Dim pp As Double=.5 'perspective
Dim As Integer n=4
Dim As Double pi=4*Atn(1)
Dim cnp(1 To 8) As Double
Dim cznp(1 To 4) As Double
Dim cz (1 To n,1 To n) As Double
Dim As Double cx,cy

Dim As Integer paint_order(1 To n)
For z As Integer=1 To n:paint_order(z)=z:Next
Dim fl As Integer=0
Dim denom As Integer
#macro edge(number)
denom=4
Select Case number
Case 1
cnp(1)=np(1)
cnp(2)=np(2)
cnp(3)=np(4)
cnp(4)=np(5)
cznp(1)=np(3)
cznp(2)=np(6)
Case 2
cnp(5)=np(1)
cnp(6)=np(2)
cnp(7)=np(4)
cnp(8)=np(5)
cznp(3)=np(3)
cznp(4)=np(6)
End Select
'get the z centroid
For n As Integer=1 To 4
For m As Integer = n+1 To 4
If Abs(cznp(n)-cznp(m)) <1e-3 Then
cznp(m)=0
fl=1
denom=denom-1
Exit For
End If
Next m
If fl=1 Then
fl=0
Exit For
End If
Next n
'get the centroids
cx=(cnp(1)+cnp(3)+cnp(5)+cnp(7))/4
cy=(cnp(2)+cnp(4)+cnp(6)+cnp(8))/4
cz(paint_order(count),paint_order(count))=(cznp(1)+cznp(2)+cznp(3)+cznp(4))/denom

#endmacro
#macro zsort(n)
' a quick bubblesort on z axis to get new paint order
For p1 As Integer = 1 To n - 1
For p2 As Integer  = p1 + 1 To n
If (cz(p1,p1)) <= (cz(p2,p2)) Then 'Goto skip
Swap cz(p1,p1),cz(p2,p2)
Swap paint_order(p1),paint_order(p2)
Endif
Next p2
Next p1
#endmacro
Dim  As Double u1,u2,u3,v1,v2,v3,wx,wy,wz,nw
#macro crossproduct(of_two_sides)
'get vectors to origin
u1=cnp(1)-cnp(3)
u2=cnp(2)-cnp(4)
u3=cznp(1)-cznp(2)
v1=cnp(5)-cnp(7)
v2=cnp(6)-cnp(8)
v3=cznp(3)-cznp(4)
'get the cross product
wx=(u2*v3-v2*u3)
wy=-(u1*v3-v1*u3)
wz=(u1*v2-v1*u2)
nw=Sqr(wx^2+wy^2+wz^2)
'normalized cross product components
wx=wx/nw
wy=wy/nw
wz=wz/nw
#endmacro
'GOEMETRY OF TETRAHEDRON
Dim h As Double=(l.d)*Tan(60 rad) 'height
Dim d As Double=(1/3)*Sqr(6)*l.d*2 'depth
Dim k As Integer
Dim As String action
Dim As Double limit=.02
For z As Integer=1 To 2
If z=1 Then
action="linepoint"
End If
If z=2 Then
action="line"
zsort(n)
End If
For count As Integer=1 To n
k=paint_order(count)
Select Case k
Case 1
c.b=1
'base
rotate3d(p.x,p.y,p.z,v.x-l.d,v.y,v.z,v.x+l.d,v.y,v.z,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'base bottom
edge(1)
rotate3d(p.x,p.y,p.z,v.x+l.d,v.y,v.z,v.x,v.y-h,v.z,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'base right
'edge(2)
rotate3d(p.x,p.y,p.z,v.x,v.y-h,v.z,v.x-l.d,v.y,v.z,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'base left
edge(2)
crossproduct(0)
If z=2 And Abs(wz) > limit Then Paint(cx,cy),rgb(155-100*(wx),0,0),rgb(c.r,c.g,c.b)
Case 2
c.b=2
'lower side
rotate3d(p.x,p.y,p.z,v.x-l.d,v.y,v.z,v.x+l.d,v.y,v.z,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'base bottom
edge(1)
rotate3d(p.x,p.y,p.z,v.x-l.d,v.y,v.z,v.x,v.y-(1/3)*h,v.z-d,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'left leg
'edge(2)
rotate3d(p.x,p.y,p.z,v.x+l.d,v.y,v.z,v.x,v.y-(1/3)*h,v.z-d,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'right leg
edge(2)
crossproduct(0)
If z=2 And Abs(wz) > limit Then Paint(cx,cy),rgb(0,155-100*(wx),0),rgb(c.r,c.g,c.b)
Case 3
c.b=3
'left side
rotate3d(p.x,p.y,p.z,v.x,v.y-h,v.z,v.x-l.d,v.y,v.z,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'base left
edge(1)
rotate3d(p.x,p.y,p.z,v.x,v.y-h,v.z,v.x,v.y-(1/3)*h,v.z-d,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'upper left
'edge(2)
rotate3d(p.x,p.y,p.z,v.x-l.d,v.y,v.z,v.x,v.y-(1/3)*h ,v.z-d,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'lower left
edge(2)
crossproduct(0)
If z=2 And Abs(wz) > limit Then Paint(cx,cy),rgb(0,0,155-100*(wx)),rgb(c.r,c.g,c.b)
Case 4
c.b=4
'right side
rotate3d(p.x,p.y,p.z,v.x+l.d,v.y,v.z,v.x,v.y-h,v.z,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'base right
edge(1)
rotate3d(p.x,p.y,p.z,v.x+l.d,v.y,v.z,v.x,v.y-(1/3)*h ,v.z-d,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'lower right
'edge(2)
rotate3d(p.x,p.y,p.z,v.x,v.y-h,v.z,v.x,v.y-(1/3)*h,v.z-d,0,an.x,an.y,an.z,1,1,rgb(c.r,c.g,c.b),1,action,"3d",pp)'upper right
edge(2)
crossproduct(0)
If z=2 And Abs(wz) > limit Then Paint(cx,cy),rgb(100-50*(wx),100-50*(wx),100-50*(wx)),rgb(c.r,c.g,c.b)
End Select
Next count

Next z
End Sub
Do
ang.x=ang.x+.6/3
ang.y=ang.y+.7/3
ang.z=ang.z+.8/3
screenlock
Cls
put(0,0),image,pset
tetra(p,v,l,ang)
screenunlock
Sleep 1,1
If ang.x>360 Then ang.x=0
If ang.y>360 Then ang.y=0
If ang.z>360 Then ang.z=0
Loop Until Inkey=Chr(27)
imagedestroy image
end
dodicat
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
Well Rollie~
It's SATURDAY NIGHT again.
I'm going up to the old County Hotel for a jar or three.
Must get a packet of ciggies, you can't beat the old cigarette, so relaxing.
And those great big smoke rings, billowing out, fantastico.
But I'll leave a Saturday doodle, the bresenham gun in action.

Code: Select all

#include "fbgfx.bi"
dim shared as integer xres,yres
xres=700'1024
yres=700'768
screenres xres,yres,32,1,fb.GFX_ALPHA_PRIMITIVES
declare Function rr(first As Double, last As Double) As Double
declare Sub _thickline(x1 As Double,_
y1 As Double,_
x2 As Double,_
y2 As Double,_
thickness As Double,_
colour As Uinteger)

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 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
Dim Shared np(1 To 6) As Double

dim shared as double px,py,pz,xc,yc,ax,ay,az,pv,gradient
dim shared as double ex,ey,Ppi
dim shared as uinteger colour(1 to 4)
dim as double pi=4*atn(1)
dim shared as integer count,bandflag,cc
Dim shared As Double thickness,radius
Dim shared As Double r,g,b,delta 'colour adjusters
delta=20 'if delta=0 then full range (0 to 255)
Dim shared As String drawflag'="pset"
#macro psetline(xf,yf,zf,xs,ys,zs)
scope
Dim As Single x1=xf
Dim As Single y1=yf
Dim As Single z1=zf
Dim As Single x2=xs
Dim As Single y2=ys
Dim As Single z2=zs
Dim As Single nx=x2-x1
Dim As Single ny=y2-y1
Dim As Single nz=z2-z1
Dim As Single length=Sqr(nx^2+ny^2+nz^2)
nx=nx/length
ny=ny/length
nz=nz/length
Dim As Single lastx=0
Dim As Single lasty=0
For i As Integer=0 To length
x1=x1+nx
y1=y1+ny
z1=z1+nz
Dim col As Uinteger=(255-delta)*(z1-zf)/(zs-zf)+delta
If drawflag="thickline" Then
If i>2 Then _thickline(x1,y1,lastx,lasty,thickness,rgb(col*r,col*g,col*b))
lastx=x1
lasty=y1
End If
If drawflag="pset" Then Pset(x1,y1),rgb(col*r,col*g,col*b)
If drawflag="circle" Then Circle(x1,y1),(40-10)*(z1-zf)/(zs-zf)+10,rgb(col*r,col*g,col*b),,,,f
Next i
end scope
#endmacro
#macro init(zz)
ax=1
Ppi=2
r=1:g=1:b=.1
pv=.8  'PERSPECTIVE
ex=1:ey=1
xc=.5*xres
yc=.5*yres
px=xc 'pivot position
py=yc
pz=.5*xres
#endmacro
' ***************************************  CODE ***********************

r=1:g=1:b=1
thickness=100
init(0)
drawflag="thickline"
dim k as integer=1
dim q as integer=3

do
q=q+k*1
az=az+.9
ax=ax+1.1
ay=ay+1
screenlock
sleep 1,1
cls
regular_polygon(q,xc,yc,colour(),3,yres/3,0)
screenunlock
if q>100 then k=-k
if q<3 then k=-k
if az>360 then az=0
if ay>360 then ay=0
if ax>360 then ax=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
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
count=0
for z as double=0+offset to Ppi*pi+offset step slug
count=count+1
'bander(bandflag)
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,rgba(col(1),col(2),col(3),col(4)),1,"linepoint","3d",pv,im)
psetline(np(1),np(2),np(3),np(4),np(5),np(6))
next k
next z
end sub
Function rr(first As Double, last As Double) As Double
Function = Rnd * (last - first) + first
End Function
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

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
Sub _thickline(x1 As Double,_
y1 As Double,_
x2 As Double,_
y2 As Double,_
thickness As Double,_
colour As Uinteger)
Dim p As Uinteger
p=Rgb(255, 255, 255)
If thickness<2 Then
Line(x1,y1)-(x2,y2),colour
Else
Dim As Double s,h,c
h=Sqr((x2-x1)^2+(y2-y1)^2)  'hypotenuse
s=(y1-y2)/h                 'sine
c=(x2-x1)/h                 'cosine
'Line (x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),p
'Line (x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
'Line (x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),p
'Line (x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
'Paint((x1+x2)/2, (y1+y2)/2), p, p
Line (x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),colour
Line (x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
Line (x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),colour
Line (x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
'Paint((x1+x2)/2, (y1+y2)/2), colour, colour
End If
End Sub
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
Good show dodicat. A mobius strip?

*Chews nicotine gum while licking nicotine patch while inhaling e-cigarette vapor*

I never realized how bad this place smells.

I think I'm going to start smoking again. THANKS DODICAT!
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
What do you get when cross a Square with a Circle?

A Black Squircle

Code: Select all

#include once "fbgfx.bi"

#define centerx 400
#define centery 300

'Black Squiircle

type point2d
as single x,y
end type

dim as point2d corners(3)

corners(0).x = centerx - 100
corners(0).y = centery - 100
corners(1).x = centerx + 100
corners(1).y = centery - 100
corners(2).x = centerx + 100
corners(2).y = centery + 100
corners(3).x = centerx - 100
corners(3).y = centery + 100

sub DrawPoly ( points() as point2d, clr as uinteger )
dim as integer j=0, numv = ubound(points)
for i as integer = 0 to numv
j=i+1: if i = numv then j=0
line ( points(i).x, points(i).y ) - ( points(j).x, points(j).y ), clr
next
end sub

function rSIN ( p1 as point2d, p2 as point2d, theta as integer ) as point2d

dim as point2d d

d.x= p2.x-p1.x
d.y= p2.y-p1.y

dim as single l= SQR(d.x*d.x+d.y*d.y)
d.x/=l
d.y/=l
theta mod= l
d.x = p1.x + ( theta*d.x )
d.y = p1.y + ( theta*d.y )

return d

end function

function rCOS ( p1 as point2d, p2 as point2d, theta as integer ) as point2d

dim as point2d d

d.x= p2.x-p1.x
d.y= p2.y-p1.y

dim as single l= SQR(d.x*d.x+d.y*d.y)
d.x/=l
d.y/=l
theta mod= l
d.x = p2.x - ( theta*d.x )
d.y = p2.y - ( theta*d.y )

return d

end function

screen 19,32
dim as integer j,k, theta
dim as single someradius = 0.0
dim as point2d center
for i as integer = 0 to ubound(corners)
center.x += corners(i).x
center.y += corners(i).y
next

center.x/=4
center.y/=4

dim as point2d p1, p2
dim as integer selection
dim as string key

?"Square/Circle Hybrid in Negative Space"

for theta as integer = 0 to 360
for i as integer = 0 to ubound(corners)
k=i+2:j=i+1:if i = ubound(corners) then j=0:k=1
if i = ubound(corners)-1 then j=ubound(corners):k=0
p1 = rSIN( corners(i), corners(j), theta )
p2 = rSIN( corners(j), corners(k), theta )
line ( p1.x, p1.y ) - ( p2.x,p2.y ), RGB(0,255,0)
next
next

sleep

Do

screenlock
cls
Locate 1,1 : ? "...Hit Spacebar..."
DrawPoly ( corners(), RGB(255,0,0) )

for i as integer = 0 to ubound(corners)
k=i+2:j=i+1:if i = ubound(corners) then j=0:k=1
if i = ubound(corners)-1 then j=ubound(corners):k=0
select case selection
case 0:
p1 = rSIN( corners(i), corners(j), theta )
p2 = rCOS( corners(j), corners(k), theta )
case 1:
p1 = rSIN( corners(i), corners(j), theta )
p2 = rSIN( corners(j), corners(k), theta )
case 2:
p1 = rCOS( corners(i), corners(j), theta )
p2 = rCOS( corners(j), corners(k), theta )
case 3:
p1 = rSIN( corners(i), corners(j), theta )
p2 = rCOS( corners(i), corners(k), theta )
case 4:
p1 = rCOS( corners(i), corners(j), theta )
p2 = rCOS( corners(i), corners(k), theta )
end select
line ( p1.x, p1.y ) - ( p2.x,p2.y ), RGB(0,255,0)
'line ( p1.x, p1.y ) - ( center.x,center.y ), RGB(0,255,0)
next
screenunlock
sleep 5
key=inkey
if key = " " then
selection+=1
if selection > 4 then selection = 0
endif
theta+=1

loop until multikey(fb.sc_escape)
dodicat
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
rolliebollocks wrote:What do you get when cross a Square with a Circle?

A Black Squircle

I like this one.
I think I'll start using types now.
I'll revamp all my stuff with types.
It's clean to return a vector straight from a function.
Thanks Rollie, you've just dragged old Dodicat out from the dark ages, and I am going to quit the cigarettes also.
Richard
Posts: 3036
Joined: Jan 15, 2007 20:44
Location: Australia
@ dodicat
Another advantage of using types is that it places coupled data adjacent in memory. This makes optimisation of code easier. For example, if a point's x and y values are stored together they can be loaded together into an MMX or XMM register and processed as one with SIMD.
Can be optimised to become;
subtract x,y packed ' cx-x, cy-y
multiply packed ' (cx-x)^2,(cy-y)^2
add horizontal packed ' gives = LHS
multiply ' gives you radius^2 = RHS
subtract ' gives the sign as a boolean result

@ rolliebollocks
I have my compiler command string set to -w pedantic -exx. Your Functions, Subs and their Declarations, throw missing Byref or Byval warnings almost every time I run your code. By explicitly using Byref/Byval every time you pass a parameter you avoid the questionable default mode and make the situation clear as to the mode you intended to use. FB will warn you if you try to pass something in an unreasonable way. Because I always use -w pedantic -exx when writing and testing my code there is a disincentive to run your code since I have to edit your code or change my compiler string every time. Being -pedantic has real productivity benefits.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
@Richard

Throws an error under pedantic that is not an error, and even if it was would be unfixable.

Code: Select all

sub DoStuff ( byref somestuff() as integer )
beep
end sub

<EDIT>

Other than that unfixable error, I went through and updated everything else, until pedantic ran clean except for array case.

Thanks, Richard.

@Dodicat

Types are good. And methods within types are sometimes better because you don't have to pass some giant data type to it. Also, from a philosophical standpoint, the idea that an object (thing) can have a verbal (acting) and noumenal (thinglike) qualities appeals to me somehow. Good luck quitting. It's been a week for me. The girlfriend keeps developing an asthmatic condition over the cold harsh Buffalo winters, and she must quit, or she will get pneumonia again this winter. So I'm quitting with her. My lungs are strong as an ox's. I could smoke exhaust and live till 90. My whole family smoked, they all made it to their mid 80's.

...But I want to enjoy that time, and lugging around a respirator seems like a drag (haha).

Don't do anything you don't have to. I'm doing it because she's making me. Otherwise I'd go Hemmingway's way. Wait till my health gets so bad that I'm useless and blow my damn head off.

Anyways, here's hoping neither one of us get to that point any time soon.

btw. The Sphere mapping looks pretty good. I need to play with it to see if I can do some stuff. This is not going to be easy.