The Second-Worst ZX Spectrum Emulator in the World

tswzxseitw.pl

#!/usr/bin/env perl

use v5.40;
use autodie;

use Raylib::App;
use FFI::Platypus;
use FFI::Platypus::Memory qw/ malloc memcpy /;
use FFI::Platypus::Buffer qw/ scalar_to_buffer /;
use Time::HiRes qw/ gettimeofday tv_interval /;
use List::Util qw/ sum /;

use constant {
    CYCLES => 3_546_900,
    FPS    => 50
};

my $lib = $^O eq 'MSWin32'
    ? './Z80.dll'
    : "$ENV{HOME}/.local/lib64/libZ80.so";
my $ffi = FFI::Platypus->new(
    api => 2,
    lib => $lib
);

my $sna = $ARGV[0];
open my $fh, '<:raw', $sna;
read $fh, my $header, 27;
read $fh, my $ram, 49152;

open $fh, '<:raw', 'spec48.rom';
read $fh, my $rom, 16384;

my (
    $I,
    $HL_, $DE_, $BC_, $AF_,
    $HL,  $DE,  $BC,  $IY, $IX,
    $Int,
    $R,
    $AF, $SP,
    $IntMode,
    $Border
) = unpack '
   C
   S S S S
   S S S S S
   C
   C
   S S
   C
   C
', $header;

my $width  = 1024;
my $height = 768;

my $colours = [
    [ 0x00, 0x00, 0x00 ],
    [ 0x00, 0x00, 0xD7 ],
    [ 0xD7, 0x00, 0x00 ],
    [ 0xD7, 0x00, 0xD7 ],
    [ 0x00, 0xD7, 0x00 ],
    [ 0x00, 0xD7, 0xD7 ],
    [ 0xD7, 0xD7, 0x00 ],
    [ 0xD7, 0xD7, 0xD7 ],
    [ 0x00, 0x00, 0x00 ],
    [ 0x00, 0x00, 0xFF ],
    [ 0xFF, 0x00, 0x00 ],
    [ 0xFF, 0x00, 0xFF ],
    [ 0x00, 0xFF, 0x00 ],
    [ 0x00, 0xFF, 0xFF ],
    [ 0xFF, 0xFF, 0x00 ],
    [ 0xFF, 0xFF, 0xFF ],
];

sub rgba( $colour ) {
    join '', map { chr } $colour->@*, 0xFF;
}

sub colour( $attribute, $pixels ) {
    state @cache;
    $cache[ $attribute << 8 | $pixels ] //=
        join '', map {
            my $colour = $attribute & ( $_ ? 0b00000111 : 0b00111000 );
            $colour = $colour >> ( $_ ? 0 : 3 );
            my $bright = ( $attribute & 0b01000000 ) >> 3;
            rgba( $colours->[ $colour | $bright ] );
        } split '', unpack 'B8', chr $pixels;
}

my @line_order;
for my $third ( 0..2 ) {
    my $start_line = $third * 64;
    for my $char_line ( 0..7 ) {
        for my $char_offset ( map { $_ * 8 } 0..7 ) {
            push @line_order, $start_line +
                              $char_line +
                              $char_offset;
        }
    }
}

my @line_nos = 0..191;
sub scr2tex( @memory ) {
    my @pixels = @memory[ 0x4000..0x57FF ];
    my @attribs = @memory[ 0x5800..0x5AFF ];

    my $image = join '', map {
        my $line_idx = $line_order[ $_ ] * 32;
        my $attrib_idx = int( $_ / 8 ) * 32;
        map {
            colour( $attribs[ $attrib_idx++ ], $_ );
        } @pixels[ $line_idx..$line_idx+31 ];
    } @line_nos;

    my $buffer = malloc( length $image );
    my ( $image_ptr ) = scalar_to_buffer( $image );
    memcpy( $buffer, $image_ptr, length $image );
    my $raylib_img = Raylib::FFI::Image->new(
        data   => $buffer,
        format => 7, # PIXELFORMAT_UNCOMPRESSED_R8G8B8A8
        width  => 256,
        height => 192,
        mipmaps => 1,
    );
    Raylib::Image->new( image => $raylib_img )->as_texture;
}

my @memory = unpack 'C*', $rom . $ram;

sub mem_read( $ctx, $addr ) { $memory[ $addr ] }
sub mem_write( $ctx, $addr, $val ) { $memory[ $addr ] = $val if $addr >= 0x4000 }

sub output( $ctx, $addr, $val ) {
}

sub get_key_pressed( @keys ) {
    my $shift = 0;
    sum map {
        !Raylib::FFI::IsKeyDown( $_ ) << $shift++
    } @keys;
}

my $input_dispatch = {
    # 0 - 5
    0xf7fe => sub { get_key_pressed( 49..53 ) },
    # 6 - 0
    0xeffe => sub { get_key_pressed( 48, reverse 54..57 ) },
    # Q - T
    0xfbfe => sub { get_key_pressed( 81, 87, 69, 82, 84 ) },
    # P - Y
    0xdffe => sub { get_key_pressed( 80, 79, 73, 85, 89 ) },
    # A - G
    0xfdfe => sub { get_key_pressed( 65, 83, 68, 70, 71 ) },
    # ENTER - H
    0xbffe => sub { get_key_pressed( 257, 76, 75, 74, 72 ) },
    # CAPS - V
    0xfefe => sub { get_key_pressed( 340, 90, 88, 67, 86 ) },
    # SPACE - B
    0x7ffe => sub { get_key_pressed( 32, 342, 77, 28, 66 ) },
};

sub input( $ctx, $addr ) {
    my $sub = $input_dispatch->{ $addr };
    $sub ? $sub->() : 0xff;
}

$ffi->type( '(opaque,uint16)->uint8' => 'Z80Read' );
$ffi->type( '(opaque,uint16,uint8)->void' => 'Z80Write' );
package TSWZXSEITW::Z80 {
    use FFI::Platypus::Record qw/ record_layout_1 /;
    record_layout_1(
        $ffi,
        size_t   => 'cycles',
        size_t   => 'cycle_limit',
        opaque   => 'context',
        opaque   => 'fetch_opcode',
        opaque   => 'fetch',
        opaque   => 'read',
        opaque   => 'write',
        opaque   => 'in',
        opaque   => 'out',
        opaque   => 'halt',
        opaque   => 'nop',
        opaque   => 'nmia',
        opaque   => 'inta',
        opaque   => 'int_fetch',
        opaque   => 'ld_i_a',
        opaque   => 'ld_r_a',
        opaque   => 'reti',
        opaque   => 'retn',
        opaque   => 'hook',
        opaque   => 'illegal',
        sint32   => 'data',
        sint16   => 'ix',
        sint16   => 'iy',
        sint16   => 'pc',
        sint16   => 'sp',
        sint16   => 'xy',
        sint16   => 'memptr',
        sint16   => 'af',
        sint16   => 'bc',
        sint16   => 'de',
        sint16   => 'hl',
        sint16   => 'af_',
        sint16   => 'bc_',
        sint16   => 'de_',
        sint16   => 'hl_',
        uint8    => 'r',
        uint8    => 'i',
        uint8    => 'r7',
        uint8    => 'im',
        uint8    => 'request',
        uint8    => 'resume',
        uint8    => 'iff1',
        uint8    => 'iff2',
        uint8    => 'q',
        uint8    => 'options',
        uint8    => 'int_line',
        uint8    => 'halt_line',
    );
}
$ffi->type( 'record(TSWZXSEITW::Z80)' => 'Z80' );
$ffi->attach( z80_execute => [ 'Z80*', 'size_t' ] => 'size_t' );

my $read_closure = $ffi->closure( \&mem_read );
my $write_closure = $ffi->closure( \&mem_write );
my $input_closure = $ffi->closure( \&input );
my $output_closure = $ffi->closure( \&output );

my $read = $ffi->cast( 'Z80Read' => 'opaque', $read_closure );
my $write = $ffi->cast( 'Z80Write' => 'opaque', $write_closure );
my $input = $ffi->cast( 'Z80Read' => 'opaque', $input_closure );
my $output = $ffi->cast( 'Z80Write' => 'opaque', $output_closure );

my $Z80 = TSWZXSEITW::Z80->new(
    options      => 2 | 8 | 32, # Z80_MODEL_ZILOG_NMOS
    read         => $read,
    fetch_opcode => $read,
    fetch        => $read,
    nop          => $read,
    write        => $write,
    in           => $input,
    out          => $output,
    ix           => $IX,
    iy           => $IY,
    hl           => $HL,
    hl_          => $HL_,
    de           => $DE,
    de_          => $DE_,
    bc           => $BC,
    bc_          => $BC_,
    af           => $AF,
    af_          => $AF_,
    sp           => $SP,
    pc           => 0x72,
);

my $cycles_per_frame = CYCLES / FPS;

# Preloading this keeps frame time a bit more consistent
for my $attrib ( 0..255 ) {
    for my $pixel ( 0..255 ) {
        colour( $attrib, $pixel )
    }
}

my $app = Raylib::App->window( $width, $height, 'TSWZXSEITW' );
$app->fps( FPS );
my $fps = Raylib::Text::FPS->new;

my $scr_rect = Raylib::FFI::Rectangle->new(
    x      => 0,
    y      => 0,
    width  => 256,
    height => 192
);

my $window_rect = Raylib::FFI::Rectangle->new(
    x      => 0,
    y      => 0,
    width  => $width,
    height => $height
);

while ( !$app->exiting ) {
    z80_execute( $Z80, $cycles_per_frame );

    my $tex;
    $app->draw(
        sub {
            #my $t = [ gettimeofday ];
            $app->clear;
            $tex = scr2tex( @memory );
            $tex->draw_pro( $scr_rect, $window_rect );
            $fps->draw;
            #say tv_interval( $t );
        }
    );
}

Write up: https://fuzzix.org/building-the-secondworst-zx-spectrum-emulator-in-the-world-with-perl

20 years ago...
Perl Spectrum Emulator - https://sourceforge.net/projects/perl-spectrum/

It was inspirational... And it still works very well.

Oh, very nice! I had not heard of that one.