home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / riscos / RISCOS / DynamicArea.pm < prev    next >
Text File  |  1998-07-31  |  3KB  |  129 lines
  1. package RISCOS::DynamicArea;
  2.  
  3. use RISCOS::SWI;
  4. require Exporter;
  5. use strict;
  6. use vars qw (@ISA @EXPORT $VERSION %state $os_da $mask3 $mask2);
  7.  
  8. @ISA = qw(Exporter);
  9. @EXPORT = qw(dynamic_areas name_dynamic_area hash_dynamic_areas
  10. delete_dynamic_area);
  11. $VERSION = 0.02;
  12. # 0.02 uses map
  13.  
  14. $os_da = SWINumberFromString('XOS_DynamicArea');
  15. $mask2 = ®mask([0,1],[8]);
  16. $mask3 = ®mask([0,1],[1]);
  17.  
  18. sub dynamic_areas ()
  19. {
  20.     my ($num, $next, @result) = (-1, 'aaaa');
  21.  
  22.     while (1) {
  23.     return () unless swix ($os_da, $mask3, 3, $num, $next);
  24.  
  25.     $num = unpack 'i', $next;
  26.     return @result if $num == -1;
  27.     
  28.     push @result, $num;
  29.     }
  30. }
  31.     
  32. sub _name_dynamic_area ($)
  33. {
  34.     my $name = 'aaaa';
  35.     return undef unless swix ($os_da, $mask2, 2, 0+$_[0], $name);
  36.     unpack 'p', $name;
  37. }
  38.  
  39. sub name_dynamic_area 
  40. {
  41.     return &_name_dynamic_area unless wantarray;    # Pass on @_
  42.     map  { &_name_dynamic_area $_ } @_;
  43. }
  44.  
  45. sub hash_dynamic_areas
  46. {
  47.     my $hash = {};
  48.     
  49.     foreach (@_) {
  50.     my $name = _name_dynamic_area $_;
  51.     if (defined $name)
  52.     {
  53.         # If it's already there mark its number as -1
  54.         $hash->{$name} = defined ($hash->{$name}) ? -1
  55.                               : $_;
  56.     }
  57.     }
  58.     $hash;
  59. }
  60.  
  61. sub _delete_dynamic_area ($) {
  62.     defined (kernelswi ($os_da, 1, 0+$_[0])) ? 1 : 0;
  63. }
  64.  
  65. sub delete_dynamic_area 
  66. {
  67.     return &_delete_dynamic_area unless wantarray;    # Pass on @_
  68.     map {  &_delete_dynamic_area } @_;
  69. }
  70.  
  71.  
  72. $os_da;
  73.  
  74. __END__
  75.  
  76. =head1 NAME
  77.  
  78. RISCOS::DynamicArea -- routines to manipulate Dynamic Area
  79.  
  80. =head1 SYNOPSIS
  81.  
  82.     use RISCOS::DynamicArea(dynamic_areas,name_dynamic_area);
  83.     
  84.     print join "\n", name_dynamic_area dynamic_areas';
  85.     
  86. =head1 DESCRIPTION
  87.  
  88. C<RISCOS::DynamicArea> provides routines to list and manipulate dynamic areas.
  89.  
  90. =head2 Methods
  91.  
  92. =over 4
  93.  
  94. =item dynamic_areas
  95.  
  96. C<dynamic_areas> returns an list of the numbers of dynamic areas.
  97.  
  98. =item name_dynamic_area <number>, ...
  99.  
  100. C<name_dynamic_area> converts dynamic area numbers to names. In scalar context
  101. it returns the name of the dynamic area given by the first argument. In array
  102. context it returns a list of dynamic area names corresponding to the argument
  103. list of dynamic area numbers.
  104.  
  105. =item hash_dynamic_areas
  106.  
  107. C<hash_dynamic_areas> returns a reference to a hash of dynamic areas, keyed by
  108. name. If a name is unique to one dynamic area then the hash value is that
  109. dynamic area's number. If more than one dynamic area uses the same name, then
  110. the hash value for that area is C<undef>. Use C<exists> (see <perlfunc/exists>)
  111. to distinguish between names used for 0 or for multiple areas.
  112.  
  113. =item delete_dynamic_area
  114.  
  115. C<delete_dynamic_area> deletes dynamic areas by number. In scalar context it
  116. attempts to delete a single area, returning 1 on success, 0 on failure. In array
  117. context it returns a list of the results of attempting to the list of area
  118. numbers passed to it.
  119.  
  120. =back
  121.  
  122. =head1 BUGS
  123.  
  124. None known.
  125.  
  126. =head1 AUTHOR
  127.  
  128. Nicholas Clark <F<nick@unfortu.net>>
  129.