/t/gfx_primitives.t
Perl | 422 lines | 380 code | 24 blank | 18 comment | 21 complexity | 4b7fd4fc4436ce00ac8f9221366850f8 MD5 | raw file
1#!perl 2use strict; 3use warnings; 4use SDL; 5use SDL::Rect; 6use SDL::Config; 7use SDL::Video; 8use SDL::Version; 9use SDL::Surface; 10use SDL::PixelFormat; 11use SDL::GFX; 12use SDL::GFX::Primitives; 13use Test::More; 14 15use lib 't/lib'; 16use SDL::TestTool; 17 18my $videodriver = $ENV{SDL_VIDEODRIVER}; 19$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 20 21if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) { 22 plan( skip_all => 'Failed to init video' ); 23} elsif ( !SDL::Config->has('SDL_gfx_primitives') ) { 24 plan( skip_all => 'SDL_gfx_primitives support not compiled' ); 25} 26 27my $v = SDL::GFX::linked_version(); 28isa_ok( $v, 'SDL::Version', '[linked_version]' ); 29printf( "got version: %d.%d.%d\n", $v->major, $v->minor, $v->patch ); 30 31my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_ANYFORMAT ); 32my $pixel = SDL::Video::map_RGB( $display->format, 0, 0, 0 ); 33 34if ( !$display ) { 35 plan skip_all => 'Couldn\'t set video mode: ' . SDL::get_error(); 36} 37 38my $surface = SDL::Surface->new( SDL_SWSURFACE, 640, 480, 32, 0, 0, 0, 0 ); 39SDL::Video::fill_rect( 40 $surface, 41 SDL::Rect->new( 0, 0, $surface->w, $surface->h ), $pixel 42); 43 44# pixel tests 45is( SDL::GFX::Primitives::pixel_color( $surface, 2, 3, 0xFF0000FF ), 46 0, 'pixel_color' 47); 48is( SDL::GFX::Primitives::pixel_RGBA( $surface, 4, 3, 0x00, 0xFF, 0x00, 0xFF ), 49 0, 'pixel_RGBA' 50); 51 52# demo for pixel functions 53#SDL::GFX::Primitives::rectangle_color($surface, 3, 4, 125, 106, 0xCCCCCCFF); 54#SDL::GFX::Primitives::rectangle_color($surface, 3, 116, 125, 218, 0xCCCCCCFF); 55 56my $max_x = 120; 57my $max_y = 100; 58my $max_iterationen = 400; 59my $punkt_abstand_x = 0.015; 60my $punkt_abstand_y = 0.015; 61my $min_cx = -2.1; 62my $min_cy = -1.1; 63my $max_betrag_quadrat = 4000; 64 65my $r = 0xFF; 66my $g = 0x00; 67my $b = 0x00; 68 69for ( my $x = 0; $x <= $max_x; $x++ ) { 70 if ( $x < 20 ) { 71 $g += 12.7; 72 } elsif ( $x < 40 ) { 73 $r -= 12.7; 74 } elsif ( $x < 60 ) { 75 $r = 0; 76 $b += 12.7; 77 } elsif ( $x < 80 ) { 78 $g -= 12.7; 79 } elsif ( $x < 100 ) { 80 $g = 0; 81 $r += 12.7; 82 } else { 83 $b -= 12.7; 84 } 85 86 for ( my $y = 0; $y <= $max_y; $y++ ) { 87 88 # fractal 89 my $iteration = mandel_point( 90 $min_cx + $x * $punkt_abstand_x, 91 $min_cy + $y * $punkt_abstand_y 92 ); 93 my $col = ( $iteration / $max_iterationen * 8192 ) & 0xFF; 94 95 SDL::GFX::Primitives::pixel_RGBA( 96 $surface, 4 + $x, 5 + $y, $col, 0, 97 256 - $col, 0xFF 98 ); 99 100 # color picker 101 SDL::GFX::Primitives::pixel_RGBA( 102 $surface, 4 + $x, 117 + $y, $r, $g, 103 $b, 0xFF - 0xFF * $y / $max_y 104 ); 105 } 106} 107 108# line tests 109is( SDL::GFX::Primitives::hline_color( $surface, 131, 135, 4, 0x00FF00FF ), 110 0, 'hline_color' 111); # green 112is( SDL::GFX::Primitives::hline_RGBA( $surface, 131, 135, 6, 0xFF, 0xFF, 0x00, 0xFF ), 113 0, 114 'hline_RGBA' 115); # yellow 116is( SDL::GFX::Primitives::vline_color( $surface, 137, 3, 7, 0x0000FFFF ), 117 0, 'vline_color' 118); # blue 119is( SDL::GFX::Primitives::vline_RGBA( $surface, 139, 3, 7, 0xFF, 0x00, 0x00, 0xFF ), 120 0, 121 'vline_RGBA' 122); # red 123 124# hline/vline demo 125#SDL::GFX::Primitives::rectangle_color($surface, 131, 55 + $_ * 20, 253, 67 + $_ * 20, 0xCCCCCCFF) for(0..5); 126#SDL::GFX::Primitives::rectangle_color($surface, 136 + $_ * 20, 50, 148 + $_ * 20, 172, 0xCCCCCCFF) for(0..5); 127SDL::GFX::Primitives::hline_color( $surface, 132, 252, $_, 0xFF000080 ) for ( 56 .. 66 ); 128SDL::GFX::Primitives::hline_color( $surface, 132, 252, $_, 0xFFFF0080 ) for ( 76 .. 86 ); 129SDL::GFX::Primitives::hline_color( $surface, 132, 252, $_, 0x00FF0080 ) for ( 96 .. 106 ); 130SDL::GFX::Primitives::hline_color( $surface, 132, 252, $_, 0x00FFFF80 ) for ( 116 .. 126 ); 131SDL::GFX::Primitives::hline_color( $surface, 132, 252, $_, 0x0000FF80 ) for ( 136 .. 146 ); 132SDL::GFX::Primitives::hline_color( $surface, 132, 252, $_, 0xFF00FF80 ) for ( 156 .. 166 ); 133SDL::GFX::Primitives::vline_color( $surface, $_, 51, 171, 0xFF000080 ) for ( 137 .. 147 ); 134SDL::GFX::Primitives::vline_color( $surface, $_, 51, 171, 0xFFFF0080 ) for ( 157 .. 167 ); 135SDL::GFX::Primitives::vline_color( $surface, $_, 51, 171, 0x00FF0080 ) for ( 177 .. 187 ); 136SDL::GFX::Primitives::vline_color( $surface, $_, 51, 171, 0x00FFFF80 ) for ( 197 .. 207 ); 137SDL::GFX::Primitives::vline_color( $surface, $_, 51, 171, 0x0000FF80 ) for ( 217 .. 227 ); 138SDL::GFX::Primitives::vline_color( $surface, $_, 51, 171, 0xFF00FF80 ) for ( 237 .. 247 ); 139 140# aaline test 141is( SDL::GFX::Primitives::line_color( $surface, 261, 3, 265, 7, 0xFF00FFFF ), 142 0, 'line_color' 143); # pink 144is( SDL::GFX::Primitives::line_RGBA( $surface, 261, 7, 265, 3, 0x00, 0xFF, 0xFF, 0xFF ), 145 0, 146 'line_RGBA' 147); # turquoise 148is( SDL::GFX::Primitives::aaline_color( $surface, 267, 3, 271, 7, 0xFF00FFFF ), 149 0, 'aaline_color' 150); # pink 151is( SDL::GFX::Primitives::aaline_RGBA( $surface, 267, 7, 271, 3, 0x00, 0xFF, 0xFF, 0xFF ), 152 0, 153 'aaline_RGBA' 154); # turquoise 155 156# aaline demo 157my $last_x = 287; 158my $last_y = 62; 159my @points_x = ( 160 309, 333, 355, 372, 380, 380, 371, 354, 161 332, 308, 286, 269, 261, 261, 270, 287 162); 163my @points_y = ( 53, 53, 62, 79, 101, 125, 147, 164, 173, 173, 163, 146, 124, 100, 78, 62 ); 164 165for my $p1 ( 0 .. 15 ) { 166 for my $p2 ( 0 .. 15 ) { 167 SDL::GFX::Primitives::aaline_color( 168 $surface, $points_x[$p1], $points_y[$p1], 169 $points_x[$p2], $points_y[$p2], 0xFFFFFF50 170 ); 171 } 172} 173 174# rectangle/box demo 175#SDL::GFX::Primitives::rectangle_RGBA($surface, 260 + $_ * 2, 5 + $_ / 120 * 100, 380 - $_ * 2, 105 - $_ / 120 * 100, $_ / 60 * 256, 0, 0, 0xFF) for(0..60); 176#SDL::GFX::Primitives::box_RGBA($surface, 260 + $_, 117 + $_ / 120 * 100, 380 - $_, 217 - $_ / 120 * 100, $_ / 120 * 256, 0, 0, 0x08) for(0..120); 177 178# rectangle/box test 179is( SDL::GFX::Primitives::rectangle_color( $surface, 390, 3, 394, 7, 0x00FF00FF ), 180 0, 181 'rectangle_color' 182); # green 183is( SDL::GFX::Primitives::rectangle_RGBA( $surface, 396, 3, 400, 7, 0xFF, 0xFF, 0x00, 0xFF ), 184 0, 185 'rectangle_RGBA' 186); # yellow 187is( SDL::GFX::Primitives::box_color( $surface, 402, 3, 406, 7, 0x0000FFFF ), 188 0, 'rectangle_color' 189); # blue 190is( SDL::GFX::Primitives::box_RGBA( $surface, 408, 3, 412, 7, 0xFF, 0x00, 0x00, 0xFF ), 191 0, 192 'rectangle_RGBA' 193); # red 194 195# rectangle/box demo 196my @box = ( 197 [ '0', '0', '0', '0', '0', '0', '0', '0', 198 '0', '0', '0', '0', '0', '0', '0' 199 ], 200 [ '0', '0', '0', '0', '0', '0', '/', '_', 201 '\\', '0', '0', '0', '0', '0', '0' 202 ], 203 [ '0', '0', '0', '0', '/', '/', '/', '_', 204 '\\', '\\', '\\', '0', '0', '0', '0' 205 ], 206 [ '0', '0', '0', '/', '/', '/', '/', '_', 207 '\\', '\\', '\\', '\\', '0', '0', '0' 208 ], 209 [ '0', '0', '/', '/', '/', '/', '/', '_', 210 '\\', '\\', '\\', '\\', '\\', '0', '0' 211 ], 212 [ '0', '0', '/', '/', '/', '/', '/', '_', 213 '\\', '\\', '\\', '\\', '\\', '0', '0' 214 ], 215 [ '0', '/', '/', '/', '/', '/', '/', '_', 216 '\\', '\\', '\\', '\\', '\\', '\\', '0' 217 ], 218 [ '0', '<', '<', '<', '<', '<', '<', '0', 219 '>', '>', '>', '>', '>', '>', '0' 220 ], 221 [ '0', '\\', '\\', '\\', '\\', '\\', '\\', '-', 222 '/', '/', '/', '/', '/', '/', '0' 223 ], 224 [ '0', '0', '\\', '\\', '\\', '\\', '\\', '-', 225 '/', '/', '/', '/', '/', '0', '0' 226 ], 227 [ '0', '0', '\\', '\\', '\\', '\\', '\\', '-', 228 '/', '/', '/', '/', '/', '0', '0' 229 ], 230 [ '0', '0', '0', '\\', '\\', '\\', '\\', '-', 231 '/', '/', '/', '/', '0', '0', '0' 232 ], 233 [ '0', '0', '0', '0', '\\', '\\', '\\', '-', 234 '/', '/', '/', '0', '0', '0', '0' 235 ], 236 [ '0', '0', '0', '0', '0', '\\', '\\', '-', 237 '/', '/', '0', '0', '0', '0', '0' 238 ], 239 [ '0', '0', '0', '0', '0', '0', '0', '0', 240 '0', '0', '0', '0', '0', '0', '0' 241 ] 242); 243 244for my $y ( 0 .. 14 ) { 245 for my $x ( 0 .. 14 ) { 246 my $x_pos = 390 + $x * 8; 247 my $y_pos = 53 + $y * 8; 248 my $bg_color = ( ( $y & 1 ) ^ ( $x & 1 ) ) ? 0xFFFFFFFF : 0x333333FF; 249 my $fg_color = ( ( $y & 1 ) ^ ( $x & 1 ) ) ? 0x333333FF : 0xFFFFFFFF; 250 SDL::GFX::Primitives::box_color( 251 $surface, $x_pos, $y_pos, $x_pos + 7, 252 $y_pos + 7, $bg_color 253 ); 254 255 if ( @{ $box[$y] }[$x] =~ /[\-_]/ ) { 256 SDL::GFX::Primitives::box_color( 257 $surface, $x_pos + 1, 258 $y_pos + ( $y < 7 ? 5 : 1 ), 259 $x_pos + 2, $y_pos + ( $y < 7 ? 6 : 2 ), $fg_color 260 ); 261 SDL::GFX::Primitives::box_color( 262 $surface, $x_pos + 5, 263 $y_pos + ( $y < 7 ? 5 : 1 ), 264 $x_pos + 6, $y_pos + ( $y < 7 ? 6 : 2 ), $fg_color 265 ); 266 } 267 268 if ( @{ $box[$y] }[$x] =~ /[<>]/ ) { 269 SDL::GFX::Primitives::box_color( 270 $surface, $x_pos + ( $x < 7 ? 5 : 1 ), 271 $y_pos + 1, $x_pos + ( $x < 7 ? 6 : 2 ), 272 $y_pos + 2, $fg_color 273 ); 274 SDL::GFX::Primitives::box_color( 275 $surface, $x_pos + ( $x < 7 ? 5 : 1 ), 276 $y_pos + 5, $x_pos + ( $x < 7 ? 6 : 2 ), 277 $y_pos + 6, $fg_color 278 ); 279 } 280 281 if ( @{ $box[$y] }[$x] =~ /\\/ ) { 282 SDL::GFX::Primitives::box_color( 283 $surface, $x_pos + 1, $y_pos + 1, $x_pos + 2, 284 $y_pos + 2, $fg_color 285 ); 286 SDL::GFX::Primitives::box_color( 287 $surface, $x_pos + 5, $y_pos + 5, $x_pos + 6, 288 $y_pos + 6, $fg_color 289 ); 290 } 291 if ( @{ $box[$y] }[$x] =~ /\// ) { 292 SDL::GFX::Primitives::box_color( 293 $surface, $x_pos + 5, $y_pos + 1, $x_pos + 6, 294 $y_pos + 2, $fg_color 295 ); 296 SDL::GFX::Primitives::box_color( 297 $surface, $x_pos + 1, $y_pos + 5, $x_pos + 2, 298 $y_pos + 6, $fg_color 299 ); 300 } 301 } 302} 303 304# circle/arc/aacircle/filled_circle/pie/filled_pie test 305is( SDL::GFX::Primitives::circle_color( $surface, 520, 5, 2, 0x00FF00FF ), 306 0, 'circle_color' 307); # green 308is( SDL::GFX::Primitives::circle_RGBA( $surface, 527, 5, 2, 0xFF, 0xFF, 0x00, 0xFF ), 309 0, 310 'circle_RGBA' 311); # yellow 312is( SDL::GFX::Primitives::aacircle_color( $surface, 534, 5, 2, 0x00FF00FF ), 313 0, 'aacircle_color' 314); # green 315is( SDL::GFX::Primitives::aacircle_RGBA( $surface, 541, 5, 2, 0xFF, 0xFF, 0x00, 0xFF ), 316 0, 317 'aacircle_RGBA' 318); # yellow 319is( SDL::GFX::Primitives::filled_circle_color( $surface, 548, 5, 2, 0x00FF00FF ), 320 0, 321 'filled_circle_color' 322); # green 323is( SDL::GFX::Primitives::filled_circle_RGBA( $surface, 555, 5, 2, 0xFF, 0xFF, 0x00, 0xFF ), 324 0, 325 'filled_circle_RGBA' 326); # yellow 327SKIP: 328{ 329 skip( 'Version 2.0.17 needed', 2 ) if $v < 2.0.17; 330 is( SDL::GFX::Primitives::arc_color( $surface, 562, 5, 2, 5, 175, 0x00FF00FF ), 331 0, 332 'arc_color' 333 ); # green 334 is( SDL::GFX::Primitives::arc_RGBA( $surface, 569, 5, 2, 185, 355, 0xFF, 0xFF, 0x00, 0xFF ), 335 0, 336 'arc_RGBA' 337 ); # yellow 338} 339is( SDL::GFX::Primitives::pie_color( $surface, 576, 7, 5, 270, 0, 0xFF0000FF ), 340 0, 'pie_color' 341); # red 342is( SDL::GFX::Primitives::pie_RGBA( $surface, 583, 7, 5, 270, 0, 0x00, 0x00, 0xFF, 0xFF ), 343 0, 344 'pie_RGBA' 345); # blue 346is( SDL::GFX::Primitives::filled_pie_color( $surface, 590, 7, 5, 270, 0, 0xFF0000FF ), 347 0, 348 'filled_pie_color' 349); # red 350is( SDL::GFX::Primitives::filled_pie_RGBA( $surface, 597, 7, 5, 270, 0, 0x00, 0x00, 0xFF, 0xFF ), 351 0, 352 'filled_pie_RGBA' 353); # blue 354 355# circle/arc/aacircle/filled_circle/pie/filled_pie demo 356SDL::GFX::Primitives::filled_circle_color( $surface, 553, 137, 36, 0x00FF0080 ); 357SDL::GFX::Primitives::filled_circle_color( $surface, 601, 137, 36, 0x0000FF80 ); 358SDL::GFX::Primitives::filled_circle_color( $surface, 577, 87, 36, 0xFF000080 ); 359if ( $v->major >= 2 && $v->minor >= 0 && $v->patch >= 17 ) { 360 SDL::GFX::Primitives::arc_color( 361 $surface, 553, 137, 36, 310, 335, 362 0xFFFFFF80 363 ); 364 SDL::GFX::Primitives::arc_color( 365 $surface, 601, 137, 36, 205, 230, 366 0xFFFFFF80 367 ); 368 SDL::GFX::Primitives::arc_color( 369 $surface, 577, 87, 36, 75, 105, 370 0xFFFFFF80 371 ); 372 SDL::GFX::Primitives::arc_color( 373 $surface, 553, 137, 36, 48, 255, 374 0xFFFFFF80 375 ); 376 SDL::GFX::Primitives::arc_color( 377 $surface, 601, 137, 36, 285, 132, 378 0xFFFFFF80 379 ); 380 SDL::GFX::Primitives::arc_color( 381 $surface, 577, 87, 36, 155, 25, 382 0xFFFFFF80 383 ); 384} 385SDL::Video::blit_surface( 386 $surface, SDL::Rect->new( 0, 0, 640, 480 ), 387 $display, SDL::Rect->new( 0, 0, 640, 480 ) 388); 389SDL::Video::update_rect( $display, 0, 0, 640, 480 ); 390 391SDL::delay(3000); 392 393if ($videodriver) { 394 $ENV{SDL_VIDEODRIVER} = $videodriver; 395} else { 396 delete $ENV{SDL_VIDEODRIVER}; 397} 398 399pass 'Are we still alive? Checking for segfaults'; 400 401done_testing; 402 403sub mandel_point { 404 my $cx = shift; 405 my $cy = shift; 406 407 my $betrag_quadrat = 0; 408 my $iter = 0; 409 my $x = 0; 410 my $y = 0; 411 412 while ( $betrag_quadrat <= $max_betrag_quadrat && $iter < $max_iterationen ) { 413 my $xt = $x * $x - $y * $y + $cx; 414 my $yt = 2 * $x * $y + $cy; 415 $x = $xt; 416 $y = $yt; 417 $iter++; 418 $betrag_quadrat = $x * $x + $y * $y; 419 } 420 421 return $iter; 422}