Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Moire Graphics Experiment

by YuckFoo (Abbot)
on Dec 22, 2006 at 20:39 UTC ( #591387=CUFP: print w/ replies, xml ) Need Help??

I found this old toy while cleaning out the closet and thought some might find it interesting. It is an experiment to see what kinds of images can be made from Moire-like patterns. Output is a png image, so redirect to a file, or uncomment the Content-Type header line and run as a CGI program.

YuckFoo

#!/usr/bin/perl use strict; use GD; use POSIX; #--------------------------------------- # conf my $conf = { image => { x_size => 320, y_size => 320, }, palette => { num_colors => int(rand(56) + 8), set_points => [ [0, 0, 0], [int(rand(255)), int(rand(255)), int(rand(255))], [0, 0, 0], [255, 255, 255], [0, 0, 0], [int(rand(255)), int(rand(255)), int(rand(255))], ], repeat => rand(1.5) + .5, }, moire => { num_lines => int(rand(7)) + 2, repeat_min => 4, repeat_max => 8, wrap_prob => rand(), turn_prob => rand(), plot => int(rand(2)), }, }; #--------------------------------------- # init my $palette = setup_palette($conf->{palette}); my $moire = setup_moire($conf->{moire}); my $image = new GD::Image($conf->{image}{x_size}, $conf->{image}{y +_size}); for my $col (@$palette) { $image->colorAllocate($col->[0], $col->[1], $col->[2]); } #--------------------------------------- # go make_image($conf, $moire, $image); #print "Content-Type: image/png \n\n"; print $image->png(); #----------------------------------------------------------- sub make_image { my $conf = shift; my $moire = shift; my $image = shift; my $x_pix = 1 / $conf->{image}{x_size}; my $y_pix = 1 / $conf->{image}{y_size}; my $max; for my $line (@$moire) { if ($line->{wrap}) { $max += 1; } else { $max += .5; } } for my $xi (0..$conf->{image}{x_size}-1) { my $x = $xi * $x_pix; for my $yi (0..$conf->{image}{y_size}-1) { my $y = $yi * $y_pix; my $tot; for my $line (@$moire) { my $val = $x + $y * $line->{grad}; $val = $val * $line->{mult}; $val = $val - floor($val); if ($line->{wrap}) { if ($val > .5) { $val = 1 - $val; } } if ($line->{turn}) { $val = 1 - $val; } $tot += $val; } $tot = $conf->{moire}{plot} ? ($tot / $max) * $conf->{palette}{repeat} : $tot / @$moire; my $ci = $tot * $conf->{palette}{num_colors}; $image->setPixel($xi, $yi, $ci % $conf->{palette}{num_colors}); } } } #----------------------------------------------------------- sub setup_moire { my $conf = shift; my @lines; for (1..$conf->{num_lines}) { my $line = {}; push (@lines, $line); $line->{mult} = rand($conf->{repeat_max} - $conf->{repeat_min}); $line->{mult} = int($line->{mult} + $conf->{repeat_min}); $line->{wrap} = (rand() < $conf->{wrap_prob}) ? 1 : 0; $line->{turn} = (rand() < $conf->{turn_prob}) ? 1 : 0; $line->{grad} = rand(2); if ($line->{grad} > 1) { $line->{grad} = 1 / ($line->{grad} - 1); } if (int(rand(2))) { $line->{grad} *= -1; } } return \@lines; } #----------------------------------------------------------- sub setup_palette { my $conf = shift; my @palette_colors; my @palette_indexs; push @{$conf->{set_points}}, $conf->{set_points}[0]; my $rate = $conf->{num_colors} / $#{$conf->{set_points}}; for my $i (0 .. $#{$conf->{set_points}}) { my $j = int($i * $rate); push @palette_indexs, $j; $palette_colors[$j] = $conf->{set_points}[$i]; } for my $i (0 .. $#palette_indexs - 1) { my $beg = $palette_indexs[$i]; my $end = $palette_indexs[$i+1]; interpolate(\@palette_colors, $beg, $end); } pop @palette_colors; return \@palette_colors; } #----------------------------------------------------------- sub interpolate { my $colors = shift; my $beg = shift; my $end = shift; my $steps = $end - $beg; my $r_start = $colors->[$beg][0]; my $r_range = $colors->[$end][0] - $colors->[$beg][0]; my $r_slope = $r_range / $steps; my $g_start = $colors->[$beg][1]; my $g_range = $colors->[$end][1] - $colors->[$beg][1]; my $g_slope = $g_range / $steps; my $b_start = $colors->[$beg][2]; my $b_range = $colors->[$end][2] - $colors->[$beg][2]; my $b_slope = $b_range / $steps; for my $i (1..$steps-1) { my $j = $i + $beg; $colors->[$j][0] = int($r_start + ($i * $r_slope)); $colors->[$j][1] = int($g_start + ($i * $g_slope)); $colors->[$j][2] = int($b_start + ($i * $b_slope)); } }

Comment on Moire Graphics Experiment
Download Code
Re: Moire Graphics Experiment
by jettero (Monsignor) on Dec 22, 2006 at 21:46 UTC
    I like this a lot. I wish it printed a png header:
    use CGI; print CGI->new->header("image/png");

    UPDATE: actually, it looks like it does already but it's commented out... Just you nevermind me and my rashness, posting before I read the source... Although, if you did use CGI, you could also read x_size, y_size, num_lines, wrap_prob, turn_prob, etc from the param()s. That would be neat too.

    -Paul

Re: Moire Graphics Experiment
by alpha (Scribe) on Dec 27, 2006 at 14:51 UTC
    This is very nice :)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://591387]
Approved by Paladin
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (9)
As of 2014-07-11 05:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (219 votes), past polls