Squares

General FreeBASIC programming questions.
Locked
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

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
    #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

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

Post by rolliebollocks »

@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: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

@ 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
    #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 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:

Post by BasicScience »

@ 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: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

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
    #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 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

Post by rolliebollocks »

This is a "rough draft". I call it The Echo Mirror.

http://www.imakegames.com/rolliebollock ... Mirror.zip
Last edited by rolliebollocks on Aug 20, 2010 22:52, edited 1 time in total.
counting_pine
Site Admin
Posts: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Post by counting_pine »

(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

Post by rolliebollocks »

@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/rolliebollock ... irrors.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: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

rolliebollocks wrote:This is a "rough draft". I call it 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(1)=00+gradient/4
colour(2)=r(5,15)+gradient/4
colour(3)=00+gradient/4
colour(4)=255
case(2)
colour(1)=0+gradient/4
colour(2)=r(0,5)+gradient/4
colour(3)=0+gradient/4
colour(4)=255
case 3
    colour(1)=20+gradient/4
    colour(2)=0+gradient/4
    colour(3)=0+gradient/4
    colour(4)=200
Case 4
colour(1)=20+gradient'00+gradient/3
colour(2)=gradient'200
colour(3)=gradient'00+gradient/3
colour(4)=10
case(5)
colour(1)=gradient'200
colour(2)=20+gradient'00+gradient/3
colour(3)=gradient'00+gradient/3
colour(4)=10
case 6
     'colour(1)=100:colour(2)=00:colour(3)=60+gradient/3
     'colour(4)=10
  colour(1)=gradient'200
colour(2)=gradient'00+gradient/3
colour(3)=20+gradient'00+gradient/3
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 
     
     ax=0:az=0:gradient=y2
 case 2
     colourinfo(4)
    if count mod 2 =0 then
             colourinfo(5)
         end if
         if count mod 20=0 then
             colourinfo(6)
         end if
         gradient=y2
         gradient=y2
         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
draw string (xres/3,yres/2),"Please wait  loading..."
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
    #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
    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
'gradient=y1'(y2-y1)/(x2-x1)

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)
    #define rad *pi/180
    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: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

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
    #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
    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

Post by rolliebollocks »

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

Post by rolliebollocks »

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: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

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: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Post by Richard »

@ 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.
Your “point outside a circle macro” (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
Can be optimised to become;
load cx,cy packed
subtract x,y packed ' cx-x, cy-y
multiply packed ' (cx-x)^2,(cy-y)^2
add horizontal packed ' gives = LHS
load radius
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

Post by rolliebollocks »

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