open O, '>:raw',  $fname or die $!;
print O $im->png;
close O;
system $fname;
[download]

open(GD, ">$0.png") or die;
binmode GD;
print GD $im->png;
close GD;
[download]

My version also prints to a file (named with the input parameters for reference; but perhaps not so convenient), and then displays it.

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority". The enemy of (IT) success is complexity.

In the absence of evidence, opinion is indistinguishable from prejudice.

There is a question: What is being reflected in the chrome screws?

From a quick overview of the code, it doesn't look like a reflection, but the result of your shading algorithm as it progresses along the y axis:

            my $color = ( abs( $newPoint->[A] ) * 256 + (100 - $newY) 
+);
[download]

Which seems odd, since the coloring of each point of a turn should be equal for all turns. Or am I missing something?

Try -M=4 -P=1.5 -S=200 -L=10 substituting above line with:

            my $color = ( abs( $newPoint->[A] ) * 256 );
[download]

From a quick overview of the code, it doesn't look like a reflection, but the result of your shading algorithm as it progresses along the y axis:

Spot on! Just a pleasing result of a happy accident. I tried something (that couldn't actually work), but the result was the rather pleasing chromium affect complete with semi-random "reflections".

Which seems odd, since the coloring of each point of a turn should be equal for all turns. Or am I missing something?

Because the height of the turns is not mod 256, but the colors are, the interaction between the two produces the variability in the "reflections".

substituting above line with: my $color = ( abs( $newPoint->[A] ) * 256 );

Spot on again. In my current version of the code, that original line is now coded as these two:

            my $color = abs( $newPoint->[A] ) * 256;
            $R and $color =  ( $color + 100 - $newY ) % 256;
[download]

Given /R to turn the "reflections" on or off. I've also added a 'gold plated' option, but that's not particularly successful yet. It is quite difficult to come up with 256 rgb values that form a pleasing spectral continuum from dark to light. The best I've come up with so far is this.

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority". The enemy of (IT) success is complexity.

In the absence of evidence, opinion is indistinguishable from prejudice.

#! perl -sw
use strict;
use PDL;
use PDL::Constants qw(PI DEGRAD);
use PDL::IO::GD;
use constant FNAME => 'CGScrewPDL';
use constant {
    COS30   => 0.86602540378443864676372317075294,
    TAN30   => 0.57735026918962576450914878050196,
};
use enum qw[ X Y A ];

## Construct thread profile segment
sub constructThreadProfile {
    my @points;
    my( $dia, $pitch, $yInc ) = @_;
    my $H =  $pitch * COS30;
    # draw flat crest
    my $x = $dia / 2;
    my $y = -$yInc;
    my $yLim = $pitch / 16;
    push @points, [ $x, $y += $yInc, 1 ] while $y < $yLim;

    ## draw upper 30deg flank.
    my $xd = $yInc / TAN30;
    $yLim = $y + 5 / 16 * $pitch;
    push @points, [ $x -= $xd, $y += $yInc, 0.5 ] while $y < $yLim;

    ## draw root radius
    $yLim = $y + 4 / 16 * $pitch;
    my( $cx, $cy, $r ) = ( ( $dia/2 - 7/8*$H + $H/3 ), $pitch / 2, $H 
+/ 6 );
    while( $y < $yLim ) {
        my $dy = $cy - $y;
        my $dx = sqrt( $r**2 - $dy**2 );
        push @points, [ $cx - $dx, $y, $dx / $r ];
        $y += $yInc;
    }
    $y -= $yInc;
    ## draw lower 30deg flank
    $yLim = $y + 5 / 16 * $pitch;
    push @points, [ $x += $xd, $y +=  $yInc, - 0.5 ] while $y < $yLim;

    $yLim = $pitch;
    push @points, [ $x, $y += $yInc, 1 ] while $y < $yLim;
    return pdl \@points;
}

our $M //= 10;
our $P //= 1.5;
our $L //= 2;
our $S //= 100;
my $fname = sprintf "%sM%.2fxP%.2fxL%.2fxS%d.png", FNAME, $M, $P, $L, 
+$S;

my $profilePDL = constructThreadProfile( $M, $P, 1 / ( 10* $S ) );

my( $w, $h ) = ( $M * $S + 200, int( $L / $P + 1 ) * $P * $S + 200 );
my $xc = $w / 2;

my $imPDL = zeroes(byte, $w, $h) + 128; # no RGB as all same, dummy at
+ end

my $yTrans = $P / 360;
my $maxRad = $M * $S / 2;
my $yOff = 100;
my $turns = sequence(indx, $L / $P);
for my $turn ( $turns->list ) {
    for my $p ( map $_/2, -$maxRad*2 .. $maxRad*2 ) {
        my $rot = atan2( sqrt( $maxRad**2 - $p**2 ), $p );
        my $this_profile = $profilePDL + [0, $yTrans * DEGRAD * $rot, 
+0];
        $this_profile *= [cos($rot), 1, cos( PI/2 - $rot)];
        my ($newX, $newY) = ($xc + $this_profile->slice([X,0,0]) * $S,
+ $yOff + $this_profile->slice([Y,0,0]) * $S);
        my $color = $this_profile->slice([A,0,0])->abs * 256 + (100 - 
+$newY);
        $imPDL->indexND( $newX->cat($newY)->mv(-1,0) ) .= $color;
    }
    $yOff += $P * $S;
}

my $im = PDL::IO::GD->new({pdl=> $imPDL->dummy(2,3)});
$im->String( gdFontGetSmall, 0,0, $fname, 0 );
$im->write_Png($fname);
[download]

Here is a PDL version I like more:

#! perl -sw
use strict;
use PDL;
use PDL::Constants qw(PI DEGRAD);
use PDL::IO::GD;
use constant FNAME => 'CGScrewPDL';
use constant {
    COS30   => 0.86602540378443864676372317075294,
    TAN30   => 0.57735026918962576450914878050196,
};
use enum qw[ X Y A ];
$|=1;

## Construct thread profile segment
sub constructThreadProfile {
    my ($dia, $pitch, $yInc) = @_;
    my $H =  $pitch * COS30;
    # draw flat crest
    my $x = $dia / 2;
    my @yLim = (0, $pitch / 16);
    my $yQuant = ($yLim[-1]-$yLim[-2]) / $yInc;
    my $ySeq = zeroes($yQuant)->xlinvals(0, $yLim[-1]);
    my $topcrest = cat(pdl($x), $ySeq, pdl(1))->mv(-1,0);

    ## draw upper 30deg flank.
    my $xd = $yInc / TAN30;
    push @yLim, $yLim[-1] + 5 / 16 * $pitch;
    $yQuant = ($yLim[-1]-$yLim[-2]) / $yInc;
    my $xSeq = zeroes($yQuant)->xlinvals($x, $x - $xd*$yQuant);
    $ySeq = zeroes($yQuant)->xlinvals($yLim[-2], $yLim[-1]);
    my $topflank = cat($xSeq, $ySeq, pdl(0.5))->mv(-1,0);

    ## draw root radius
    push @yLim, $yLim[-1] + 4 / 16 * $pitch;
    my ($cx, $cy, $r) = ( ( $dia/2 - 7/8*$H + $H/3 ), $pitch / 2, $H /
+ 6 );
    $yQuant = ($yLim[-1]-$yLim[-2]) / $yInc;
    $ySeq = zeroes($yQuant)->xlinvals($yLim[-2], $yLim[-1]);
    my $dy = $cy - $ySeq;
    my $dx = sqrt( $r**2 - $dy**2 );
    my $rootradius = cat($xSeq = $cx - $dx, $ySeq, $dx / $r)->mv(-1,0)
+;
    $x = $xSeq->at(-1);

    ## draw lower 30deg flank
    push @yLim, $yLim[-1] + 5 / 16 * $pitch;
    $yQuant = ($yLim[-1]-$yLim[-2]) / $yInc;
    $xSeq = zeroes($yQuant)->xlinvals($x, $x + $xd*$yQuant);
    $ySeq = zeroes($yQuant)->xlinvals($yLim[-2], $yLim[-1]);
    my $botflank = cat($xSeq, $ySeq, pdl(-0.5))->mv(-1,0);
    $x = $xSeq->at(-1);

    ## the bottom crest
    push @yLim, $pitch;
    $yQuant = ($yLim[-1]-$yLim[-2]) / $yInc;
    $ySeq = zeroes($yQuant)->xlinvals($yLim[-2], $yLim[-1]);
    my $botcrest = cat(pdl($x), $ySeq, pdl(1))->mv(-1,0);
    $topcrest->glue(1, $topflank, $rootradius, $botflank, $botcrest);
}

our $M //= 10;
our $P //= 1.5;
our $L //= 2;
our $S //= 100;
my $profilePDL = constructThreadProfile( $M, $P, 1 / ( 10* $S ) );
my ($w, $h) = ( $M * $S + 200, int( $L / $P + 1 ) * $P * $S + 200 );
my $imPDL = zeroes(byte, $w, $h) + 128; # no RGB as all same, dummy at
+ end

my $xc = $w / 2;
my $yTrans = $P / 360;
my $maxRad = $M * $S / 2;
my $yOffs = 100 + sequence($L / $P) * $P * $S;
for my $yOff ( $yOffs->list ) {
print "*";
    my $p = zeroes(4*$maxRad+1)->xlinvals(-$maxRad, $maxRad); # 4mR
    my $rot = atan2(sqrt($maxRad**2 - $p**2), $p)->dummy(0);  # 1 4mR
    my $this_profile = $profilePDL                            # 3 pE
      + cat(pdl(0), $yTrans*DEGRAD*$rot, pdl(0))->mv(-1,0)    # 3 1  4
+mR
      ;                                                       # 3 pE 4
+mR
    $this_profile *= cat(cos($rot), pdl(1), cos( PI/2 - $rot))->mv(-1,
+0);
    my $newX = $xc + $this_profile->slice([X,0,0]) * $S;
    my $newY = $yOff + $this_profile->slice([Y,0,0]) * $S;
    my $color = $this_profile->slice([A,0,0])->abs * 256 + (100 - $new
+Y);
    $imPDL->indexND( $newX->cat($newY)->mv(-1,0) ) .= $color;
}
print "\n";

my $fname = sprintf "%sM%.2fxP%.2fxL%.2fxS%d.png", FNAME, $M, $P, $L, 
+$S;
my $im = PDL::IO::GD->new({pdl=> $imPDL->dummy(2,3)});
$im->String( gdFontGetSmall, 0,0, $fname, 0 );
$im->write_Png($fname);
[download]

For the bigger screws it runs about the same speed on my machine, but the CPU is thrashing away at over 100%, as even with the smaller one, with 1500 profile rows and 2000 maxRad entries, that means >1e6 elements, and that's when PDL's auto-pthreading kicks in. That almost certainly means that on a less puny machine it will run rather quickly.

I didn't broadcast over the yOffs, even though that's obviously possible, because it's already quite bulky in memory. Comments very welcome!

The two main lessons I got from this were:

• using pdl instead of cat is a mistake for putting bigger data together, because even though cat insists on all ndarrays as input, it will broadcast even little ones rather than just silently filling in missing stuff with $PDL::undefval (often 0)
• the technique of commenting the dimensions of initially-incompatible ndarrays makes it very very easy to figure out where to put dummy dimensions or move them, which is otherwise very difficult