#!/usr/bin/perl

# Perl program to rotate an image
#
#
# Fraga, April 16, 2001
#
# New algorithm
# Fraga, May 22, 2002

$rows = 100;
$cols = 100;

for ( $i=0; $i<$rows; $i++ ) {
	for ( $j=0; $j<$cols; $j++ ) {
		$img[ $cols * $i + $j ] = 0;
	}
}

for ( $i=0; $i<100; $i++ ) {
	for ( $j=0; $j<100; $j++ ) {
		$img[ $cols * $i + $j ] = 255;
	}
	$i+=3;
}

$val = save_pgm_img ( \@img, $rows, $cols, "imagen1.pgm" );

rotate( \@img, $rows, $cols, 30 );
$val = save_pgm_img ( \@imgout, $rows, $cols, "imagen2.pgm" );


sub rotate(\@$$$) {  # ( @img, $rows, $cols, $ang );
	local (*myimg) = shift(@_);
	my $myrow = shift(@_);
	my $mycol = shift(@_);
	my $myang = shift(@_);

	my $cy = $myrow/2.0 - 0.5;  #/**** este es el centro ****/
    my $cx = $mycol/2.0 - 0.5;

    my $xp = -$cx;
    my $yp = -$cy;

	my $T = $myang*3.141515/180;

    my $cos = cos( $T );
    my $sin = sin( $T );

	my $xi = $xp * $cos + $yp * $sin;
	my $yi =-$xp * $sin + $yp * $cos;

    for ($i=0; $i < $myrow; $i++) {
        for ($j=0; $j < $mycol; $j++) {
            $imgout[$i*$mycol + $j] = 0.0;
		}
	}
	for ($i=0; $i < $myrow; $i++) {
        my $xk = $xi;
        my $yk = $yi;

        for ($j=0; $j < $mycol; $j++) {
			my $x = $xk + $cx;
			my $y = $yk + $cy;

			$x = ($x<0) ? $x - 0.499999999 : $x + 0.5;
			$y = ($y<0) ? $y - 0.499999999 : $y + 0.5;

			my $x = int( $x );
			my $y = int( $y );

			$x %= $mycol;
			$y %= $myrow;

            $imgout[$i*$mycol + $j] = $myimg[ $y*$mycol + $x ];

			$xk += $cos;
			$yk -= $sin;
		}
		$xi += $sin;
		$yi += $cos;
	}
}


# Subroutine to save a image in raw PGM format
# (see pgm man pages on NETPBM package)
sub save_pgm_img (\@$$$) {  # ( @img, $rows, $cols, $filename );
	local (*myimg) = shift(@_);
	my $myrows = shift(@_);
	my $mycols = shift(@_);
	my $filename = shift(@_);

	my $n = @myimg;
	printf "$n $mycols $myrows $filename\n";

	open ( MYFILE, ">$filename" ) or return 1;

	select MYFILE;
	$| = 1;
	print MYFILE "P5\n";
	print MYFILE "# file: $filename\n";
	print MYFILE "$mycols $myrows\n";
	print MYFILE "255\n";

	my @data;
	for ( my $i=0; $i<$myrows; $i++ ){
		for ( my $j=0; $j<$mycols; $j++ ){
			$data[$j] = $myimg[ $mycols*$i + $j ];
		}

		my $bytes = pack( "C$mycols", @data );
		syswrite ( MYFILE, $bytes, $n );
	}

	close MYFILE;
	select STDOUT;
	return 0;
}
