DASM
DExecHW/SimpleKey.pm
Go to the documentation of this file.
00001 #!/usr/bin/perl -w
00002 ##
00003 # HW implementation for 'SimpleKey'.
00004 #
00005 # A very simple key input.
00006 #
00007 # 2 words are provided (little endian):
00008 #
00009 # | Offset | Name  | Meaning |
00010 # | ------ | ----- | ------- |
00011 # | +0     | Read  | read a key, or 0 if none available |
00012 # | +1     | Count | number of characters available |
00013 #
00014 # The characters available are dequeued by reading the Read register.
00015 # Every read of the Read register will queue any new characters for
00016 # reading.
00017 #
00018 # Writing to any register has no effect.
00019 #
00020 # @file
00021 # @author Justin Fletcher
00022 #
00023 
00024 package DExecHW::SimpleKey;
00025 
00026 use Term::ReadKey;
00027 
00028 
00029 ##
00030 # Construct a new hardware device object.
00031 #
00032 # @param[in]  $proto   This class object, or prototype to add to
00033 # @param[in]  $object  The object to proxy for
00034 # @param[in]  $offset  The offset this object is created for
00035 #
00036 # @return Assembler object
00037 sub new
00038 {
00039     my $proto = shift;
00040     my $object = shift;
00041     my $offset = shift || 0;
00042     my $class = ref($proto) || $proto;
00043     my $self = {
00044             'queue' => [],
00045         };
00046     
00047     bless $self, $class;
00048     
00049     
00050     return $self;
00051 }
00052 
00053 
00054 ##
00055 # Start up the hardware.
00056 #
00057 # We configure the terminal for 'cbreak' mode which ensures that the
00058 # keys are not buffered before delivery.
00059 #
00060 # @param[in] $self   Object
00061 sub start
00062 {
00063     my ($self) = @_;
00064 
00065     # Configure cbreak read mode, which delivers keys immediately
00066     ReadMode 'cbreak';
00067 }
00068 
00069 
00070 ##
00071 # Stop the hardware.
00072 #
00073 # Returns the terminal to the mode iti was in prior to being placed in
00074 # 'cbreak' mode.
00075 #
00076 # @param[in] $self   Object
00077 sub stop
00078 {
00079     my ($self) = @_;
00080 
00081     # Configure cbreak read mode, which delivers keys immediately
00082     ReadMode 'restore';
00083 }
00084 
00085 
00086 
00087 ##
00088 # Return the size of of the implementation.
00089 #
00090 # @param[in] $self   Object
00091 #
00092 # @return Size of the hardware implementation in words
00093 sub window
00094 {
00095     my ($self) = @_;
00096 
00097     return 2;
00098 }
00099 
00100 
00101 ##
00102 # Read value
00103 #
00104 # @param[in] $self   Object
00105 # @param[in] $offset Offset of register within window
00106 # @param[in] $exec   DExec object opon which this object is operating
00107 #
00108 # @return value of this register
00109 sub read
00110 {
00111     my ($self, $offset, $exec) = @_;
00112 
00113     # Add any new keys to the queue
00114     while (my $key = ReadKey(-1))
00115     {
00116         push @{ $self->{'queue'} }, $key;
00117     }
00118     
00119 
00120     if ($offset == 1)
00121     {
00122         # Deal with the Count register.
00123         return scalar(@{ $self->{'queue'} });
00124     }
00125     
00126     # Return a value from the queue
00127     $key = shift @{ $self->{'queue'} };
00128     
00129     if (!defined $key)
00130     {
00131         $key = 0;
00132     }
00133     else
00134     {
00135         $key = ord($key);
00136     }
00137     
00138     return $key;
00139 }
00140 
00141 
00142 ##
00143 # Write value
00144 #
00145 # @param[in] $self   Object
00146 # @param[in] $offset Offset of register within window
00147 # @param[in] $exec   DExec object upon which this object is operating
00148 # @param[in] $value  Value to write
00149 #
00150 # @return ignored
00151 sub write
00152 {
00153     my ($self, $offset, $exec, $value) = @_;
00154     # Not required
00155 }
00156 
00157 
00158 ##
00159 # Get the symbol name for an offset
00160 #
00161 # @param[in] $self   Object
00162 # @param[in] $offset Offset of register within window
00163 #
00164 # @return symbol name to use
00165 # @retval undef for a default symbol
00166 # @retval "" for no symbol
00167 sub symbol
00168 {
00169     my ($self, $offset) = @_;
00170     
00171     return ("Read", "Count")[$offset];
00172 }
00173 
00174 # Must return 1
00175 1;