$surface->pixel is slow + audio data chunks

[email protected] ("Brian Cassidy") Fri, 10 Aug 2007 17:08:30 -0300

Newsgroups	perl.sdl.devel
Message-ID	<[email protected]>

Hey All,

I've writing a little 8088 Corruption player [1] w/ SDL_Perl but I've
come across a few issues.

The data format is very much like an ANSI file where there's a
background color then a char on top of in another color. each
character in an 8x8 block needs to be checked against the bit mask of
the font to see if it writes a fg color to the screen or not.

I've attached my program + a required font data file to this message.
you can grab the original movie data file (8088_COR.DAT) from the
original zip [2].

You can see the section commented out in my program that does the fg
color calculations. Things slow to a crawl once you uncomment that
section.

If anyone has any ideas on how to speed this up, I'd love to hear them.

My other question is that I can't for the life of me figure out how to
play the audio frame portion ($abuffer in the program) -- is it even
possible to play raw audio from a variable with SDL_Perl?

-Brian

[1] http://www.oldskool.org/pc/8088_Corruption
[2] http://www.oldskool.org/pc/8088_Corruption/8088_cor.zip

8088_player.pl (application/x-perl, 3.3 KB)

use strict;
use warnings;

use SDL;
use SDL::App;
use SDL::Event;
use SDL::Mixer;
use IO::File;

my $VIDEO_FRAME_WIDTH  = 40;
my $VIDEO_FRAME_HEIGHT = 25;
my $VIDEO_FRAME_SIZE   = $VIDEO_FRAME_WIDTH * $VIDEO_FRAME_HEIGHT * 2;
my $AUDIO_FRAME_SIZE   = 735;
my $TOTAL_FRAME_SIZE   = $VIDEO_FRAME_SIZE + $AUDIO_FRAME_SIZE;
my $FPS                = 1000 / 30;

my @palette = (
    0x000000, 0x0000AA, 0x00AA00, 0x00AAAA,
    0xAA0000, 0xAA00AA, 0xAA5500, 0xAAAAAA,
    0x555555, 0x5555FF, 0x55FF55, 0x55FFFF,
    0xFF5555, 0xFF55FF, 0xFFFF55, 0xFFFFFF
);

my $dat = $ARGV[ 0 ] || die 'No data file specified';
die 'File not found' unless -e $dat;

my $filesize = -s $dat;
die 'Invalid file size' unless $filesize % $TOTAL_FRAME_SIZE == 0;

my $frames = $filesize / $TOTAL_FRAME_SIZE;

my $app = SDL::App->new(
    -height => $VIDEO_FRAME_HEIGHT * 8,
    -width  => $VIDEO_FRAME_WIDTH * 8,
    -depth  => 32,
    -title  => '8088 Corruption Player',
    -flags  => SDL_SWSURFACE,
);

my @colors = map {
    SDL::Color->new(
        -r => ( $_ & 0xFF0000 ) >> 16,
        -g => ( $_ & 0x00FF00 ) >> 8,
        -b => ( $_ & 0x0000FF )
    )
} @palette;

my @font = unpack( 'C*', do { my $font = IO::File->new( 'CGA_FONT.8X8' ); local $/; <$font> } );

my( $done, $paused );
my $event = SDL::Event->new;
my $file  = IO::File->new( $dat );

while( !$file->eof and !$done ) {
    if( $event->poll ) {
        $done = 1 if $event->type eq SDL_QUIT;
        if( $event->type eq SDL_KEYDOWN ) {
            if( $event->key_sym eq SDLK_ESCAPE ) {
                $done = 1;
                next;
            }
        }
        elsif( $event->type eq SDL_KEYUP ) {
            my $sym = $event->key_sym;
            if( $sym eq SDLK_SPACE ) {
                $paused = !$paused;
                next;
            }
            elsif( grep { $sym eq $_ } (
                SDLK_0, SDLK_1, SDLK_2, SDLK_3, SDLK_4,
                SDLK_5, SDLK_6, SDLK_7, SDLK_8, SDLK_9
            ) ) {
                $file->seek( int( ( $frames * ( $sym - SDLK_0 ) / 10 ) ) * $TOTAL_FRAME_SIZE, 0 );
            }
        }
    }

    next if $paused;

    $app->delay( $FPS );

    my( $vbuffer, $abuffer );
    $file->read( $vbuffer, $VIDEO_FRAME_SIZE );
    $file->read( $abuffer, $AUDIO_FRAME_SIZE );

    $app->lock if $app->lockp;
    render_frame( $app, $vbuffer );
    $app->unlock if $app->lockp;
    $app->sync;
}

$file->close;

sub render_frame {
    my( $app, $buffer ) = @_;
    my @frame     = unpack( 'C*', $buffer );
    my $frame_idx = 0;

    for my $y ( 0..$VIDEO_FRAME_HEIGHT - 1 ) {
        for my $x ( 0..$VIDEO_FRAME_WIDTH - 1 ) {
            my( $idx, $attr ) = @frame[ $frame_idx++..$frame_idx++ ];

            my $scale_x = $x * 8;
            my $scale_y = $y * 8;
            $app->fill(
                SDL::Rect->new( -x => $scale_x, -y => $scale_y, -width => 8, -height => 8 ),
                $colors[ $attr >> 4 ]
            );

            my $fg    = $colors[ $attr & 0x0F ];
            my $start = $idx * 8;

=pod

            for my $fy ( 0..8 ) {
                my $mask = 0x80;
                my $bit  = $font[ $start + $fy ];
                for my $fx ( 0..8  ) {
                    $app->pixel( $scale_x + $fx, $scale_y + $fy, $fg ) if $bit & $mask;
                    $mask >>= 1;
                }
            }

=cut

        }
    }

}

CGA_FONT.8X8 (application/octet-stream, 2 KB) - not displayed