1 2use strict; 3use warnings; 4 5use Test::More; 6use Prima::sys::Test qw(noX11); 7 8sub is_pict 9{ 10 my ( $i, $name, $pict ) = @_; 11 my $ok = 1; 12 ALL: for ( my $y = 0; $y < $i->height; $y++) { 13 for ( my $x = 0; $x < $i->width; $x++) { 14 my $actual = ( $i->pixel($x,$y) > 0) ? 1 : 0; 15 my $expected = (substr($pict, ($i->height-$y-1) * $i->width + $x, 1) eq ' ') ? 0 : 1; 16 next if $actual == $expected; 17 $ok = 0; 18 last ALL; 19 } 20 } 21 ok( $ok, $name ); 22 return 1 if $ok; 23 warn "# Actual vs expected:\n"; 24 for ( my $y = 0; $y < $i->height; $y++) { 25 my $actual = join '', map { ($i->pixel($_,$i->height-$y-1) > 0) ? '*' : ' ' } 0..$i->width-1; 26 my $expected = substr($pict, $y * $i->width, $i->width); 27 warn "$actual | $expected\n"; 28 } 29 return 0; 30} 31 32# check optimizers 33for my $bpp ( 1, 4, 8, 24 ) { 34 my $i = Prima::Image->create( 35 width => 5, 36 height => 5, 37 type => $bpp, 38 color => cl::White, 39 backColor => cl::Black, 40 ); 41 42 $i->clear; 43 $i->line(1,1,3,1); 44 is_pict($i, "$bpp: unclipped hline", 45 " ". 46 " ". 47 " ". 48 " *** ". 49 " " 50 ); 51 52 $i->clear; 53 $i->line(-1,1,3,1); 54 is_pict($i, "$bpp: left clipped hline", 55 " ". 56 " ". 57 " ". 58 "**** ". 59 " " 60 ); 61 62 $i->clear; 63 $i->line(1,1,9,1); 64 is_pict($i, "$bpp: left clipped hline", 65 " ". 66 " ". 67 " ". 68 " ****". 69 " " 70 ); 71 72 $i->clear; 73 $i->line(-1,1,9,1); 74 is_pict($i, "$bpp: clipped hline", 75 " ". 76 " ". 77 " ". 78 "*****". 79 " " 80 ); 81 82 $i->clear; 83 $i->rop(rop::XorPut); 84 $i->rectangle( 1,1,3,3); 85 is_pict($i, "$bpp: rectangle", 86 " ". 87 " *** ". 88 " * * ". 89 " *** ". 90 " " 91 ); 92} 93 94# those are unoptimized 95my $i = Prima::Image->create( 96 width => 5, 97 height => 5, 98 type => im::bpp1, 99 color => cl::White, 100 backColor => cl::Black, 101); 102$i->clear; 103$i->line(1,1,3,3); 104is_pict($i, "line", 105 " ". 106 " * ". 107 " * ". 108 " * ". 109 " " 110); 111 112 113$i->clear; 114$i->linePattern(lp::DotDot); 115$i->rop2(rop::NoOper); 116$i->line(1,1,3,3); 117$i->linePattern(lp::Solid); 118is_pict($i, "line dotted transparent", 119 " ". 120 " * ". 121 " ". 122 " * ". 123 " " 124); 125 126$i->clear; 127$i->linePattern(lp::DotDot); 128$i->rop2(rop::CopyPut); 129$i->line(1,1,3,3); 130$i->linePattern(lp::Solid); 131is_pict($i, "line dotted opaque white", 132 " ". 133 " * ". 134 " ". 135 " * ". 136 " " 137); 138 139$i->clear; 140$i->backColor(cl::White); 141$i->linePattern(lp::DotDot); 142$i->rop2(rop::CopyPut); 143$i->line(1,1,3,3); 144$i->backColor(cl::Black); 145$i->linePattern(lp::Solid); 146is_pict($i, "line dotted opaque black", 147 " ". 148 " * ". 149 " * ". 150 " * ". 151 " " 152); 153 154$i->clear; 155$i->region( Prima::Region->new( box => [2,2,1,1])); 156$i->line(1,1,3,3); 157is_pict($i, "line with simple region", 158 " ". 159 " ". 160 " * ". 161 " ". 162 " " 163); 164$i->region( undef ); 165 166$i->clear; 167$i->region( Prima::Region->new( box => [1,1,1,1, 3,3,1,1])); 168$i->line(1,1,3,3); 169is_pict($i, "line with complex region", 170 " ". 171 " * ". 172 " ". 173 " * ". 174 " " 175); 176$i->region( undef ); 177 178$i->clear; 179$i->region( Prima::Region->new( box => [10,10,10,10])); 180$i->line(1,1,3,3); 181is_pict($i, "line outside region", 182 " ". 183 " ". 184 " ". 185 " ". 186 " " 187); 188$i->region( undef ); 189 190$i->clear; 191$i->region( Prima::Region->new( box => [1,1,1,1, 3,3,1,1])); 192$i->translate(-1,-1); 193$i->line(1,1,3,3); 194is_pict($i, "line with complex region and transform", 195 " ". 196 " ". 197 " ". 198 " * ". 199 " " 200); 201$i->translate(0,0); 202$i->region( undef ); 203 204$i->linePattern(lp::Solid); 205$i->clear; 206$i->ellipse(2,2,5,5); 207is_pict($i, "ellipse", 208 " * ". 209 " * * ". 210 "* *". 211 " * * ". 212 " * " 213); 214 215$i->clear; 216$i->arc(2,2,5,5,0,90); 217is_pict($i, "arc", 218 " * ". 219 " * ". 220 " *". 221 " ". 222 " " 223); 224 225$i->clear; 226$i->chord(2,2,5,5,180,0); 227is_pict($i, "chord", 228 " * ". 229 " * * ". 230 "*****". 231 " ". 232 " " 233); 234 235$i->clear; 236$i->sector(2,2,5,5,0,270); 237is_pict($i, "sector", 238 " * ". 239 " * * ". 240 "* ***". 241 " ** ". 242 " * " 243); 244 245$i->clear; 246$i->lines([1,1,3,1, 1,3,3,3, 1,4,4,4]); 247is_pict($i, "lines", 248 " ****". 249 " *** ". 250 " ". 251 " *** ". 252 " " 253); 254 255$i->clear; 256$i->polyline([1,1,4,1,1,4,4,4]); 257is_pict($i, "polyline", 258 " ****". 259 " * ". 260 " * ". 261 " ****". 262 " " 263); 264 265$i->clear; 266$i->fillMode(fm::Overlay|fm::Winding); 267$i->fill_ellipse(2,2,5,5); 268is_pict($i, "fill_ellipse", 269 " * ". 270 " *** ". 271 "*****". 272 " *** ". 273 " * " 274); 275 276$i->clear; 277$i->fill_sector(2,2,5,5,0,90); 278is_pict($i, "fill_sector", 279 " * ". 280 " ** ". 281 " ***". 282 " ". 283 " " 284); 285 286$i->clear; 287$i->fill_chord(2,2,5,5,0,90); 288is_pict($i, "fill_chord", 289 " * ". 290 " * ". 291 " *". 292 " ". 293 " " 294); 295 296done_testing; 297