home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / archimedes / aruudec.bas < prev    next >
BASIC Source File  |  1993-04-30  |  4KB  |  112 lines
  1.    10REM>ARCUUDEC
  2.    20    REM *************************************************************
  3.    30    REM UUDECODE.BAS
  4.    40    REM
  5.    50    REM UUDECODE in Atari Basic
  6.    60    REM Original version 1.0  23-Sep-1987   by Brian Robinson
  7.    65    REM This version 2.0 16-Aug-1988
  8.    70    REM
  9.    80    REM slow and crude version only designed as a bootstrap
  10.    90    REM to convert the correct UUDECODE.UUE into UUDECODE.TTP
  11.   100    REM
  12.   110    REM  Modified for Archimedes  - 16 August 1988
  13.   120    REM  by A.F.Abbey - Physics Dept, Leicester University
  14.   130    REM  AFA@UK.AC.LE.STAR
  15.   140    REM *************************************************************
  16.   150   MAXCHAR   = 127
  17.   160   CODEDLN   = 61
  18.   170   NORMLEN   = 45
  19.   180   DIM CHTBL(MAXCHAR)
  20.   190   DEF FNT(A$)=ASC(A$)-32
  21.   200   FOR C=0 TO MAXCHAR: CHTBL(C)=0: NEXT C
  22.   210   ON ERROR REPORT:PRINT" at ";ERL:CLOSE #0:END
  23.   220   REM *************************************************************
  24.   230   REM main program
  25.   240   REM *************************************************************
  26.   250   PRINT
  27.   260   PRINT "UUDECODE v2.0  16-Aug-1988  AFA"
  28.   270   PRINT
  29.   280   INPUT "Enter filename to decode ";INFILE$
  30.   290   PRINT "File open : ";INFILE$
  31.   300   ch%=OPENIN(INFILE$)
  32.   310   PRINT "File opened"
  33.   320   REPEAT LI$=GET$#ch%:UNTIL  LEN(LI$)>0
  34.   330   REM next 2 lines are a quick and dirty fudge for bad file structure
  35.   340   REM LI$="table"
  36.   350   IF LI$="table" THEN GOSUB 490
  37.   360   IF LEFT$(LI$,5)="begin" THEN GOSUB 710
  38.   370   GOSUB 850
  39.   380   LI$=GET$#ch%:IF LEN(LI$)=0 LI$=GET$#ch%
  40.   390   IF LEFT$(LI$,3)="end" THEN PRINT:PRINT "End of file"
  41.   400   REPEAT LI$=GET$#ch% :UNTIL LEN(LI$)>0
  42.   410   IF LEFT$(LI$,4)="size" THEN PRINT:PRINT"Code length ";MID$(LI$,6,(LEN(LI$)-5))
  43.   420   PRINT
  44.   430   PRINT "Uudecode complete"
  45.   440    CLOSE #0
  46.   450   END
  47.   460   REM *************************************************************
  48.   470   REM build a character translation table
  49.   480   REM *************************************************************
  50.   490   REM GETTABLE:
  51.   500   PRINT
  52.   510   PRINT "Table definition start"
  53.   520   FOR C=0 TO MAXCHAR: CHTBL(C)=0: NEXT C
  54.   530   REPEAT LI$=GET$#ch% :UNTIL LEN(LI$)>0
  55.   540   L=LEN(LI$)
  56.   550   FOR C=1 TO L
  57.   560   C$=MID$(LI$,C,1)
  58.   570   CHTBL(C)=ASC(C$)
  59.   580   NEXT C
  60.   590   REPEAT LI$=GET$#ch% :UNTIL LEN(LI$)>0
  61.   600   L=LEN(LI$)
  62.   610   FOR C=1 TO L
  63.   620   C$=MID$(LI$,C,1)
  64.   630   CHTBL(C+32)=ASC(C$)
  65.   640   NEXT C
  66.   650   PRINT "Table definition finish"
  67.   660   RETURN
  68.   670   REM *************************************************************
  69.   680   REM open output file
  70.   690   REM use a large direct access file to avoid carriage returns
  71.   700   REM *************************************************************
  72.   710   REM OPENOUTFILE:
  73.   720   PRINT
  74.   730   PRINT LI$
  75.   740   L=LEN(LI$)-9
  76.   750   OUTFILE$=MID$(LI$,11,L)
  77.   760   PRINT "File open : ";OUTFILE$
  78.   770   ch2%=OPENOUT(OUTFILE$)
  79.   780   PRINT "File opened"
  80.   790   RETURN
  81.   800   REM *************************************************************
  82.   810   REM decode main data block
  83.   820   REM all data is decoded as full blocks of 4 characters
  84.   830   REM to give 3 bytes into the output file
  85.   840   REM *************************************************************
  86.   850   REM DECODE:
  87.   860   lines=0
  88.   870   PRINT
  89.   880   REPEAT LI$=GET$#ch% :UNTIL LEN(LI$)>0
  90.   890   WHILE LEN(LI$)>3
  91.   900   LL=LEN(LI$)-1
  92.   910   CL=FNT(LEFT$(LI$,1))
  93.   920   FOR I%=2 TO LL STEP 4
  94.   930   G1%=FNT(MID$(LI$,I%  ,1))
  95.   940   G2%=FNT(MID$(LI$,I%+1,1))
  96.   950   G3%=FNT(MID$(LI$,I%+2,1))
  97.   960   G4%=FNT(MID$(LI$,I%+3,1))
  98.   970   B0%=(G1%<<2)+(G2%>>4)
  99.   980   B1%=((G2%<<4)+(G3%>>2))AND &FF
  100.   990   B2%=((G3%<<6)+G4%)AND &FF
  101.  1000   BPUT#ch2%,CHR$(B0%)+CHR$(B1%)+CHR$(B2%);
  102.  1010   NEXT I%
  103.  1020   lines=lines+1
  104.  1030    IF lines MOD 10 =0 PRINT"Lines = ";lines;CHR$(&D);
  105.  1040   REPEAT LI$=GET$#ch% :UNTIL LEN(LI$)>0
  106.  1050   ENDWHILE
  107.  1060  PRINT "Lines decoded = ";lines
  108.  1070  CL=FNT(LEFT$(LI$,1))
  109.  1080  IF CL=0 THEN PRINT "End of data block"
  110.  1090  RETURN
  111.  1100
  112.