t/t30t1font.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..6\n"; }
  10 END {print "not ok 1\n" unless $loaded;}
  11 use Imager qw(:all);
  12 use Imager::Color;
  13
  14 $loaded = 1;
  15 print "ok 1\n";
  16
  17 #$Imager::DEBUG=1;
  18
  19 init_log("testout/t30t1font.log",1);
  20
  21 if (!(i_has_format("t1")) ) {
  22   for (2..6) {
  23     print "ok $_ # skip t1lib unavailable or disabled\n";
  24   }
  25 } else {
  26
  27   print "# has t1\n";
  28
  29   $fontname_pfb=$ENV{'T1FONTTESTPFB'}||'./fontfiles/dcr10.pfb';
  30   $fontname_afm=$ENV{'T1FONTTESTAFM'}||'./fontfiles/dcr10.afm';
  31
  32   if (! -f $fontname_pfb) {
  33     print "# cannot find fontfile for truetype test $fontname_pfb\n";
  34     skip();
  35   }
  36
  37   if (! -f $fontname_afm) {
  38     print "# cannot find fontfile for truetype test $fontname_afm\n";
  39     skip();
  40   }
  41
  42   i_init_fonts();
  43   i_t1_set_aa(1);
  44
  45   $fnum=Imager::i_t1_new($fontname_pfb,$fontname_afm); # this will load the pfb font
  46   if ($fnum<0) { die "Couldn't load font $fontname_pfb"; }
  47
  48   $bgcolor=Imager::Color->new(255,0,0,0);
  49   $overlay=Imager::ImgRaw::new(200,70,3);
  50
  51   i_t1_cp($overlay,5,50,1,$fnum,50.0,'XMCLH',5,1)
  52     or print "not ";
  53   print "ok 2\n";
  54
  55   i_draw($overlay,0,50,100,50,$bgcolor);
  56
  57   @bbox=i_t1_bbox(0,50.0,'XMCLH',5);
  58   print "bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
  59
  60   open(FH,">testout/t30t1font.ppm") || die "cannot open testout/t35t1font.ppm\n";
  61   binmode(FH); # for os2
  62   $IO = Imager::io_new_fd( fileno(FH) );
  63   i_writeppm_wiol($overlay,$IO);
  64   close(FH);
  65
  66   $bgcolor=Imager::Color::set($bgcolor,200,200,200,0);
  67   $backgr=Imager::ImgRaw::new(280,150,3);
  68
  69   i_t1_set_aa(2);
  70   i_t1_text($backgr,10,100,$bgcolor,$fnum,150.0,'test',4,1)
  71     or print "not ";
  72
  73   print "ok 3\n";
  74
  75   open(FH,">testout/t30t1font2.ppm") || die "cannot open testout/t35t1font.ppm\n";
  76   binmode(FH);
  77   $IO = Imager::io_new_fd( fileno(FH) );
  78   i_writeppm_wiol($backgr, $IO);
  79   close(FH);
  80
  81   $rc=i_t1_destroy($fnum);
  82   if ($fnum <0) { die "i_t1_destroy failed: rc=$rc\n"; }
  83
  84   print "ok 4\n";
  85
  86   print "# debug: ",join(" x ",i_t1_bbox(0,50,"eses",4) ),"\n";
  87   print "# debug: ",join(" x ",i_t1_bbox(0,50,"llll",4) ),"\n";
  88
  89   unlink "t1lib.log"; # lose it if it exists
  90   init(t1log=>0);
  91   print -e("t1lib.log") ? "not ok 5\n" : "ok 5\n";
  92   init(t1log=>1);
  93   print -e("t1lib.log") ? "ok 6\n" : "not ok 6\n";
  94   init(t1log=>0);
  95   unlink "t1lib.log";
  96 }
  97
  98 #malloc_state();