dot sphere

[ATLUS]

so looked but very slow fps if dot > 750

PlayBASIC Code: [Select]

; PROJECT : Project1
; AUTHOR  : ATLUS
; CREATED : 11.11.2008
; EDITED  : 11.11.2008
; ---------------------------------------------------------------------
openscreen 640,480,32,1
dots_in_ball = 450; How many dots are in the ball?

; Globals for the 3d.
Global numpoints = dots_in_ball; Number of points in the point table.
Global distance  = 700; Needed for perspective.
Global vx#; X location.
Global vy#; Y location.
Global vz#; Z location.

; Arrays used by 3d code.
Dim points(numpoints, 3); Holds the point locations of the game over 3d.


; make points on the surface of a sphere
; calculation to make a sphere:
; x = cos(theta) * cos(phi)
; y = cos(theta) * sin(phi)
; z = sin(theta)
; where theta = -90 to 90
; and phi = 0 to 360
For t= 1 To dots_in_ball
   xd = Rndrange(-90,90)
   x0 = (Cos(xd) * 10) * (Cos(t) * 10)
   y0 = (Cos(xd) * 10) * (Sin(t) * 10)
   z0 = Sin(xd) * 100
   points(t,1) = x0
   points(t,2) = y0
   points(t,3) = z0
Next

; Loop till esc is pressed.
do
   cls rgb(0,0,0)   
   threed(); Call the threed thing.
   print "Depth Colored Real 3D Dot Ball"
   sync; Flip the screen.
loop

Function threed()
   vx# = vx# + 0.5; X rotation speed of ball.
   vy# = vy# + 0.5; Y rotation speed of ball.
   vz# = vz# + 0.5; Z rotation speed of ball.

   For n = 1 To numpoints
      x3d = points(n, 1)
      y3d = points(n, 2)
      z3d = points(n, 3)
       
      ty# = ((y3d * Cos(vx#)) - (z3d * Sin(vx#)))
      tz# = ((y3d * Sin(vx#)) + (z3d * Cos(vx#)))
      tx# = ((x3d * Cos(vy#)) - (tz# * Sin(vy#)))
      tz# = ((x3d * Sin(vy#)) + (tz# * Cos(vy#)))
      ox# = tx#
      tx# = ((tx# * Cos(vz#)) - (ty# * Sin(vz#)))
      ty# = ((ox# * Sin(vz#)) + (ty# * Cos(vz#)))
      nx  = Int(512 * (tx#) / (distance - (tz#))) + 320
      ny  = Int(240 - (512 * ty#) / (distance - (tz#)))
      
      setcolor(tz#)
      ;box nx,ny,1,1,0
      dot nx,ny
   Next
EndFunction

; This function looks at the z-value of the pixel
; and sets the color accoordingly.
Function setcolor(t#)
   If t# <= 100 And t# >= 75
      ink rgb(250,250,250)
   EndIf
   If t# <= 75 And t# >= 50
      ink rgb(225,225,225)
   EndIf
   If t# <= 50 And t# >= 25
      ink rgb(200,200,200)
   EndIf
   If t# <= 25 And t# >= 0
      ink rgb(175,175,175)
   EndIf
   If t# <= 0 And t# >= -25
      ink rgb(150,150,150)
   EndIf
   If t# <= -25 And t# >= -50
      ink rgb(125,125,125)
   EndIf
   If t# <= -50 And t# >= -75
      ink rgb(100,100,100)
   EndIf
   If t# <= -75 And t# >= -100
      ink rgb(50,50,50)
   EndIf
EndFunction

[kevin]

PlayBASIC Code: [Select]

   MakeBitmapFont 1,$ffffff

   ProjectionX#=300
   ProjectionY#=300

   SizeX=1000
   SizeY=1000
   SizeZ=1000

   NumberOfVertex=5000

   SrcVertSize            =12
   DestVertSize         =20      

   ; Create Vertex Buffers      
   SrcVertexBank      =NewBank((NumberOfVertex+1)*SrcVertSize)
   DestVertexBank      =NewBank((NumberOfVertex+1)*DestVertSize)
   SrcAddress         =GetBankPtr(SrcVertexBank)

   For t=0 To NumberOfVertex
      xd = Rndrange(-90,90)
      x# = (Cos(xd) * 10) * (Cos(t) * 10)
      Y# = (Cos(xd) * 10) * (Sin(t) * 10)
      z# = Sin(xd) * 100

      PokeFloat SrcAddress      ,x#
      PokeFloat SrcAddress+4   ,y#
      PokeFloat SrcAddress+8   ,z#
      SrcAddress=SrcAddress+SrcVertSize
   Next   

   basex#=0
   basey#=0
   basez#=1500


   Dim ShadeBufferBuffer(20000)
   NumberOfVertexdepth#=400
   scaler#=100/NumberOfVertexdepth#   
   col=RGB(255,255,255)
   For lp=0 To NumberOfVertexdepth#
      ShadeBufferBuffer(lp)=RGBFade(col,(NumberOfVertexdepth#-lp)*scaler#)
   Next   

   CreateCamera 1

Do
   CaptureToScene
   ClsScene
      
   
      ; Rotate vertex list (with XYZ rotation order)
      SrcAddress   =GetBankPtr(SrcVertexBank)
      DestAddress   =GetBankPtr(DestVertexBank)
      RotateVertexListXYZ SrcAddress,SrcVertSize,DestAddress,DestVertSize,baseX#,basey#,baseZ#,ax#,ay#,az#,NumberOfVertex   

      t=Timer()
         Address   =GetBankPtr(DestVertexBank)
         counter=NumberOfVertex
         Do
               z#=PeekFloat(Address+8)
               If z#>10
                     CaptureDepth z#
                     DotC 400+((PeekFloat(Address)*projectionx#)/z#),300+((PeekFloat(Address+4)*projectiony#)/z#),ShadeBufferBuffer(z#)
               EndIf
               address=address+DestVertSize
         DecLoop counter
   
      t=Timer()-t      


   DrawCamera 1

   if Intro=false
      BaseZ#=BaseZ#-2
      if BaseZ#<150 then Intro=true
   
   endif

   SetCursor 0,0
   speed#=10
   If UpKey() Then basez#=basez#-speed#
   If DownKey() Then  basez#=basez#+speed#
   If basez#>500 Then Basez#=500
   If basez#<-500 Then Basez#=-500

   ax#=WrapAngle(ax#,0.31)
   ay#=WrapAngle(ay#,0.42)
   az#=WrapAngle(az#,0.49)

   Print "Sphere Vertex List"
   Print Str$(NumberOfVertex)+" Shaded Z buffered Vertex"
   Print FPS()
   Sync
Loop

[ATLUS]

Wow very nice!!!!!!!!!!!!!its impossible!!!!Great!!! Thanks Kevin!!!!!!!

[kevin]

 Dot Sphere

 Source Code:

PlayBASIC Code: [Select]

openscreen 640,480,32,1
titlescreen PlayBasic$
dots_in_ball = 2000; How many dots are in the ball?

; Globals for the 3d.
Global numpoints = dots_in_ball; Number of points in the point table.
Global distance  = 700; Needed for perspective.
Global vx#; X location.
Global vy#; Y location.
Global vz#; Z location.

; Arrays used by 3d code.
Dim points(numpoints, 3); Holds the point locations of the game over 3d.


; make points on the surface of a sphere
; calculation to make a sphere:
; x = cos(theta) * cos(phi)
; y = cos(theta) * sin(phi)
; z = sin(theta)
; where theta = -90 to 90
; and phi = 0 to 360
For t= 1 To dots_in_ball
   xd = Rndrange(-90,90)
   x0 = (Cos(xd) * 10) * (Cos(t) * 10)
   y0 = (Cos(xd) * 10) * (Sin(t) * 10)
   z0 = Sin(xd) * 100
   points(t,1) = x0
   points(t,2) = y0
   points(t,3) = z0
Next

; Precalc the shading
Dim DepthDueTable(500)
For lp=-200 to 200
   DepthDueTable(lp+200)=SetColor(lp)
next

; Loop till esc is pressed.
do
   cls rgb(0,0,0)   
   threed(); Call the threed thing.
   print "Depth Colored Real 3D Dot Ball"
   print fps()
   sync; Flip the screen.
loop

Function threed()
   vx# = vx# + 0.5; X rotation speed of ball.
   vy# = vy# + 0.5; Y rotation speed of ball.
   vz# = vz# + 0.5; Z rotation speed of ball.

   lockbuffer

   cvx#=Cos(vx#)
   svx#=Sin(vx#)

   cvy#=Cos(vy#)
   svy#=Sin(vy#)
   
   cvz#=Cos(vz#)
   svz#=Sin(vz#)

   For n = 1 To numpoints
      x3d = points(n, 1)
      y3d = points(n, 2)
      z3d = points(n, 3)
       
      ty# = ((y3d * cvx#) - (z3d * svx#))
      tz# = ((y3d * svx#) + (z3d * Cvx#))
      tx# = ((x3d * Cvy#) - (tz# * svy#))
      tz# = ((x3d * svy#) + (tz# * Cvy#))
      ox# = tx#
      tx# = ((tx# * cvz#) - (ty# * svz#))
      ty# = ((ox# * svz#) + (ty# * cvz#))

      nx  = Int(512 * (tx#) / (distance - (tz#))) + 320
      ny  = Int(240 - (512 * ty#) / (distance - (tz#)))

      dotc nx,ny,DepthDueTable(tz#+200)
   Next
unlockbuffer

EndFunction

; This function looks at the z-value of the pixel
; and sets the color accoordingly.
Function setcolor(t#)
   If t# <= 100 And t# >= 75
      c= rgb(250,250,250)
   EndIf
   If t# <= 75 And t# >= 50
      c= rgb(225,225,225)
   EndIf
   If t# <= 50 And t# >= 25
      c=rgb(200,200,200)
   EndIf
   If t# <= 25 And t# >= 0
      c= rgb(175,175,175)
   EndIf
   If t# <= 0 And t# >= -25
      c= rgb(150,150,150)
   EndIf
   If t# <= -25 And t# >= -50
      c= rgb(125,125,125)
   EndIf
   If t# <= -50 And t# >= -75
      c=rgb(100,100,100)
   EndIf
   If t# <= -75 And t# >= -100
      c=rgb(50,50,50)
   EndIf
EndFunction c

This PlayBASIC code creates a rotating sphere of vertices on the screen using 3D graphics. Here's a detailed explanation of the code:

   Setting up the Screen:

PlayBASIC Code: [Select]

openscreen 640,480,32,1
titlescreen PlayBasic$
dots_in_ball = 2000; How many dots are in the ball?

The openscreen command initializes a graphical window with a resolution of 640x480 pixels and a color depth of 32 bits. dots_in_ball is a variable representing the number of points in the sphere.

Global Variables and Arrays:

PlayBASIC Code: [Select]

Global numpoints = dots_in_ball; Number of points in the point table.
Global distance  = 700; Needed for perspective.
Global vx#; X location.
Global vy#; Y location.
Global vz#; Z location.
Dim points(numpoints, 3); Holds the point locations of the game over 3d.

Global variables are declared to store information about the 3D environment. An array points is created to hold the 3D coordinates of the points on the sphere.

Creating Points on the Sphere:

PlayBASIC Code: [Select]

For t = 1 To dots_in_ball
   ' Calculation to make a sphere:
   ' x = cos(theta) * cos(phi)
   ' y = cos(theta) * sin(phi)
   ' z = sin(theta)
   ' where theta = -90 to 90 and phi = 0 to 360
   xd = Rndrange(-90,90)
   x0 = (Cos(xd) * 10) * (Cos(t) * 10)
   y0 = (Cos(xd) * 10) * (Sin(t) * 10)
   z0 = Sin(xd) * 100
   points(t,1) = x0
   points(t,2) = y0
   points(t,3) = z0
Next

This loop generates points on the surface of a sphere using spherical coordinates.

Precalculating Shading:

PlayBASIC Code: [Select]

Dim DepthDueTable(500)
For lp = -200 to 200
   DepthDueTable(lp + 200) = SetColor(lp)
next

A table (DepthDueTable) is precalculated to determine the color based on the depth of each point.

Main Loop:

PlayBASIC Code: [Select]

do
   cls rgb(0,0,0)   
   threed(); Call the threed thing.
   print "Depth Colored Real 3D Dot Ball"
   print fps()
   sync; Flip the screen.
loop

The main program loop clears the screen, calls the threed function (responsible for 3D rendering), and prints information on the screen.

3D Rendering Function (threed):

PlayBASIC Code: [Select]

Function threed()
   ' Rotation speeds
   vx# = vx# + 0.5
   vy# = vy# + 0.5
   vz# = vz# + 0.5

   ' Lock buffer for drawing
   lockbuffer

   ' Calculate rotation matrices
   cvx# = Cos(vx#)
   svx# = Sin(vx#)
   cvy# = Cos(vy#)
   svy# = Sin(vy#)
   cvz# = Cos(vz#)
   svz# = Sin(vz#)

   ' Loop through each point and perform 3D transformations
   For n = 1 To numpoints
      ' Extract point coordinates
      x3d = points(n, 1)
      y3d = points(n, 2)
      z3d = points(n, 3)

      ' Apply rotation transformations
      ty# = ((y3d * cvx#) - (z3d * svx#))
      tz# = ((y3d * svx#) + (z3d * cvx#))
      tx# = ((x3d * cvy#) - (tz# * svy#))
      tz# = ((x3d * svy#) + (tz# * cvy#))
      ox# = tx#
      tx# = ((tx# * cvz#) - (ty# * svz#))
      ty# = ((ox# * svz#) + (ty# * cvz#))

      ' Perspective projection
      nx = Int(512 * (tx#) / (distance - (tz#))) + 320
      ny = Int(240 - (512 * ty#) / (distance - (tz#)))

      ' Draw the point with depth-based color
      dotc nx, ny, DepthDueTable(tz# + 200)
   Next

   ' Unlock buffer
   unlockbuffer
EndFunction

The threed function is responsible for updating the 3D rotation angles, performing 3D transformations on each point, and rendering the points on the screen with depth-based color.

Color Setting Function (setcolor):

PlayBASIC Code: [Select]

    Function setcolor(t#)
       ' Set color based on depth value
       If t# <= 100 And t# >= 75
          c = rgb(250,250,250)
       ' ... (similar checks for other depth ranges)
       EndIf
    EndFunction c

   The setcolor function assigns a color based on the depth value of a point.

Overall, the code generates a rotating 3D sphere with points on its surface, applying perspective projection and depth-based color shading. The rotation speeds and color gradients are adjustable based on the specified parameters.

[ATLUS]

so vertex and Graphics code work equally?