home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Acorn User 10
/
AU_CD10.iso
/
Updates
/
Perl
/
Perl_Libs
/
wimptask.pl
< prev
Wrap
Perl Script
|
2000-05-21
|
2KB
|
79 lines
#!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;
}