Death Star

From Rosetta Code
Revision as of 23:31, 28 August 2015 by rosettacode>Gerard Schildberger (→‎{{header|REXX}}: changed extra digits and optimized the sqrt function, added a comment, moved subroutines around, changed some comments.)
Task
Death Star
You are encouraged to solve this task according to the task description, using any language you may know.

Death Star is a task to display a region that consists of a large sphere with part of a smaller sphere removed from it as a result of geometric subtraction. (This will basically produce a shape like a "death star".)

See also: Draw a sphere.

AutoHotkey

Library: GDIP

<lang ahk>#NoEnv SetBatchLines, -1

  1. SingleInstance, Force
Uncomment if Gdip.ahk is not in your standard library
  1. Include, Gdip.ahk
Settings

X := 200, Y := 200, Width := 200, Height := 200 ; Location and size of sphere rotation := 60 ; degrees ARGB := 0xFFFF0000 ; Color=Solid Red

If !pToken := Gdip_Startup() ; Start gdi+ { MsgBox, 48, gdiplus error!, Gdiplus failed to start. Please ensure you have gdiplus on your system ExitApp } OnExit, Exit

Gui, -Caption +E0x80000 +LastFound +AlwaysOnTop +ToolWindow +OwnDialogs ; Create GUI Gui, Show, NA ; Show GUI hwnd1 := WinExist() ; Get a handle to this window we have created in order to update it later hbm := CreateDIBSection(A_ScreenWidth, A_ScreenHeight) ; Create a gdi bitmap drawing area hdc := CreateCompatibleDC() ; Get a device context compatible with the screen obm := SelectObject(hdc, hbm) ; Select the bitmap into the device context pGraphics := Gdip_GraphicsFromHDC(hdc) ; Get a pointer to the graphics of the bitmap, for use with drawing functions Gdip_SetSmoothingMode(pGraphics, 4) ; Set the smoothing mode to antialias = 4 to make shapes appear smother

Gdip_TranslateWorldTransform(pGraphics, X, Y) Gdip_RotateWorldTransform(pGraphics, rotation)

Base ellipse

pBrush := Gdip_CreateLineBrushFromRect(0, 0, Width, Height, ARGB, 0xFF000000) Gdip_FillEllipse(pGraphics, pBrush, 0, 0, Width, Height)

First highlight ellipse

pBrush := Gdip_CreateLineBrushFromRect(Width*0.1, Height*0.01, Width*0.8, Height*0.6, 0x33FFFFFF, 0x00FFFFFF) Gdip_FillEllipse(pGraphics, pBrush, Width*0.1, Height*0.01, Width*0.8, Height*0.6)

Second highlight ellipse

pBrush := Gdip_CreateLineBrushFromRect(Width*0.3, Height*0.02, Width*0.3, Height*0.2, 0xBBFFFFFF, 0x00FFFFFF) Gdip_FillEllipse(pGraphics, pBrush, Width*0.3, Height*0.02, Width*0.3, Height*0.2)


Reset variables for smaller subtracted sphere

X-=150 Y-=10 Width*=0.5 Height*=0.4 rotation-=180

Gdip_TranslateWorldTransform(pGraphics, X, Y) Gdip_RotateWorldTransform(pGraphics, rotation)

Base ellipse

pBrush := Gdip_CreateLineBrushFromRect(0, 0, Width, Height, ARGB, 0xFF000000) Gdip_FillEllipse(pGraphics, pBrush, 0, 0, Width, Height)

First highlight ellipse

pBrush := Gdip_CreateLineBrushFromRect(Width*0.1, Height*0.01, Width*0.8, Height*0.6, 0x33FFFFFF, 0x00FFFFFF) Gdip_FillEllipse(pGraphics, pBrush, Width*0.1, Height*0.01, Width*0.8, Height*0.6)

Second highlight ellipse

pBrush := Gdip_CreateLineBrushFromRect(Width*0.3, Height*0.02, Width*0.3, Height*0.2, 0xBBFFFFFF, 0x00FFFFFF) Gdip_FillEllipse(pGraphics, pBrush, Width*0.3, Height*0.02, Width*0.3, Height*0.2)


UpdateLayeredWindow(hwnd1, hdc, 0, 0, A_ScreenWidth, A_ScreenHeight) SelectObject(hdc, obm) ; Select the object back into the hdc Gdip_DeletePath(Path) Gdip_DeleteBrush(pBrush) DeleteObject(hbm) ; Now the bitmap may be deleted DeleteDC(hdc) ; Also the device context related to the bitmap may be deleted Gdip_DeleteGraphics(G) ; The graphics may now be deleted Return

Exit:

gdi+ may now be shutdown on exiting the program

Gdip_Shutdown(pToken) ExitApp</lang>

Brlcad

<lang brlcad># We need a database to hold the objects opendb deathstar.g y

  1. We will be measuring in kilometers

units km

  1. Create a sphere of radius 60km centred at the origin

in sph1.s sph 0 0 0 60

  1. We will be subtracting an overlapping sphere with a radius of 40km
  2. The resultant hole will be smaller than this, because we only
  3. only catch the edge

in sph2.s sph 0 90 0 40

  1. Create a region named deathstar.r which consists of big minus small sphere

r deathstar.r u sph1.s - sph2.s

  1. We will use a plastic material texture with rgb colour 224,224,224
  2. with specular lighting value of 0.1 and no inheritance

mater deathstar.r "plastic sp=0.1" 224 224 224 0

  1. Clear the wireframe display and draw the deathstar

B deathstar.r

  1. We now trigger the raytracer to see our finished product

rt</lang>

C

Primitive ray tracing. <lang c>#include <stdio.h>

  1. include <math.h>
  2. include <unistd.h>

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

double light[3] = { -50, 0, 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; }

typedef struct { double cx, cy, cz, r; } sphere_t;

/* positive shpere and negative sphere */ sphere_t pos = { 20, 20, 0, 20 }, neg = { 1, 1, -6, 20 };

/* check if a ray (x,y, -inf)->(x, y, inf) hits a sphere; if so, return

  the intersecting z values.  z1 is closer to the eye */

int hit_sphere(sphere_t *sph, double x, double y, double *z1, double *z2) { double zsq; x -= sph->cx; y -= sph->cy; zsq = sph->r * sph->r - (x * x + y * y); if (zsq < 0) return 0; zsq = sqrt(zsq); *z1 = sph->cz - zsq; *z2 = sph->cz + zsq; return 1; }

void draw_sphere(double k, double ambient) { int i, j, intensity, hit_result; double b; double vec[3], x, y, zb1, zb2, zs1, zs2; for (i = floor(pos.cy - pos.r); i <= ceil(pos.cy + pos.r); i++) { y = i + .5; for (j = floor(pos.cx - 2 * pos.r); j <= ceil(pos.cx + 2 * pos.r); j++) { x = (j - pos.cx) / 2. + .5 + pos.cx;

/* ray lands in blank space, draw bg */ if (!hit_sphere(&pos, x, y, &zb1, &zb2)) hit_result = 0;

/* ray hits pos sphere but not neg, draw pos sphere surface */ else if (!hit_sphere(&neg, x, y, &zs1, &zs2)) hit_result = 1;

/* ray hits both, but pos front surface is closer */ else if (zs1 > zb1) hit_result = 1;

/* pos sphere surface is inside neg sphere, show bg */ else if (zs2 > zb2) hit_result = 0;

/* back surface on neg sphere is inside pos sphere, the only place where neg sphere surface will be shown */ else if (zs2 > zb1) hit_result = 2; else hit_result = 1;

switch(hit_result) { case 0: putchar('+'); continue; case 1: vec[0] = x - pos.cx; vec[1] = y - pos.cy; vec[2] = zb1 - pos.cz; break; default: vec[0] = neg.cx - x; vec[1] = neg.cy - y; vec[2] = neg.cz - zs2; }

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]); } putchar('\n'); } }

int main() { double ang = 0;

while (1) { printf("\033[H"); light[1] = cos(ang * 2); light[2] = cos(ang); light[0] = sin(ang); normalize(light); ang += .05;

draw_sphere(2, .3); usleep(100000); } return 0; }</lang>

D

Translation of: C

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

struct V3 {

   double[3] v;
   @property V3 normalize() pure nothrow const @nogc {
       immutable double len = dotProduct(v, v).sqrt;
       return [v[0] / len, v[1] / len, v[2] / len].V3;
   }
   double dot(in ref V3 y) pure nothrow const @nogc {
       immutable double d = dotProduct(v, y.v);
       return d < 0 ? -d : 0;
   }

}


const struct Sphere { double cx, cy, cz, r; }

void drawSphere(in double k, in double ambient, in V3 light) nothrow {

   /** Check if a ray (x,y, -inf).(x, y, inf) hits a sphere; if so,
   return the intersecting z values.  z1 is closer to the eye.*/
   static bool hitSphere(in ref Sphere sph,
                         in double x0, in double y0,
                         out double z1,
                         out double z2) pure nothrow @nogc {
       immutable double x = x0 - sph.cx;
       immutable double y = y0 - sph.cy;
       immutable double zsq = sph.r ^^ 2 - (x ^^ 2 + y ^^ 2);
       if (zsq < 0)
           return false;
       immutable double szsq = zsq.sqrt;
       z1 = sph.cz - szsq;
       z2 = sph.cz + szsq;
       return true;
   }
   immutable shades = ".:!*oe&#%@";
   // Positive and negative spheres.
   immutable pos = Sphere(20, 20, 0, 20);
   immutable neg = Sphere(1, 1, -6, 20);
   foreach (immutable int i; cast(int)floor(pos.cy - pos.r) ..
                             cast(int)ceil(pos.cy + pos.r) + 1) {
       immutable double y = i + 0.5;
   JLOOP:
       foreach (int j; cast(int)floor(pos.cx - 2 * pos.r) ..
                       cast(int)ceil(pos.cx + 2 * pos.r) + 1) {
           immutable double x = (j - pos.cx) / 2.0 + 0.5 + pos.cx;
           enum Hit { background, posSphere, negSphere }
           double zb1, zs2;
           immutable Hit hitResult = {
               double zb2, zs1;
               if (!hitSphere(pos, x, y, zb1, zb2)) {
                   // Ray lands in blank space, draw bg.
                   return Hit.background;
               } else if (!hitSphere(neg, x, y, zs1, zs2)) {
                   // Ray hits pos sphere but not neg one,
                   // draw pos sphere surface.
                   return Hit.posSphere;
               } else if (zs1 > zb1) {
                   // ray hits both, but pos front surface is closer.
                   return Hit.posSphere;
               } else if (zs2 > zb2) {
                   // pos sphere surface is inside neg sphere,
                   // show bg.
                   return Hit.background;
               } else if (zs2 > zb1) {
                   // Back surface on neg sphere is inside pos
                   // sphere, the only place where neg sphere
                   // surface will be shown.
                   return Hit.negSphere;
               } else {
                   return Hit.posSphere;
               }
           }();
           V3 vec_;
           final switch (hitResult) {
               case Hit.background:
                   ' '.putchar;
                   continue JLOOP;
               case Hit.posSphere:
                   vec_ = [x - pos.cx, y - pos.cy, zb1 - pos.cz].V3;
                   break;
               case Hit.negSphere:
                   vec_ = [neg.cx - x, neg.cy - y, neg.cz - zs2].V3;
                   break;
           }
           immutable nvec = vec_.normalize;
           immutable double b = light.dot(nvec) ^^ k + ambient;
           immutable intensity = cast(int)((1 - b) * shades.length);
           immutable normInt = min(shades.length, max(0, intensity));
           shades[normInt].putchar;
       }
       '\n'.putchar;
   }

}


void main() {

   immutable light = [-50, 30, 50].V3.normalize;
   drawSphere(2, 0.5, light);

}</lang>

The output is the same of the C version.

DWScript

Translation of: C

<lang delphi>const cShades = '.:!*oe&#%@';

type TVector = array [0..2] of Float;

var light : TVector = [-50.0, 30, 50];

procedure Normalize(var v : TVector); begin

  var 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 : TVector) : Float; begin

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

end;

type

  TSphere = record
     cx, cy, cz, r : Float;
  end;
  

const big : TSphere = (cx: 20; cy: 20; cz: 0; r: 20); const small : TSphere = (cx: 7; cy: 7; cz: -10; r: 15);

function HitSphere(sph : TSphere; x, y : Float; var z1, z2 : Float) : Boolean; begin

  x -= sph.cx;
  y -= sph.cy;
  var zsq = sph.r * sph.r - (x * x + y * y);
  if (zsq < 0) then Exit False;
  zsq := Sqrt(zsq);
  z1 := sph.cz - zsq;
  z2 := sph.cz + zsq;
  Result:=True;

end;

procedure DrawSphere(k, ambient : Float); var

  i, j, intensity : Integer;
  b : Float;
  x, y, zb1, zb2, zs1, zs2 : Float;
  vec : TVector;

begin

  for i:=Trunc(big.cy-big.r) to Trunc(big.cy+big.r)+1 do begin
     y := i + 0.5;
     for j := Trunc(big.cx-2*big.r) to Trunc(big.cx+2*big.r) do begin
        x := (j-big.cx)/2 + 0.5 + big.cx;

        if not HitSphere(big, x, y, zb1, zb2) then begin
           Print(' ');
           continue;
        end;
        if not HitSphere(small, x, y, zs1, zs2) then begin
           vec[0] := x - big.cx;
           vec[1] := y - big.cy;
           vec[2] := zb1 - big.cz;
        end else begin
           if zs1 < zb1 then begin
              if zs2 > zb2 then begin
                 Print(' ');
                 continue;
              end;
              if zs2 > zb1 then begin
                 vec[0] := small.cx - x;
                 vec[1] := small.cy - y;
                 vec[2] := small.cz - zs2;
              end else begin
                 vec[0] := x - big.cx;
                 vec[1] := y - big.cy;
                 vec[2] := zb1 - big.cz;
              end;
           end else begin
              vec[0] := x - big.cx;
              vec[1] := y - big.cy;
              vec[2] := zb1 - big.cz;
           end;
        end;

        Normalize(vec);
        b := Power(Dot(light, vec), k) + ambient;
        intensity := Round((1 - b) * Length(cShades));
        Print(cShades[ClampInt(intensity+1, 1, Length(cShades))]);
     end;
     PrintLn();
  end;

end;

Normalize(light);

DrawSphere(2, 0.3);</lang>

Go

Output png
Translation of: C

<lang go>package main

import (

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

)

type vector [3]float64

func (v *vector) normalize() {

   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]

}

type sphere struct {

   cx, cy, cz int
   r          int

}

func (s *sphere) hit(x, y int) (z1, z2 float64, hit bool) {

   x -= s.cx
   y -= s.cy
   if zsq := s.r*s.r - (x*x + y*y); zsq >= 0 {
       zsqrt := math.Sqrt(float64(zsq))
       return float64(s.cz) - zsqrt, float64(s.cz) + zsqrt, true
   }
   return 0, 0, false

}

func deathStar(pos, neg *sphere, k, amb float64, dir *vector) *image.Gray {

   w, h := pos.r*4, pos.r*3
   bounds := image.Rect(pos.cx-w/2, pos.cy-h/2, pos.cx+w/2, pos.cy+h/2)
   img := image.NewGray(bounds)
   vec := new(vector)
   for y, yMax := pos.cy-pos.r, pos.cy+pos.r; y <= yMax; y++ {
       for x, xMax := pos.cx-pos.r, pos.cx+pos.r; x <= xMax; x++ {
           zb1, zb2, hit := pos.hit(x, y)
           if !hit {
               continue
           }
           zs1, zs2, hit := neg.hit(x, y)
           if hit {
               if zs1 > zb1 {
                   hit = false
               } else if zs2 > zb2 {
                   continue
               }
           }
           if hit {
               vec[0] = float64(neg.cx - x)
               vec[1] = float64(neg.cy - y)
               vec[2] = float64(neg.cz) - zs2
           } else {
               vec[0] = float64(x - pos.cx)
               vec[1] = float64(y - pos.cy)
               vec[2] = zb1 - float64(pos.cz)
           }
           vec.normalize()
           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{20, -40, -10}
   dir.normalize()
   pos := &sphere{0, 0, 0, 120}
   neg := &sphere{-90, -90, -30, 100}
   img := deathStar(pos, neg, 1.5, .2, dir)
   f, err := os.Create("dstar.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>

J

Translation of: Python

<lang J> load'graphics/viewmat' mag =: +/&.:*:"1 norm=: %"1 0 mag dot =: +/@:*"1

NB. (pos;posr;neg;negr) getvec (x,y) getvec =: 4 :0 "1

 pt =. y
 'pos posr neg negr' =. x
 if. (dot~ pt-}:pos) > *:posr do.
   0 0 0
 else.
   zb =. ({:pos) (-,+)  posr -&.:*: pt mag@:- }:pos
   if. (dot~ pt-}:neg) > *:negr do.
     (pt,{:zb) - pos
   else.
     zs =. ({:neg) (-,+) negr -&.:*: pt mag@:- }:neg
     if. zs >&{. zb do. (pt,{:zb) - pos
     elseif. zs >&{: zb do. 0 0 0
     elseif. ({.zs) < ({:zb) do. neg - (pt,{.zs)
     elseif. do. (pt,{.zb) - pos end.
   end.
 end.

)


NB. (k;ambient;light) draw_sphere (pos;posr;neg;negr) draw_sphere =: 4 :0

 'pos posr neg negr' =. y
 'k ambient light' =. x
 vec=. norm y getvec ,"0// (2{.pos) +/ i: 200 j.~ 0.5+posr
 b=. (mag vec) * ambient + k * 0>. light dot vec

)

togray =: 256#. 255 255 255 <.@*"1 0 (%>./@,)

env=.(2; 0.5; (norm _50 30 50)) sph=. 20 20 0; 20; 1 1 _6; 20 'rgb' viewmat togray env draw_sphere sph</lang>

JavaScript

Layer circles and gradients to achieve result similar to that of the Wikipedia page for the Death Star. <lang JavaScript> <!DOCTYPE html> <html> <body style="margin:0">

 <canvas id="myCanvas" width="250" height="250" style="border:1px solid #d3d3d3;">
   Your browser does not support the HTML5 canvas tag.
 </canvas>
 <script>
   var c = document.getElementById("myCanvas");
   var ctx = c.getContext("2d");
   //Fill the canvas with a dark gray background
   ctx.fillStyle = "#222222";
   ctx.fillRect(0,0,250,250);
   // Create radial gradient for large base circle
   var grd = ctx.createRadialGradient(225,175,190,225,150,130);
   grd.addColorStop(0,"#EEEEEE");
   grd.addColorStop(1,"black");
   //Apply gradient and fill circle
   ctx.fillStyle = grd;
   ctx.beginPath();
   ctx.arc(125,125,105,0,2*Math.PI);
   ctx.fill();
   
   // Create linear gradient for small inner circle
   var grd = ctx.createLinearGradient(75,90,102,90);
   grd.addColorStop(0,"black");
   grd.addColorStop(1,"gray");
   //Apply gradient and fill circle
   ctx.fillStyle = grd;
   ctx.beginPath();
   ctx.arc(90,90,30,0,2*Math.PI);
   ctx.fill();
   
   //Add another small circle on top of the previous one to enhance the "shadow"
   ctx.fillStyle = "black";
   ctx.beginPath();
   ctx.arc(80,90,17,0,2*Math.PI);
   ctx.fill();
 </script> 

</body> </html>

</lang>

LSL

Rez a box on the ground, raise it up a few meters, add the following as a New Script. <lang LSL>default {

   state_entry() {
       llSetPrimitiveParams([PRIM_NAME, "RosettaCode DeathStar"]);
       llSetPrimitiveParams([PRIM_DESC, llGetObjectName()]);
       llSetPrimitiveParams([PRIM_TYPE, PRIM_TYPE_SPHERE, PRIM_HOLE_CIRCLE, <0.0, 1.0, 0.0>, 0.0, <0.0, 0.0, 0.0>, <0.12, 1.0, 0.0>]);
       llSetPrimitiveParams([PRIM_ROTATION, <-0.586217, 0.395411, -0.586217, 0.395411>]);
       llSetPrimitiveParams([PRIM_TEXTURE, ALL_SIDES, TEXTURE_BLANK, ZERO_VECTOR, ZERO_VECTOR, 0.0]);
       llSetPrimitiveParams([PRIM_TEXT, llGetObjectName(), <1.0, 1.0, 1.0>, 1.0]);
       llSetPrimitiveParams([PRIM_COLOR, ALL_SIDES, <0.5, 0.5, 0.5>, 1.0]);
       llSetPrimitiveParams([PRIM_BUMP_SHINY, ALL_SIDES, PRIM_SHINY_HIGH, PRIM_BUMP_NONE]);
       llSetPrimitiveParams([PRIM_SIZE, <10.0, 10.0, 10.0>]);
       llSetPrimitiveParams([PRIM_OMEGA, <0.0, 0.0, 1.0>, 1.0, 1.0]);
   }

}</lang> Output: Death Star

Mathematica

<lang Mathematica>RegionPlot3D[x^2 + y^2 + z^2 < 1 && (x + 1.7)^2 + y^2 + z^2 > 1, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, Boxed -> False, Mesh -> False, Axes -> False, Background -> Black, PlotPoints -> 100]</lang>

Openscad

<lang openscad>// We are performing geometric subtraction

difference() {

 // Create the primary sphere of radius 60 centred at the origin
 translate(v = [0,0,0]) {
   sphere(60);
 }
 /*Subtract an overlapping sphere with a radius of 40
    The resultant hole will be smaller than this, because we only
    only catch the edge
 */
 translate(v = [0,90,0]) {
   sphere(40);
 }

}</lang>

Perl

Writes a PGM to stdout. <lang perl>use strict;

sub sq { my $s = 0; $s += $_ ** 2 for @_; $s; }

sub hit { my ($sph, $x, $y) = @_; $x -= $sph->[0]; $y -= $sph->[1];

my $z = sq($sph->[3]) - sq($x, $y); return if $z < 0;

$z = sqrt $z; return $sph->[2] - $z, $sph->[2] + $z; }

sub normalize { my $v = shift; my $n = sqrt sq(@$v); $_ /= $n for @$v; $v; }

sub dot { my ($x, $y) = @_; my $s = $x->[0] * $y->[0] + $x->[1] * $y->[1] + $x->[2] * $y->[2]; $s > 0 ? $s : 0; }

my $pos = [ 120, 120, 0, 120 ]; my $neg = [ -77, -33, -100, 190 ]; my $light = normalize([ -12, 13, -10 ]); sub draw { my ($k, $amb) = @_; binmode STDOUT, ":raw"; print "P5\n", $pos->[0] * 2 + 3, " ", $pos->[1] * 2 + 3, "\n255\n"; for my $y (($pos->[1] - $pos->[3] - 1) .. ($pos->[1] + $pos->[3] + 1)) { my @row = (); for my $x (($pos->[0] - $pos->[3] - 1) .. ($pos->[0] + $pos->[3] + 1)) { my ($hit, @hs) = 0; my @h = hit($pos, $x, $y);

if (!@h) { $hit = 0 } elsif (!(@hs = hit($neg, $x, $y))) { $hit = 1 } elsif ($hs[0] > $h[0]) { $hit = 1 } elsif ($hs[1] > $h[0]) { $hit = $hs[1] > $h[1] ? 0 : 2 } else { $hit = 1 }

my ($val, $v); if ($hit == 0) { $val = 0 } elsif ($hit == 1) { $v = [ $x - $pos->[0], $y - $pos->[1], $h[0] - $pos->[2] ]; } else { $v = [ $neg->[0] - $x, $neg->[1] - $y, $neg->[2] - $hs[1] ]; } if ($v) { normalize($v); $val = int((dot($v, $light) ** $k + $amb) * 255); $val = ($val > 255) ? 255 : ($val < 0) ? 0 : $val; } push @row, $val; } print pack("C*", @row); } }

draw(2, 0.2);</lang>

Perl 6

Translation of: C

Reimplemented to output a .pgm image.

<lang perl6>class sphere {

  has $.cx; # center x coordinate
  has $.cy; # center y coordinate
  has $.cz; # center z coordinate
  has $.r;  # radius

}

my $depth = 255; # image color depth

my $x = my $y = 255; # dimensions of generated .pgm; must be odd

my $s = ($x - 1)/2; # scaled dimension to build geometry

my @light = normalize([ 4, -1, -3 ]);

  1. positive sphere at origin

my $pos = sphere.new(

   cx => 0,
   cy => 0,
   cz => 0,
   r  => $s.Int

);

  1. negative sphere offset to upper left

my $neg = sphere.new(

   cx => (-$s*.90).Int,
   cy => (-$s*.90).Int,
   cz => (-$s*.3).Int,
   r  => ($s*.7).Int

);

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

   my $out = open( $outfile, :w, :bin ) or die "$!\n";
   $out.say("P5\n$x $y\n$depth"); # .pgm header
   say 'Calculating row:';
   $out.print( draw_ds(3, .15)».chrs );
   $out.close;

}

sub draw_ds ( $k, $ambient ) {

   my @pixels;
   my $bs = "\b" x 8;
   for ($pos.cy - $pos.r) .. ($pos.cy + $pos.r) -> $y {
       note $bs, $y, ' '; # monitor progress
       for ($pos.cx - $pos.r) .. ($pos.cx + $pos.r) -> $x {
           # black if we don't hit positive sphere, ignore negative sphere
           if not hit($pos, $x, $y, my $posz) {
               @pixels.push(0);
               next;
           }
           my @vec;
           # is front of positive sphere inside negative sphere?
           if hit($neg, $x, $y, my $negz) and $negz.min < $posz.min < $negz.max {
               # make black if whole positive sphere eaten here
               if $negz.min < $posz.max < $negz.max { @pixels.push(0); next; }
               # render inside of negative sphere
               @vec = normalize([$neg.cx - $x, $neg.cy - $y, -$negz.max - $neg.cz]);
           }
           else {
               # render outside of positive sphere
               @vec = normalize([$x - $pos.cx, $y - $pos.cy,  $posz.max - $pos.cz]);
           }
           my $intensity = dot(@light, @vec) ** $k + $ambient;
           @pixels.push( ($intensity * $depth).Int min $depth );
       }
   }
   say $bs, 'Writing file.';
   return @pixels;

}

  1. normalize a vector

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

  1. dot product of two vectors

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

  1. are the coordinates within the radius of the sphere?

sub hit ($sphere, $x is copy, $y is copy, $z is rw) {

   $x -= $sphere.cx;
   $y -= $sphere.cy;
   my $z2 = $sphere.r * $sphere.r - $x * $x - $y * $y;
   return 0 if $z2 < 0;
   $z2 = $z2.sqrt;
   $z = $sphere.cz - $z2 .. $sphere.cz + $z2;
   return 1;

}</lang>

POV-Ray

<lang POV-Ray>camera { perspective location <0.0 , .8 ,-3.0> look_at 0

        aperture .1 blur_samples 20 variance 1/100000 focal_point 0}
                           

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

sky_sphere { pigment{ color rgb <0,.2,.5>}}

plane {y,-5 pigment {color rgb .54} normal {hexagon} }

difference {

sphere { 0,1 }
sphere { <-1,1,-1>,1 }
 texture { 
   pigment{ granite } 
   finish { phong 1 reflection {0.10 metallic 0.5} }
 } 

} </lang>

Python

Translation of: C

<lang python>import sys, math, collections

Sphere = collections.namedtuple("Sphere", "cx cy cz r") V3 = collections.namedtuple("V3", "x y z")

def normalize((x, y, z)):

   len = math.sqrt(x**2 + y**2 + z**2)
   return V3(x / len, y / len, z / len)

def dot(v1, v2):

   d = v1.x*v2.x + v1.y*v2.y + v1.z*v2.z
   return -d if d < 0 else 0.0

def hit_sphere(sph, x0, y0):

   x = x0 - sph.cx
   y = y0 - sph.cy
   zsq = sph.r ** 2 - (x ** 2 + y ** 2)
   if zsq < 0:
       return (False, 0, 0)
   szsq = math.sqrt(zsq)
   return (True, sph.cz - szsq, sph.cz + szsq)

def draw_sphere(k, ambient, light):

   shades = ".:!*oe&#%@"
   pos = Sphere(20.0, 20.0, 0.0, 20.0)
   neg = Sphere(1.0, 1.0, -6.0, 20.0)
   for i in xrange(int(math.floor(pos.cy - pos.r)),
                   int(math.ceil(pos.cy + pos.r) + 1)):
       y = i + 0.5
       for j in xrange(int(math.floor(pos.cx - 2 * pos.r)),
                       int(math.ceil(pos.cx + 2 * pos.r) + 1)):
           x = (j - pos.cx) / 2.0 + 0.5 + pos.cx
           (h, zb1, zb2) = hit_sphere(pos, x, y)
           if not h:
               hit_result = 0
           else:
               (h, zs1, zs2) = hit_sphere(neg, x, y)
               if not h:
                   hit_result = 1
               elif zs1 > zb1:
                   hit_result = 1
               elif zs2 > zb2:
                   hit_result = 0
               elif zs2 > zb1:
                   hit_result = 2
               else:
                   hit_result = 1
           if hit_result == 0:
               sys.stdout.write(' ')
               continue
           elif hit_result == 1:
               vec = V3(x - pos.cx, y - pos.cy, zb1 - pos.cz)
           elif hit_result == 2:
               vec = V3(neg.cx-x, neg.cy-y, neg.cz-zs2)
           vec = normalize(vec)
           b = dot(light, vec) ** k + ambient
           intensity = int((1 - b) * len(shades))
           intensity = min(len(shades), max(0, intensity))
           sys.stdout.write(shades[intensity])
       print

light = normalize(V3(-50, 30, 50)) draw_sphere(2, 0.5, light)</lang>


Racket

<lang racket>

  1. lang racket

(require plot) (plot3d (polar3d (λ (φ θ) (real-part (- (sin θ) (sqrt (- (sqr 1/3) (sqr (cos θ)))))))

                #:samples 100 #:line-style 'transparent #:color 9)
       #:altitude 60 #:angle 80
       #:height  500 #:width 400
       #:x-min  -1/2 #:x-max 1/2
       #:y-min  -1/2 #:y-max 1/2
       #:z-min     0 #:z-max 1)

</lang>

REXX

Translation of: D

(Apologies for the comments making the lines so wide, but it was easier to read and compare to the original   D   source.) <lang rexx>/*REXX pgm draws a sphere with another sphere subtracted where superimposed. */ call deathStar 2, .5, v3('-50 30 50') exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────one─liner subroutines────────────────────────────────────────*/ dot.: procedure; parse arg x,y; d=dot(x,y); if d<0 then return -d; return 0 dot: procedure; parse arg x,y; s=0; do j=1 for words(x); s=s+word(x,j)*word(y,j); end; return s ceil: procedure; parse arg x; _=trunc(x); return _+(x>0)*(x\=_) floor: procedure; parse arg x; _=trunc(x); return _-(x<0)*(x\=_) v3: procedure; parse arg a b c; s=sqrt(a**2+b**2+c**2); return a/s b/s c/s /*──────────────────────────────────DEATHSTAR subroutine──────────────────────*/ deathStar: procedure; parse arg k,ambient,sun /* [↓] draw deathstar*/ parse var sun s1 s2 s3 /*identify the lightsource coördinates.*/

if 6=='f6'x then shading= '.:!*oe&#%@' /*shading characters for EBCDIC machine*/

           else shading= '·:!ºoe@░▒▓' /*   "        "       "  ASCII     "   */

shadesLen=length(shading) shades.=' '; do i=1 for shadesLen; shades.i=substr(shading,i,1); end /*i*/

ship= 20 20 0 20 ; parse var ship ship.cx ship.cy ship.cz ship.radius hole=' 1 1 -6 20'; parse var hole hole.cx hole.cy hole.cz hole.radius

 do   i=floor(ship.cy-ship.radius)           to ceil(ship.cy+ship.radius) +1;  y=i+.5;  $=
   do j=trunc(floor(ship.cx-2*ship.radius))  to trunc(ceil(ship.cx+2*ship.radius) +1)
   x=.5*(j-ship.cx)+.5+ship.cx;    !.=0
   ?=hitSphere(ship, x, y);                 b1=!.z1;   b2=!.z2             /*?  is boolean,  "true"  indicates ray hits the sphere.*/
   if \? then !.bg=1                                                       /*ray lands in blank space, so draw the background.     */
         else do; ?=hitSphere(hole, x, y);  s1=!.z1;   s2=!.z2
              if \? then !.pos=1                                           /*ray hits ship but not the hole, so draw ship surface. */
                    else if s1>b1 then !.pos=1                             /*ray hits both, but ship front surface is closer.      */
                                  else if s2>b2 then !.bg=1                /*ship surface is inside hole,  so show the background. */
                                                else if s2>b1 then !.neg=1 /*hole back surface is inside ship; the only place hole surface will be shown.*/
                                                              else !.pos=1
              end
     select
     when !.bg   then do;    $=$' ';     iterate j;   end                  /*append a blank to the line to be displayed.*/
     when !.pos  then vec_=v3(x-ship.cx  y-ship.cy  b1-ship.cz)
     when !.neg  then vec_=v3(hole.cx-x  hole.cy-y  hole.cz-s2)
     end    /*select*/
   b=1+min(shadesLen,max(0,trunc((1-(dot.(sun,v3(vec_))**k+ambient))*shadesLen)))
   $=$ || shades.b                       /*B  is the ray's intensity│brightness*/
   end      /*j*/                        /* [↑]  build line for showing sphere.*/
 if $\=  then say strip($,'T')         /*strip any trailing blanks from line.*/
 end        /*i*/                        /* [↑]  show all lines for the sphere.*/

return /*──────────────────────────────────HITSPHERE subroutine──────────────────────────*/ hitSphere: procedure expose !.; parse arg xx yy zz r,x0,y0; x=x0-xx; y=y0-yy z=r**2-(x**2+y**2); if z<0 then return 0; _=sqrt(z); !.z1=zz-_; !.z2=zz+_; return 1 /*──────────────────────────────────SQRT subroutine───────────────────────────*/ sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9

     numeric digits 9; numeric form; h=d+6;  if x<0  then  do; x=-x; i='i'; end
     parse value format(x,2,1,,0) 'E0'  with  g 'E' _ .;       g=g*.5'e'_%2
        do j=0  while h>9;      m.j=h;              h=h%2+1;         end  /*j*/
        do k=j+5  to 0  by -1;  numeric digits m.k; g=(g+x/g)*.5;    end  /*k*/</lang>

output

                                    eeeee:::::::
                                eeeeeeeee··············
                             ooeeeeeeeeee··················
                           ooooeeeeeeeee······················
                        oooooooeeeeeeee··························
                      ooooooooooeeeee······························
                    ººooooooooooeeee·································
                  ººººooooooooooee·····································
                !ºººººooooooooooe·······································
              !!!ºººººooooooooo:··········································
            :!!!!ºººººooooooo:::···········································
          :::!!!!ºººººooooo!:::::···········································
        ::::!!!!!ºººººooo!!!!::::············································
       ·::::!!!!ºººººooº!!!!!::::············································
     ···::::!!!!ººººººººº!!!!:::::············································
    ···::::!!!!ººººoººººº!!!!!::::············································
  ····::::!!!!ºººoooºººººº!!!!!::::············································
 ····::::!!!!ºoooooooººººº!!!!!:::::···········································
···::::!!!!!ooooooooooººººº!!!!!:::::··········································
:::::!!!!eeoooooooooooºººººº!!!!!:::::·········································
!!!!!eeeeeeeoooooooooooºººººº!!!!!:::::········································
eeeeeeeeeeeeooooooooooooºººººº!!!!!:::::·······································
eeeeeeeeeeeeeooooooooooooºººººº!!!!!!:::::·····································
eeeeeeeeeeeeeeooooooooooooºººººº!!!!!!:::::····································
 eeeeeeeeeeeeeeooooooooooooººººººº!!!!!!:::::·································
 eeeeeeeeeeeeeeeoooooooooooooºººººº!!!!!!::::::······························:
  eeeeeeeeeeeeeeeoooooooooooooººººººº!!!!!!:::::::··························:
  eeeeeeeeeeeeeeeeooooooooooooooººººººº!!!!!!!:::::::·····················::!
   eeeeeeeeeeeeeeeeeoooooooooooooºººººººº!!!!!!!:::::::::··············::::!
    eeeeeeeeeeeeeeeeeooooooooooooooºººººººº!!!!!!!!::::::::::::::::::::::!º
     eeeeeeeeeeeeeeeeeeoooooooooooooooºººººººº!!!!!!!!!!:::::::::::::!!!!º
       eeeeeeeeeeeeeeeeeooooooooooooooooºººººººººº!!!!!!!!!!!!!!!!!!!!!º
        eeeeeeeeeeeeeeeeeeoooooooooooooooooºººººººººººº!!!!!!!!!!!!ºººº
          eeeeeeeeeeeeeeeeeeooooooooooooooooooººººººººººººººººººººººo
            eeeeeeeeeeeeeeeeeeeoooooooooooooooooooooººººººººººººooo
              eeeeeeeeeeeeeeeeeeeeooooooooooooooooooooooooooooooo
                 eeeeeeeeeeeeeeeeeeeeooooooooooooooooooooooooo
                    eeeeeeeeeeeeeeeeeeeeeoooooooooooooooooo
                        eeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
                               eeeeeeeeeeeeeeeee

Tcl

Translation of: C

Note that this code has a significant amount of refactoring relative to the C version, including the addition of specular reflections and the separation of the scene code from the raytracing from the rendering. <lang tcl>package require Tcl 8.5

proc normalize vec {

   upvar 1 $vec v
   lassign $v x y z
   set len [expr {sqrt($x**2 + $y**2 + $z**2)}]
   set v [list [expr {$x/$len}] [expr {$y/$len}] [expr {$z/$len}]]
   return

}

proc dot {a b} {

   lassign $a ax ay az
   lassign $b bx by bz
   return [expr {-($ax*$bx + $ay*$by + $az*$bz)}]

}

  1. Intersection code; assumes that the vector is parallel to the Z-axis

proc hitSphere {sphere x y z1 z2} {

   dict with sphere {

set x [expr {$x - $cx}] set y [expr {$y - $cy}] set zsq [expr {$r**2 - $x**2 - $y**2}] if {$zsq < 0} {return 0} upvar 1 $z1 _1 $z2 _2 set zsq [expr {sqrt($zsq)}] set _1 [expr {$cz - $zsq}] set _2 [expr {$cz + $zsq}] return 1

   }

}

  1. How to do the intersection with our scene

proc intersectDeathStar {x y vecName} {

   global big small
   if {![hitSphere $big $x $y zb1 zb2]} {

# ray lands in blank space return 0

   }
   upvar 1 $vecName vec
   # ray hits big sphere; check if it hit the small one first
   set vec [if {

![hitSphere $small $x $y zs1 zs2] || $zs1 > $zb1 || $zs2 <= $zb1

   } then {

dict with big { list [expr {$x - $cx}] [expr {$y - $cy}] [expr {$zb1 - $cz}] }

   } else {

dict with small { list [expr {$cx - $x}] [expr {$cy - $y}] [expr {$cz - $zs2}] }

   }]
   normalize vec
   return 1

}

  1. Intensity calculators for different lighting components

proc diffuse {k intensity L N} {

   expr {[dot $L $N] ** $k * $intensity}

} proc specular {k intensity L N S} {

   # Calculate reflection vector
   set r [expr {2 * [dot $L $N]}]
   foreach l $L n $N {lappend R [expr {$l-$r*$n}]}
   normalize R
   # Calculate the specular reflection term
   return [expr {[dot $R $S] ** $k * $intensity}]

}

  1. Simple raytracing engine that uses parallel rays

proc raytraceEngine {diffparms specparms ambient intersector shades renderer fx tx sx fy ty sy} {

   global light
   for {set y $fy} {$y <= $ty} {set y [expr {$y + $sy}]} {

set line {} for {set x $fx} {$x <= $tx} {set x [expr {$x + $sx}]} { if {![$intersector $x $y vec]} { # ray lands in blank space set intensity end } else { # ray hits something; we've got the normalized vector set b [expr { [diffuse {*}$diffparms $light $vec] + [specular {*}$specparms $light $vec {0 0 -1}] + $ambient }] set intensity [expr {int((1-$b) * ([llength $shades]-1))}] if {$intensity < 0} { set intensity 0 } elseif {$intensity >= [llength $shades]-1} { set intensity end-1 } } lappend line [lindex $shades $intensity] } {*}$renderer $line

   }

}

  1. The general scene settings

set light {-50 30 50} set big {cx 20 cy 20 cz 0 r 20} set small {cx 7 cy 7 cz -10 r 15} normalize light

  1. Render as text

proc textDeathStar {diff spec lightBrightness ambient} {

   global big
   dict with big {

raytraceEngine [list $diff $lightBrightness] \ [list $spec $lightBrightness] $ambient intersectDeathStar \ [split ".:!*oe&#%@ " {}] {apply {l {puts [join $l ""]}}} \ [expr {$cx+floor(-$r)}] [expr {$cx+ceil($r)+0.5}] 0.5 \ [expr {$cy+floor(-$r)+0.5}] [expr {$cy+ceil($r)+0.5}] 1

   }

} textDeathStar 3 10 0.7 0.3</lang> Output:

                                #######&eeeeeeeee                                 
                         ee&&&&&&########%eeoooooooooooe                          
                     **oooee&&&&&&########%ooooo**********oo                      
                  !!!***oooee&&&&&&########%********!!!!!!!!***                   
               !!!!!!!****ooee&&&&&&#######%*****!!!!!!!!!!!!!!!**                
             ::::!!!!!!***oooee&&&&&&######***!!!!!!!::::::::::::!!*              
           :::::::!!!!!!***ooeee&&&&&&#####**!!!!!!:::::::::::::::::!*            
         ::::::::::!!!!!***oooee&&&&&&####*!!!!!!::::::::.........::::!*          
        ::::::::::!!!!!!***oooeee&&&&&&###!!!!!!:::::::..............:::!         
      ..:::::::::!!!!!!****oooeee&&&&&&##!!!!!!::::::..................::!*       
     ...::::::::!!!!!!****ooooeee&&&&&&!!!!!!:::::::....................::!*      
    ....::::::!!!!!!*****ooooeeee&&&&&!!!!!!:::::::......................::!*     
   ....::::::!!!!!*****oooooeeeee&&&&!!!!!!::::::::.......................::!*    
   ...::::::!!!!!*****oooooeeeee&&&!!!!!!:::::::::.........................::!    
  ...:::::!!!!!*****oooooeeeeee&&!!!!!!!:::::::::..........................::!*   
  ..:::::!!!!!****oooooeeeeee&&&!!!!!!!::::::::::..........................::!!   
 .::::::!!!!*****ooooeeeeee&&*!!!!!!!::::::::::::.........................:::!!*  
 :::::!!!!!****oooooeeeee&&**!!!!!!!::::::::::::::.......................::::!!*  
 !!!!!!!!****oooooeeeee&****!!!!!!!::::::::::::::::::..................::::::!!*  
 #!!!******oooooeeeeeoo*****!!!!!!!:::::::::::::::::::::::::::::::::::::::::!!!*  
 ##oooooooooooeeeeeeoooo****!!!!!!!:::::::::::::::::::::::::::::::::::::::!!!!**  
 %#####eeee&&&&&&&eeeooo****!!!!!!!!:::::::::::::::::::::::::::::::::::!!!!!!**o  
 %#########&&&&&&&&eeeooo****!!!!!!!!!::::::::::::::::::!!!!!!!!!!!!!!!!!!!****o  
 %##########&&&&&&&&eeeooo****!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!****ooe  
  %##########&&&&&&&&eeeooo*****!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!**********ooo   
  %%##########&&&&&&&&eeeoooo*****!!!!!!!!!!!!!!!!!!!*********************ooooe   
   %%##########&&&&&&&&eeeoooo***************************************oooooooee    
   @%###########&&&&&&&&&eeeooooo*************************ooooooooooooooooeee&    
    @%###########&&&&&&&&&eeeeoooooo*************ooooooooooooooooooooooeeeee&     
     @%%##########&&&&&&&&&&eeeeoooooooooooooooooooooooooooooooeeeeeeeeeee&&      
      @%%###########&&&&&&&&&&eeeeeoooooooooooooooooooeeeeeeeeeeeeeeeeee&&&       
        %%############&&&&&&&&&&eeeeeeeeeeooeeeeeeeeeeeeeeeeeeeeeeee&&&&&         
         @%%###########&&&&&&&&&&&&eeeeeeeeeeeeeeeeeeeeeeeeee&&&&&&&&&&&          
           %%############&&&&&&&&&&&&&&eeeeeeeeeeeeeee&&&&&&&&&&&&&&&&            
             %%############&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&              
               %%#############&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&                
                  %%#############&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&                   
                     %##############&&&&&&&&&&&&&&&&&&&&&&&&                      
                         %##############&&&&&&&&&&&&&&&&                          
                                #################                                 

To render it as an image, we just supply different code to map the intensities to displayable values:

Library: Tk
Rendering of the Death Star by the Tcl solution.

<lang tcl># Render as a picture (with many hard-coded settings) package require Tk proc guiDeathStar {photo diff spec lightBrightness ambient} {

   set row 0
   for {set i 255} {$i>=0} {incr i -1} {

lappend shades [format "#%02x%02x%02x" $i $i $i]

   }
   raytraceEngine [list $diff $lightBrightness] \

[list $spec $lightBrightness] $ambient intersectDeathStar \ $shades {apply {l { upvar 2 photo photo row row $photo put [list $l] -to 0 $row incr row update }}} 0 40 0.0625 0 40 0.0625 } pack [label .l -image [image create photo ds]] guiDeathStar ds 3 10 0.7 0.3</lang>