#!/usr/bin/perl

use strict;
$|++;

use Image::Magick;

use lib './lib';
use ServerApp;  #NOT IN CPAN, see perlmonks.org

my $app = new ServerApp({
    Port => 2690,
});

my $ret = $app->run_with(
    [ '/', sub { return indexPage(); } ],
	
    [ 'font-list', sub {
        my ($req, $info) = @_;
        
        use CGI;
        my $cgi = new CGI($req->content); #POST - this is no good...ServerApp must provide a better facility
        my %vars = %{ $cgi->Vars };
        
        if( exists $vars{'fontDir'} ) {
            print "dir: $vars{'fontDir'}\n";
            if( -e $vars{'fontDir'} ) {
                my $ret = [];
                
                opendir DIR, $vars{'fontDir'};
                foreach( readdir DIR ) {
                    next if /^\.{1,2}/ || !/\.ttf$/i;
                    push @$ret, $_;
                }
                closedir DIR;
                
                @$ret = sort { lc $a cmp lc $b } @$ret;
                return { js => $ret };
            }
        }
        
    } ],

    [ 'render', sub {
        my ($req, $info) = @_;
        
        use CGI;
        my $cgi = new CGI($req->url->query); #POST - this is no good...ServerApp must provide a better facility
        my %vars = %{ $cgi->Vars };
        
        if( exists $vars{'f'} ) {
            if( -e $vars{'f'} ) {
                my $text =  $vars{'t'} || 'AaBbCcDd';
                my $font = $vars{'f'};
                my $size =  $vars{'p'} || '30';
                my $antiAlias =  $vars{'a'};
                my $color = $vars{'c'} || 'black';
                my $baseColor = $vars{'bg'} || 'white';
            
                my $newline_ct = $text =~ tr/\n/\n/;
                

            	my $im = new Image::Magick( 
                    'size'=>'1000x1000',
                    magick => 'gif',
                    #~ debug=>'All',
                );
                my $params = {
                    'font'=>$font,
                    'pointsize'=>$size,
                    'fill'=> $color,
                    'gravity'=>'NorthWest',
                    'text'=>$text,
                    'antialias'=>$antiAlias,
                };
               
                my $r;
                $r = $im->Read( 'xc:'.$baseColor );
                    warn "$r" if "$r";
                my @values = $im->QueryFontMetrics( %$params );
                use Data::Dumper;print Dumper($params);
                my ($charWidth, $charHeight, $ascender, $descender, $width, $height, $max_advance) = @values;
                $height = ($height + 1) * ($newline_ct + 1);
                
                print $width.'x'.$height . "\n";
                
                $r = $im->Resize( width=>$width+30, height=> $height+5);
                    warn "$r" if "$r";
                                    
                $r = $im->Annotate( %$params );
                    warn "$r" if "$r";
    
                my @blobs = $im->ImageToBlob( );
                return $blobs[0];
            }
        }
        
    }, ],

    ['quit', undef, 1],
);

print "Exited with $ret\n";

sub indexPage {
    return join '', ;
}


__END__



    

        
            
            Pick a directory to browse: 
            

                        
        
    
    

        

            
            
            

            
                        
               
            
        
        

            

                

                    
                        
                        Point size:
                    
                    

                        
                    
                
                

                    
                        
                        Antialias? 
                    
                    

                        
                    
                
                

                    
                        
                        Text: