Draw a sphere
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.
You are encouraged to solve this task according to the task description, using any language you may know.
Ada
Translation from the C code at http://cairographics.org/samples/gradient Uses the Cairo component of GtkAda to create and save as png
<lang Ada>with Glib; use Glib; with Cairo; use Cairo; with Cairo.Png; use Cairo.Png; with Cairo.Pattern; use Cairo.Pattern; with Cairo.Image_Surface; use Cairo.Image_Surface; with Ada.Numerics;
procedure Sphere is
subtype Dub is Glib.Gdouble;
Surface : Cairo_Surface; Cr : Cairo_Context; Pat : Cairo_Pattern; Status_Out : Cairo_Status; M_Pi : constant Dub := Dub (Ada.Numerics.Pi);
begin
Surface := Create (Cairo_Format_ARGB32, 512, 512); Cr := Create (Surface); Pat := Cairo.Pattern.Create_Radial (230.4, 204.8, 51.1, 204.8, 204.8, 256.0); Cairo.Pattern.Add_Color_Stop_Rgba (Pat, 0.0, 1.0, 1.0, 1.0, 1.0); Cairo.Pattern.Add_Color_Stop_Rgba (Pat, 1.0, 0.0, 0.0, 0.0, 1.0); Cairo.Set_Source (Cr, Pat); Cairo.Arc (Cr, 256.0, 256.0, 153.6, 0.0, 2.0 * M_Pi); Cairo.Fill (Cr); Cairo.Pattern.Destroy (Pat); Status_Out := Write_To_Png (Surface, "SphereAda.png"); pragma Assert (Status_Out = Cairo_Status_Success);
end Sphere;</lang>
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>
BBC BASIC
Using Direct3D. <lang bbcbasic> MODE 8
INSTALL @lib$+"D3DLIB" D3DTS_VIEW = 2 D3DTS_PROJECTION = 3 D3DRS_SPECULARENABLE = 29 SYS "LoadLibrary", @lib$+"D3DX8BBC.DLL" TO d3dx% IF d3dx%=0 ERROR 100, "Couldn't load D3DX8BBC.DLL" SYS "GetProcAddress", d3dx%, "D3DXCreateSphere" TO `D3DXCreateSphere` SYS "GetProcAddress", d3dx%, "D3DXMatrixLookAtLH" TO `D3DXMatrixLookAtLH` SYS "GetProcAddress", d3dx%, "D3DXMatrixPerspectiveFovLH" TO `D3DXMatrixPerspectiveFovLH` DIM eyepos%(2), lookat%(2), up%(2), mat%(3,3) DIM D3Dlight8{Type%, Diffuse{r%,g%,b%,a%}, Specular{r%,g%,b%,a%}, \ \ Ambient{r%,g%,b%,a%}, Position{x%,y%,z%}, Direction{x%,y%,z%}, \ \ Range%, Falloff%, Attenuation0%, Attenuation1%, Attenuation2%, \ \ Theta%, Phi%} DIM D3Dmaterial8{Diffuse{r%,g%,b%,a%}, Ambient{r%,g%,b%,a%}, \ \ Specular{r%,g%,b%,a%}, Emissive{r%,g%,b%,a%}, Power%} DIM D3Dbasemesh8{QueryInterface%, Addref%, Release%, \ \ DrawSubset%, GetNumFaces%, GetNumVertices%, GetFVF%, \ \ GetDeclaration%, GetOptions%, GetDevice%, \ \ CloneMeshFVF%, CloneMesh%, GetVertexBuffer%, GetIndexBuffer%, \ \ LockVertexBuffer%, UnlockVertexBuffer%, LockIndexBuffer%, \ \ UnlockIndexBuffer%, GetAttributeTable%} DIM D3Ddevice8{QueryInterface%, AddRef%, Release%, TestCooperativeLevel%, \ \ GetAvailableTextureMem%, ResourceManagerDiscardBytes%, GetDirect3D%, \ \ GetDeviceCaps%, GetDisplayMode%, GetCreationParameters%, SetCursorProperties%, \ \ SetCursorPosition%, ShowCursor%, CreateAdditionalSwapChain%, Reset%, \ \ Present%, GetBackBuffer%, GetRasterStatus%, SetGammaRamp%, GetGammaRamp%, \ \ CreateTexture%, CreateVolumeTexture%, CreateCubeTexture%, CreateVertexBuffer%, \ \ CreateIndexBuffer%, CreateRenderTarget%, CreateDepthStencilSurface%, \ \ CreateImageSurface%, CopyRects%, UpdateTexture%, GetFrontBuffer%, \ \ SetRenderTarget%, GetRenderTarget%, GetDepthStencilSurface%, BeginScene%, \ \ EndScene%, Clear%, SetTransform%, GetTransform%, MultiplyTransform%, \ \ SetViewport%, GetViewport%, SetMaterial%, GetMaterial%, SetLight%, GetLight%, \ \ LightEnable%, GetLightEnable%, SetClipPlane%, GetClipPlane%, SetRenderState%, \ \ GetRenderState%, BeginStateBlock%, EndStateBlock%, ApplyStateBlock%, \ \ CaptureStateBlock%, DeleteStateBlock%, CreateStateBlock%, SetClipStatus%, \ \ GetClipStatus%, GetTexture%, SetTexture%, GetTextureStageState%, \ \ SetTextureStageState%, ValidateDevice%, GetInfo%, SetPaletteEntries%, \ \ GetPaletteEntries%, SetCurrentTexturePalette%, GetCurrentTexturePalette%, \ \ DrawPrimitive%, DrawIndexedPrimitive%, DrawPrimitiveUP%, \ \ DrawIndexedPrimitiveUP%, ProcessVertices%, CreateVertexShader%, \ \ SetVertexShader%, GetVertexShader%, DeleteVertexShader%, \ \ SetVertexShaderConstant%, GetVertexShaderConstant%, GetVertexShaderDeclaration%, \ \ GetVertexShaderFunction%, SetStreamSource%, GetStreamSource%, SetIndices%, \ \ GetIndices%, CreatePixelShader%, SetPixelShader%, GetPixelShader%, \ \ DeletePixelShader%, SetPixelShaderConstant%, GetPixelShaderConstant%, \ \ GetPixelShaderFunction%, DrawRectPatch%, DrawTriPatch%, DeletePatch%} pDevice%=FN_initd3d(@hwnd%, 1, 1) IF pDevice%=0 ERROR 100, "Couldn't create Direct3D8 device" !(^D3Ddevice8{}+4) = !pDevice% SYS `D3DXCreateSphere`, pDevice%, FN_f4(1), 50, 50, ^meshSphere%, 0 IF meshSphere% = 0 ERROR 100, "D3DXCreateSphere failed" !(^D3Dbasemesh8{}+4) = !meshSphere% REM. Point-source light: D3Dlight8.Type%=1 : REM. point source D3Dlight8.Diffuse.r% = FN_f4(1) D3Dlight8.Diffuse.g% = FN_f4(1) D3Dlight8.Diffuse.b% = FN_f4(1) D3Dlight8.Specular.r% = FN_f4(1) D3Dlight8.Specular.g% = FN_f4(1) D3Dlight8.Specular.b% = FN_f4(1) D3Dlight8.Position.x% = FN_f4(2) D3Dlight8.Position.y% = FN_f4(1) D3Dlight8.Position.z% = FN_f4(4) D3Dlight8.Range% = FN_f4(10) D3Dlight8.Attenuation0% = FN_f4(1) REM. Material: D3Dmaterial8.Diffuse.r% = FN_f4(0.2) D3Dmaterial8.Diffuse.g% = FN_f4(0.6) D3Dmaterial8.Diffuse.b% = FN_f4(1.0) D3Dmaterial8.Specular.r% = FN_f4(0.4) D3Dmaterial8.Specular.g% = FN_f4(0.4) D3Dmaterial8.Specular.b% = FN_f4(0.4) D3Dmaterial8.Power% = FN_f4(100) fovy = RAD(30) aspect = 5/4 znear = 1 zfar = 1000 bkgnd% = &7F7F7F eyepos%() = 0, 0, FN_f4(6) lookat%() = 0, 0, 0 up%() = 0, FN_f4(1), 0 SYS D3Ddevice8.Clear%, pDevice%, 0, 0, 3, bkgnd%, FN_f4(1), 0 SYS D3Ddevice8.BeginScene%, pDevice% SYS D3Ddevice8.SetLight%, pDevice%, 0, D3Dlight8{} SYS D3Ddevice8.LightEnable%, pDevice%, 0, 1 SYS D3Ddevice8.SetMaterial%, pDevice%, D3Dmaterial8{} SYS D3Ddevice8.SetRenderState%, pDevice%, D3DRS_SPECULARENABLE, 1 SYS `D3DXMatrixLookAtLH`, ^mat%(0,0), ^eyepos%(0), ^lookat%(0), ^up%(0) SYS D3Ddevice8.SetTransform%, pDevice%, D3DTS_VIEW, ^mat%(0,0) SYS `D3DXMatrixPerspectiveFovLH`, ^mat%(0,0), FN_f4(fovy), \ \ FN_f4(aspect), FN_f4(znear), FN_f4(zfar) SYS D3Ddevice8.SetTransform%, pDevice%, D3DTS_PROJECTION, ^mat%(0,0) SYS D3Dbasemesh8.DrawSubset%, meshSphere%, 0 SYS D3Ddevice8.EndScene%, pDevice% SYS D3Ddevice8.Present%, pDevice%, 0, 0, 0, 0 SYS D3Ddevice8.Release%, pDevice% SYS D3Dbasemesh8.Release%, meshSphere% SYS "FreeLibrary", d3dx% END
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>
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
- 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
<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
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
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
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
<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.
<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
<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
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
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)
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
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
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:
XPL0
<lang XPL0>include c:\cxpl\codes; \intrinsic 'code' declarations def R=100, R2=R*R; \radius, in pixels; radius squared def X0=640/2, Y0=480/2; \coordinates of center of screen int X, Y, Z, C, D2; \coords, color, distance from center squared [SetVid($112); \set 640x480x24 graphics mode for Y:= -R to +R do \for all the coordinates near the circle
for X:= -R to +R do \ which is under the sphere [D2:= X*X + Y*Y; C:= 0; \default color is black if D2 <= R2 then \coordinate is inside circle under sphere [Z:= sqrt(R2-D2); \height of point on surface of sphere above X,Y C:= Z-(X+Y)/2+130; \color is proportional; offset X and Y, and ]; \ shift color to upper limit of its range Point(X+X0, Y+Y0, C<<8+C); \green + blue = cyan ];
repeat until KeyHit; \wait for keystroke SetVid($03); \restore normal text mode ]</lang>