package qli; use GD::Image::AnimatedGif; use strict; our $pixel = 5; our $grad = 256; our $normal = 0; our $day = 0; # Allocate a matrix filled with some number. sub mat { my ($size, $fill) = @_; [ map { [ map { $fill } (1..$size) ] } (1..$size) ] } # Allocate a matrix filled by a function. sub fmat { my ($size, $fill) = @_; [ map { [ map { $fill->() } (1..$size) ] } (1..$size) ] } # Duplicate a matrix. sub dup { my ($mat) = @_; my $size = @$mat; [ map { my $x = $_-1; [ map { my $y = $_-1; $$mat[$x][$y]; } (1..$size) ] } (1..$size) ] } # Duplicate a matrix, but mirror its x coordinates. sub dup_flipx { my ($mat) = @_; my $size = @$mat; [ map { my $x = $_-1; [ map { my $y = $_-1; $$mat[$size-$x-1][$y]; } (1..$size) ] } (1..$size) ] } # Duplicate a matrix, but mirror its y coordinates. sub dup_flipy { my ($mat) = @_; my $size = @$mat; [ map { my $x = $_-1; [ map { my $y = $_-1; $$mat[$x][$size-$y-1]; } (1..$size) ] } (1..$size) ] } # Given two matrices, copy the contents of the second into the first at coordinates atx, aty. sub paste { my ($into, $pattern, $atx, $aty) = @_; my $pats = @$pattern; my $ints = @$into; for my $x (0..($pats-1)) { for my $y (0..($pats-1)) { $$into[($x+$atx)%$ints][($y+$aty)%$ints] += $$pattern[$x][$y]; } } return $into; } # Given a matrix, multiply all its elements by a constant. sub mult { my ($mat, $co) = @_; my $size = @$mat; for my $x (0..($size-1)) { for my $y (0..($size-1)) { $$mat[$x][$y] *= $co; } } return $mat; } # Given a matrix, "fill in" its empty areas with a constant. sub bg { my ($mat, $co) = @_; my $size = @$mat; for my $x (0..($size-1)) { for my $y (0..($size-1)) { unless ($$mat[$x][$y]) {$$mat[$x][$y] = $co;} } } return $mat; } my ($s1, $s2) = (0,1); # Round to color sub rtc { int( ($_[0]-$s1)*$s2*($grad-1) ) } # Draw one frame into an opened GDI object. sub frame { my ($frm, $data) = @_; my $size = @$data; my $white = 0; my $black = $grad-1; # For some reason, if I don't duplicate the color allocation here, GD crashes when I try to use more than 4 colors. for(0..($grad-1)) { $_ = $grad-$_-1; $frm->colorAllocate($_*(256/$grad),$_*(256/$grad),$_*(256/$grad));} if ($normal) { my ($low, $high) = (1,0); for my $x (0..($size-1)) { for my $y (0..($size-1)) { $low = $$data[$x][$y] if ($$data[$x][$y] < $low); $high = $$data[$x][$y] if ($$data[$x][$y] > $high); } } $s1 = $low; $s2 = ($high ? 1/($high-$low): 1); } # $frm->filledRectangle(0, 0, $size*$pixel-1, $size*$pixel-1, $red); for my $x (0..($size-1)) { for my $y (0..($size-1)) { $frm->filledRectangle($y*$pixel, $x*$pixel, ($y+1)*$pixel-1, ($x+1)*$pixel-1, rtc($$data[$x][$y])); # $frm->setPixel($y,$x, # $$data[$x][$y] ? $black : $white); } } } # Run an entire game of Life. sub make2 { my ($fh, $frames, $speed, $data) = @_; my $size = scalar(@$data); # setup the image my $image = GD::Image->new($size*$pixel,$size*$pixel); # my $white = $image->colorAllocate(0,0,0); # $image->colorAllocate(1,1,1); # $image->colorAllocate(2,2,2); # my $black = $image->colorAllocate(255,255,255); for(0..($grad-1)) { $_ = $grad-$_-1; $image->colorAllocate($_*(256/$grad),$_*(256/$grad),$_*(256/$grad));} # not strictly needed my $fontcolor = 0; my $font = 0; my $loop = 1; my $x_font = 0; my $y_font = 0; my $nextd = sub { my $ndata = fmat($size, sub {[1, map{0}(1..9)]}); for my $x (0..($size-1)) { for my $y (0..($size-1)) { if($$data[$x][$y]) { # just to optimize. for my $xd (-1, 0, 1) { for my $yd (-1, 0, 1) { if (0 != $xd || 0 != $yd) { my $chance = $$data[$x][$y]; my $unchance = 1-$chance; my $leftover = 0; #print("* $chance: [\n"); for my $prob ( @{$$ndata[($x+$xd)%$size][($y+$yd)%$size]} ) { my $oldprob = $prob; $prob = $oldprob * $unchance + $leftover; $leftover = $oldprob * $chance; #print("$oldprob\t$prob\n"); #$$ndata[($x+$xd)%$size][($y+$yd)%$size]++; } #print("];\n\n"); } } } } } } # for my $x (0..($size-1)) { for my $y (0..($size-1)) { print STDERR $$data[$x][$y] . " "; } print STDERR "\n"; } print STDERR "\n"; # print STDERR "\n"; # for my $x (0..($size-1)) { for my $y (0..($size-1)) { print STDERR $$ndata[$x][$y] . " "; } print STDERR "\n"; } print STDERR "\n"; # print STDERR "-----\n\n"; for my $x (0..($size-1)) { for my $y (0..($size-1)) { $$ndata[$x][$y] = $day ? $$ndata[$x][$y][3] + $$data[$x][$y] * $$ndata[$x][$y][4] + $$ndata[$x][$y][6] +$$ndata[$x][$y][7] +$$ndata[$x][$y][8] : $$ndata[$x][$y][3] + $$data[$x][$y] * $$ndata[$x][$y][2]; # $$ndata[$x][$y] = int( # 3 == $$ndata[$x][$y] # || (4 == $$ndata[$x][$y] && $$data[$x][$y])); } } $data = $ndata; }; my $optional_frame_handler = sub { my $frm = shift; frame($frm, $data); $nextd->(); }; my $x = 0; # unless ($fh) { open($fh, '>mcc.gif'); $x = 1; } print $fh $image->animated_gif($loop,$font,$fontcolor,$speed,$x_font,$y_font,[1..$frames], $optional_frame_handler); if ($x) { close $fh; } } 1;