DASM
|
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;