'rotating cube with texture 'by BasicCoder2 ≫ Nov 20, 2014 0:02 'https://www.freebasic.net/forum/viewtopic.php?f=7&t=23053 ' Sets the graphics method GDI ' 描画方法を GDI に設定 SetEnviron("fbgfx=GDI") 'some useful defines Const Pi = 4 * Atn(1) Dim Shared As Double TwoPi = 8 * Atn(1) Dim Shared As Double RtoD = 180 / Pi ' radians * RtoD = degrees Dim Shared As Double DtoR = Pi / 180 ' degrees * DtoR = radians const ScrW = 1000 const ScrH = 600 screenres ScrW,ScrH,32 dim as integer wImg,hImg 'width and height of image wImg = 256 hImg = 256 '===== DODICAT IMAGE =========== dim as any ptr image image = imagecreate(wImg,hImg) 'draw something on image For y As Integer=0 To hImg-1 For x As Integer=0 To wImg-1 Pset image,(x,y),Rgb(x,x Xor y,y) Next x Next y '=============================== Cls type Point3D x as double y as double z as double c as uinteger end type type Point2D x as double y as double c as uinteger end type dim as Point3D e e.x = 0 e.y = 300 e.z = 1000 dim as Point3D pt3D(24) dim as double angle,x,y,z,rx,ry,rz,px,py dim as double cosAngle,sinAngle dim as uinteger c for aRot as double = 0 to 360 step 5 angle = aRot*DtoR cosAngle = cos(angle) sinAngle = sin(angle) screenlock() cls 'draw bottom for j as integer = 0 to 255 for i as integer = 0 to 255 x = i-127 y = 127 z = j-127 c = point(i,j,image) 'rotate rx = (cosAngle *x) - (sinAngle * z) ry = y rz = (sinAngle * x) + (cosAngle * z) rx = rx - e.x ry = ry - e.y rz = rz - e.z 'convert 3d to 2d coordinates px = (rx/rz) * ScrW + ScrW / 2 py = (ry/rz) * ScrH + ScrH / 2 pset (px,py),c next i next j 'draw front side for j as integer = 0 to 255 for i as integer = 0 to 255 x = i-127 y = j+127 z = 127 c = point(i,j,image) 'rotate rx = (cos(Angle) *x) - (sin(Angle) * z) ry = y rz = (sin(Angle) * x) + (cos(Angle) * z) rx = rx - e.x ry = ry - e.y rz = rz - e.z 'convert 3d to 2d coordinates px = (rx/rz) * ScrW + ScrW / 2 py = (ry/rz) * ScrH + ScrH / 2 line (px,py)-(px+1,py+1),c,bf next i next j locate 2,2 print "angle of rotation =";aRot screenunlock() sleep 10 next aRot sleep
'rotating cube with texture 'by dodicat ≫ Nov 21, 2014 0:13 'https://www.freebasic.net/forum/viewtopic.php?f=7&t=23053 ' Sets the graphics method GDI ' 描画方法を GDI に設定 SetEnviron("fbgfx=GDI") Type v3 As integer x,y,z End Type type float as single x,y,z end type Dim Shared As v3 eyepoint Sub rotateImage(im As Any Ptr,angle As float,shift As V3,Byref centroid As V3,da as float) Dim As Single dx,dy,dz=shift.z,w Dim As Single SinAX=Sin(angle.x+da.x) Dim As Single SinAY=Sin(angle.y+da.y) Dim As Single SinAZ=Sin(angle.z+da.z) Dim As Single CosAX=Cos(angle.x+da.x) Dim As Single CosAY=Cos(angle.y+da.y) Dim As Single CosAZ=Cos(angle.z+da.z) '==============these are for direct pixel Dim As Uinteger c Dim As Integer pitch Dim As Any Ptr row Dim As Uinteger Ptr pixel '======================================== Dim As Integer ddx,ddy Imageinfo im,ddx,ddy,,pitch,row Dim As V3 centre 'the centre of rotation (fulcrum) centre.x = ddx/2 centre.y = ddy/2 centre.z = shift.z Dim As V3 result Dim As Integer dp=1 'size of pixel to fill gaps For y As Integer=0 To ddy-1 For x As Integer=0 To ddx-1 '========this bit replaces c=point(x,y,im)=============(point is VERY slow) pixel=row+pitch*(y)+(x) Shl 2 (c)=*pixel '================================================== 'dx and dy make x and y relative to the image centre dx=x-centre.x:dy=y-centre.y Result.x=((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz)+centre.x result.y=((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz)+centre.y result.z=((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz)+centre.z if x=ddx\2 andalso y=ddy\2 then centroid=result 'Bang in the middle 'this bit is purely to add perspective ================ w = 1 + (result.z/eyepoint.z) result.x = (result.x-eyepoint.x)/w+eyepoint.x result.y = (result.y-eyepoint.y)/w+eyepoint.y result.z = (result.z-eyepoint.z)/w+eyepoint.z Line(result.x+shift.x-dp,result.y+shift.y-dp)-(result.x+shift.x+dp,result.y+shift.y+dp),c,bf Next x Next y End Sub 'sort by .z distance Sub sort(array() As V3,painter() As Integer) For p1 As Integer = 1 To Ubound(array,1) - 1 For p2 As Integer = p1 + 1 To Ubound(array,1) If array(p1).z<array(p2).z Then Swap painter(p1),painter(p2):Swap array(p1),array(p2) Next p2 Next p1 End Sub Function Regulate(Byval MyFps As Integer,Byref fps As Integer) As Integer Static As Double timervalue,lastsleeptime,t3,frames var t=Timer frames+=1 If (t-t3)>=1 Then t3=t:fps=frames:frames=0 Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000 If sleeptime<1 Then sleeptime=1 lastsleeptime=sleeptime timervalue=T Return sleeptime End Function '========================================================================== Screen 19,32,2 dim as any ptr image(1 to 4) image(1)=imagecreate(300,300) image(2)=imagecreate(300,300,Rgb(255,255,255)) image(3)=imagecreate(300,300,Rgb(255,255,255)) image(4)=imagecreate(300,300,rgb(100,100,100)) eyepoint=Type(150,150,600) 'behind image centres 'draw something on each image For y As Integer=0 To 300 For x As Integer=0 To 300 Pset image(1),(x,y),Rgb(x,x Xor y,y) If y Mod 100=0 And x Mod 100=0 Then Circle image(2),(x,y),50,Rgb(Rnd*255,Rnd*255,Rnd*255),,,,f If y Mod 50=0 And x Mod 50=0 Then Circle image(3),(x,y),10,Rgb(Rnd*255,Rnd*255,Rnd*255),,,,f If y Mod 75=0 And x Mod 75=0 Then line image(4),(x-20,y-20)-(x+20,y+20),Rgb(Rnd*255,Rnd*255,Rnd*255),bf Next x Next y dim as single pi=4*atn(1) Dim As v3 translate=type(250,150,150) dim as V3 centroid(1 to 4) Dim As float angle Dim As Integer fps Dim As Integer painter(1 To 4) For n As Integer=1 To 4:painter(n)=n:Next n Screenset 1,0 color ,rgb(0,100,200) Do angle.x+=.05 :if angle.x>=2*pi then angle.x=0 angle.y+=.025 :if angle.y>=2*pi then angle.y=0 angle.z+=.015 :if angle.z>=2*pi then angle.z=0 'sort by .z to reset painter and centroids sort(centroid(),painter()) Cls Draw String(20,20),"Framerate " &fps for n as integer=1 to 4 select case as const painter(n) case 1:rotateImage(image(1),angle,Translate,centroid(1),type<float>(0,0,0)) case 2:rotateImage(image(2),angle,Translate,centroid(2),type<float>(pi/2,0,0)) case 3:rotateImage(image(3),angle,Translate,centroid(3),type<float>(pi,0,0)) case 4:rotateImage(image(4),angle,Translate,centroid(4),type<float>(3*pi/2,0,0)) end select next n Flip For n As Integer=1 To 4:painter(n)=n:Next n 'reset the painter Sleep regulate(20,fps),1 Loop Until Len(Inkey) Sleep imagedestroy image(1) imagedestroy image(2) imagedestroy image(3) imagedestroy image(4)