home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / crossplatform / transfer / datassette / decode.pl < prev    next >
Encoding:
Perl Script  |  2002-12-31  |  2.1 KB  |  61 lines

  1. #!/USR/BIN/PERL
  2. # tHIS pERL SCRIPT TRIES TO DECODE DATA IN cOMMODORE TAPE FORMAT
  3. # FROM CORRUPTED PULSE STREAMS IN THE "tap FILE" FORMAT.
  4. # iT TOLERATES LARGE VARIATIONS IN THE PULSE WIDTHS.
  5.  
  6. # tHIS SCRIPT HAS BEEN SUCCESSFULLY USED IN DECODING DATA FROM ABOUT
  7. # 18 YEARS OLD TAPES THAT WERE UNREADABLE BY THE cOMMODORE rom
  8. # ROUTINES.
  9.  
  10. # uSAGE: ./DECODE.PL DATA.TAP > DATA.BIN 2> ERRORS.TXT
  11. # yOU WILL NEED TO EDIT "DATA.BIN" - IT CONTAINS TWO COPIES OF EACH BLOCK.
  12. # tHE FIRST COPY SHOULD START WITH THE COUNTDOWN SEQUENCE $89,$88,...,$81,
  13. # AND THE SECOND COPY SHOULD START WITH 9,8,...,1.  yOU CAN EXTRACT AND
  14. # COMPARE THE TWO COPIES E.G. WITH gnu eMACS AND DIFF.  gOOD LUCK!
  15.  
  16. # iMPROVEMENTS ARE WELCOMED AT MSMAKELA@NIC.FUNET.FI.  oN MY TAPES,
  17. # THE SCRIPT SEEMS TO REPORT BOGUS PARITY ERRORS - THE DATA BITS ARE
  18. # OFTEN CORRECT.
  19.  
  20. {$7b}
  21.     LOCAL $/, $CNT=0, $LAST="";
  22.     $_=<>;
  23.     FOR (SPLIT /([o-~])/)
  24.     {$7b}
  25. IF ((LENGTH) > 19)
  26. {$7b}
  27.     WARN "IGNORING ", LENGTH ($LAST) + (LENGTH), " PULSES AT $CNT\N";
  28.     $LAST = "";
  29. {$7d}
  30. ELSIF ((LENGTH) < 19)
  31. {$7b}
  32.     # A MEDIUM PULSE WAS MISINTERPRETED AS A LONG ONE
  33.     $LAST .= $_ IF LENGTH ($LAST) {$7c}{$7c} (LENGTH) > 1;
  34.     IF (LENGTH ($LAST) == 19)
  35.     {$7b}
  36. $_ = $LAST; $LAST = "";
  37.     {$7d}
  38. {$7d}
  39. IF (LENGTH == 19)
  40. {$7b}
  41.     WARN "IGNORING ", LENGTH ($LAST), " PULSES AT $CNT\N"
  42. IF LENGTH ($LAST);
  43.     $LAST="";
  44.     $CNT++;
  45.     LOCAL @_ = SPLIT //;
  46.     LOCAL $BITS = "", $PARITY = 0;
  47.     IF ($_[1] GT $_[2]) {$7b}$BITS.="1";$PARITY=!$PARITY{$7d}ELSE{$7b}$BITS.="0"{$7d}
  48.     IF ($_[3] GT $_[4]) {$7b}$BITS.="1";$PARITY=!$PARITY{$7d}ELSE{$7b}$BITS.="0"{$7d}
  49.     IF ($_[5] GT $_[6]) {$7b}$BITS.="1";$PARITY=!$PARITY{$7d}ELSE{$7b}$BITS.="0"{$7d}
  50.     IF ($_[7] GT $_[8]) {$7b}$BITS.="1";$PARITY=!$PARITY{$7d}ELSE{$7b}$BITS.="0"{$7d}
  51.     IF ($_[9] GT $_[10]) {$7b}$BITS.="1";$PARITY=!$PARITY{$7d}ELSE{$7b}$BITS.="0"{$7d}
  52.     IF ($_[11] GT $_[12]) {$7b}$BITS.="1";$PARITY=!$PARITY{$7d}ELSE{$7b}$BITS.="0"{$7d}
  53.     IF ($_[13] GT $_[14]) {$7b}$BITS.="1";$PARITY=!$PARITY{$7d}ELSE{$7b}$BITS.="0"{$7d}
  54.     IF ($_[15] GT $_[16]) {$7b}$BITS.="1";$PARITY=!$PARITY{$7d}ELSE{$7b}$BITS.="0"{$7d}
  55.     IF ($_[17] GT $_[18]) {$7b}$PARITY=!$PARITY{$7d}
  56.     WARN "PARITY ERROR AT $CNT\N" IF ($PARITY);
  57.     PRINT PACK ("B*", $BITS);
  58. {$7d}
  59.     {$7d}
  60. {$7d}
  61.