Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Reflections on graphic screwing!

by BrowserUk (Patriarch)
on Apr 02, 2017 at 00:52 UTC ( [id://1186698]=CUFP: print w/replies, xml ) Need Help??

A few examples of what the code below can produce (SFW): 1 2 3 4. The embedded text contains the parameters used.

The command line parameters are:

  • -M=nn

    This is the size of the screw threads nominal major diameter. Eg M10 is a 10 mm diameter thread.

  • -P=n.m

    This is the pitch of the thread in mm. Can be fractional as in a M0.6x0.15 (using -M=0.6 -P=0.15)

  • -L=i

    This is the length (number of pitches or turns) of the thread that are drawn.

    The length of the screw in mm is M/P*L rounded up to the nearest whole turn.

  • -S=nnn

    Integer value for the scale (number of pixels per millimeter) used for the drawing.

    Lower numbers (50 or 100) give a pretty good impression of what you will see, fairly quickly. Higher numbers improve the "quality"of the drawing (upto a point). Much beyond 1000 will create huge images for little improvement.

For most realistic "reflections", use relatively large pitch on small diameters. (eg. -M=4 -P=1.5 -S=200 -L=10 (shown above). It is easy to produce weird, unrealistic, confusing results, especially with large diameters and small pitches.

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

#! perl -slw no warnings 'pack'; use strict; use Data::Dump qw[ pp ]; use GD; use constant FNAME => 'CGScrew'; use constant { COS30 => 0.86602540378443864676372317075294, TAN30 => 0.57735026918962576450914878050196, DEG2RAD => 0.017453292519943295769236907684886, RAD2DEG => 57.295779513082320876798154814105, }; use enum qw[ X Y Z A ]; sub rgb2n{ unpack 'N', pack 'CCCC', 0, @_ } ## 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; push @points, [ $x, $y += $yInc, 0, 1 ] while $y < ( $pitch / 16 ) +; ## draw upper 30deg flank. my $xd = $yInc / TAN30; my $yLim = $y + 5 / 16 * $pitch; push @points, [ $x -= $xd, $y += $yInc, 0, 0.5 ] while $y < $yLim; ## draw root radius $yLim = $y + $pitch / 4; ## cx = $dia /2 - 7/8*$H +$H/3 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, $cy - $dy, 0, $dx / $r ]; $y += $yInc; } $y -= $yInc; ## draw lower 30deg flank $yLim = $y + 5 / 16 * $pitch; push @points, [ $x += $xd, $y += $yInc, 0, - 0.5 ] while $y < $yL +im; push @points, [ $x, $y += $yInc, 0, 1 ] while $y < $pitch; return \@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 $profile = constructThreadProfile( $M, $P, 1 / ( 10* $S ) ); #pp $profile; my( $w, $h ) = ( $M * $S + 200, int( $L / $P + 1 ) * $P * $S + 200 ); my $xc = $w / 2; my $im = GD::Image->new( $w, $h, 1 ); $im->fill( 0,0, rgb2n( 128, 128, 128 ) ); sub xformPoint { my( $point, $rot, $yTrans ) = @_; $rot *= DEG2RAD; my $x = $point->[X] * cos( $rot ); my $y = $point->[Y] + $yTrans; my $z = $point->[X] * sin( $rot ); my $a = $point->[A] * cos( 90 * DEG2RAD - $rot ); return [ $x, $y, $z, $a ]; } my $yTrans = $P / 360; my $maxRad = $M * $S / 2; my $yOff = 100; for my $turn ( 1 .. $L / $P ) { for my $p ( map $_/2, -$maxRad*2 .. $maxRad*2 ) { my $rot = RAD2DEG * atan2( sqrt( $maxRad**2 - $p**2 ), $p ); for my $point ( @$profile ) { my $newPoint = xformPoint( $point, $rot, $yTrans * $rot ); my( $newX, $newY ) = ( $xc + $newPoint->[X] * $S, $yOff + +$newPoint->[Y] * $S ); my $color = ( abs( $newPoint->[A] ) * 256 + (100 - $newY) +); $im->setPixel( $newX, $newY, rgb2n( ( $color ) x 3 ) ); } } $yOff += $P * $S; } $im->string( gdSmallFont, 0,0, $fname, 0 ); open O, '>:raw', $fname or die $!; print O $im->png; close O; system $fname;

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.

Replies are listed 'Best First'.
Re: Reflections on graphic screwing!
by zentara (Archbishop) on Apr 02, 2017 at 13:00 UTC
    Hi, nice code, but it seems geared toward a Window's machine. In the interests of newbies, and linux users, the last lines
    open O, '>:raw', $fname or die $!; print O $im->png; close O; system $fname;
    can be changed to the following
    open(GD, ">$0.png") or die; binmode GD; print GD $im->png; close GD;
    That will print it to a conveniently named file instead of trying to display it.
    0m, zentara

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

      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.
Re: Reflections on graphic screwing!
by shmem (Chancellor) on Apr 02, 2017 at 16:46 UTC
    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) +);

    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 );
    perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'
      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;

      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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://1186698]
Approved by kcott
Front-paged by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (7)
As of 2024-04-24 21:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found