#!perl -w

# open (STDOUT, ">loggit");
use RISCOS::SWI;

# Only want user message quit, prequit and help
my $message_block = pack "I*", 0x502, 8, 0;
my $poll = SWINumberFromString ('Wimp_Poll');
my $poll_regmask = regmask ([0,1]);

my $block = 'x' x 256;

my $task_name = 'Hello world in perl'; # Can't pass read only string to SWIs
#
my $result = kernelswi ('Wimp_Initialise', 310, unpack ('I', 'TASK'),
			$task_name, $message_block);

die $^E unless defined $result;

END	{ kernelswi ('Wimp_CloseDown');}

my ($wimp, $handle) = unpack 'I2', $result;

my ($window, $winblock) = &create_window;

# Get first 7 words (28 bytes) from winblock
my $openblock = pack "Ia28", $window, $winblock;
swi ('Wimp_OpenWindow', regmask([1]), $openblock);

while (1) {
    # Don't mask
    #  1 Redraw window
    #  2 Open window
    #  3 Close window
    #  6 Mouse click
    #  8 Key pressed
    #  9 Menu selection
    # 17 User message
    # 18 User message recorded

    $result = swi ($poll, $poll_regmask, 0x00003831, $block);
    # print "$result\n";
    if ($result == 17 or $result == 18) {
	&user_message ($block);
    } elsif ($result == 2) {
	kernelswi ('Wimp_OpenWindow', 0, $block);
    } elsif ($result == 3) {
	kernelswi ('Wimp_CloseWindow', 0, $block);
	exit;
    }
}
# Never get here...
kernelswi ('Wimp_CloseDown');
exit;

sub user_message {
    my $block = shift;
    my ($length, $sender, $my_ref, $your_ref, $code) = unpack 'I5', $block;

    if ($code == 0) {
	exit 0;
    }
}

sub create_window {
    my $winflags = 0xFF000052;
    my $titleflags = 0x0700003D;	# Text icon
    my $buttonflags = 0;

    my $windowblock = pack "i4i2iI"	# x,y,x,y scroll x,y behinmd, flags
    . "C7xi4II"			# Colours min x,y max x,y titleicon workbutton
    . "IS2a12I",		# Sprites Min w,h Title NumIcons
    200, 200, 800, 400, 0, 0, -1, $winflags, 7, 2, 7, 2, 3, 1, 12,
    0, -200, 600, 0, $titleflags, $buttonflags, 1, 0, 0, 'Hello World', 0;

    my $handle = swi ('Wimp_CreateWindow', regmask([1]), $windowblock);
    return wantarray ? ($handle, $windowblock) : $handle;
}