Index: /trunk/tools/ds9_regions_mask.pl
===================================================================
--- /trunk/tools/ds9_regions_mask.pl	(revision 20600)
+++ /trunk/tools/ds9_regions_mask.pl	(revision 20600)
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+use constant COLOURS => { 'green' => 0,
+                          'blue' => 1,
+                          'yellow' => 2,
+                          'magenta' => 3,
+                          'cyan' => 4,
+                          'red' => 5,
+                      };
+
+my $regions = shift @ARGV;      # Input regions file
+my $masks = shift @ARGV;        # Output mask description
+
+my $global_colour;              # Default colour
+
+my ($input, $output);           # Files
+open $input, $regions;
+open $output, "> $masks";
+while (<$input>) {
+    s/\#.*//;                   # Comments
+    next unless /\S+/;          # Blank line
+    if (/^global.*color=(\S+)/) {
+        $global_colour = $1;
+        next;
+    }
+    next if /^physical/;        # Boring line
+    if (/^circle\((\S+),(\S+),(\S+)\)/) {
+        my $x = $1;             # x coord
+        my $y = $2;             # y coord
+        my $rad = $3;           # radius
+        my $col;                # Colour
+        if (/color=(\S+)/) {
+            $col = $1;
+        } else {
+            $col = $global_colour;
+        }
+        die "Unknown colour." unless defined $col;
+
+        my $code = ${COLOURS()}{$col};
+        die "Unrecognised colour: $col" unless defined $code;
+
+        print $output "$code $x $y $rad\n";
+        next;
+    }
+    die "Unrecognised line: $_";
+}
+close $input;
+close $output;
+
+__END__
