/[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 96 by dpavlin, Thu Aug 2 13:58:26 2007 UTC revision 103 by dpavlin, Thu Aug 2 18:01:51 2007 UTC
# Line 140  Run interactive emulation loop Line 140  Run interactive emulation loop
140  sub run {  sub run {
141          my $self = shift;          my $self = shift;
142    
143            $self->show_mem( 1 );
144    
145          $self->boot if ( ! $self->booted );          $self->boot if ( ! $self->booted );
146          $self->loop;          $self->loop;
147  };  };
# Line 305  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 => sub {
319                    my ( $self, $key ) = @_;
320                    if ( $key eq 'return' ) {
321                            M6502::_write( 0xfc, 13 );
322                            return 0;
323                    } elsif ( $self->key_down( 'left ctrl' ) || $self->key_down( 'right ctrl' ) ) {
324                            return 16;
325                    }
326            },
327            0x87FA => {
328                    'f4' => 16,
329                    'f3' => 128,
330                    'f2' => 192,
331                    'f1' => 224,
332            },
333            0x87FB => sub {
334                    my ( $self, $key ) = @_;
335                    if ( $key eq 'space' ) {
336                            return 32;
337                    } elsif ( $self->key_down( 'left shift' ) || $self->key_down( 'right shift' ) ) {
338                            return 16;
339                    }
340            },
341            0x87F6 => {
342                    '6' => 16,
343                    't' => 128,
344                    'z' => 192,
345                    'r' => 224,
346            },
347            0x87F7 => {
348                    '5' => 32,
349                    '4' => 16,
350            },
351            0x87EE => {
352                    '7' => 16,
353                    'u' => 128,
354                    'i' => 192,
355                    'o' => 224,
356            },
357            0x87EF => {
358                    '8' => 32,
359                    '9' => 16,
360            },
361            0x87DE => {
362                    '1' => 16,
363                    'w' => 128,
364                    'q' => 192,
365                    'e' => 224,
366            },
367            0x87DF => {
368                    '2' => 32,
369                    '3' => 16,
370            },
371            0x87BE => {
372                    'm' => 16,
373                    'k' => 128,
374                    'j' => 192,
375                    'l' => 224,
376            },
377            0x87BF => {
378                    ',' => 32,
379                    '.' => 16,
380            },
381            0x877E => {
382                    'y' => 16,
383                    's' => 128,
384                    'a' => 192,
385                    'd' => 224,
386            },
387            0x877F => {
388                    'x' => 32,
389                    'c' => 16,
390            },
391            0x86FE => {
392                    'n' => 16,
393                    'g' => 128,
394                    'h' => 192,
395                    'f' => 224,
396            },
397            0x86FF => {
398                    'b' => 32,
399                    'v' => 16,
400            },
401            0x85FE => {
402                    ';' => sub { $_[0]->key_down('left shift') ? 16 : 224 },
403                    '\\' => 128,
404                    '\'' => 192,
405    #               ';' => 224,
406                    '8' => 16,      # FIXME?
407            },
408            0x85FF => {
409                    '/' => 32,
410                    '6' => 16,      # FIXME?
411            },
412            0x83FE => {
413                    ';' => 16,
414                    '[' => 128,
415                    ']' => 192,
416                    'p' => 224,
417                    '=' => 16,      # FIXME?
418            },
419            0x83FF => {
420                    '-' => 32,
421                    '0' => 16,
422            },
423    };
424    
425    my $keyboard_none = 255;
426    
427  sub read {  sub read {
428          my $self = shift;          my $self = shift;
429          my ($addr) = @_;          my ($addr) = @_;
# Line 315  sub read { Line 434  sub read {
434          # keyboard          # keyboard
435    
436          if ( first { $addr == $_ } @kbd_ports ) {          if ( first { $addr == $_ } @kbd_ports ) {
437                  warn sprintf("keyboard port: %04x\n",$addr);                  warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;
438          } elsif ( $addr == 0x87fc ) {                  my $key = $self->key_pressed;
439                  warn "0x87fc - arrows/back\n";                  if ( defined($key) ) {
440  =for pascal                          my $ret = $keyboard_none;
441                  if VKey=VK_RIGHT then Result:=16;                          my $r = $keyboard->{$addr} || confess "no definition for keyboard port found";
442                  if VKey=VK_DOWN then Result:=128;                          if ( ref($r) eq 'CODE' ) {
443                  if VKey=VK_UP then Result:=192;                                  $ret = $r->($self, $key);
444                  if VKey=VK_LEFT then Result:=224;                          } elsif ( $ret = $r->{$key} ) {
445                  if Ord(KeyPressed)=VK_BACK then Result:=224;                                  if ( ref($ret) eq 'CODE' ) {
446  =cut                                          $ret = $ret->($self);
447          } elsif ( $addr == 0x87fd ) {                                          warn "executed $key and got: $ret\n";
448                  warn "0x87fd - enter\n";                                  } else {
449  =for pascal                                          warn sprintf("keyboard port: %04x key: '%s' code: %02x\n", $addr, $key, $ret);
450      if KeyPressed=Chr(13) then begin                                  }
451        Mem[$FC]:=13;                                  $mem[$addr] = $ret;
452        Result:=0;                                  warn "keypress: $key = $ret\n";
453      end;                                  return $ret;
454  =cut                          } else {
455          } elsif ( $addr == 0x87fa ) {                                  warn sprintf("keyboard port: %04x unknown key: '%s'\n", $addr, $key) if $debug;
456                  warn "0x87fa = F1 - F4\n";                          }
457  =for pascal                          warn sprintf("keyboard port: %04x %s\n",$addr,dump( $r )) if $self->trace;
458      if VKey=VK_F4 then Result:=16;                  }
459      if VKey=VK_F3 then Result:=128;                  return $keyboard_none;
     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  
460          }          }
461    
462          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
# Line 415  sub prompt { Line 511  sub prompt {
511          my $self = shift;          my $self = shift;
512          $self->app->sync;          $self->app->sync;
513          my $a = shift;          my $a = shift;
514          print STDERR $self->hexdump( $a ),          print $self->hexdump( $a ),
515                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
516                  "> ";                  "> ";
517          my $in = <STDIN>;          my $in = <STDIN>;
# Line 464  d\t\tdebug [$d] Line 560  d\t\tdebug [$d]
560    
561  __USAGE__  __USAGE__
562                          warn $self->dump_R;                          warn $self->dump_R;
563                            $last = '';
564                  } elsif ( $c =~ m/^e/i ) {                  } elsif ( $c =~ m/^e/i ) {
565                          $a = $v if defined($v);                          $a = $v if defined($v);
566                          my $to = shift @v;                          my $to = shift @v;
Legend:
Removed from v.96  
changed lines
  Added in v.103
  ViewVC Help
Powered by ViewVC 1.1.26