' A small 3D globe rotation program ' Converted to SB(fltk) 23,may 2006, from an old basic code ' by Keijo koskinen ' You can download sphere.gif from: ' http://users.csolve.net/~keiko/smallbasic/sphere.gif ' When sphere.gif appears to screen, ..right clic it and shoose save as ..to your bas_home directory img= env("Bas_Home")+"sphere.gif" if (!exist(img)) then ? "Sphere.gif does not exist " ? "then we are rolling this text" ? "with SmallBasic program" else open img for input as #1 w = imagew(#1,0) h = imageh(#1,0) x = 1 y = 1 image #1,0, x,y,0,0,w,h close #1 fi ' Sphere numbers r=80 ' radius 180 n=100 ' number of lattitudes NumPoints=(n/1)*n*4+2 ' number of dots on sphere NumVerts=(n/1)*(n*4-2)+2 ' number of triangles DIM Points(NumPoints, 3) DIM Vertices(NumVerts,4) DIM Rotation(NumPoints,3) DIM Sinus(628) DIM CoSin(628) ' Precalc Sine and CoSinus tables FOR j = 1 TO 360 trig=j*(2*pi)/360 Sinus(j) = sin(trig) 'shl 8 'sin x 256 CoSin(j) = cos(trig) 'shl 8 'cos x 256 NEXT j '*** Create a Sphere **** ' pixel colors from bitmap image for maptexture jjj=0 for yy=1 to n/2 apu0=n*2 for xx=1 to apu0 m_col = point(xx,yy) 'get pixelcolor at x, y jjj=jjj+1 Vertices(jjj,4)=m_col next next 'Clear the screen cls xx=0 yy=0 IF r < 0 THEN r = -r IF n < 3 THEN n = 3 iii=0 jjj=0 apu0=(n/2)-1 FOR thh= 0 TO apu0 '// lluulisi navalta navalle pituus theta1 = thh * pi/(n/2)-pi/2 '2*pi / n - pi/2; theta2 = (thh + 1) * pi/(n/2)-pi/2 '2*pi / n - pi/2; jij=iii+1 ' seuraavan vertices eka piste FOR thn= 0 TO n iii=iii+1 theta3 = thn * 2*pi / n Points(iii,1)= r*COS(theta2) * COS(theta3) Points(iii,2)= r*SIN(theta2) Points(iii,3)=r*COS(theta2) * SIN(theta3) iii=iii+1 Points(iii,1)=r*COS(theta1) * COS(theta3) Points(iii,2)= r*SIN(theta1) Points(iii,3)=r*COS(theta1) * SIN(theta3) NEXT 'jij=iii-(2*n+2) apu1=jij apu2=iii-2 for jep = apu1 to apu2 step 2 jjj=jjj+1 Vertices(jjj,1)=jep Vertices(jjj,2)=jep+1 Vertices(jjj,3)=jep+2 jjj=jjj+1 Vertices(jjj,1)=jep+3 Vertices(jjj,2)=jep+2 Vertices(jjj,3)=jep+1 next NEXt NumPoints=iii NumVerts=jjj ' END of Sphere goto vector END 'end of prog label vector: ' main loop for rotation \ '-- Rotate angles AngleX=1 'AngleX+0.2 IF AngleX > 360 THEN AngleX = 1 AngleY=AngleY+1 IF AngleY > 360 THEN AngleY = 1 AngleZ=1' AngleZ+0'.2 IF AngleZ > 360 THEN AngleZ = 1 ' rotate the points according to angles FOR i = 1 TO NumPoints X = Points(i, 1): Y = Points(i, 2): Z = Points(i, 3) Ty = Y * CoSin(AngleX) - Z * Sinus(AngleX) ' Tz = Y * Sinus(AngleX) + Z * CoSin(AngleX) Tx = X * CoSin(AngleY) - Tz * Sinus(AngleY) Tz = X * Sinus(AngleY) + Tz * CoSin(AngleY) Ox = Tx Tx = Tx * CoSin(AngleZ) - Ty * Sinus(AngleZ) Ty = Ox * Sinus(AngleZ) + Ty * CoSin(AngleZ) Nx=Tx Ny=Ty Rotation(i, 1) = Nx: Rotation(i, 2) = Ny: Rotation(i, 3) = Tz NEXT i ' check if face N is visible. FOR j = 1 TO NumVerts k = Vertices(j, 1): l = Vertices(j, 2): m = Vertices(j, 3):m_col=Vertices(j,4) X1 = Rotation(k, 1): X2 = Rotation(l, 1): X3 = Rotation(m, 1) Y1 = Rotation(k, 2): Y2 = Rotation(l, 2): Y3 = Rotation(m, 2) Z1 = Rotation(k, 3): Z2 = Rotation(l, 3): Z3 = Rotation(m, 3) VIS= (X3 - X1) * (Y2 - Y1) - ((X2 - X1) * (Y3 - Y1)) 'VIS = value of visibility ' Render the Sphere IF VIS <-3 then ' only clearly visible will be drawn 'triangle vertices color XX1=X1+200 XX2=X2+200 XX3=X3+200 YY1=Y1+200 YY2=Y2+200 YY3=Y3+200 '** triangles, globe is so small, so filling not actually needed = faster Line XX1, YY1, XX2, YY2, m_col Line XX2, YY2, XX3, YY3, m_col Line XX3, YY3, XX1, YY1, m_col ' triangle centers = filling or drawing points l = (XX1 + XX2 + XX3) / 3 m = (YY1 + YY2 + YY3) / 3 '** if trianles used then they can be filled **** ' Paint l, m,m_col,m_col ' can't use ..this overflows '** if triangles not used ...use one of following *** ' circle l,m,2,1,m_col filled ' rect l-2,m-2,l+2,m+2,m_col filled ' PSET l,m,m_col END IF NEXT j goto vector