Draw a sphere: Difference between revisions

Content added Content deleted

Inline

Revision as of 17:00, 1 May 2012

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.

BASIC

QBasic

<lang QBASIC>SCREEN 13 ' enter high-color graphic mode

' sets palette colors B/N FOR i = 0 TO 255

PALETTE 255 - i, INT(i / 4) + INT(i / 4) * 256 + INT(i / 4) * 65536

NEXT i PALETTE 0, 0

' draw the sphere FOR i = 255 TO 0 STEP -1

x = 50 + i / 3
y = 99
CIRCLE (x, y), i / 3, i
PAINT (x, y), i

NEXT i

' wait until keypress DO: LOOP WHILE INKEY$ = "" END</lang>

DarkBASIC

Some simple 3D objects are built into DarkBASIC. Creating a sphere only takes 1 line:

<lang darkbasic>MAKE OBJECT SPHERE 1,1</lang>

<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>

C

The lighting calculation is somewhere between crude and bogus, but hey, I'm shading it with ASCII characters, don't expect too much. <lang C>#include <stdio.h>

include <stdlib.h>
include <string.h>
include <ctype.h>
include <math.h>

char shades[] = ".:!*oe&#%@";

double light[3] = { 30, 30, -50 }; void normalize(double * v) {

       double len = sqrt(v[0]*v[0] + v[1]*v[1] + v[2]*v[2]);
       v[0] /= len; v[1] /= len; v[2] /= len;

}

double dot(double *x, double *y) {

       double d = x[0]*y[0] + x[1]*y[1] + x[2]*y[2];
       return d < 0 ? -d : 0;

}

void draw_sphere(double R, double k, double ambient) {

       int i, j, intensity;
       double b;
       double vec[3], x, y;
       for (i = floor(-R); i <= ceil(R); i++) {
               x = i + .5;
               for (j = floor(-2 * R); j <= ceil(2 * R); j++) {
                       y = j / 2. + .5;
                       if (x * x + y * y <= R * R) {
                               vec[0] = x;
                               vec[1] = y;
                               vec[2] = sqrt(R * R - x * x - y * y);
                               normalize(vec);
                               b = pow(dot(light, vec), k) + ambient;
                               intensity = (1 - b) * (sizeof(shades) - 1);
                               if (intensity < 0) intensity = 0;
                               if (intensity >= sizeof(shades) - 1)
                                       intensity = sizeof(shades) - 2;
                               putchar(shades[intensity]);
                       } else
                               putchar(' ');
               }
               putchar('\n');
       }

}

int main() {

       normalize(light);
       draw_sphere(20, 4, .1);
       draw_sphere(10, 2, .4);

       return 0;

}</lang>Output:<lang> #############%%%%

                      ##&&eeeeeeeeee&&&&&&&####%%%%%%%%                         
                  &&eeooooooooooooooeeeee&&&&######%%%%%%%%                     
                eeoo**************oooooooeeee&&&&####%%%%%%%%                   
            &&oo**!!!!!!::!!!!!!!!****oooooee&&&&######%%%%%%%%%%               
          eeoo!!!!::::::::::::::!!!!*****ooeeee&&&&####%%%%%%%%%%%%             
        ee**!!::::............::::!!!!***ooooeeee&&######%%%%%%%%%%%%           
      &&oo!!::..................::!!!!*****ooeeee&&&&####%%%%%%%%%%%%%%         
      oo!!::....................::::!!*****ooeeee&&&&####%%%%%%%%%%%%%%         
    ee**!!::....................::::!!*****ooeeee&&&&####%%%%%%%%%%%%%%%%       
  &&oo!!::......................::::!!*****ooeeee&&&&######%%%%%%%%%%%%%%%%     
  ee**!!::......................::::!!*****ooeeee&&&&######%%%%%%%%%%%%%%%%     
##oo**!!::......................::!!!!*****ooeeee&&&&####%%%%%%%%%%%%%%%%%%%%   
&&oo**::::....................::::!!!!***ooooeeee&&&&####%%%%%%%%%%%%%%%%%%%%   
eeoo**!!::..................::::!!!!*****ooooee&&&&######%%%%%%%%%%%%%%%%%%%%   
eeoo**!!::................::::!!!!****oooooeeee&&&&######%%%%%%%%%%%%%%%%%%%%

eeoo**!!::::............::::!!!!!!****oooeeee&&&&&&######%%%%%%%%%%%%%%%%%%%%%%
eeoo**!!!!::::::::::::::::!!!!!!****oooooeeee&&&&######%%%%%%%%%%%%%%%%%%%%%%%%
eeoooo**!!!!!!::::::::!!!!!!******ooooeeeee&&&&&&######%%%%%%%%%%%%%%%%%%%%%%%%
&&eeoo****!!!!!!!!!!!!!!!!******ooooeeeee&&&&&&######%%%%%%%%%%%%%%%%%%%%%%%%%%
&&eeoooo********************ooooooeeee&&&&&&&######%%%%%%%%%%%%%%%%%%%%%%%%%%%%
&&&&eeoooooo************ooooooeeeeee&&&&&&&########%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%##&&eeeeeeooooooooooooooooooeeeeee&&&&&&&########%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %####&&&&eeeeeeeeeeeeeeeeeeeeee&&&&&&&&#########%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%##&&&&&&eeeeeeeeeeeeeeee&&&&&&&&&&#########%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%   
%%######&&&&&&&&&&&&&&&&&&&&&&&&###########%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%   
%%%%########&&&&&&&&&&&&&&############%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%   
%%%%%%##############################%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%   
  %%%%%%%%######################%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%     
  %%%%%%%%%%%%%%%%####%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%     
    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%       
      %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%         
      %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%         
        %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%           
          %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%             
            %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%               
                %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%                   
                  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%                     
                      %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%                         
                              %%%%%%%%%%%%%%%%%                                 
                                                                                
            ::..:::::!!**               
        .............::!!**oo           
    ...................::!!**ooee       
  .......................::!!ooeeee     
  .......................::!!**ooee     
.........................::!!**ooeeee   
.........................::!!**ooeeee

.........................::!!**ooeeeeee

........................::!!**ooooeeeeee

.......................::!!**ooeeeeeeee

.....................::!!****ooeeeeeeee

!::................:::!!****ooeeeeeeeeee

!!::..........::::!!!****ooooeeeeeeeeee

**!!::::::::::!!!!*****ooooeeeeeeeeee   
oo**!!!!!!!!!!*******ooooeeeeeeeeeeee   
  oooo********oooooooeeeeeeeeeeeeee     
  eeeeooooooooooeeeeeeeeeeeeeeeeeee     
    eeeeeeeeeeeeeeeeeeeeeeeeeeeee       
        eeeeeeeeeeeeeeeeeeeee           
            eeeeeeeeeeeee               </lang>

Fun with 3D noise texture

<lang c>#include <stdio.h>

include <stdlib.h>
include <math.h>

define MAXD 8

int g[] = { -1, 0, 1 }; /* Perlin-like noise */ inline void hashed(int *data, int *out, int len) {

define ror(a, d) ((a << (d)) | (a >> (32 - d)))

register unsigned int h = 0x12345678, tmp; unsigned int *d = (void*)data; int i = len;

while (i--) { tmp = *d++; h += ror(h, 15) ^ ror(tmp, 5); }

h ^= ror(h, 7); h += ror(h, 23); h ^= ror(h, 19); h += ror(h, 11); h ^= ror(h, 13); h += ror(h, 17);

undef ror

for (i = len; i--; ) { out[i] = g[h % 3]; h /= 3; } }

double scale[MAXD], scale_u[MAXD]; void noise_init() { int i; for (i = 1; i < MAXD; i++) { scale[i] = 1 / (1 + sqrt(i + 1)); scale_u[i] = scale[i] / sqrt(i + 1); } }

double noise(double *x, int d) {

define sum(s, x) for (s = 0, j = 0; j < d; j++) s += x

register int i, j; int n[MAXD], o[MAXD], g[MAXD], tmp; double s, r, t, ret, u[MAXD];

sum(s, x[j]); s *= scale[d];

for (i = 0; i < d; i++) { o[i] = i; t = x[i] + s; u[i] = t - (n[i] = floor(t)); } o[d] = 0;

for (i = 0; i < d - 1; i++) for (j = i; j < d; j++) if (u[o[i]] < u[o[j]]) tmp = o[i], o[i] = o[j], o[j] = tmp;

sum(r, n[j]); r *= (s = scale_u[d]); for (j = 0; j < d; j++) u[j] = x[j] + r - n[j];

for (ret = 0, i = 0; i <= d; i++) { for (t = (d + 1.) / (2 * d), j = 0; j < d; j++) if ((t -= u[j] * u[j]) <= 0) break;

if (t >= 0) { r = 0; hashed(n, g, d); for (j = 0; j < d; j++) if (g[j] == 1) r += u[j]; else if (g[j] == -1) r -= u[j];

t *= t; ret += r * t * t; }

if (i < d) { n[o[i]]++, u[o[i]]--; for (j = 0; j < d; j++) u[j] += s; } } return ret * (d * d); }

double get_noise2(double x, double y) { int i; double ws, r = 0, v[2];

for (i = 1, ws = 0; i <= 64; i <<= 1) { v[0] = x * i, v[1] = y * i; r += noise(v, 2); ws ++; } r /= ws; return r; }

double get_noise3(double x, double y, double z) { int i; double r = 0, v[3], w, ws;

for (i = 1, ws = 0; i <= 8; i <<= 1) { v[0] = x * i, v[1] = y * i, v[2] = z * i; w = 1./sqrt(i); r += noise(v, 3) * w; ws += w; } return r / ws; }

int main(int c, char** v) { unsigned char pix[256 * 256], *p; int i, j; double x, y, z, w; FILE *fp;

noise_init();

for (p = pix, i = 0; i < 256 * 256; i++) *p++ = 0;

for (p = pix, i = 0; i < 256; i++) { y = (i - 128) / 125.; for (j = 0; j < 256; j++, p++) { x = (j - 128) / 125.; //*p = (get_noise2(i/256., j/256.) + 1) / 6 * i; *p = (get_noise2(i/256., j/256.) + 1) * 100;

z = 1- x*x - y*y; if (z < 0) continue;

z = sqrt(z);

w = get_noise3(x, y, -z); if (w > 0) *p = 50;

w = get_noise3(x, y, z); if (w < 0) continue;

w = (1.5 + x - y + z) / 3.5; *p = w * 255; } }

fp = fopen("out.pgm", "w+"); fprintf(fp, "P5\n256 256\n255\n"); fwrite(pix, 1, 256 * 256, fp); fclose(fp);

return 0; }</lang>

D

Translation of: C

<lang d>import std.stdio, std.math, std.algorithm, std.numeric;

alias double[3] V3; V3 light = [30, 30, -50];

void normalize(ref V3 v) pure {

   v[] /= dotProduct(v, v) ^^ 0.5;

}

double dot(const ref V3 x, const ref V3 y) pure nothrow {

   immutable double d = dotProduct(x, y);
   return d < 0 ? -d : 0;

}

void drawSphere(in double R, in double k, in double ambient) {

   enum shades = ".:!*oe&#%@";
   foreach (int i; cast(int)floor(-R) .. cast(int)ceil(R) + 1) {
       immutable double x = i + 0.5;
       foreach (int j; cast(int)floor(-2*R)..cast(int)ceil(2*R)+1){
           immutable double y = j / 2. + 0.5;
           if (x ^^ 2 + y ^^ 2 <= R ^^ 2) {
               V3 vec = [x, y, (R^^2 - x^^2 - y^^2) ^^ 0.5];
               vec.normalize();
               immutable double b = dot(light, vec) ^^ k + ambient;
               int intensity = cast(int)((1-b) * (shades.length-1));
               intensity = min(shades.length-1, max(intensity, 0));
               putchar(shades[intensity]);
           } else
               putchar(' ');
       }
       putchar('\n');
   }

}

void main() {

   light.normalize();
   drawSphere(20, 4, 0.1);
   drawSphere(10, 2, 0.4);

}</lang>

Delphi

Translation of: C

Under Microsoft Windows: If you notice the big sphere loses its roundness, then try increasing the width of the Windows console. By default it’s 80; so put it to something bigger, let’s say 90.

Steps: Run the CMD Windows shell. Then follow this path to setup the new width: Main Menu-> Properties -> Layout -> Window Size -> Width.

<lang Delphi> program DrawASphere;

{$APPTYPE CONSOLE}

uses

 SysUtils,
 Math;

type

 TDouble3  = array[0..2] of Double;
 TChar10 = array[0..9] of Char;

var

 shades: TChar10 = ('.', ':', '!', '*', 'o', 'e', '&', '#', '%', '@');
 light: TDouble3 = (30, 30, -50 );

 procedure normalize(var v: TDouble3);
 var
   len: Double;
 begin
   len:= sqrt(v[0]*v[0] + v[1]*v[1] + v[2]*v[2]);
   v[0] := v[0] / len;
   v[1] := v[1] / len;
   v[2] := v[2] / len;
 end;

 function dot(x, y: TDouble3): Double;
 begin
   Result:= x[0]*y[0] + x[1]*y[1] + x[2]*y[2];
   Result:= IfThen(Result < 0, -Result, 0 );
 end;

 procedure drawSphere(R, k, ambient: Double);
 var
   vec: TDouble3;
   x, y, b: Double;
   i, j,
   intensity: Integer;
 begin
   for i:= Floor(-R) to Ceil(R) do
   begin
     x := i + 0.5;
     for j:= Floor(-2*R) to Ceil(2 * R) do
     begin
       y:= j / 2 + 0.5;
       if(x * x + y * y <= R * R) then
       begin
         vec[0]:= x;
         vec[1]:= y;
         vec[2]:= sqrt(R * R - x * x - y * y);
         normalize(vec);
         b:= Power(dot(light, vec), k) + ambient;
         intensity:= IfThen(b <= 0,
                            Length(shades) - 2,
                            Trunc(max( (1 - b) * (Length(shades) - 1), 0 )));
         Write(shades[intensity]);
       end
       else
         Write(' ');
     end;
     Writeln;
   end;
 end;

begin

 normalize(light);
 drawSphere(19, 4, 0.1);
 drawSphere(10, 2, 0.4);
 Readln;

end. </lang>

Output:

                             &&&&&&&&&&#######
                       &eeeeeooeeeeeeee&&&&&&#######
                   eeooo*********oooooeeeee&&&&&#######%
                eo***!!!!!!!!!!!*****ooooeeee&&&&&#######%%
             eo**!!!::::::::::!!!!!****ooooeeee&&&&########%%%
           eo*!!::::........:::::!!!!****oooeeee&&&&########%%%%
         eo*!!::..............:::::!!!***ooooeeee&&&&#########%%%%
       eo*!!::..................:::!!!!***oooeeee&&&&&########%%%%%%
      eo*!::....................::::!!!***ooooeeee&&&&#########%%%%%%
     o**!::.....................::::!!!***ooooeeee&&&&#########%%%%%%%
    eo*!::......................::::!!!***ooooeeee&&&&##########%%%%%%%
   eo*!!::......................:::!!!!***ooooeee&&&&&##########%%%%%%%%
  eo**!!::.....................:::!!!!***ooooeeee&&&&&##########%%%%%%%%%
 &eo**!!::...................::::!!!!****oooeeeee&&&&&##########%%%%%%%%%%
 eeo**!!:::................:::::!!!!****ooooeeee&&&&&##########%%%%%%%%%%%
&eoo**!!!::::............:::::!!!!****oooooeeee&&&&&###########%%%%%%%%%%%%
&eeo***!!!::::::::::::::::::!!!!!****ooooeeeee&&&&&&##########%%%%%%%%%%%%%
&eeoo***!!!!::::::::::::!!!!!!*****oooooeeeee&&&&&&###########%%%%%%%%%%%%%
&&eeoo****!!!!!!!!!!!!!!!!!!*****oooooeeeee&&&&&&############%%%%%%%%%%%%%%
&&eeeooo*****!!!!!!!!!!*******ooooooeeeeee&&&&&&############%%%%%%%%%%%%%%%
#&&eeeoooo*****************oooooooeeeeee&&&&&&&############%%%%%%%%%%%%%%%%
#&&&eeeeoooooooooooooooooooooooeeeeeee&&&&&&&#############%%%%%%%%%%%%%%%%%
##&&&&eeeeeoooooooooooooooeeeeeeeee&&&&&&&&##############%%%%%%%%%%%%%%%%%%
 ###&&&&eeeeeeeeeeeeeeeeeeeeeee&&&&&&&&&&##############%%%%%%%%%%%%%%%%%%%
 ####&&&&&&&eeeeeeeeeeeeeee&&&&&&&&&&&################%%%%%%%%%%%%%%%%%%%%
  #####&&&&&&&&&&&&&&&&&&&&&&&&&&&&#################%%%%%%%%%%%%%%%%%%%%%
   ########&&&&&&&&&&&&&&&&&&&####################%%%%%%%%%%%%%%%%%%%%%%
    ############################################%%%%%%%%%%%%%%%%%%%%%%%
     %#######################################%%%%%%%%%%%%%%%%%%%%%%%%%
      %%##################################%%%%%%%%%%%%%%%%%%%%%%%%%%%
       %%%%###########################%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
         %%%%%%#################%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
             %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                       %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                             %%%%%%%%%%%%%%%%%

             ::...:::!!!*o
         ..............::!!*oo
      ..................::!!**ooe
    .....................::!!**ooee
   .......................::!!**ooee
  ........................::!!**oooee
 .........................::!!**oooeee
:........................::!!!**oooeeee
........................::!!!**ooooeeee
:......................::!!!***oooeeeee
:....................:::!!!***oooeeeeee
!:.................:::!!!****oooeeeeeee
*!:::...........::::!!!!***ooooeeeeeeee
 *!!!:::::::::::!!!!!****oooooeeeeeeee
  o**!!!!!!!!!!!!!*****oooooeeeeeeeee
   oo**************ooooooeeeeeeeeeee
    eoooooooooooooooooeeeeeeeeeeeee
      eeeooooooooeeeeeeeeeeeeeeee
         eeeeeeeeeeeeeeeeeeeee
             eeeeeeeeeeeee

DWScript

Translation of: C

but adapted to spit out a PGM image

<lang delphi> type

  TFloat3  = array[0..2] of Float;

var

  light : TFloat3 = [ 30, 30, -50 ];

procedure normalize(var v : TFloat3); var

  len: Float;

begin

   len := sqrt(v[0]*v[0] + v[1]*v[1] + v[2]*v[2]);
   v[0] /= len;
   v[1] /= len;
   v[2] /= len;

end;

function dot(x, y : TFloat3) : Float; begin

   Result := x[0]*y[0] + x[1]*y[1] + x[2]*y[2];
   if Result<0 then
      Result:=-Result
   else Result:=0;

end;

procedure drawSphere(R, k, ambient : Float); var

  vec : TFloat3;
  x, y, b : Float;
  i, j, size, intensity : Integer;

begin

  size:=Trunc(Ceil(R)-Floor(-R)+1);
  PrintLn('P2');
  PrintLn(IntToStr(size)+' '+IntToStr(size));
  PrintLn('255');
  for i := Floor(-R) to Ceil(R) do begin
     x := i + 0.5;
     for j := Floor(-R) to Ceil(R) do begin
        y := j + 0.5;
        if (x * x + y * y <= R * R) then begin
           vec[0] := x;
           vec[1] := y;
           vec[2] := sqrt(R * R - x * x - y * y);
           normalize(vec);
           b := Power(dot(light, vec), k) + ambient;
           intensity := ClampInt( Round(b*255), 0, 255);
           Print(intensity);
           Print(' ')
        end else Print('0 ');
     end;
     PrintLn();
  end;

end;

normalize(light); drawSphere(19, 4, 0.1); </lang>

Go

Translation of: C

Using image library rather than ASCII art. <lang go>package main

import (

   "fmt"
   "image"
   "image/color"
   "image/png"
   "math"
   "os"

)

type vector [3]float64

func normalize(v *vector) {

   invLen := 1 / math.Sqrt(dot(v, v))
   v[0] *= invLen
   v[1] *= invLen
   v[2] *= invLen

}

func dot(x, y *vector) float64 {

   return x[0]*y[0] + x[1]*y[1] + x[2]*y[2]

}

func drawSphere(r int, k, amb float64, dir *vector) *image.Gray {

   w, h := r*4, r*3
   img := image.NewGray(image.Rect(-w/2, -h/2, w/2, h/2))
   vec := new(vector)
   for x := -r; x < r; x++ {
       for y := -r; y < r; y++ {
           if z := r*r - x*x - y*y; z >= 0 {
               vec[0] = float64(x)
               vec[1] = float64(y)
               vec[2] = math.Sqrt(float64(z))
               normalize(vec)
               s := dot(dir, vec)
               if s < 0 {
                   s = 0
               }
               lum := 255 * (math.Pow(s, k) + amb) / (1 + amb)
               if lum < 0 {
                   lum = 0
               } else if lum > 255 {
                   lum = 255
               }
               img.SetGray(x, y, color.Gray{uint8(lum)})
           }
       }
   }
   return img

}

func main() {

   dir := &vector{-30, -30, 50}
   normalize(dir)
   img := drawSphere(200, 1.5, .2, dir)
   f, err := os.Create("sphere.png")
   if err != nil {
       fmt.Println(err)
       return
   }
   if err = png.Encode(f, img); err != nil {
       fmt.Println(err)
   }
   if err = f.Close(); err != nil {
       fmt.Println(err)
   }

}</lang>

Icon and Unicon

Unicon provides a built-in interface to openGL including some higher level abstractions (for more information see Unicon Technical References, 3D Graphics). The example below draws a blue sphere on a black background and waits for input to quit.

<lang Unicon>procedure main() W := open("Demo", "gl", "size=400,400", "bg=black") | stop("can't open window!") WAttrib(W, "slices=40", "rings=40", "light0=on, ambient white; diffuse gold; specular gold; position 5, 0, 0" ) Fg(W, "emission blue") DrawSphere(W, 0, 0, -5, 1) Event(W) end</lang>

J

The simplest way to draw a sphere is to run the sphere demo code from J's simple demos. (This assumes J version 6.)

Normally you would bring up this demo by using the menu system:

Studio
 > Demos...
  > opengl simple... [ok]
    > sphere [Run]

<lang j>load 'system/examples/graphics/opengl/simple/sphere.ijs'</lang>

Raytracing Solution

Here's a version using raytracing computed in J. luminosity is an array of luminosity values with theoretical maximum 1 and minimum 0, and viewmat is used to display this.

<lang j>'R k ambient' =. 10 2 0.4 light =. (% +/&.:*:) 30 30 _50 pts =. (0&*^:(0={:))@:(,,(0>.(*:R)-+)&.*:)"0/~ i:15j200 luminosity =. (>:ambient) %~ (ambient * * +/&.:*:"1 pts) + k^~ 0>. R%~ pts +/@:*"1 -light

load 'viewmat' togreyscale =. 256 #. [: <. 255 255 255 *"1 0 ] 'rgb' viewmat togreyscale luminosity</lang>

Java

Translation of: C

<lang java>public class Sphere{

   static char[] shades = {'.', ':', '!', '*', 'o', 'e', '&', '#', '%', '@'};

   static double[] light = { 30, 30, -50 };
   private static void normalize(double[] v){
       double len = Math.sqrt(v[0]*v[0] + v[1]*v[1] + v[2]*v[2]);
       v[0] /= len; v[1] /= len; v[2] /= len;
   }

   private static double dot(double[] x, double[] y){
       double d = x[0]*y[0] + x[1]*y[1] + x[2]*y[2];
       return d < 0 ? -d : 0;
   }

   public static void drawSphere(double R, double k, double ambient){
       double[] vec = new double[3];
       for(int i = (int)Math.floor(-R); i <= (int)Math.ceil(R); i++){
           double x = i + .5;
           for(int j = (int)Math.floor(-2 * R); j <= (int)Math.ceil(2 * R); j++){
               double y = j / 2. + .5;
               if(x * x + y * y <= R * R) {
                   vec[0] = x;
                   vec[1] = y;
                   vec[2] = Math.sqrt(R * R - x * x - y * y);
                   normalize(vec);
                   double b = Math.pow(dot(light, vec), k) + ambient;
                   int intensity = (b <= 0) ?
                               shades.length - 2 :
                               (int)Math.max((1 - b) * (shades.length - 1), 0);
                   System.out.print(shades[intensity]);
               } else
                   System.out.print(' ');
           }
           System.out.println();
       }
   }

   public static void main(String[] args){
       normalize(light);
       drawSphere(20, 4, .1);
       drawSphere(10, 2, .4);
   }

}</lang> Output:

                               &&&&&&&&&&#######                                 
                        &eeeeeeeeeeeeeeee&&&&&&#######%                          
                    &eoooo*******oooooooeeeee&&&&&########%                      
                 eoo****!!!!!!!!******oooooeeee&&&&&########%%                   
              eoo**!!!!::::::::!!!!!*****ooooeeee&&&&&########%%%                
            eo**!!::::::...:::::::!!!!!***ooooeeee&&&&&########%%%%              
          eo*!!:::.............:::::!!!!***ooooeeee&&&&&########%%%%%            
        eo*!!:::.................::::!!!!***ooooeeee&&&&#########%%%%%%          
       eo*!!::....................::::!!!****oooeeee&&&&&#########%%%%%%         
     &o**!::......................::::!!!****oooeeee&&&&&##########%%%%%%%       
    &o**!::.......................::::!!!****oooeeee&&&&&##########%%%%%%%%      
   &oo*!!::.......................:::!!!!***ooooeeee&&&&&##########%%%%%%%%%     
  &eo*!!::.......................::::!!!****ooooeeee&&&&&##########%%%%%%%%%%    
  eo**!!::......................::::!!!!***ooooeeeee&&&&&##########%%%%%%%%%%    
 &eo**!!:::...................:::::!!!!****ooooeeee&&&&&###########%%%%%%%%%%%   
 eeo**!!::::................:::::!!!!!****ooooeeee&&&&&&###########%%%%%%%%%%%   
&eeo***!!:::::...........::::::!!!!!****oooooeeee&&&&&&###########%%%%%%%%%%%%%  
&eeoo**!!!!::::::::::::::::::!!!!!*****ooooeeeee&&&&&&############%%%%%%%%%%%%%  
&eeooo***!!!!::::::::::::!!!!!!!*****oooooeeeee&&&&&&############%%%%%%%%%%%%%%  
&&eeooo***!!!!!!!!!!!!!!!!!!!******oooooeeeeee&&&&&&############%%%%%%%%%%%%%%%  
&&eeeooo******!!!!!!!!!!********ooooooeeeeee&&&&&&&############%%%%%%%%%%%%%%%%  
#&&eeeooooo******************oooooooeeeeee&&&&&&&#############%%%%%%%%%%%%%%%%%  
#&&&eeeeoooooooo******oooooooooooeeeeeee&&&&&&&&#############%%%%%%%%%%%%%%%%%%  
##&&&&eeeeeooooooooooooooooooeeeeeeee&&&&&&&&&##############%%%%%%%%%%%%%%%%%%%  
 ##&&&&&eeeeeeeeeeeeeeeeeeeeeeeeee&&&&&&&&&################%%%%%%%%%%%%%%%%%%%   
 ####&&&&&&eeeeeeeeeeeeeeeeeee&&&&&&&&&&&################%%%%%%%%%%%%%%%%%%%%%   
  #####&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&#################%%%%%%%%%%%%%%%%%%%%%%    
  %#######&&&&&&&&&&&&&&&&&&&&&&&&###################%%%%%%%%%%%%%%%%%%%%%%%%    
   %###########&&&&&&&&&&&&&#######################%%%%%%%%%%%%%%%%%%%%%%%%%     
    %############################################%%%%%%%%%%%%%%%%%%%%%%%%%%      
     %%#######################################%%%%%%%%%%%%%%%%%%%%%%%%%%%%       
       %%#################################%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%         
        %%%%%#########################%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%          
          %%%%%%%%#############%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%            
            %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%              
              %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%                
                 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%                   
                    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%                      
                        %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%                          
                               %%%%%%%%%%%%%%%%%                                 
                                                                                 
             ::...:::!!!*o               
         ..............::!!*oo           
      ..................::!!**ooe        
    .....................::!!**ooee      
   .......................::!!**ooee     
  ........................::!!**oooee    
 .........................::!!**oooeee   
:........................::!!!**oooeeee  
........................::!!!**ooooeeee  
:......................::!!!***oooeeeee  
:....................:::!!!***oooeeeeee  
!:.................:::!!!****oooeeeeeee  
*!:::...........::::!!!!***ooooeeeeeeee  
 *!!!:::::::::::!!!!!****oooooeeeeeeee   
  o**!!!!!!!!!!!!!*****oooooeeeeeeeee    
   oo**************ooooooeeeeeeeeeee     
    eoooooooooooooooooeeeeeeeeeeeee      
      eeeooooooooeeeeeeeeeeeeeeee        
         eeeeeeeeeeeeeeeeeeeee           
             eeeeeeeeeeeee

Logo

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>

Liberty BASIC

<lang lb> WindowWidth =420 WindowHeight =460

nomainwin

open "Sphere" for graphics_nsb_nf as #w

w "down ; fill lightgray"

xS =200 yS =200 for radius =150 to 0 step -1

   level$ =str$( int( 256 -256 *radius /150))
   c$ =level$ +" " +level$ +" " +level$ 
   #w "color ";     c$
   #w "backcolor "; c$
   #w "place "; xS; " "; yS
   xS =xS -0.5
   yS =yS -0.2
   #w "circlefilled "; radius

next radius

w "flush"

wait close #w end </lang>

Lua

Translation of: C

Works with: Lua version 5.1.4

<lang Lua>require ("math")

shades = {'.', ':', '!', '*', 'o', 'e', '&', '#', '%', '@'}

function normalize (vec)

   len = math.sqrt(vec[1]^2 + vec[2]^2 + vec[3]^2)
   return {vec[1]/len, vec[2]/len, vec[3]/len}

end

light = normalize{30, 30, -50}

function dot (vec1, vec2)

   d = vec1[1]*vec2[1] + vec1[2]*vec2[2] + vec1[3]*vec2[3]
   return d < 0 and -d or 0

end

function draw_sphere (radius, k, ambient)

   for i = math.floor(-radius),-math.floor(-radius) do
       x = i + .5
       local line = 
       for j = math.floor(-2*radius),-math.floor(-2*radius) do
           y = j / 2 + .5
           if x^2 + y^2 <= radius^2 then
               vec = normalize{x, y, math.sqrt(radius^2 - x^2 - y^2)}
               b = dot(light,vec) ^ k + ambient
               intensity = math.floor ((1 - b) * #shades)
               line = line .. (shades[intensity] or shades[1])
           else
               line = line .. ' '
           end
       end
       print (line)
   end

end

draw_sphere (20, 4, 0.1) draw_sphere (10, 2, 0.4)</lang> Output:

                               &&&&&&&&&&&&#####                                 
                        &eeeoooooooooeeeeee&&&&&#######                          
                    eooo*************oooooeeee&&&&&########                      
                 eo**!!!!!!!!!!!!!!!*****ooooeeee&&&&#########                   
              eo*!!!:::::...:::::::!!!!****oooeeee&&&&&##########                
            o**!:::..............::::!!!!***ooooeee&&&&&###########              
          o*!!::...................::::!!!***ooooeee&&&&&############            
        eo*!::......................::::!!!***oooeeee&&&&&#############          
       o*!::.........................:::!!!***ooooeee&&&&&##############         
     &o*!::..........................:::!!!***ooooeeee&&&&###############%       
    eo*!::...........................:::!!!***ooooeeee&&&&&###############%      
   eo*!::............................:::!!!***ooooeeee&&&&&###############%%     
  &o*!!::...........................:::!!!!***oooeeee&&&&&#################%%    
  eo*!!:...........................::::!!!***ooooeeee&&&&&#################%%    
 eo**!!::.........................::::!!!****oooeeee&&&&&&#################%%%   
 eo**!!::.......................::::!!!!****oooeeeee&&&&&##################%%%   
&eo**!!:::....................:::::!!!!***ooooeeeee&&&&&&##################%%%%  
&eoo**!!::::................:::::!!!!****ooooeeeee&&&&&&###################%%%%  
&eoo***!!!:::::........:::::::!!!!!****oooooeeeee&&&&&&###################%%%%%  
&eeoo***!!!!:::::::::::::::!!!!!!*****ooooeeeee&&&&&&&####################%%%%%  
&&eeoo****!!!!!!!!!!!!!!!!!!!!*****oooooeeeeee&&&&&&######################%%%%%  
&&eeeooo******!!!!!!!!!!!*******ooooooeeeeee&&&&&&&######################%%%%%%  
#&&eeeooooo******************oooooooeeeeee&&&&&&&#######################%%%%%%%  
##&&&eeeeoooooooooo*ooooooooooooeeeeeeee&&&&&&&&#######################%%%%%%%%  
 ##&&&eeeeeeooooooooooooooooeeeeeeeee&&&&&&&&&########################%%%%%%%%   
 ###&&&&&eeeeeeeeeeeeeeeeeeeeeeee&&&&&&&&&&##########################%%%%%%%%%   
  ####&&&&&&&eeeeeeeeeeeeeee&&&&&&&&&&&&############################%%%%%%%%%    
  ######&&&&&&&&&&&&&&&&&&&&&&&&&&&&&##############################%%%%%%%%%%    
   ########&&&&&&&&&&&&&&&&&&&&&&################################%%%%%%%%%%%     
    ###############&&&&&#######################################%%%%%%%%%%%%      
     #########################################################%%%%%%%%%%%%       
       #####################################################%%%%%%%%%%%%         
        #################################################%%%%%%%%%%%%%%          
          #############################################%%%%%%%%%%%%%%            
            ########################################%%%%%%%%%%%%%%%              
              ##################################%%%%%%%%%%%%%%%%%                
                 %##########################%%%%%%%%%%%%%%%%%%                   
                    %%%%############%%%%%%%%%%%%%%%%%%%%%%%                      
                        %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%                          
                               %%%%%%%%%%%%%%%%%                                 
                                                                                 
             ........::!!*               
         ...............::!!*o           
      ....................::!**oo        
    .......................::!**ooo      
   ........................::!!**ooo     
  .........................::!!**oooo    
 ..........................::!!**ooooe   
...........................::!!**ooooee  
..........................::!!***ooooee  
.........................::!!!**oooooee  
.......................:::!!!**oooooeee  
:.....................::!!!***ooooooeee  
!::................:::!!!!***ooooooeeee  
 !!::..........:::::!!!****ooooooeeeee   
  *!!!::::::::::!!!!!****oooooooeeeee    
   o***!!!!!!!!!******ooooooooeeeeee     
    ooo***********ooooooooooeeeeeee      
      oooooooooooooooooooeeeeeeee        
         eooooooooooeeeeeeeeee           
             eeeeeeeeeeeee

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>

Pascal

Works with: Free_Pascal

After changing "{$APPTYPE CONSOLE}" to "{$mode delphi}" or "{$mode objfpc}" the Delphi example works with FreePascal.

Perl 6

Translation of C. Modified to output .pgm file.

<lang perl6>my $x = my $y = 255; $x +|= 1; # must be odd

my @light = normalize([ 3, 2, -5 ]);

my $depth = 255;

sub MAIN ($outfile = 'sphere-perl6.pgm') {

   my $out = open( $outfile, :w, :bin ) or die "$!\n";
   $out.say("P5\n$x $y\n$depth"); # .pgm header
   $out.print( draw_sphere( ($x-1)/2, .9, .2)».chrs );
   $out.close;

}

sub normalize (@vec) { return @vec »/» ([+] @vec Z* @vec).sqrt }

sub dot (@x, @y) { return -([+] @x Z* @y) max 0 }

sub draw_sphere ( $rad, $k, $ambient ) {

   my @pixels;
   my $r2 = $rad * $rad;
   my @range = -$rad .. $rad;
   for @range X @range -> $x, $y {
       if (my $x2 = $x * $x) + (my $y2 = $y * $y) < $r2 {
           my @vector = normalize([$x, $y, ($r2 - $x2 - $y2).sqrt]);
           my $intensity = dot(@light, @vector) ** $k + $ambient;
           my $pixel = (0 max ($intensity * $depth).Int) min $depth;
           @pixels.push($pixel);
       }
       else {
           @pixels.push(0);
       }
   }
   return @pixels;

}</lang>

PicoLisp

Library: GLUT

This is for the 64-bit version. <lang PicoLisp>(load "@lib/openGl.l")

(glutInit) (glutInitDisplayMode (| GLUT_RGBA GLUT_DOUBLE GLUT_ALPHA GLUT_DEPTH)) (glutInitWindowSize 400 400) (glutCreateWindow "Sphere")

(glEnable GL_LIGHTING) (glEnable GL_LIGHT0) (glLightiv GL_LIGHT0 GL_POSITION (10 10 -10 0))

(glEnable GL_COLOR_MATERIAL) (glColorMaterial GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE)

(glClearColor 0.3 0.3 0.5 0) (glColor4f 0.0 0.8 0.0 1.0)

(displayPrg

  (glClear (| GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
  (glutSolidSphere 0.9 40 32)
  (glFlush)
  (glutSwapBuffers) )

Exit upon mouse click

(mouseFunc '((Btn State X Y) (bye))) (glutMainLoop)</lang>

PostScript

Gradient filled circle: <lang PostScript>%!PS-Adobe-3.0 %%BoundingBox 0 0 300 300

150 150 translate 0 0 130 0 360 arc

/Pattern setcolorspace << /PatternType 2

       /Shading <<     
               /ShadingType    3
               /ColorSpace     /DeviceRGB
               /Coords         [-60 60 0 0 0 100]
               /Function <<    
                       /FunctionType   2
                       /Domain         [0 1]
                       /C0             [1 1 1]
                       /C1             [0 0 0]
                       /N              2
               >>
       >>

>> matrix makepattern setcolor fill

showpage %%EOF </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()

_SIZEVERT = 36
_SIZETRIS = 6
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>

REXX

This program is modeled after the "C" version.
The REXX language doesn't have a SQRT function, so I included a version.
Same with CEILing and FLOOR. <lang rexx> /*REXX program to express a lighted sphere with simple chars for shading*/

call drawSphere 19, 4, 2/10 call drawSphere 10, 2, 4/10 exit

/*─────────────────────────────────────drawSphere subroutine────────────*/ drawSphere: procedure; parse arg r,k,ambient

                shading='·:!ºoe@░▒█'                /*for ASCI machines*/

if 1=='f1'x then shading='.:!*oe&#%@' /*for EBCDIC machs.*/ parse value '30 30 -50' with s1 s2 s3 /*the light source.*/ _=sqrt(s1**2 + s2**2 + s3**2); s1=s1/_; s2=s2/_; s3=s3/_ /*normalize S'*/ sLen=length(shading); sLen1=sLen-1; rr=r*r

 do   i=floor(-r)   to ceil(r)  ;  x=  i+.5;  xx=x**2;  aLine=
   do j=floor(-2*r) to ceil(2*r);  y=j/2+.5;  yy=y**2
   if xx+yy<=rr then do
                     parse value x y sqrt(rr-xx-yy) with v1 v2 v3
                     _=sqrt(v1**2 + v2**2 + v3**2)
                     v1=v1/_;  v2=v2/_;  v3=v3/_       /*normalize V's.*/
                     dot=s1*v1 + s2*v2 + s3*v3
                     if dot>0 then dot=0
                     b=abs(dot)**k + ambient
                     if b<=0 then brite=sLenm1
                             else brite=trunc(max((1-b)*sLen1,0))
                     aLine=aLine||substr(shading,brite+1,1)
                     end
                else aLine=aLine' '
   end   /*j*/
 say strip(aLine,'T')
 end     /*i*/

return

/*─────────────────────────────────────"1─liner" subroutines────────────*/ sqrt: procedure expose $.; parse arg x; if x=0 then return 0; d=digits()

     numeric digits 11; g=$sqguess(); do j=0 while p>9; m.j=p;p=p%2+1;end
     do k=j+5 to 0 by -1; if m.k>11 then numeric digits m.k
     g=.5*(g+x/g); end; numeric digits d; return g/1

$sqguess: numeric form scientific; m.=11; p=d+d%4+2

       parse value format(x,2,1,,0) 'E0' with g 'E' _ .;return g*.5'E'_%2

ceil: procedure; parse arg x; _=trunc(x); return _+(x>0)*(x\=_) floor: procedure; parse arg x; _=trunc(x); return _-(x<0)*(x\=_) </lang> Output:

                             eeeeeeeeee@@@@@@@
                       eoooooooooooooooeeeee@@@@@@@░
                   ooººº!!!!!!!!ººººººooooeeeee@@@@@@@░░
                oºº!!!:::::::::!!!!!ºººººooooeeee@@@@@@@░░░
             oº!!::::·········:::::!!!!ºººooooeeeee@@@@@@@░░░░
           oº!:::················::::!!!ººººoooeeeee@@@@@@@░░░░░
         oº!::····················::::!!!ººººoooeeeee@@@@@@@░░░░░░
       oº!::·······················:::!!!!ºººooooeeee@@@@@@@@░░░░░░░
      oº!::·························:::!!!ºººooooeeeee@@@@@@@░░░░░░░░
     oº!:···························:::!!!ººººoooeeeee@@@@@@@@░░░░░░░░
    oº!::··························::::!!!ºººooooeeeee@@@@@@@@░░░░░░░░░
   oº!::···························:::!!!!ºººooooeeeee@@@@@@@@░░░░░░░░░░
  oº!!::··························::::!!!ººººooooeeeee@@@@@@@@░░░░░░░░░░░
 eoº!!::·························::::!!!ººººooooeeeee@@@@@@@@@░░░░░░░░░░░░
 ooº!!::························::::!!!ººººooooeeeeee@@@@@@@@░░░░░░░░░░░░░
eooº!!:::·····················::::!!!!ººººoooooeeeee@@@@@@@@@░░░░░░░░░░░░░░
eooºº!!:::·················:::::!!!!!ººººooooeeeeee@@@@@@@@@░░░░░░░░░░░░░░░
eooºº!!!:::::··········:::::::!!!!!ººººoooooeeeeee@@@@@@@@@@░░░░░░░░░░░░░░░
eeooººº!!!:::::::::::::::::!!!!!!ºººººoooooeeeeee@@@@@@@@@@░░░░░░░░░░░░░░░░
eeoooººº!!!!!!!:::::::!!!!!!!!ººººººoooooeeeeee@@@@@@@@@@@░░░░░░░░░░░░░░░░░
@eeoooººººº!!!!!!!!!!!!!!!ºººººººooooooeeeeeee@@@@@@@@@@@░░░░░░░░░░░░░░░░░░
@@eeeooooºººººººººººººººººººººoooooooeeeeeee@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░
@@@eeeooooooºººººººººººººoooooooooeeeeeeee@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░
 @@@eeeeeooooooooooooooooooooooeeeeeeeee@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░
 @@@@@eeeeeeeooooooooooooeeeeeeeeeeee@@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░░░
  @@@@@@eeeeeeeeeeeeeeeeeeeeeeeee@@@@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░░░░
   @@@@@@@@@eeeeeeeeeeeeeeeee@@@@@@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░░░░░
    ░@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░░░░░░░
     ░░@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
      ░░░░@@@@@@@@@@@@@@@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
       ░░░░░░░@@@@@@@@@@@@@@@@@@░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
         ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
           ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
             ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
                ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
                   ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
                       ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
                             ░░░░░░░░░░░░░░░░░

             ::···:::!!!ºo
         ··············::!!ºoo
      ··················::!!ººooe
    ·····················::!!ººooee
   ·······················::!!ººooee
  ························::!!ººoooee
 ·························::!!ººoooeee
:························::!!!ººoooeeee
························::!!!ººooooeeee
:······················::!!!ºººoooeeeee
:····················:::!!!ºººoooeeeeee
!:·················:::!!!ººººoooeeeeeee
º!:::···········::::!!!!ºººooooeeeeeeee
 º!!!:::::::::::!!!!!ººººoooooeeeeeeee
  oºº!!!!!!!!!!!!!ºººººoooooeeeeeeeee
   ooººººººººººººººooooooeeeeeeeeeee
    eoooooooooooooooooeeeeeeeeeeeee
      eeeooooooooeeeeeeeeeeeeeeee
         eeeeeeeeeeeeeeeeeeeee
             eeeeeeeeeeeee

Ruby

Library: Shoes

Shoes comes with this sample program.

<lang ruby>Shoes.app :width => 500, :height => 500, :resizable => false do

 image 400, 470, :top => 30, :left => 50 do
   nostroke
   fill "#127"
   image :top => 230, :left => 0 do
     oval 70, 130, 260, 40
     blur 30
   end
   oval 10, 10, 380, 380
   image :top => 0, :left => 0 do
     fill "#46D"
     oval 30, 30, 338, 338
     blur 10
   end
   fill gradient(rgb(1.0, 1.0, 1.0, 0.7), rgb(1.0, 1.0, 1.0, 0.0))
   oval 80, 14, 240, 176
   image :top => 0, :left => 0 do
     fill "#79F"
     oval 134, 134, 130, 130
     blur 40
   end
   image :top => 150, :left => 40, :width => 320, :height => 260 do
     fill gradient(rgb(0.7, 0.9, 1.0, 0.0), rgb(0.7, 0.9, 1.0, 0.6))
     oval 60, 60, 200, 136
     blur 20
   end
 end

end</lang>

SVG

Not quite a sphere.

Tcl

Library: Tk

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:

Draw a sphere: Difference between revisions

Revision as of 17:00, 1 May 2012

Ada

BASIC

QBasic

DarkBASIC

BBC BASIC

Brlcad

C

Fun with 3D noise texture

D

Delphi

DWScript

Go

Icon and Unicon

J

Raytracing Solution

Java

Logo

Liberty BASIC

Lua

Mathematica

Openscad

Pascal

Perl 6

PicoLisp

PostScript

POV-Ray

PureBasic

REXX

Ruby

SVG

Tcl