home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Perl_Libs / wimptask.pl < prev   
Perl Script  |  2000-05-21  |  2KB  |  79 lines
  1. #!perl -w
  2.  
  3. # open (STDOUT, ">loggit");
  4. use RISCOS::SWI;
  5.  
  6. # Only want user message quit, prequit and help
  7. my $message_block = pack "I*", 0x502, 8, 0;
  8. my $poll = SWINumberFromString ('Wimp_Poll');
  9. my $poll_regmask = regmask ([0,1]);
  10.  
  11. my $block = 'x' x 256;
  12.  
  13. my $task_name = 'Hello world in perl'; # Can't pass read only string to SWIs
  14. #
  15. my $result = kernelswi ('Wimp_Initialise', 310, unpack ('I', 'TASK'),
  16.             $task_name, $message_block);
  17.  
  18. die $^E unless defined $result;
  19.  
  20. END    { kernelswi ('Wimp_CloseDown');}
  21.  
  22. my ($wimp, $handle) = unpack 'I2', $result;
  23.  
  24. my ($window, $winblock) = &create_window;
  25.  
  26. # Get first 7 words (28 bytes) from winblock
  27. my $openblock = pack "Ia28", $window, $winblock;
  28. swi ('Wimp_OpenWindow', regmask([1]), $openblock);
  29.  
  30. while (1) {
  31.     # Don't mask
  32.     #  1 Redraw window
  33.     #  2 Open window
  34.     #  3 Close window
  35.     #  6 Mouse click
  36.     #  8 Key pressed
  37.     #  9 Menu selection
  38.     # 17 User message
  39.     # 18 User message recorded
  40.  
  41.     $result = swi ($poll, $poll_regmask, 0x00003831, $block);
  42.     # print "$result\n";
  43.     if ($result == 17 or $result == 18) {
  44.     &user_message ($block);
  45.     } elsif ($result == 2) {
  46.     kernelswi ('Wimp_OpenWindow', 0, $block);
  47.     } elsif ($result == 3) {
  48.     kernelswi ('Wimp_CloseWindow', 0, $block);
  49.     exit;
  50.     }
  51. }
  52. # Never get here...
  53. kernelswi ('Wimp_CloseDown');
  54. exit;
  55.  
  56. sub user_message {
  57.     my $block = shift;
  58.     my ($length, $sender, $my_ref, $your_ref, $code) = unpack 'I5', $block;
  59.  
  60.     if ($code == 0) {
  61.     exit 0;
  62.     }
  63. }
  64.  
  65. sub create_window {
  66.     my $winflags = 0xFF000052;
  67.     my $titleflags = 0x0700003D;    # Text icon
  68.     my $buttonflags = 0;
  69.  
  70.     my $windowblock = pack "i4i2iI"    # x,y,x,y scroll x,y behinmd, flags
  71.     . "C7xi4II"            # Colours min x,y max x,y titleicon workbutton
  72.     . "IS2a12I",        # Sprites Min w,h Title NumIcons
  73.     200, 200, 800, 400, 0, 0, -1, $winflags, 7, 2, 7, 2, 3, 1, 12,
  74.     0, -200, 600, 0, $titleflags, $buttonflags, 1, 0, 0, 'Hello World', 0;
  75.  
  76.     my $handle = swi ('Wimp_CreateWindow', regmask([1]), $windowblock);
  77.     return wantarray ? ($handle, $windowblock) : $handle;
  78. }
  79.