#!perl5

# Spheroid.pl

# This program generates 1/4 of a dome or other shape

# Written by Erik Olson

# You will need to edit this sample code to get what you want:

$s = SpheroidSection::Sample(7);

# Add your desired shapes to the Sample() function or do it here like so:
# $s = new SpheroidSection(1, 4, 4, 10); # makes a 4x4 sphere section

$wantldraw = 1;

if ($wantldraw)
{
	print $s->Ldraw(4);
	# Some colors:
	# 0 black
	# 1 blue
	# 2 green
	# 4 red
	# 7 grey
	# 14 yellow
	# 15 white
	# 378 might be sand green (dithered)
}
else
{
	print $s->TextInstructions();
}

exit; 


package SpheroidSection;

# Make a sample spheroid, your choices are 1 through 6
sub Sample
{
	my ($x) = @_;
	my ($s);

	if      ($x == 1)  {
		$s = new SpheroidSection(1, 8, 8, 20); # Sphere variation 1 
	} elsif ($x == 2) {
		$s = new SpheroidSection(1, 8, 8, 10); # a squashed Sphere
	} elsif ($x == 3) {
		$s = new SpheroidSection(5, 8, 8, 20); # Cone variation 1
	} elsif ($x == 4) {
		$s = new SpheroidSection(5, 8, 8, 10); # low Cone
	} elsif ($x == 5) {
		$s = new SpheroidSection(9, 8, 8, 20); # Tent variation 1
	} elsif ($x == 6) {
		$s = new SpheroidSection(9, 8, 8, 10); # low tent
	} elsif ($x == 7) {
		$s = new SpheroidSection(1, 29, 29, 72); # Jason Mantor R2D2 radius
	} else {
		die "Sample object number $x not known, try 1 through 6\n";
	}
	return $s;
}

# For a good sphere, give height as 2.5 times width
# (Height is measured in plates)

sub new
{
	my ($that, $rule, $xradius, $yradius, $height) = @_;
	my $class = ref($that) || $that;
	my ($self) = {};
	bless $self, $class;

	$self->{rule} = $rule;
	$self->{xradius} = $xradius;
	$self->{yradius} = $yradius;
	$self->{height} = $height;

	$self->Generate();

	return $self;
}

# Calculate all the positions in steps[] that should be occupied by a plate
sub Generate
{
	my ($self) = @_;
	
	my ($grid, $x, $y, $z, $h);
	# steps indexed by z, y, x. 0,0,0 is innermost stud of spheroid section.
	my $steps = $self->{steps} = []; 
		
	for ($z = 0; $z < $self->{height}; $z++)
	{
		$steps->[$z] = [];	# initialize array
		for ($y = 0; $y<$self->{yradius}; $y++)
		{
			$steps->[$z]->[$y] = [];	# initialize array
			for ($x = 0; $x<$self->{xradius}; $x++)
			{
				$steps->[$z]->[$y]->[$x] = 0;	# initialize cell
				
				# determine if point is inside, using stud center
				if ($self->InsideTest($self->{rule}, $x, $y, $z, $radius, $radius, $height))
				{
					$steps->[$z]->[$y]->[$x] = 1;
				}
			}
		}
	}
}

# Printable ASCII instructions
# Subroutine returns a big string
# "O" marks a piece
# "*" marks a piece from previous step for guidance
# "." is no piece 
sub TextInstructions
{
	my ($self) = @_;
	my ($a, $b) = (0,0);
	my ($c);
	my ($text);
	# print step by step picture
	for ($z = 0; $z < $self->{height}; $z++)
	{
		$text .= sprintf( "Step %d\n",$z+1);
		for ($y = 0; $y<$self->{yradius}; $y++)
		{
			for ($x = 0; $x<$self->{xradius}; $x++)
			{
				$a = $self->{steps}->[$z]->[$y]->[$x];
				$b = $self->{steps}->[$z-1]->[$y]->[$x] unless $z==0;
				$c = $a ? "O" : $b ? "*" : ".";
				$text .= $c;
			}
			$text .= "\n";
		}
		$text .= "\n";
	}
	return $text;
}

# LDRAW instruction or model file using 1x1 plates, part 3024
# Subroutine returns a big string
sub Ldraw
{
	my ($self, $color) = @_;
	my ($a, $b) = (0,0);
	my ($c);
	my ($text);
	my ($imatrix) = "1 0 0 0 1 0 0 0 1";
	my ($part) = "3024.DAT";

	for ($z = 0; $z < $self->{height}; $z++)
	{
		$text .= sprintf( "0 STEP %d\n",$z+1);
		for ($y = 0; $y<$self->{yradius}; $y++)
		{
			for ($x = 0; $x<$self->{xradius}; $x++)
			{
				$a = $self->{steps}->[$z]->[$y]->[$x];
				if ($a) 
				{ 
					$text .= sprintf("1 $color %d %d %d $imatrix $part\n", $x*20, -$z*8, $y*20);
				}
			}
		}
	}
	return $text;
}

# Various point-in-sphere rules selected by $rule parameter
# 
# Rule 0 makes a spheroid
# Rule 4 makes a cone
# Rule 8 makes a "tentoid"

# The last few bits of the rule number are the stud inclusion rule
# +1 test center base of plate for inclusion
# +2 test center base of stud (top of plate) for inclusion
# +3 test center top of stud for inclusion
# +0 is the same as +1

sub InsideTest
{
	my ($self, $rule, $x, $y, $z) = @_;
	my ($v);
	# exponent functions:
	sub sq { return $_[0] * $_[0]; }
	sub hy { return $_[0] ^ 0.50; }
	
	my $zrule = ($rule & 0x3);
	my $mainrule = $rule - $zrule;

	my $zadd = [ 0, 0, 1, 1.64 ] -> [$zrule];

	# rule 0: spheroid
	if ($mainrule == 0)
	{
		$v = sq(($x+0.5)/$self->{xradius}) + sq(($y+0.5)/$self->{yradius}) + sq(($z+$zadd)/$self->{height});
		return $v < 1.0;
	}
	# rule 4: cone 
	elsif ($mainrule == 4)
	{
		$v = sq(($x+0.5)/$self->{xradius}) + sq(($y+0.5)/$self->{yradius});
		return $v < sq(1.0 - ($z+$zadd)/$self->{height});
	}
	# rule 8: tent 
	elsif ($mainrule == 8)
	{
		$v = sq(($x+0.5)/$self->{xradius}) + sq(($y+0.5)/$self->{yradius});
		return $v < sq(1.0 - sqrt( ($z+$zadd)/$self->{height}) );
	}
	else { die "InsideTest rule $rule not a known rule"; }
	
}