PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

3D Ball

https://www.purebasic.fr/english/viewtopic.php?t=12536

Page 1 of 1

3D Ball

Posted: Tue Sep 21, 2004 6:21 am
by FvEldijk
Does anyone have some code to create a 3D ball out of triangles?

If possible: Complete with normals and UV coords to map one image on it...

Thanks

Posted: Tue Sep 21, 2004 8:22 am
by benny
@FvEldijk:

There was a discussion going on in the german forum about this topic.
Danilo posted some nice step-by-step examples.

To see the original thread (in german) - have a look at this url.

http://robsite.de/php/pureboard-archiv/ ... c&start=20

His final version is the following :

Code: Select all

Procedure.f GSin(winkel.f) 
   ProcedureReturn Sin(winkel*(2*3.14159265/360)) 
EndProcedure 

Procedure.f GCos(winkel.f) 
   ProcedureReturn Cos(winkel*(2*3.14159265/360)) 
EndProcedure 

;----- 

#sw = 1024 
#sh = 768 
#sn = "Sinus" 

#hsw = #sw/2 
#hsh = #sh/2 

If InitSprite()=0 Or InitKeyboard()=0 
  MessageRequester("ERROR","Cant init game engine !"):End 
EndIf 

If OpenScreen(#sw,#sh,32,#sn)=0 
  If OpenScreen(#sw,#sh,24,#sn)=0 
    If OpenScreen(#sw,#sh,16,#sn)=0 
      If OpenScreen(#sw,#sh,08,#sn)=0 
        MessageRequester("ERROR","Cant open screen !"):End 
EndIf:EndIf:EndIf:EndIf 


Procedure Point3Dto2D(x.f,y.f,z.f,*pt.POINT) 
  #proj = 400 ; gew?nlich 100 
  z + 1 
  *pt\x = Round((x/z)* #proj+#hsw,1) 
  *pt\y = Round((y/z)*-#proj+#hsh,1) 
EndProcedure 


Procedure Line3D(x1.f,y1.f,z1.f,x2.f,y2.f,z2.f,color) 
  ; draw a line in 3D space 
  Point3Dto2D(x1,y1,z1,p1.POINT) 
  Point3Dto2D(x2,y2,z2,p2.POINT) 
  If color = -1 
    LineXY(p1\x,p1\y,p2\x,p2\y) 
  Else 
    LineXY(p1\x,p1\y,p2\x,p2\y,color) 
  EndIf 
EndProcedure 

Procedure DrawObject(Radius.f,schrittweite1,schrittweite2,obj_x.f,obj_y.f,obj_z.f) 
  If Schrittweite1 < 3 : Schrittweite1 = 3 : EndIf 
  If Schrittweite2 < 1 : Schrittweite2 = 1 : EndIf 
  gradschritte.f = 90.0 / Schrittweite2 
  sincos.f    = 90.0 
  For i = 1 To schrittweite2 
    grad.f = 90.0 
    Point3Dto2D(obj_x+gSin(grad)*(Radius*GSin(sincos)),obj_y-Radius*GCos(sincos),(obj_z+0-(Radius*GSin(sincos))*GCos(grad)*0.1),pt1.POINT) 
    Point3Dto2D(obj_x+gSin(grad)*(Radius*GSin(sincos)),obj_y+Radius*GCos(sincos),(obj_z+0-(Radius*GSin(sincos))*GCos(grad)*0.1),pt2.POINT) 
    old_x1 = pt1\x : old_y1 = pt1\y 
    old_x2 = pt2\x : old_y2 = pt2\y 
    While grad =< 360+90+360/schrittweite1 
      Point3Dto2D(obj_x+gSin(grad)*(Radius*GSin(sincos)),obj_y-Radius*GCos(sincos),(obj_z+0-(Radius*GSin(sincos))*GCos(grad)*0.1),pt1.POINT ) 
      Point3Dto2D(obj_x+gSin(grad)*(Radius*GSin(sincos)),obj_y+Radius*GCos(sincos),(obj_z+0-(Radius*GSin(sincos))*GCos(grad)*0.1),pt2.POINT ) 
      If i = schrittweite2 
        Point3Dto2D(obj_x,obj_y+Radius,obj_z,m1.POINT) 
        Point3Dto2D(obj_x,obj_y-Radius,obj_z,m2.POINT) 
        LineXY(pt1\x  ,pt1\y  ,m1\x  ,m1\y ) 
        LineXY(pt2\x  ,pt2\y  ,m2\x  ,m2\y ) 
      EndIf 
      LineXY(pt1\x ,pt1\y ,old_x1,old_y1) 
      If i>1 
        LineXY(pt2\x ,pt2\y ,old_x2,old_y2) 

        Point3Dto2D(obj_x+gSin(grad)*(Radius*GSin(sincos-gradschritte)),obj_y-Radius*GCos(sincos-gradschritte),(obj_z+0-(Radius*GSin(sincos-gradschritte))*GCos(grad)*0.1),pt3.POINT ) 
        LineXY(pt1\x,pt1\y,pt3\x,pt3\y) 
        Point3Dto2D(obj_x+gSin(grad)*(Radius*GSin(sincos-gradschritte)),obj_y+Radius*GCos(sincos-gradschritte),(obj_z+0-(Radius*GSin(sincos-gradschritte))*GCos(grad)*0.1),pt4.POINT ) 
        LineXY(pt2\x,pt2\y,pt4\x,pt4\y) 
      EndIf 
      old_x1 = pt1\x  : old_y1 = pt1\y 
      old_x2 = pt2\x  : old_y2 = pt2\y 
      grad + 360/schrittweite1 
    Wend 
    sincos + gradschritte 
    doit = 1 
  Next i 
EndProcedure 

schrittweite1 = 25 
schrittweite2 = 8 
z.f     = 0 
obj_y.f = 0 
obj_x.f = 0 
obj_z.f = -0.1 

Repeat 
    ExamineKeyboard() 
    FlipBuffers() 
    If IsScreenActive() 
      ClearScreen (0,0,0) 

      If StartDrawing(ScreenOutput()) 
        FrontColor($FF,$FF,$00) 
        DrawObject(0.7,Schrittweite1,Schrittweite2,obj_x,obj_y,obj_z) 
        
        FrontColor(255, 255, 255) 
        DrawingMode(1) 
        Locate(50,30) 
        DrawText("Schrittweite 1 (F1/F2): " + Str(Schrittweite1)) 
        Locate(50,50) 
        DrawText("Schrittweite 2 (F3/F4): " + Str(Schrittweite2)) 
        Locate(50,80) 
        DrawText("Cursor Keys left/right & up/down to move object") 
        Locate(50,100) 
        DrawText("Keypad +/- to z00m object") 
        StopDrawing() 
      EndIf 

      If KeyboardPushed(#PB_KEY_F1) And keypressed = 0 
        Schrittweite1 + 1 
        keypressed = 5 
      ElseIf KeyboardPushed(#PB_KEY_F2) And keypressed = 0 
        Schrittweite1 - 1 
        If Schrittweite1 < 3 : Schrittweite1 = 3 : EndIf 
        keypressed = 5 
      ElseIf KeyboardPushed(#PB_KEY_F3) And keypressed = 0 
        Schrittweite2 + 1 
        keypressed = 5 
      ElseIf KeyboardPushed(#PB_KEY_F4) And keypressed = 0 
        Schrittweite2 - 1 
        If Schrittweite2 < 1 : Schrittweite2 = 1 : EndIf 
        keypressed = 5 
      ElseIf KeyboardPushed(#PB_KEY_UP) 
        obj_y + 0.01 
      ElseIf KeyboardPushed(#PB_KEY_DOWN) 
        obj_y - 0.01 
      ElseIf KeyboardPushed(#PB_KEY_LEFT) 
        obj_x - 0.01 
      ElseIf KeyboardPushed(#PB_KEY_RIGHT) 
        obj_x + 0.01 
      ElseIf KeyboardPushed(#PB_KEY_ADD)      ; keypad + 
        obj_z - 0.01 
      ElseIf KeyboardPushed(#PB_KEY_SUBTRACT) ; keypad - 
        obj_z + 0.01 
      EndIf 
      If keypressed : keypressed - 1 : EndIf      

      Delay(10) 

    EndIf 
Until KeyboardPushed(#PB_Key_Escape)

Posted: Thu Sep 23, 2004 6:09 am
by FvEldijk
Thanks, but I realy wanted to create a ball-mesh - and especially the texture mapping won't work...

Code: Select all

InitKeyboard() 
InitEngine3D()
InitSprite() 

#HEAD_L = 12   ; 
#HEAD_B = 12   ; schijven in de bol
#HEAD_VERT=#HEAD_L*#HEAD_B
#HEAD_FACES=#HEAD_L*(#HEAD_B-1)*2


Procedure create_head()
  
  Dim HeadVertices.f(#HEAD_VERT*3)
  Dim HeadNormals.f(#HEAD_VERT*3)
  HeadVerticesCount=0
  
  lfactor.f=(3.141593*2)/#HEAD_L
  bfactor.f=3.141593/(#HEAD_B-1)
  texLfactor.f=1/#HEAD_L
  texBfactor.f=1/#HEAD_B
  
  For b=0 To #HEAD_B-1
    y=(0.5-Cos(bfactor*b))*100
    For l=0 To #HEAD_L-1
      x=Cos(l*lfactor)*100*Sin(b*bfactor)
      z=Sin(l*lfactor)*100*Sin(b*bfactor)
      
      HeadVertices(HeadVerticesCount*3+0)=x
      HeadVertices(HeadVerticesCount*3+1)=y
      HeadVertices(HeadVerticesCount*3+2)=z
      
      
      ;HeadTexCoords(HeadVerticesCount*2+0)=texLfactor*l
      ;HeadTexCoords(HeadVerticesCount*2+1)=texBfactor*b
      
      HeadVerticesCount=HeadVerticesCount+1
    Next l
  Next b
  
  Dim HeadFaces.w(#HEAD_FACES*3)
  Dim HeadTexCoords.f(#HEAD_FACES*8)
  HeadFacesCount=0 
  
  For b=0 To #HEAD_B-2
    For l=0 To #HEAD_L-1
      If l=#HEAD_L-1
        lnext=0
      Else
        lnext=l+1
      EndIf
      h0=b*#HEAD_L+l
      h1=b*#HEAD_L+lnext
      h2=(b+1)*#HEAD_L+l
      h3=(b+1)*#HEAD_L+lnext
      
      HeadFaces(HeadFacesCount*6+0)=h2
      HeadFaces(HeadFacesCount*6+1)=h1
      HeadFaces(HeadFacesCount*6+2)=h0
      HeadFaces(HeadFacesCount*6+3)=h2
      HeadFaces(HeadFacesCount*6+4)=h3
      HeadFaces(HeadFacesCount*6+5)=h1
      
      HeadTexCoords(HeadFacesCount*16+ 0)=l*texLfactor
      HeadTexCoords(HeadFacesCount*16+ 1)=b*texBfactor+texBfactor
      HeadTexCoords(HeadFacesCount*16+ 2)=(l+1)*texLfactor
      HeadTexCoords(HeadFacesCount*16+ 3)=b*texBfactor
      HeadTexCoords(HeadFacesCount*16+ 4)=l*texLfactor
      HeadTexCoords(HeadFacesCount*16+ 5)=b*texBfactor
      HeadTexCoords(HeadFacesCount*16+ 6)=(l+1)*texLfactor
      HeadTexCoords(HeadFacesCount*16+ 7)=b*texBfactor+texBfactor
   
      HeadTexCoords(HeadFacesCount*16+ 8)=l*texLfactor
      HeadTexCoords(HeadFacesCount*16+ 9)=b*texBfactor+texBfactor
      HeadTexCoords(HeadFacesCount*16+10)=(l+1)*texLfactor
      HeadTexCoords(HeadFacesCount*16+11)=b*texBfactor
      HeadTexCoords(HeadFacesCount*16+12)=l*texLfactor
      HeadTexCoords(HeadFacesCount*16+13)=b*texBfactor
      HeadTexCoords(HeadFacesCount*16+14)=(l+1)*texLfactor
      HeadTexCoords(HeadFacesCount*16+15)=b*texBfactor+texBfactor
      
      
      
      HeadFacesCount=HeadFacesCount+1
      

    Next l
  Next b
  CreateMesh(0)
  SetMeshData(0, #PB_Mesh_Vertices ,  HeadVertices(), #HEAD_VERT) 
  SetMeshData(0, #PB_Mesh_Triangles , HeadFaces(), #HEAD_FACES)
  SetMeshData(0, #PB_Mesh_UVCoordinates, HeadTexCoords(), #HEAD_FACES)
  
  LoadTexture(0,"test2.png")
  CreateEntity(0, MeshID(0), CreateMaterial(0, TextureID(0)))
  EntityLocate(0,0,0,1000)
  ProcedureReturn 0
EndProcedure




OpenScreen(640,480,32,"") 

CreateCamera(1, 0, 0, 100, 100) 
CameraProjection(1,0)
CameraLocate(1, 0, 0, 0) 
CameraBackColor(1,$FFAA88)
CameraFOV(1, 45) 
;CameraRange(1, 0, 1000) 

AmbientColor($FFAAAA)

tbob=create_head()

CameraLookAt(1,0,0,100)
CreateLight(0, $AAAAFF , 20, 20, 300) 
Dist=500

Repeat 
  ExamineKeyboard() 
  
  RotateEntity(0, 1, 0, 0)  

  lstKey$=KeyboardInkey()
  If lstKey$="="
    Dist=Dist+10
  EndIf 
  If lstKey$="-" 
    Dist=Dist-10  
  EndIf 
  EntityLocate(0,0,0,Dist)
  RenderWorld()
  StartDrawing(ScreenOutput()) 
  
  DrawingMode(1) 
  Locate(50,50) 
  DrawText("This was a test: "+Str(Dist)) 
  StopDrawing() 
  
  FlipBuffers() 
  
  
Until KeyboardReleased(#PB_Key_Escape)
I find this 3d stuff very hard to get into...
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited