/[VRac]/Orao.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /Orao.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 97 by dpavlin, Thu Aug 2 14:07:52 2007 UTC revision 98 by dpavlin, Thu Aug 2 16:01:16 2007 UTC
# Line 307  Read from memory Line 307  Read from memory
307    
308  =cut  =cut
309    
310    my $keyboard = {
311            0x87FC => {
312                    'right'         => 16,
313                    'down'          => 128,
314                    'up'            => 192,
315                    'left'          => 224,
316                    'backspace' => 224,
317            },
318            0x87FD => {
319                    'return' => sub {
320                            M6502::write( 0xfc, 13 );
321                            return 0;
322                    },
323                    'left ctrl'  => 16,
324                    'right ctrl' => 16,
325            },
326            0x87FA => {
327                    'f4' => 16,
328                    'f3' => 128,
329                    'f2' => 192,
330                    'f1' => 224,
331            },
332            0x87FB => {
333                    'space' => 32,
334                    'left shift' => 16,
335                    'right shift' => 16,
336            },
337            0x87F6 => {
338                    '6' => 16,
339                    't' => 128,
340                    'z' => 192,
341                    'r' => 224,
342            },
343            0x87F7 => {
344                    '5' => 32,
345                    '4' => 16,
346            },
347            0x87EE => {
348                    '7' => 16,
349                    'u' => 128,
350                    'i' => 192,
351                    'o' => 224,
352            },
353            0x87EF => {
354                    '8' => 32,
355                    '9' => 16,
356            },
357            0x87DE => {
358                    '1' => 16,
359                    'w' => 128,
360                    'q' => 192,
361                    'e' => 224,
362            },
363            0x87DF => {
364                    '2' => 32,
365                    '3' => 16,
366            },
367            0x87BE => {
368                    'm' => 16,
369                    'k' => 128,
370                    'j' => 192,
371                    'l' => 224,
372            },
373            0x87BF => {
374                    ',' => 32,
375                    '.' => 16,
376            },
377            0x877E => {
378                    'y' => 16,
379                    's' => 128,
380                    'a' => 192,
381                    'd' => 224,
382            },
383            0x877F => {
384                    'x' => 32,
385                    'c' => 16,
386            },
387            0x86FE => {
388                    'n' => 16,
389                    'g' => 128,
390                    'h' => 192,
391                    'f' => 224,
392            },
393            0x86FF => {
394                    'b' => 32,
395                    'c' => 16,
396            },
397            0x85FE => {
398                    ':' => 16,
399                    '\\' => 128,
400                    '\'' => 192,
401                    ';' => 224,
402                    '8' => 16,      # FIXME?
403            },
404            0x85FF => {
405                    '/' => 32,
406                    '6' => 16,      # FIXME?
407            },
408            0x83FE => {
409                    ';' => 16,
410                    '[' => 128,
411                    ']' => 192,
412                    'p' => 224,
413                    '=' => 16,      # FIXME?
414            },
415            0x83FF => {
416                    '-' => 32,
417                    '0' => 16,
418            },
419    };
420    
421    
422  sub read {  sub read {
423          my $self = shift;          my $self = shift;
424          my ($addr) = @_;          my ($addr) = @_;
# Line 318  sub read { Line 430  sub read {
430    
431          if ( first { $addr == $_ } @kbd_ports ) {          if ( first { $addr == $_ } @kbd_ports ) {
432                  warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;                  warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;
433          } elsif ( $addr == 0x87fc ) {                  if ( my $key = $self->key_pressed ) {
434                  warn "0x87fc - arrows/back\n";                          my $r = $keyboard->{$addr} || confess "no definition for keyboard port found";
435  =for pascal                          if ( my $ret = $r->{$key} ) {
436                  if VKey=VK_RIGHT then Result:=16;                                  if ( ref($ret) eq 'CODE' ) {
437                  if VKey=VK_DOWN then Result:=128;                                          $ret = $ret->();
438                  if VKey=VK_UP then Result:=192;                                          warn "executed $key and got: $ret\n";
439                  if VKey=VK_LEFT then Result:=224;                                  } else {
440                  if Ord(KeyPressed)=VK_BACK then Result:=224;                                          warn sprintf("keyboard port: %04x key: '%s' code: %02x\n", $addr, $key, $ret);
441  =cut                                  }
442          } elsif ( $addr == 0x87fd ) {                                  $mem[$addr] = $ret;
443                  warn "0x87fd - enter\n";                                  return $ret;
444  =for pascal                          } else {
445      if KeyPressed=Chr(13) then begin                                  warn sprintf("keyboard port: %04x unknown key: '%s'\n", $addr, $key);
446        Mem[$FC]:=13;                          }
447        Result:=0;                          warn sprintf("keyboard port: %04x %s\n",$addr,dump( $r )) if $self->trace;
448      end;                  }
 =cut  
         } elsif ( $addr == 0x87fa ) {  
                 warn "0x87fa = F1 - F4\n";  
 =for pascal  
     if VKey=VK_F4 then Result:=16;  
     if VKey=VK_F3 then Result:=128;  
     if VKey=VK_F2 then Result:=192;  
     if VKey=VK_F1 then Result:=224;  
 =cut  
         } elsif ( $addr == 0x87fb ) {  
                 warn "0x87fb\n";  
 =for pascal  
     if KeyPressed=Chr(32) then Result:=32;  
     if KeyPressed='"' then Result:=16;  
     if KeyPressed='!' then Result:=16;  
     if KeyPressed='$' then Result:=16;  
     if KeyPressed='%' then Result:=16;  
     if KeyPressed='&' then Result:=16;  
     if KeyPressed='(' then Result:=16;  
     if KeyPressed=')' then Result:=16;  
     if KeyPressed='=' then Result:=16;  
     if KeyPressed='#' then Result:=16;  
     if KeyPressed='+' then Result:=16;  
     if KeyPressed='*' then Result:=16;  
     if KeyPressed='?' then Result:=16;  
     if KeyPressed='<' then Result:=16;  
     if KeyPressed='>' then Result:=16;  
     if VKey=191 then Result:=16;  
 =cut  
449          }          }
450    
451          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
Legend:
Removed from v.97  
changed lines
  Added in v.98
  ViewVC Help
Powered by ViewVC 1.1.26