Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Moire Graphics Experiment

by YuckFoo (Abbot)
on Dec 22, 2006 at 20:39 UTC ( [id://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)); } }

Replies are listed 'Best First'.
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
Domain Nodelet?
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?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (7)
As of 2024-04-19 10:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found