#!/usr/bin/perl # Copyright (c) 2004-2005, Geoff Broadwell; this script is released # as open source and may be distributed and modified under the terms # of either the Artistic License or the GNU General Public License, # in the same manner as Perl itself. These licenses should have been # distributed to you as part of your Perl distribution, and can be # read using `perldoc perlartistic` and `perldoc perlgpl` respectively. use strict; use warnings; use SDL::App; use SDL::Constants; use SDL::Event; use SDL::OpenGL; use Time::HiRes 'time'; our $VERSION = '0.1.17'; ### USER CONFIG # Primitive sizes (and therefore counts) are integer divisors of # (A^i * B^j * C^k ...) where good A, B, C, ... are relatively prime; # this number is used for the draw area height and width and defaults to # 2^4 * 3^2 * 5 = 720 my @max_powers = (2 => 4, 3 => 2, 5 => 1); # my @max_powers = (16 => 1, 9 => 1, 5 => 1); # Maximum quads along each axis for known slow versus usually fast tests; # chosen to be somewhat reasonable for most common settings of @max_powers my $max_count_slow = 60; my $max_count_fast = 154; # True to attempt to switch to in fullscreen mode my $full_screen = 0; # Frames to render per test run (== combination of method and primitive count) my $frames_per_run = 100; ### METHODS TO BENCHMARK my %va_types = ( quad => \&make_quads_va, tri => \&make_tris_va, qs => \&make_qs_va, ts => \&make_ts_va, ); my %dl_types = ( qs => \&draw_qs, ts => \&draw_ts, qs_va => \&draw_qs_va, ts_va => \&draw_ts_va, ); my @tests = ( [empty => \&draw_empty, \&stats_empty, 'single', [0 , 0 , 0 ]], [q => \&draw_quads, \&stats_quads, 'slow', [.5, 0 , 0 ]], [t => \&draw_tris, \&stats_tris, 'slow', [.6, .4, 0 ]], [qs => \&draw_qs, \&stats_qs, 'slow', [.6, .6, 0 ]], [ts => \&draw_ts, \&stats_ts, 'slow', [0 , .5, 0 ]], [qs_dl => \&draw_qs_dl, \&stats_qs, 'fast', [0 , .5, .5]], [ts_dl => \&draw_ts_dl, \&stats_ts, 'fast', [0 , 0 , .5]], [q_va => \&draw_quads_va, \&stats_quads, 'fast', [1 , 0 , 0 ]], [t_va => \&draw_tris_va, \&stats_tris, 'fast', [1 , .8, 0 ]], [qs_va => \&draw_qs_va, \&stats_qs, 'fast', [1 , 1 , 0 ]], [ts_va => \&draw_ts_va, \&stats_ts, 'fast', [0 , 1 , 0 ]], [qs_va_dl => \&draw_qs_va_dl, \&stats_qs, 'fast', [0 , 1 , 1 ]], [ts_va_dl => \&draw_ts_va_dl, \&stats_ts, 'fast', [0 , 0 , 1 ]], ); ### MISC GLOBALS my $sdl_app; my ($w, $h); my (%dls, %vas); my (@combos, @slow, @fast); my ($done, $showing_graph); my ($empty_time, @stats, @total, @max); ### CODE START: main(); sub main { init(); benchmark(); cleanup(); } sub init { # Lots of places we want to have autoflushing $| = 1; # Figure out primitive counts for each run of each test type my %combos; @combos{recurse_combos(@max_powers)} = (); @combos = sort { $a <=> $b } keys %combos; @slow = grep { $_ <= $max_count_slow } @combos; @fast = grep { $_ > $max_count_slow && $_ <= $max_count_fast } @combos; # Choose drawing area size to match counts $h = $w = $combos[-1]; # Let user know what's going on show_user_message(); # Initialize GL window init_sdl_opengl('Triangle Slammer'); # Make sure GL state is consistent for VA and DL creation start_frame(); # Create vertex arrays and display lists outside timing loop init_vertex_arrays(); init_display_lists(); # Clean up GL state end_frame(); } sub recurse_combos { my ($base, $max_power, @rest) = @_; return (1) unless $base; my @combos; foreach my $power (0 .. $max_power) { my $multiplier = $base ** $power; push @combos, $_ * $multiplier foreach recurse_combos(@rest); } return @combos; } sub show_user_message { print <<"EOM"; TRISLAM Perl/OpenGL Benchmark, version $VERSION TRISLAM benchmarks several methods of pushing OpenGL primitives, testing each method with various primitive counts and sizes. During the benchmark, the test window will start out black, slowly brightening to white as testing progresses. Once benchmarking is complete, the collected data will be dumped in tabular form. The following configuration will be used for this test: EOM show_config(); print '-' x 79, "\n"; } sub show_config { print <<"EOC"; window size: $h x $w fullscreen: $full_screen frames per run: $frames_per_run standard runs: @slow extra fast runs: @fast EOC } sub init_sdl_opengl { my $title = shift; $sdl_app = new SDL::App(-title => $title, -width => $w, -height => $h, -gl => 1, ($full_screen ? (-fullscreen => 1) : ()), -r => 0, -g => 0, -b => 0, -a => 0, -d => 0, ); SDL::ShowCursor(0); glViewport(0, 0, $w, $h); glOrtho(0, $w, 0, $h, -1, 1); } sub init_vertex_arrays { print "Init vertex arrays:"; foreach my $type (sort keys %va_types) { print " $type"; foreach my $count (@slow, @fast) { my $data = $va_types{$type}->($count, $w / $count); my $va = pack 'f*', @$data; $vas{"${type}_$count"} = $va; } } print ".\n"; } sub init_display_lists { print "Init display lists:"; my $num_lists = (scalar keys %dl_types) * (@slow + @fast); my $current = glGenLists($num_lists); my $list; foreach my $type(sort keys %dl_types) { print " $type"; foreach my $count (@slow, @fast) { $list = $current++; $dls{"${type}_$count"} = $list; glNewList($list, GL_COMPILE); $dl_types{$type}->($count, $w / $count); glEndList; } } print ".\n"; } sub benchmark { print "Benchmarks:"; TEST: foreach my $test (0 .. $#tests) { my ($name, $draw, $stats, $class) = @{$tests[$test]}; my $counts = $class eq 'single' ? [1] : $class eq 'slow' ? [@slow] : [@slow, @fast]; # After printing current test name, busy wait for a second # so that the terminal can catch up and not do work while # the GL timing is in progress print " $name"; my $a = time; 1 while 1 > time() - $a; foreach my $run (0 .. $#$counts) { my $count = $counts->[$run]; my $size = $w / $count; my $color = ($test + ($run / @$counts)) / @tests; glColor($color, $color, $color); my $start = time; foreach (1 .. $frames_per_run) { start_frame(); $draw->($count, $size); end_frame(); } my $end = time; my $time = $end - $start; push @stats, [$name, $count, $time, $frames_per_run, $stats->($count, $size)]; check_events(); last TEST if $done; } } print ".\n"; } sub start_frame { glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); } sub draw_empty { my ($count, $size) = @_; } sub stats_empty { return (0, 0, 0, 0); } sub draw_quads { my ($count, $size) = @_; glBegin(GL_QUADS); foreach my $y (0 .. $count - 1) { foreach my $x ( 0 .. $count - 1) { glVertex($x * $size , $y * $size + $size); glVertex($x * $size , $y * $size ); glVertex($x * $size + $size, $y * $size ); glVertex($x * $size + $size, $y * $size + $size); } } glEnd; } sub make_quads_va { my ($count, $size) = @_; my @data; foreach my $y (0 .. $count - 1) { foreach my $x ( 0 .. $count - 1) { push @data, $x * $size , $y * $size + $size; push @data, $x * $size , $y * $size ; push @data, $x * $size + $size, $y * $size ; push @data, $x * $size + $size, $y * $size + $size; } } return \@data; } sub draw_quads_va { my ($count, $size) = @_; my $va = $vas{"quad_$count"}; glEnableClientState(GL_VERTEX_ARRAY); glVertexPointer(2, GL_FLOAT, 0, $va); glDrawArrays(GL_QUADS, 0, 4 * $count * $count); glDisableClientState(GL_VERTEX_ARRAY); } sub stats_quads { my ($count, $size) = @_; my $length = $size * $count; my $area = $length * $length; my $prims = $count * $count; my $tris = 2 * $prims; my $verts = 4 * $prims; return ($area, $prims, $tris, $verts); } sub draw_qs { my ($count, $size) = @_; foreach my $y (0 .. $count - 1) { glBegin(GL_QUAD_STRIP); foreach my $x ( 0 .. $count) { glVertex($x * $size, $y * $size + $size); glVertex($x * $size, $y * $size ); } glEnd; } } sub make_qs_va { my ($count, $size) = @_; my @data; foreach my $y (0 .. $count - 1) { foreach my $x ( 0 .. $count) { push @data, $x * $size, $y * $size + $size; push @data, $x * $size, $y * $size ; } } return \@data; } sub draw_qs_va { my ($count, $size) = @_; my $va = $vas{"qs_$count"}; my $row = 2 * ($count + 1); glEnableClientState(GL_VERTEX_ARRAY); glVertexPointer(2, GL_FLOAT, 0, $va); foreach my $y (0 .. $count - 1) { glDrawArrays(GL_QUAD_STRIP, $y * $row, $row); } glDisableClientState(GL_VERTEX_ARRAY); } sub draw_qs_dl { my ($count, $size) = @_; glCallList($dls{"qs_$count"}); } sub draw_qs_va_dl { my ($count, $size) = @_; my $va = $vas{"qs_$count"}; glEnableClientState(GL_VERTEX_ARRAY); glVertexPointer(2, GL_FLOAT, 0, $va); glCallList($dls{"qs_va_$count"}); glDisableClientState(GL_VERTEX_ARRAY); } sub stats_qs { my ($count, $size) = @_; my $length = $size * $count; my $area = $length * $length; my $prims = $count; my $tris = 2 * $count * $prims; my $verts = 2 * ($count + 1) * $prims; return ($area, $prims, $tris, $verts); } sub draw_tris { my ($count, $size) = @_; glBegin(GL_TRIANGLES); foreach my $y (0 .. $count - 1) { foreach my $x ( 0 .. $count - 1) { glVertex($x * $size , $y * $size + $size); glVertex($x * $size , $y * $size ); glVertex($x * $size + $size, $y * $size + $size); glVertex($x * $size + $size, $y * $size + $size); glVertex($x * $size , $y * $size ); glVertex($x * $size + $size, $y * $size ); } } glEnd; } sub make_tris_va { my ($count, $size) = @_; my @data; foreach my $y (0 .. $count - 1) { foreach my $x ( 0 .. $count - 1) { push @data, $x * $size , $y * $size + $size; push @data, $x * $size , $y * $size ; push @data, $x * $size + $size, $y * $size + $size; push @data, $x * $size + $size, $y * $size + $size; push @data, $x * $size , $y * $size ; push @data, $x * $size + $size, $y * $size ; } } return \@data; } sub draw_tris_va { my ($count, $size) = @_; my $va = $vas{"tri_$count"}; glEnableClientState(GL_VERTEX_ARRAY); glVertexPointer(2, GL_FLOAT, 0, $va); glDrawArrays(GL_TRIANGLES, 0, 6 * $count * $count); glDisableClientState(GL_VERTEX_ARRAY); } sub stats_tris { my ($count, $size) = @_; my $length = $size * $count; my $area = $length * $length; my $prims = 2 * $count * $count; my $tris = $prims; my $verts = 3 * $prims; return ($area, $prims, $tris, $verts); } sub draw_ts { my ($count, $size) = @_; foreach my $y (0 .. $count - 1) { glBegin(GL_TRIANGLE_STRIP); foreach my $x ( 0 .. $count) { glVertex($x * $size, $y * $size + $size); glVertex($x * $size, $y * $size ); } glEnd; } } sub make_ts_va { my ($count, $size) = @_; my @data; foreach my $y (0 .. $count - 1) { foreach my $x ( 0 .. $count) { push @data, $x * $size, $y * $size + $size; push @data, $x * $size, $y * $size ; } } return \@data; } sub draw_ts_va { my ($count, $size) = @_; my $va = $vas{"ts_$count"}; my $row = 2 * ($count + 1); glEnableClientState(GL_VERTEX_ARRAY); glVertexPointer(2, GL_FLOAT, 0, $va); foreach my $y (0 .. $count - 1) { glDrawArrays(GL_TRIANGLE_STRIP, $y * $row, $row); } glDisableClientState(GL_VERTEX_ARRAY); } sub draw_ts_dl { my ($count, $size) = @_; glCallList($dls{"ts_$count"}); } sub draw_ts_va_dl { my ($count, $size) = @_; my $va = $vas{"ts_$count"}; glEnableClientState(GL_VERTEX_ARRAY); glVertexPointer(2, GL_FLOAT, 0, $va); glCallList($dls{"ts_va_$count"}); glDisableClientState(GL_VERTEX_ARRAY); } sub stats_ts { my ($count, $size) = @_; my $length = $size * $count; my $area = $length * $length; my $prims = $count; my $tris = 2 * $count * $prims; my $verts = 2 * ($count + 1) * $prims; return ($area, $prims, $tris, $verts); } sub end_frame { glFinish; $sdl_app->sync; } sub check_events { my $e = new SDL::Event; $e->pump; while (not $done and $e->poll) { my $type = $e->type; if ($type eq SDL_QUIT) { $done = 1; } elsif ($type eq SDL_KEYDOWN) { my $key = SDL::GetKeyName($e->key_sym); $done = 1 if $key eq 'q' or $key eq 'escape'; } elsif ($type eq SDL_ACTIVEEVENT) { draw_stats() if $showing_graph and $e->active_gain; } } } sub cleanup { fixup_stats(); show_stats(); draw_stats(); check_events until $done; } sub fixup_stats { my $empty = shift @stats; $empty_time = $empty->[2]; @total = (total => ave => (0) x 11); @max = (max => max => (0) x 11); foreach my $stat (@stats) { my ($name, $count, $time, $frames, $pixpf, $prmpf, $tpf, $vpf) = @$stat; # Subtract out empty loop time, and loop if negative result $time = $stat->[2] -= $empty_time; if ($time <= 0) { push @$stat, (0) x 5; next; } # Calc fps my $fps = $frames / $time; # Calc other perf stats my $pixps = $pixpf * $fps; my $prmps = $prmpf * $fps; my $tps = $tpf * $fps; my $vps = $vpf * $fps; # Add them to stat row push @$stat, $fps, $pixps, $prmps, $tps, $vps; # Convert per frame counts to totals $stat->[$_] *= $frames foreach 4 .. 7; # Update running totals $total[$_] += $stat->[$_] foreach 2 .. 7; # Update running maximums foreach (2 .. 12) { $max[$_] = $stat->[$_] if $max[$_] < $stat->[$_]; } } # Calc averages for totals line $total[$_] = $total[$_ - 5] / $total[2] foreach (8 .. 12); } sub show_stats { my @basic = qw( Name Cnt Time ); my @raw = qw( Frms Mpix Kprim Ktri Kvert ); my @calc = qw( f/s Mpx/s Kpr/s Kt/s Kv/s ); my @scale = (qw( 0 6 3 3 3 )) x 2; my @header = (@basic, @raw, @calc); @scale = map {10 ** $_} @scale; my $h_form = '%-8s %3s %6s' . (' %5s' x (@raw + @calc)) . "\n"; my $format = '%-8s %3s %6.3f' . (' %5d' x (@raw + @calc)) . "\n"; printf $h_form, @header; printf $format, empty => 1, $empty_time, (0) x 10; foreach my $stat (@stats, \@total) { my @stat = @$stat; foreach (0 .. $#scale) { $stat[$_ + 3] /= $scale[$_]; } printf $format, @stat; } } sub draw_stats { # Graph config my $x_off = 10; my $y_off = 10; my $tick_size = 3; my $val_space = 100; my $x_scale = ($w - 2 * $x_off) / $fast[-1]; my $y_scale = 1; # Get a fresh black frame for graphing start_frame(); # Use antialiased lines glEnable (GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glEnable (GL_LINE_SMOOTH); glHint (GL_LINE_SMOOTH_HINT, GL_NICEST); # Draw axis ticks glColor(1, 1, 1); glBegin(GL_LINES); foreach my $value (0 .. int(($h - 2 * $y_off) / $val_space)) { glVertex($x_off, $value * $val_space + $y_off); glVertex($x_off - $tick_size, $value * $val_space + $y_off); } foreach my $count (0, @slow, @fast) { glVertex($count * $x_scale + $x_off, $y_off); glVertex($count * $x_scale + $x_off, $y_off - $tick_size); } glEnd; # Draw axes glBegin(GL_LINE_STRIP); glVertex($x_off, $h - $y_off); glVertex($x_off, $y_off); glVertex($w - $x_off, $y_off); glEnd; # Draw performance graph lines my %colors = map {($_->[0] => $_->[-1])} @tests; my $last = $stats[0][0]; # Pixels per second my $max_pps = $max[9]; $y_scale = ($h - 2 * $y_off) / $max_pps; glBegin(GL_LINE_STRIP); foreach my $run (0 .. $#stats) { my ($name, $count, $time, $frames, $pix, $prm, $t, $v, $fps, $pixps, $prmps, $tps, $vps) = @{$stats[$run]}; if ($name ne $last) { glEnd; glBegin(GL_LINE_STRIP); $last = $name; } glColor(@{$colors{$name}}); glVertex($count * $x_scale + $x_off, $pixps * $y_scale + $y_off); } glEnd; # Vertices per second my $max_vps = $max[12]; $y_scale = ($h - 2 * $y_off) / $max_vps; glLineStipple(1, 0x00FF); glEnable(GL_LINE_STIPPLE); glBegin(GL_LINE_STRIP); foreach my $run (0 .. $#stats) { my ($name, $count, $time, $frames, $pix, $prm, $t, $v, $fps, $pixps, $prmps, $tps, $vps) = @{$stats[$run]}; if ($name ne $last) { glEnd; glBegin(GL_LINE_STRIP); $last = $name; } glColor(@{$colors{$name}}); glVertex($count * $x_scale + $x_off, $vps * $y_scale + $y_off); } glEnd; glDisable(GL_LINE_STIPPLE); # Show our graph end_frame(); $showing_graph = 1; }