## 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 CIRCLEdim as integer xres,yresscreeninfo xres,yresscreenres xres,yres,32declare 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 VECTORdeclare 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,pdim as uinteger colour(1 to 3)p=1  'PERSPECTIVEcolour(1)=100colour(2)=200colour(3)=0xc=xres/2yc=yres/2px=xc 'pivot positionpy=ycpz=0do     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)screenunlockif ax>360 then ax=0if ay>360 then ay=0if az>360 then az=0loop 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 polygonfor 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 knext zend subSub 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 SubDim 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_xDim p As Double = 4*Atn(1)  '(pi)Dim angleX_degrees As DoubleDim angleY_degrees As DoubleDim angleZ_degrees As Double#Macro thickline(t)Dim As Double s,h,cDim As Uinteger prime=rgb(255,255,255)h=Sqr(((np(1))-(np(4)))^2+((np(2))-(np(5)))^2)s=((np(5))-np(2))/hc=(np(1)-(np(4)))/hLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),primeLine image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primeLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),primeLine image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primePaint image,((np(4)+np(1))/2, (np(5)+np(2))/2),prime,primeLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),colourLine image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),colourLine image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourPaint 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,yp2Dim arc1 As Double=second_z*p/180Dim arc2 As Double=second_arc*p/180arc1=2*p+(arc1-(anglez_degrees))arc2=2*p+(arc2-(anglez_degrees))sx=sx*magnifierIf 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,colourEnd Ifif 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,colourEnd If#endmacro#macro get_perspective(np3,np6)For n As Integer=3 To 6 Step 3zval =np(n)  'for perspectivepp=perspective*((zval+1000)/1000-1)pp=(1-pp)If n=3 Then np(n-2)=np(n-2)-pivot_xnp(n-1)=np(n-1)-pivot_ynp(n-2)=np(n-2)*ppnp(n-1)=np(n-1)*ppnp(n-2)=np(n-2)+pivot_xnp(n-1)=np(n-1)+pivot_yEndifIf 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_yEndifNext nsx=(pp)*sx#endmacroDim pivot_vector(1 To 3) As DoubleDim line_vector(1 To 3) As Doublemagnifier=dilator*magnifierIf shape="circle" ThenangleX=angleX Mod 360:angleY=angleY Mod 360:angleZ=angleZ Mod 360End IfangleX_degrees=(2*p/360)*angleX      angleY_degrees=(2*p/360)*angleYangleZ_degrees=(2*p/360)*angleZpivot_vector(1)=first_x-pivot_xpivot_vector(2)=first_y-pivot_ypivot_vector(3)=first_z-pivot_zpivot_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 DoubleDim Ry(1 To 3,1 To 3) As DoubleDim Rz(1 To 3,1 To 3) As Double'rotat1on matrices about the three axixIf mode="3d" ThenRx(1,1)=1:Rx(1,2)=0:Rx(1,3)=0Rx(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)=0Ry(3,1)=-Sin(angleY_degrees):Ry(3,2)=0:Ry(3,3)=Cos(angleY_degrees)EndifRz(1,1)=Cos(angleZ_degrees):Rz(1,2)=-Sin(angleZ_degrees):Rz(1,3)=0Rz(2,1)=Sin(angleZ_degrees):Rz(2,2)=Cos(angleZ_degrees):Rz(2,3)=0Rz(3,1)=0:Rz(3,2)=0:Rz(3,3)=1line_vector(1)=magnifier*(second_x-first_x)'*pp                   'get the vectorline_vector(2)=magnifier*(second_y-first_y)'*pp                   'get the vectorline_vector(3)=magnifier*(second_z-first_z)'*ppDim new_pos(1 To 3) As DoubleDim temp1(1 To 3) As DoubleDim temp2(1 To 3) As DoubleIf mode="3d" Thenmv Rx(),pivot_vector(),temp1()           mv Ry(),temp1(),temp2()mv Rz(),temp2(),new_pos()EndifIf mode="2d" Then    mv Rz(),pivot_vector(),new_pos()    Endifnew_pos(1)=new_pos(1)+pivot_xnew_pos(2)=new_pos(2)+pivot_ynew_pos(3)=new_pos(3)+pivot_zDim new_one(1 To 3) As Double            'To hold the turned valueIf mode="3d" Thenmv Rx(),line_vector(),temp1()              'rotatemv Ry(),temp1(),temp2()mv Rz(),temp2(),new_one()EndifIf mode="2d" Then    mv Rz(),line_vector(),new_one()    Endifnew_one(1)=new_one(1)+first_x              'translatenew_one(2)=new_one(2)+first_ynew_one(3)=new_one(3)+first_zDim xx As Double   Dim yy As DoubleDim zz As Doublexx=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-zzIf perspective <> 0 Then get_perspective(np(3),np(6))End IfSelect Case shapeCase "line"    If th<2 Then Line image,(np(4),np(5))-(np(1),np(2)),colour Else thickline(th)    End IfCase "circle"    Dim arc1 As Double=second_z*p/180Dim 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_yElse thickcircle(th)End IfEndifIf arc1<>arc2 Then If th<=2 Then    Circle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_yElse    thickcircle(th)End IfEnd IfCase "circlefill"    Dim As Double xp1,xp2,yp1,yp2Dim As Uinteger prime=rgb(255,255,255)Dim arc1 As Double=second_z*p/180Dim arc2 As Double=second_arc*p/180If arc1=arc2 Then Circle image,(np(4),np(5)),magnifier*sx,colour,,,second_y,FIf arc1<>arc2 Then xp1=np(4)+magnifier*sx*Cos(.5*(arc2+arc1))*3/4yp1=np(5)-magnifier*sx*Sin(.5*(arc2+arc1))*3/4   Circle image,(np(4),np(5)),magnifier*sx,prime,arc1,arc2,second_yLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),primeLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),primePaint image,(xp1,yp1),prime,primeCircle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_yLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),colourLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),colourPaint image,(xp1,yp1),colour,colourEnd If Case"box"  Line image,(np(4),np(5))-(np(1),np(2)),colour,bCase "boxfill"  Line image,(np(4),np(5))-(np(1),np(2)),colour,bf        Case "linepoint","circlepoint"  'nothing drawnCase "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 squareDim As Integer xres,yres'screeninfo xres,yresxres=640yres=640screenres xres,yres,32Declare 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 VECTORDeclare 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=2Dim As Uinteger colour(1 To 3)p=0  'PERSPECTIVEcolour(1)=0colour(2)=255colour(3)=255xc=xres/2yc=yres/2px=xc 'pivot positionpy=ycpz=0Do     '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)'screenunlocksleep 10'If ax>360 Then ax=0'If ay>360 Then ay=0If az<-360 Then az=0Loop 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 polygonFor 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 kNext zEnd SubSub 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 SubDim 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_xDim p As Double = 4*Atn(1)  '(pi)Dim angleX_degrees As DoubleDim angleY_degrees As DoubleDim angleZ_degrees As Double#Macro thickline(t)Dim As Double s,h,cDim As Uinteger prime=rgb(255,255,255)h=Sqr(((np(1))-(np(4)))^2+((np(2))-(np(5)))^2)s=((np(5))-np(2))/hc=(np(1)-(np(4)))/hLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),primeLine image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primeLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),primeLine image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primePaint image,((np(4)+np(1))/2, (np(5)+np(2))/2),prime,primeLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),colourLine image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),colourLine image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourPaint 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,yp2Dim arc1 As Double=second_z*p/180Dim arc2 As Double=second_arc*p/180arc1=2*p+(arc1-(anglez_degrees))arc2=2*p+(arc2-(anglez_degrees))sx=sx*magnifierIf 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,colourEnd Ifif 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,colourEnd If#endmacro#macro get_perspective(np3,np6)For n As Integer=3 To 6 Step 3zval =np(n)  'for perspectivepp=perspective*((zval+1000)/1000-1)pp=(1-pp)If n=3 Then np(n-2)=np(n-2)-pivot_xnp(n-1)=np(n-1)-pivot_ynp(n-2)=np(n-2)*ppnp(n-1)=np(n-1)*ppnp(n-2)=np(n-2)+pivot_xnp(n-1)=np(n-1)+pivot_yEndifIf 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_yEndifNext nsx=(pp)*sx#endmacroDim pivot_vector(1 To 3) As DoubleDim line_vector(1 To 3) As Doublemagnifier=dilator*magnifierIf shape="circle" ThenangleX=angleX Mod 360:angleY=angleY Mod 360:angleZ=angleZ Mod 360End IfangleX_degrees=(2*p/360)*angleX      angleY_degrees=(2*p/360)*angleYangleZ_degrees=(2*p/360)*angleZpivot_vector(1)=first_x-pivot_xpivot_vector(2)=first_y-pivot_ypivot_vector(3)=first_z-pivot_zpivot_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 DoubleDim Ry(1 To 3,1 To 3) As DoubleDim Rz(1 To 3,1 To 3) As Double'rotat1on matrices about the three axixIf mode="3d" ThenRx(1,1)=1:Rx(1,2)=0:Rx(1,3)=0Rx(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)=0Ry(3,1)=-Sin(angleY_degrees):Ry(3,2)=0:Ry(3,3)=Cos(angleY_degrees)EndifRz(1,1)=Cos(angleZ_degrees):Rz(1,2)=-Sin(angleZ_degrees):Rz(1,3)=0Rz(2,1)=Sin(angleZ_degrees):Rz(2,2)=Cos(angleZ_degrees):Rz(2,3)=0Rz(3,1)=0:Rz(3,2)=0:Rz(3,3)=1line_vector(1)=magnifier*(second_x-first_x)'*pp                   'get the vectorline_vector(2)=magnifier*(second_y-first_y)'*pp                   'get the vectorline_vector(3)=magnifier*(second_z-first_z)'*ppDim new_pos(1 To 3) As DoubleDim temp1(1 To 3) As DoubleDim temp2(1 To 3) As DoubleIf mode="3d" Thenmv Rx(),pivot_vector(),temp1()           mv Ry(),temp1(),temp2()mv Rz(),temp2(),new_pos()EndifIf mode="2d" Then    mv Rz(),pivot_vector(),new_pos()    Endifnew_pos(1)=new_pos(1)+pivot_xnew_pos(2)=new_pos(2)+pivot_ynew_pos(3)=new_pos(3)+pivot_zDim new_one(1 To 3) As Double            'To hold the turned valueIf mode="3d" Thenmv Rx(),line_vector(),temp1()              'rotatemv Ry(),temp1(),temp2()mv Rz(),temp2(),new_one()EndifIf mode="2d" Then    mv Rz(),line_vector(),new_one()    Endifnew_one(1)=new_one(1)+first_x              'translatenew_one(2)=new_one(2)+first_ynew_one(3)=new_one(3)+first_zDim xx As Double   Dim yy As DoubleDim zz As Doublexx=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-zzIf perspective <> 0 Then get_perspective(np(3),np(6))End IfSelect Case shapeCase "line"    If th<2 Then Line image,(np(4),np(5))-(np(1),np(2)),colour Else thickline(th)    End IfCase "circle"    Dim arc1 As Double=second_z*p/180Dim 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_yElse thickcircle(th)End IfEndifIf arc1<>arc2 Then If th<=2 Then    Circle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_yElse    thickcircle(th)End IfEnd IfCase "circlefill"    Dim As Double xp1,xp2,yp1,yp2Dim As Uinteger prime=rgb(255,255,255)Dim arc1 As Double=second_z*p/180Dim arc2 As Double=second_arc*p/180If arc1=arc2 Then Circle image,(np(4),np(5)),magnifier*sx,colour,,,second_y,FIf arc1<>arc2 Then xp1=np(4)+magnifier*sx*Cos(.5*(arc2+arc1))*3/4yp1=np(5)-magnifier*sx*Sin(.5*(arc2+arc1))*3/4   Circle image,(np(4),np(5)),magnifier*sx,prime,arc1,arc2,second_yLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),primeLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),primePaint image,(xp1,yp1),prime,primeCircle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_yLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),colourLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),colourPaint image,(xp1,yp1),colour,colourEnd If Case"box"  Line image,(np(4),np(5))-(np(1),np(2)),colour,bCase "boxfill"  Line image,(np(4),np(5))-(np(1),np(2)),colour,bf        Case "linepoint","circlepoint"  'nothing drawnCase "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 pointDim As Integer xres,yresscreeninfo xres,yresscreenres xres,yres,32Declare 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 VECTORDeclare 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,z2dim shared as double angx,angy,angzDim As Uinteger colour(1 To 3)p=.5  'PERSPECTIVE#macro info(zz)select case zzcase 1    z1=0:z2=0    p=.5:angx=ax:angy=ay:angz=azcolour(1)=0:colour(2)=155:colour(3)=0xc=xres/2:yc=yres/2:px=xc :py=yc:pz=500case 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=300case 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=100case 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=100case 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=00case 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=100end select#endmacroDo     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)screenunlocksleep 1,1If ax>360 Then ax=0If ay>360 Then ay=0If az>360 Then az=0Loop 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 polygonFor 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 kNext zEnd SubSub 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 SubDim 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_xDim p As Double = 4*Atn(1)  '(pi)Dim angleX_degrees As DoubleDim angleY_degrees As DoubleDim angleZ_degrees As Double#Macro thickline(t)Dim As Double s,h,cDim As Uinteger prime=rgb(255,255,255)h=Sqr(((np(1))-(np(4)))^2+((np(2))-(np(5)))^2)s=((np(5))-np(2))/hc=(np(1)-(np(4)))/hLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),primeLine image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primeLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),primeLine image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primePaint image,((np(4)+np(1))/2, (np(5)+np(2))/2),prime,primeLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),colourLine image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),colourLine image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourPaint 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,yp2Dim arc1 As Double=second_z*p/180Dim arc2 As Double=second_arc*p/180arc1=2*p+(arc1-(anglez_degrees))arc2=2*p+(arc2-(anglez_degrees))sx=sx*magnifierIf 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,colourEnd Ifif 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,colourEnd If#endmacro#macro get_perspective(np3,np6)For n As Integer=3 To 6 Step 3zval =np(n)  'for perspectivepp=perspective*((zval+1000)/1000-1)pp=(1-pp)If n=3 Then np(n-2)=np(n-2)-pivot_xnp(n-1)=np(n-1)-pivot_ynp(n-2)=np(n-2)*ppnp(n-1)=np(n-1)*ppnp(n-2)=np(n-2)+pivot_xnp(n-1)=np(n-1)+pivot_yEndifIf 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_yEndifNext nsx=(pp)*sx#endmacroDim pivot_vector(1 To 3) As DoubleDim line_vector(1 To 3) As Doublemagnifier=dilator*magnifierIf shape="circle" ThenangleX=angleX Mod 360:angleY=angleY Mod 360:angleZ=angleZ Mod 360End IfangleX_degrees=(2*p/360)*angleX      angleY_degrees=(2*p/360)*angleYangleZ_degrees=(2*p/360)*angleZpivot_vector(1)=first_x-pivot_xpivot_vector(2)=first_y-pivot_ypivot_vector(3)=first_z-pivot_zpivot_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 DoubleDim Ry(1 To 3,1 To 3) As DoubleDim Rz(1 To 3,1 To 3) As Double'rotat1on matrices about the three axixIf mode="3d" ThenRx(1,1)=1:Rx(1,2)=0:Rx(1,3)=0Rx(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)=0Ry(3,1)=-Sin(angleY_degrees):Ry(3,2)=0:Ry(3,3)=Cos(angleY_degrees)EndifRz(1,1)=Cos(angleZ_degrees):Rz(1,2)=-Sin(angleZ_degrees):Rz(1,3)=0Rz(2,1)=Sin(angleZ_degrees):Rz(2,2)=Cos(angleZ_degrees):Rz(2,3)=0Rz(3,1)=0:Rz(3,2)=0:Rz(3,3)=1line_vector(1)=magnifier*(second_x-first_x)'*pp                   'get the vectorline_vector(2)=magnifier*(second_y-first_y)'*pp                   'get the vectorline_vector(3)=magnifier*(second_z-first_z)'*ppDim new_pos(1 To 3) As DoubleDim temp1(1 To 3) As DoubleDim temp2(1 To 3) As DoubleIf mode="3d" Thenmv Rx(),pivot_vector(),temp1()           mv Ry(),temp1(),temp2()mv Rz(),temp2(),new_pos()EndifIf mode="2d" Then    mv Rz(),pivot_vector(),new_pos()    Endifnew_pos(1)=new_pos(1)+pivot_xnew_pos(2)=new_pos(2)+pivot_ynew_pos(3)=new_pos(3)+pivot_zDim new_one(1 To 3) As Double            'To hold the turned valueIf mode="3d" Thenmv Rx(),line_vector(),temp1()              'rotatemv Ry(),temp1(),temp2()mv Rz(),temp2(),new_one()EndifIf mode="2d" Then    mv Rz(),line_vector(),new_one()    Endifnew_one(1)=new_one(1)+first_x              'translatenew_one(2)=new_one(2)+first_ynew_one(3)=new_one(3)+first_zDim xx As Double   Dim yy As DoubleDim zz As Doublexx=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-zzIf perspective <> 0 Then get_perspective(np(3),np(6))End IfSelect Case shapeCase "line"    If th<2 Then Line image,(np(4),np(5))-(np(1),np(2)),colour Else thickline(th)    End IfCase "circle"    Dim arc1 As Double=second_z*p/180Dim 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_yElse thickcircle(th)End IfEndifIf arc1<>arc2 Then If th<=2 Then    Circle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_yElse    thickcircle(th)End IfEnd IfCase "circlefill"    Dim As Double xp1,xp2,yp1,yp2Dim As Uinteger prime=rgb(255,255,255)Dim arc1 As Double=second_z*p/180Dim arc2 As Double=second_arc*p/180If arc1=arc2 Then Circle image,(np(4),np(5)),magnifier*sx,colour,,,second_y,FIf arc1<>arc2 Then xp1=np(4)+magnifier*sx*Cos(.5*(arc2+arc1))*3/4yp1=np(5)-magnifier*sx*Sin(.5*(arc2+arc1))*3/4   Circle image,(np(4),np(5)),magnifier*sx,prime,arc1,arc2,second_yLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),primeLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),primePaint image,(xp1,yp1),prime,primeCircle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_yLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),colourLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),colourPaint image,(xp1,yp1),colour,colourEnd If Case"box"  Line image,(np(4),np(5))-(np(1),np(2)),colour,bCase "boxfill"  Line image,(np(4),np(5))-(np(1),np(2)),colour,bf        Case "linepoint","circlepoint"  'nothing drawnCase "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,yresxres=1024yres=768screenres xres,yres,32,1,fb.GFX_ALPHA_PRIMITIVESdeclare 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 Doubledeclare 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 VECTORdeclare 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,gradientdim shared as double ex,ey,Ppi dim shared as uinteger colour(1 to 4)dim as double pi=4*atn(1)'dim as integer infoflagdim shared image as any pointerimage=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=1xc=.7*xresyc=.5*yrespx=xc 'pivot positionpy=ycpz=0 #endmacro#macro colourinfo(zz)Select Case zzCase 1colour(1)=00+gradient/4colour(2)=r(5,15)+gradient/4colour(3)=00+gradient/4colour(4)=255case(2)colour(1)=0+gradient/4colour(2)=r(0,5)+gradient/4colour(3)=0+gradient/4colour(4)=255case 3    colour(1)=20+gradient/4    colour(2)=0+gradient/4    colour(3)=0+gradient/4    colour(4)=200Case 4colour(1)=20+gradient'00+gradient/3colour(2)=gradient'200colour(3)=gradient'00+gradient/3colour(4)=10case(5)colour(1)=gradient'200colour(2)=20+gradient'00+gradient/3colour(3)=gradient'00+gradient/3colour(4)=10case 6     'colour(1)=100:colour(2)=00:colour(3)=60+gradient/3     'colour(4)=10  colour(1)=gradient'200colour(2)=gradient'00+gradient/3colour(3)=20+gradient'00+gradient/3colour(4)=10        End Select#endmacro#macro bander(zz)select case zzcase 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 c7for 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=1regular_polygon(150,xc,yc,colour(),4,.5*yres,87,image)screenunlockif ax>360 then ax=0if ay>360 then ay=0if az>360 then az=0loop until ay>180'inkey=chr(27)ax=0:ay=0:az=0:bandflag=2:ey=1:yc=.1*yres:xc=.1*xrespx=xc 'pivot positionpy=ycpz=0 do    cc=cc+1    screenlockax=ax+1:ay=ay+1:az=az+1regular_polygon(40,xc,yc,colour(),40,40,0,image)screenunlockif ax>360 then ax=0if ay>360 then ay=0if az>360 then az=0loop until cc>300#endmacrodraw 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=0for 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 zend subsub 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,colourend subsub 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 subFunction r(first As Double, last As Double) As Double    Function = Rnd * (last - first) + firstEnd FunctionSub 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_xDim p As Double = 4*Atn(1)  '(pi)Dim angleX_degrees As DoubleDim angleY_degrees As DoubleDim angleZ_degrees As Double#Macro thickline(t)Dim As Double s,h,cDim As Uinteger prime=rgb(255,255,255)h=Sqr(((np(1))-(np(4)))^2+((np(2))-(np(5)))^2)s=((np(5))-np(2))/hc=(np(1)-(np(4)))/hLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),primeLine image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primeLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),primeLine image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primePaint image,((np(4)+np(1))/2, (np(5)+np(2))/2),prime,primeLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),colourLine image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),colourLine image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourPaint 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,yp2Dim arc1 As Double=second_z*p/180Dim arc2 As Double=second_arc*p/180arc1=2*p+(arc1-(anglez_degrees))arc2=2*p+(arc2-(anglez_degrees))sx=sx*magnifierIf 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,colourEnd Ifif 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,colourEnd If#endmacro#macro get_perspective(np3,np6)For n As Integer=3 To 6 Step 3zval =np(n)  'for perspectivepp=perspective*((zval+1000)/1000-1)pp=(1-pp)If n=3 Then np(n-2)=np(n-2)-pivot_xnp(n-1)=np(n-1)-pivot_ynp(n-2)=np(n-2)*ppnp(n-1)=np(n-1)*ppnp(n-2)=np(n-2)+pivot_xnp(n-1)=np(n-1)+pivot_yEndifIf 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_yEndifNext nsx=(pp)*sx#endmacroDim pivot_vector(1 To 3) As DoubleDim line_vector(1 To 3) As Doublemagnifier=dilator*magnifierIf shape="circle" ThenangleX=angleX Mod 360:angleY=angleY Mod 360:angleZ=angleZ Mod 360End IfangleX_degrees=(2*p/360)*angleX      angleY_degrees=(2*p/360)*angleYangleZ_degrees=(2*p/360)*angleZpivot_vector(1)=first_x-pivot_xpivot_vector(2)=first_y-pivot_ypivot_vector(3)=first_z-pivot_zpivot_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 DoubleDim Ry(1 To 3,1 To 3) As DoubleDim Rz(1 To 3,1 To 3) As Double'rotat1on matrices about the three axixIf mode="3d" ThenRx(1,1)=1:Rx(1,2)=0:Rx(1,3)=0Rx(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)=0Ry(3,1)=-Sin(angleY_degrees):Ry(3,2)=0:Ry(3,3)=Cos(angleY_degrees)EndifRz(1,1)=Cos(angleZ_degrees):Rz(1,2)=-Sin(angleZ_degrees):Rz(1,3)=0Rz(2,1)=Sin(angleZ_degrees):Rz(2,2)=Cos(angleZ_degrees):Rz(2,3)=0Rz(3,1)=0:Rz(3,2)=0:Rz(3,3)=1line_vector(1)=magnifier*(second_x-first_x)'*pp                   'get the vectorline_vector(2)=magnifier*(second_y-first_y)'*pp                   'get the vectorline_vector(3)=magnifier*(second_z-first_z)'*ppDim new_pos(1 To 3) As DoubleDim temp1(1 To 3) As DoubleDim temp2(1 To 3) As DoubleIf mode="3d" Thenmv Rx(),pivot_vector(),temp1()           mv Ry(),temp1(),temp2()mv Rz(),temp2(),new_pos()EndifIf mode="2d" Then    mv Rz(),pivot_vector(),new_pos()    Endifnew_pos(1)=new_pos(1)+pivot_xnew_pos(2)=new_pos(2)+pivot_ynew_pos(3)=new_pos(3)+pivot_zDim new_one(1 To 3) As Double            'To hold the turned valueIf mode="3d" Thenmv Rx(),line_vector(),temp1()              'rotatemv Ry(),temp1(),temp2()mv Rz(),temp2(),new_one()EndifIf mode="2d" Then    mv Rz(),line_vector(),new_one()    Endifnew_one(1)=new_one(1)+first_x              'translatenew_one(2)=new_one(2)+first_ynew_one(3)=new_one(3)+first_zDim xx As Double   Dim yy As DoubleDim zz As Doublexx=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-zzIf perspective <> 0 Then get_perspective(np(3),np(6))End IfSelect Case shapeCase "line"    If th<2 Then Line image,(np(4),np(5))-(np(1),np(2)),colour Else thickline(th)    End IfCase "circle"    Dim arc1 As Double=second_z*p/180Dim 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_yElse thickcircle(th)End IfEndifIf arc1<>arc2 Then If th<=2 Then    Circle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_yElse    thickcircle(th)End IfEnd IfCase "circlefill"    Dim As Double xp1,xp2,yp1,yp2Dim As Uinteger prime=rgb(255,255,255)Dim arc1 As Double=second_z*p/180Dim arc2 As Double=second_arc*p/180If arc1=arc2 Then Circle image,(np(4),np(5)),magnifier*sx,colour,,,second_y,FIf arc1<>arc2 Then xp1=np(4)+magnifier*sx*Cos(.5*(arc2+arc1))*3/4yp1=np(5)-magnifier*sx*Sin(.5*(arc2+arc1))*3/4   Circle image,(np(4),np(5)),magnifier*sx,prime,arc1,arc2,second_yLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),primeLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),primePaint image,(xp1,yp1),prime,primeCircle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_yLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),colourLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),colourPaint image,(xp1,yp1),colour,colourEnd If Case"box"  Line image,(np(4),np(5))-(np(1),np(2)),colour,bCase "boxfill"  Line image,(np(4),np(5))-(np(1),np(2)),colour,bf        Case "linepoint","circlepoint"  'nothing drawnCase "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 ROTATORType pivot    x As Double    y As Double    z As DoubleEnd TypeType vertex    x As Double    y As Double    z As DoubleEnd Typetype length    d As DoubleEnd Typetype angle    x As Double    y As Double    z As DoubleEnd Typetype colour    r As Uinteger    g As Uinteger    b As Uinteger    End TypeDim p As pivotDim v As vertexDim ang As angleDim l As lengthDim Shared c As colourp.x=xres/2'500p.y=(.55*yres)'450p.z=200v.x=xres/2'500v.y=.6*yres'500v.z=0l.d=xres/7'150ang.z=1ang.x=2ang.y=3c.r=255:c.g=50:c.b=0Sub 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 centroidFor 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 IfNext mIf fl=1 Then    fl=0    Exit For    End IfNext n   'get the centroidscx=(cnp(1)+cnp(3)+cnp(5)+cnp(7))/4cy=(cnp(2)+cnp(4)+cnp(6)+cnp(8))/4cz(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 orderFor 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 TETRAHEDRONDim h As Double=(l.d)*Tan(60 rad) 'heightDim d As Double=(1/3)*Sqr(6)*l.d*2 'depthDim k As IntegerDim As String actionDim As Double limit=.02For z As Integer=1 To 2    If z=1 Then     action="linepoint"    End If    If z=2 Then     action="line"    zsort(n)    End IfFor 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 leftedge(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 siderotate3d(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 bottomedge(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 legedge(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 siderotate3d(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 leftedge(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 leftedge(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 siderotate3d(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 rightedge(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 rightedge(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 SelectNext countNext zEnd SubDo     ang.x=ang.x+.6/3    ang.y=ang.y+.7/3    ang.z=ang.z+.8/3    screenlock    Cls    put(0,0),image,psettetra(p,v,l,ang)screenunlockSleep 1,1If ang.x>360 Then ang.x=0If ang.y>360 Then ang.y=0If ang.z>360 Then ang.z=0Loop Until Inkey=Chr(27)imagedestroy imageend`
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,yresxres=700'1024yres=700'768screenres xres,yres,32,1,fb.GFX_ALPHA_PRIMITIVESdeclare Function rr(first As Double, last As Double) As Doubledeclare 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,gradientdim 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,ccDim shared As Double thickness,radiusDim shared As Double r,g,b,delta 'colour adjustersdelta=20 'if delta=0 then full range (0 to 255)Dim shared As String drawflag'="pset"        #macro psetline(xf,yf,zf,xs,ys,zs)scopeDim As Single x1=xfDim As Single y1=yfDim As Single z1=zfDim As Single x2=xsDim As Single y2=ysDim As Single z2=zsDim As Single nx=x2-x1Dim As Single ny=y2-y1Dim As Single nz=z2-z1Dim As Single length=Sqr(nx^2+ny^2+nz^2)nx=nx/lengthny=ny/lengthnz=nz/lengthDim As Single lastx=0Dim As Single lasty=0For 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=1Ppi=2r=1:g=1:b=.1pv=.8  'PERSPECTIVE ex=1:ey=1xc=.5*xresyc=.5*yrespx=xc 'pivot positionpy=ycpz=.5*xres #endmacro' ***************************************  CODE ***********************r=1:g=1:b=1thickness=100init(0)drawflag="thickline"dim k as integer=1dim q as integer=3do    q=q+k*1    az=az+.9    ax=ax+1.1    ay=ay+1    screenlock    sleep 1,1clsregular_polygon(q,xc,yc,colour(),3,yres/3,0)screenunlockif q>100 then k=-kif q<3 then k=-kif az>360 then az=0if ay>360 then ay=0if ax>360 then ax=0loop until inkey=chr(27)sleepsub 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=0for 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 knext zend subFunction rr(first As Double, last As Double) As Double    Function = Rnd * (last - first) + firstEnd FunctionSub 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_xDim p As Double = 4*Atn(1)  '(pi)Dim angleX_degrees As DoubleDim angleY_degrees As DoubleDim angleZ_degrees As Double#Macro thickline(t)Dim As Double s,h,cDim As Uinteger prime=rgb(255,255,255)h=Sqr(((np(1))-(np(4)))^2+((np(2))-(np(5)))^2)s=((np(5))-np(2))/hc=(np(1)-(np(4)))/hLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),primeLine image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primeLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),primeLine image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primePaint image,((np(4)+np(1))/2, (np(5)+np(2))/2),prime,primeLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),colourLine image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourLine image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),colourLine image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourPaint 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,yp2Dim arc1 As Double=second_z*p/180Dim arc2 As Double=second_arc*p/180arc1=2*p+(arc1-(anglez_degrees))arc2=2*p+(arc2-(anglez_degrees))sx=sx*magnifierIf 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,colourEnd Ifif 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,colourEnd If#endmacro#macro get_perspective(np3,np6)For n As Integer=3 To 6 Step 3zval =np(n)  'for perspectivepp=perspective*((zval+1000)/1000-1)pp=(1-pp)If n=3 Then np(n-2)=np(n-2)-pivot_xnp(n-1)=np(n-1)-pivot_ynp(n-2)=np(n-2)*ppnp(n-1)=np(n-1)*ppnp(n-2)=np(n-2)+pivot_xnp(n-1)=np(n-1)+pivot_yEndifIf 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_yEndifNext nsx=(pp)*sx#endmacroDim pivot_vector(1 To 3) As DoubleDim line_vector(1 To 3) As Doublemagnifier=dilator*magnifierIf shape="circle" ThenangleX=angleX Mod 360:angleY=angleY Mod 360:angleZ=angleZ Mod 360End IfangleX_degrees=(2*p/360)*angleX      angleY_degrees=(2*p/360)*angleYangleZ_degrees=(2*p/360)*angleZpivot_vector(1)=first_x-pivot_xpivot_vector(2)=first_y-pivot_ypivot_vector(3)=first_z-pivot_zpivot_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 DoubleDim Ry(1 To 3,1 To 3) As DoubleDim Rz(1 To 3,1 To 3) As Double'rotat1on matrices about the three axixIf mode="3d" ThenRx(1,1)=1:Rx(1,2)=0:Rx(1,3)=0Rx(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)=0Ry(3,1)=-Sin(angleY_degrees):Ry(3,2)=0:Ry(3,3)=Cos(angleY_degrees)EndifRz(1,1)=Cos(angleZ_degrees):Rz(1,2)=-Sin(angleZ_degrees):Rz(1,3)=0Rz(2,1)=Sin(angleZ_degrees):Rz(2,2)=Cos(angleZ_degrees):Rz(2,3)=0Rz(3,1)=0:Rz(3,2)=0:Rz(3,3)=1line_vector(1)=magnifier*(second_x-first_x)'*pp                   'get the vectorline_vector(2)=magnifier*(second_y-first_y)'*pp                   'get the vectorline_vector(3)=magnifier*(second_z-first_z)'*ppDim new_pos(1 To 3) As DoubleDim temp1(1 To 3) As DoubleDim temp2(1 To 3) As DoubleIf mode="3d" Thenmv Rx(),pivot_vector(),temp1()           mv Ry(),temp1(),temp2()mv Rz(),temp2(),new_pos()EndifIf mode="2d" Then    mv Rz(),pivot_vector(),new_pos()    Endifnew_pos(1)=new_pos(1)+pivot_xnew_pos(2)=new_pos(2)+pivot_ynew_pos(3)=new_pos(3)+pivot_zDim new_one(1 To 3) As Double            'To hold the turned valueIf mode="3d" Thenmv Rx(),line_vector(),temp1()              'rotatemv Ry(),temp1(),temp2()mv Rz(),temp2(),new_one()EndifIf mode="2d" Then    mv Rz(),line_vector(),new_one()    Endifnew_one(1)=new_one(1)+first_x              'translatenew_one(2)=new_one(2)+first_ynew_one(3)=new_one(3)+first_zDim xx As Double   Dim yy As DoubleDim zz As Doublexx=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-zzIf perspective <> 0 Then get_perspective(np(3),np(6))End IfSelect Case shapeCase "line"    If th<2 Then Line image,(np(4),np(5))-(np(1),np(2)),colour Else thickline(th)    End IfCase "circle"    Dim arc1 As Double=second_z*p/180Dim 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_yElse thickcircle(th)End IfEndifIf arc1<>arc2 Then If th<=2 Then    Circle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_yElse    thickcircle(th)End IfEnd IfCase "circlefill"    Dim As Double xp1,xp2,yp1,yp2Dim As Uinteger prime=rgb(255,255,255)Dim arc1 As Double=second_z*p/180Dim arc2 As Double=second_arc*p/180If arc1=arc2 Then Circle image,(np(4),np(5)),magnifier*sx,colour,,,second_y,FIf arc1<>arc2 Then xp1=np(4)+magnifier*sx*Cos(.5*(arc2+arc1))*3/4yp1=np(5)-magnifier*sx*Sin(.5*(arc2+arc1))*3/4   Circle image,(np(4),np(5)),magnifier*sx,prime,arc1,arc2,second_yLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),primeLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),primePaint image,(xp1,yp1),prime,primeCircle image,(np(4),np(5)),magnifier*sx,colour,arc1,arc2,second_yLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc2),np(5)-magnifier*sx*Sin(arc2)),colourLine image,(np(4),np(5))-(np(4)+magnifier*sx*Cos(arc1),np(5)-magnifier*sx*Sin(arc1)),colourPaint image,(xp1,yp1),colour,colourEnd If Case"box"  Line image,(np(4),np(5))-(np(1),np(2)),colour,bCase "boxfill"  Line image,(np(4),np(5))-(np(1),np(2)),colour,bf        Case "linepoint","circlepoint"  'nothing drawnCase "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 ROTATORSub _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,ch=Sqr((x2-x1)^2+(y2-y1)^2)  'hypotenuses=(y1-y2)/h                 'sinec=(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, pLine (x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),colourLine (x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colourLine (x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),colourLine (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, colourEnd IfEnd 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 Squiircletype point2d    as single x,yend typedim as point2d corners(3)corners(0).x = centerx - 100corners(0).y = centery - 100corners(1).x = centerx + 100corners(1).y = centery - 100corners(2).x = centerx + 100corners(2).y = centery + 100corners(3).x = centerx - 100corners(3).y = centery + 100sub 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    nextend subfunction 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 dend functionfunction 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 dend functionscreen 19,32dim as integer j,k, thetadim as single someradius = 0.0dim as point2d centerfor i as integer = 0 to ubound(corners)    center.x += corners(i).x    center.y += corners(i).ynextcenter.x/=4center.y/=4dim as point2d p1, p2dim as integer selectiondim 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)    nextnextsleepDo    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 )  beepend 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.