Draw a sphere: Difference between revisions

From Rosetta Code
Content added Content deleted
No edit summary
m (mis-spelled language)
Line 31: Line 31:


[[Category:Geometric Primitives]]
[[Category:Geometric Primitives]]
=={{header|POVray}}==
=={{header|POV-Ray}}==


This is what POVray was made for. An example with a sky, surface and transparency:
This is what POVray was made for. An example with a sky, surface and transparency:

Revision as of 21:41, 25 April 2011

Task
Draw a sphere
You are encouraged to solve this task according to the task description, using any language you may know.

The task is to draw a sphere. The sphere can be represented graphically, or in ascii art, depending on the language capabilities. Either static or rotational projection is acceptable for this task.

Brlcad

<lang brlcad>opendb balls.g y # Create a database to hold our shapes units cm # Set the unit of measure in ball.s sph 0 0 0 3 # Create a sphere of radius 3 cm named ball.s with its centre at 0,0,0 </lang>

Drawing a sphere is actually very simple in logo, using the perspective function to make life easier.

Works with: MSWlogo

<lang logo>to sphere :r cs perspective ht ;making the room ready to use repeat 180 [polystart circle :r polyend down 1] polyview end</lang>

Mathematica

Mathematica has many 3D drawing capabilities. To create a sphere with radius one centered at (0,0,0): <lang Mathematica>Graphics3D[Sphere[{0,0,0},1]]</lang>

Openscad

Drawing a sphere is easy in openscad:

<lang openscad>// This will produce a sphere of radius 5 sphere(5);</lang>

POV-Ray

This is what POVray was made for. An example with a sky, surface and transparency:

<lang POVray> camera { location <0.0 , .8 ,-3.0> look_at 0}

light_source{< 3,3,-3> color rgb 1}

sky_sphere { pigment{ gradient <0,1,0> color_map {[0 color rgb <.2,.1,0>][.5 color rgb 1]} scale 2}}

plane {y,-2 pigment { hexagon color rgb .7 color rgb .5 color rgb .6 }}

sphere { 0,1 

 texture { 
   pigment{ color rgbft <.8,1,1,.4,.4> } 
   finish { phong 1 reflection {0.40 metallic 0.5} }
 } 
 interior { ior 1.5}

} </lang>

Yields this:


PureBasic

3D Sphere animation. <lang PureBasic>; Original by Comtois @ 28/03/06

Updated/Formated by Fluid Byte @ March.24,2009
http://www.purebasic.fr/english/viewtopic.php?p=281258#p281258

Declare CreateSphere(M,P) Declare UpdateMesh()

  1. _SIZEVERT = 36
  2. _SIZETRIS = 6
  3. FULLSCREEN = 0

Structure VECTOR 

 X.f
 Y.f
 Z.f

EndStructure

Structure VERTEX 

 X.f
 Y.f
 Z.f
 NX.f
 NY.f
 NZ.f
 Color.l
 U.f
 V.f

EndStructure

Structure TRIANGLE 

 V1.w
 V2.w
 V3.w

EndStructure

Macro CALC_NORMALS 

 *PtrV\NX = *PtrV\X
 *PtrV\NY = *PtrV\Y
 *PtrV\NZ = *PtrV\Z

EndMacro

Global *VBuffer, *IBuffer Global Meridian = 50, Parallele = 50, PasLength = 4, Length

Define EventID, i, NbSommet, CameraMode, Angle.f, Pas.f = 0.5

InitEngine3D() : InitSprite() : InitKeyboard()

Add3DArchive(GetTemporaryDirectory(),#PB_3DArchive_FileSystem) Add3DArchive(#PB_Compiler_Home + "Examples\Sources\Data\",#PB_3DArchive_FileSystem)

If #FULLSCREEN 

 OpenScreen(800,600,32,"Sphere 3D")

Else 

 OpenWindow(0,0,0,800,600,"Sphere 3D",#PB_Window_SystemMenu | 1)
 OpenWindowedScreen(WindowID(0),0,0,800,600,0,0,0)

EndIf

-Texture

CreateImage(0,128,128) StartDrawing(ImageOutput(0)) For i = 0 To 127 Step 4 

 Box(0,i,ImageWidth(0),2,RGB(255,255,255))
 Box(0,i + 2,ImageWidth(0),2,RGB(0,0,155))

Next i StopDrawing() SaveImage(0,GetTemporaryDirectory() + "temp.bmp") : FreeImage(0)

-Material

CreateMaterial(0,LoadTexture(0,"temp.bmp")) RotateMaterial(0,0.1,#PB_Material_Animated)

-Mesh

CreateSphere(Meridian,Parallele)

-Entity

CreateEntity(0,MeshID(0),MaterialID(0)) ScaleEntity(0,60,60,60)

-Camera

CreateCamera(0,0,0,100,100) MoveCamera(0,0,0,-200) CameraLookAt(0,EntityX(0),EntityY(0),EntityZ(0))

-Light

AmbientColor(RGB(105, 105, 105)) CreateLight(0, RGB(255, 255, 55), EntityX(0) + 150, EntityY(0) , EntityZ(0)) CreateLight(1, RGB( 55, 255, 255), EntityX(0) - 150, EntityY(0) , EntityZ(0)) CreateLight(2, RGB( 55, 55, 255), EntityX(0) , EntityY(0) + 150, EntityZ(0)) CreateLight(3, RGB(255, 55, 255), EntityX(0) , EntityY(0) - 150, EntityZ(0))

----------------------------------------------------------------------------------------------------
MAINLOOP
----------------------------------------------------------------------------------------------------

Repeat 

 If #FULLSCREEN = 0
   Repeat
     EventID = WindowEvent()
     
     Select EventID
       Case #PB_Event_CloseWindow : End
     EndSelect
   Until EventID = 0
 EndIf
 
 Angle + Pas
 RotateEntity(0, Angle, Angle,Angle)
 
 If PasLength > 0 : UpdateMesh() : EndIf
 
 If ExamineKeyboard()
   If KeyboardReleased(#PB_Key_F1)
     CameraMode = 1 - CameraMode
     CameraRenderMode(0, CameraMode)
   EndIf
 EndIf
 
 RenderWorld()
 FlipBuffers()

Until KeyboardPushed(#PB_Key_Escape)

----------------------------------------------------------------------------------------------------
FUNCTIONS
----------------------------------------------------------------------------------------------------

Procedure CreateSphere(M,P) 

 ; M = Meridian
 ; P = Parallele
 ; The radius is 1. Front to remove it later, it's just for the demo.
 
 If M < 3 Or P < 2  : ProcedureReturn 0 : EndIf
 
 Protected Normale.VECTOR, NbSommet, i, j, Theta.f, cTheta.f, sTheta.f
 Protected Alpha.f, cAlpha.f, sAlpha.f, *PtrV.VERTEX, *PtrF.TRIANGLE, NbTriangle
 
 NbSommet = 2 + ((M + 1) * P)
 *VBuffer = AllocateMemory(#_SIZEVERT * Nbsommet)
 
 For i = 0 To M
   Theta  = i * #PI * 2.0 / M
   cTheta = Cos(theta)
   sTheta = Sin(theta)
   
   For j = 1 To P
     Alpha  = j * #PI / (P + 1)
     cAlpha = Cos(Alpha)
     sAlpha = Sin(Alpha)
     *PtrV = *VBuffer + #_SIZEVERT * ((i * P) + (j - 1))
     *PtrV\X = sAlpha * cTheta
     *PtrV\Y = sAlpha * sTheta
     *PtrV\Z = cAlpha
     *PtrV\U  = Theta / (2.0 * #PI)
     *PtrV\V  = Alpha / #PI
     CALC_NORMALS
   Next j
 Next i
 
 ; Southpole
 *PtrV = *VBuffer + #_SIZEVERT * ((M + 1) * P)   
 *PtrV\X =  0
 *PtrV\Y =  0   
 *PtrV\Z = -1
 *PtrV\U =  0
 *PtrV\V =  0
 CALC_NORMALS
 
 ; Northpole
 *PtrV + #_SIZEVERT
 *PtrV\X = 0
 *PtrV\Y = 0   
 *PtrV\Z = 1
 *PtrV\U = 0
 *PtrV\V = 0
 CALC_NORMALS
 
 ; Les facettes
 NbTriangle = 4 * M * P
 *IBuffer = AllocateMemory(#_SIZETRIS * NbTriangle)
 *PtrF = *IBuffer
 
 For i = 0 To M - 1
   For j = 1 To P - 1
     *PtrF\V1 = ((i + 1) * P) + j
     *PtrF\V2 = ((i + 1) * P) + (j - 1)
     *PtrF\V3 = (i * P) + (j - 1)
     *PtrF + #_SIZETRIS
     *PtrF\V3 = ((i + 1) * P) + j        ;Recto
     *PtrF\V2 = ((i + 1) * P) + (j - 1)  ;Recto
     *PtrF\V1 = (i * P) + (j - 1)        ;Recto
     *PtrF + #_SIZETRIS
     *PtrF\V1 = i * P + j
     *PtrF\V2 = ((i + 1) * P) + j
     *PtrF\V3 = (i * P) + (j - 1)
     *PtrF + #_SIZETRIS
     *PtrF\V3 = i * P + j               ;Recto
     *PtrF\V2 = ((i + 1) * P) + j       ;Recto
     *PtrF\V1 = (i * P) + (j - 1)       ;Recto
     *PtrF + #_SIZETRIS
   Next j     
 Next i
 
 ; The Poles
 For i = 0 To M - 1
   *PtrF\V3 = (M + 1) * P + 1
   *PtrF\V2 = (i + 1) * P
   *PtrF\V1 = i * P
   *PtrF + #_SIZETRIS
   *PtrF\V1 = (M + 1) * P + 1   ;Recto
   *PtrF\V2 = (i + 1) * P       ;Recto
   *PtrF\V3 = i * P             ;Recto
   *PtrF + #_SIZETRIS
 Next i     
 
 For i = 0 To M - 1
   *PtrF\V3 = (M + 1) * P
   *PtrF\V2 = i * P + (P - 1)
   *PtrF\V1 = (i + 1) * P + (P - 1)
   *PtrF + #_SIZETRIS
   *PtrF\V1 = (M + 1) * P              ;Recto
   *PtrF\V2 = i * P + (P - 1)          ;Recto
   *PtrF\V3 = (i + 1) * P + (P - 1)    ;Recto
   *PtrF + #_SIZETRIS 
 Next i     
 
 If CreateMesh(0,100)
   Protected Flag = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color
   SetMeshData(0,Flag,*VBuffer,NbSommet)
   SetMeshData(0,#PB_Mesh_Face,*IBuffer,NbTriangle)
   ProcedureReturn 1
 EndIf
 
 ProcedureReturn 0

EndProcedure

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Procedure UpdateMesh() 

 Protected NbTriangle = 4 * Meridian * Parallele
 
 Length + PasLength
 
 If Length >= NbTriangle
   PasLength = 0
   Length = Nbtriangle
 EndIf
 
 SetMeshData(0,#PB_Mesh_Face,*IBuffer,Length)

EndProcedure</lang>

Tcl

Assuming the task is to draw a likeness of a sphere, this would usually do:

<lang Tcl> proc grey {n} {format "#%2.2x%2.2x%2.2x" $n $n $n}

pack [canvas .c -height 400 -width 640 -background white]

for {set i 0} {$i < 255} {incr i} { 

 set h [grey $i] 
 .c create arc [expr {100+$i/5}] [expr {50+$i/5}] [expr {400-$i/1.5}] [expr {350-$i/1.5}] \
                -start 0 -extent 359 -fill $h -outline $h}

} </lang> Results in this image:

Retrieved from "https://rosettacode.org/wiki/Draw_a_sphere?oldid=176115"