t/t35ttfont.t

   1 # Before `make install' is performed this script should be runnable with
   2 # `make test'. After `make install' it should work as `perl test.pl'
   3
   4 ######################### We start with some black magic to print on failure.
   5
   6 # Change 1..1 below to 1..last_test_to_print .
   7 # (It may become useful if the test is moved to ./t subdirectory.)
   8
   9 BEGIN { $| = 1; print "1..3\n"; }
  10 END {print "not ok 1\n" unless $loaded;}
  11 use Imager qw(:all);
  12 $loaded = 1;
  13 print "ok 1\n";
  14
  15 init_log("testout/t35ttfont.log",1);
  16
  17 sub skip {
  18   print "ok 2 # skip\n";
  19   print "ok 3 # skip\n";
  20   malloc_state();
  21   exit(0);
  22 }
  23
  24 if (!(i_has_format("tt")) ) { skip(); }
  25 print "# has tt\n";
  26
  27 $fontname=$ENV{'TTFONTTEST'}||'./fontfiles/dodge.ttf';
  28
  29 if (! -f $fontname) {
  30   print "# cannot find fontfile for truetype test $fontname\n";
  31   skip();
  32 }
  33
  34 i_init_fonts();
  35 #     i_tt_set_aa(1);
  36
  37 $bgcolor = i_color_new(255,0,0,0);
  38 $overlay = Imager::ImgRaw::new(200,70,3);
  39
  40 $ttraw = Imager::i_tt_new($fontname);
  41
  42 #use Data::Dumper;
  43 #warn Dumper($ttraw);
  44
  45 @bbox = i_tt_bbox($ttraw,50.0,'XMCLH',5);
  46 print "#bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
  47
  48 i_tt_cp($ttraw,$overlay,5,50,1,50.0,'XMCLH',5,1);
  49 i_draw($overlay,0,50,100,50,$bgcolor);
  50
  51 open(FH,">testout/t35ttfont.ppm") || die "cannot open testout/t35ttfont.ppm\n";
  52 binmode(FH);
  53 $IO = Imager::io_new_fd( fileno(FH) );
  54 i_writeppm_wiol($overlay, $IO);
  55 close(FH);
  56
  57 print "ok 2\n";
  58
  59 $bgcolor=i_color_set($bgcolor,200,200,200,0);
  60 $backgr=Imager::ImgRaw::new(500,300,3);
  61
  62 #     i_tt_set_aa(2);
  63
  64 i_tt_text($ttraw,$backgr,100,100,$bgcolor,50.0,'test',4,1);
  65
  66 my $ugly = Imager::i_tt_new("./fontfiles/ImUgly.ttf");
  67 i_tt_text($ugly, $backgr,100, 50, $bgcolor, 14, 'g%g', 3, 1);
  68 i_tt_text($ugly, $backgr,150, 50, $bgcolor, 14, 'delta', 5, 1);
  69
  70
  71 open(FH,">testout/t35ttfont2.ppm") || die "cannot open testout/t35ttfont.ppm\n";
  72 binmode(FH);
  73 $IO = Imager::io_new_fd( fileno(FH) );
  74 i_writeppm_wiol($backgr, $IO);
  75 close(FH);
  76
  77 print "ok 3\n";
  78