How to resolve the algorithm Death Star step by step in the Delphi programming language

Published on 12 May 2024 09:40 PM

How to resolve the algorithm Death Star step by step in the Delphi programming language

Table of Contents

Problem Statement

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".)

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Death Star step by step in the Delphi programming language

Source code in the delphi programming language

program Death_Star;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils,
  system.Math,
  Vcl.Graphics,
  Vcl.Imaging.pngimage;

type
  TVector = array of double;

var
  light: TVector = [20, -40, -10];

function ClampInt(value, amin, amax: Integer): Integer;
begin
  Result := Max(amin, Min(amax, value))
end;

procedure Normalize(var v: TVector);
begin
  var 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: TVector): Double;
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: Double;
  end;

const
  pos: TSphere = (
    cx: 0;
    cy: 0;
    cz: 0;
    r: 120
  );

const
  neg: TSphere = (
    cx: -90;
    cy: -90;
    cz: -30;
    r: 80
  );

function HitSphere(sph: TSphere; x, y: double; var z1, z2: Double): Boolean;
begin
  x := x - sph.cx;
  y := 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;

function DeathStar(pos, neg: TSphere; k, amb: Double; light: TVector): TBitmap;
var
  w, h, yMax, xMax, s: double;
  zp1, zp2, zn1, zn2, b: Double;
  x, y: Integer;
  hit: Boolean;
  vec: TVector;
  intensity: Byte;
  ox, oy: Integer;
begin
  w := pos.r * 4;
  h := pos.r * 3;
  ox := -trunc(pos.cx - w / 2);
  oy := -trunc(pos.cy - h / 2);

  vec := [0, 0, 0];
  Result := TBitmap.Create;
  Result.SetSize(trunc(w), trunc(h));

  yMax := pos.cy + pos.r;
  for y := Trunc(pos.cy - pos.r) to Trunc(yMax) do
  begin
    xMax := pos.cx + pos.r;
    for x := trunc(pos.cy - pos.r) to trunc(xMax) do
    begin
      hit := HitSphere(pos, x, y, zp1, zp2);
      if not hit then
        continue;

      hit := HitSphere(neg, x, y, zn1, zn2);

      if hit then
      begin
        if zn1 > zp1 then
          hit := false
        else if zn2 > zp2 then
          continue;
      end;

      if hit then
      begin
        vec[0] := neg.cx - x;
        vec[1] := neg.cy - y;
        vec[2] := neg.cz - zn2;
      end
      else
      begin
        vec[0] := x - pos.cx;
        vec[1] := y - pos.cy;
        vec[2] := zp1 - pos.cz;
      end;

      Normalize(vec);

      s := max(0, dot(light, vec));

      b := Power(s, k) + amb;

      intensity := ClampInt(round(255 * b / (1 + amb)), 0, 254);

      Result.Canvas.Pixels[x + ox, y + oy] := rgb(intensity, intensity, intensity);
    end;
  end;
end;

var
  bmp: TBitmap;

begin
  Normalize(light);
  bmp := DeathStar(pos, neg, 1.2, 0.3, light);

  with TPngImage.Create do
  begin
    Assign(bmp);
    TransparentColor := clwhite;
    SaveToFile('out.png');
    bmp.Free;
    Free;
  end;
end.


  

You may also check:How to resolve the algorithm Boustrophedon transform step by step in the J programming language
You may also check:How to resolve the algorithm Wireworld step by step in the Lua programming language
You may also check:How to resolve the algorithm Regular expressions step by step in the Standard ML programming language
You may also check:How to resolve the algorithm FizzBuzz step by step in the GAP programming language
You may also check:How to resolve the algorithm Hello world/Text step by step in the MIPS Assembly programming language