! CODER.BAS -   A program to encrypt/decrypt any sequential file.
!
!       Dave Britson
!       Des Moines, Ia
!       November '85
!
!       XCALL Subroutines used: FILEIN, STRIP
!
!               Thanks to Tom Dahlquist for FILEIN.SBR
!

MAP1 IFILE
       MAP2 AREA,X,616
       MAP2 BUFFER,X,1

MAP1 FILENAME,S,10
MAP1 INLINE,S,132
MAP1 OUTLINE,S,132
MAP1 CODE,S,6
MAP1 NUM'CODE,S,6,""
MAP1 CODE'TYPE,S,1
MAP1 PREF,S,6
MAP1 ENTRY,S,20

BEGIN:
       Y=0
       PRINT TAB(-1,0);"File Encoder/Decoder";
       PRINT TAB(08,10);"E)ncode or D)ecode: _";
       PRINT TAB(10,10);"Document Name:      __________";
       PRINT TAB(12,10);"Code:               ______";

ENCODE:
       PRINT TAB(8,30);
       INPUT LINE CODE'TYPE
       IF CODE'TYPE="" GOTO BACKOUT
       CODE'TYPE=UCS(CODE'TYPE[1;1])
       IF INSTR(1,"ED",CODE'TYPE[1;1])=0 GOTO ENCODE

DOCUMENT:
       PRINT TAB(10,30);
       INPUT LINE FILENAME
       IF FILENAME="" GOTO ENCODE

CODE:
       PRINT TAB(12,30);
       INPUT LINE CODE
       IF CODE="" GOTO DOCUMENT

ANYCNG:
       PRINT TAB(23,1);"ANY CHANGE? _";
       PRINT TAB(23,13);
       INPUT LINE ENTRY
       ENTRY=UCS(ENTRY)
       IF ENTRY="Y" GOTO BEGIN

       XCALL STRIP,FILENAME
       BRK=INSTR(1,FILENAME,".")
       IF BRK=0 &
               BRK=LEN(FILENAME)+1 : &
               FILENAME=FILENAME+".TXT"

       PREF=FILENAME[1,BRK-1]
       LOOKUP FILENAME,THERE
       IF THERE=0 &
               PRINT TAB(23,1);CHR(7);"DOCUMENT NOT FOUND"; : &
               INPUT LINE ENTRY : &
               GOTO BEGIN

       IF THERE<0 &
               PRINT TAB(23,1);CHR(7);"CANNOT PROCESS CONTIGUOUS FILES"; : &
               INPUT LINE ENTRY : &
               GOTO BEGIN

       FOR I = 1 TO 6
               C=C+(ASC(CODE[I,I])**I)
       NEXT I
       D=SQR(C)
       NUM'CODE=INT(D)
       XCALL STRIP,NUM'CODE

       XCALL FILEIN,1,AREA,FILENAME
       IF CODE'TYPE="E" &
               OPEN #14,PREF+".CDE",OUTPUT &
       ELSE &
               OPEN #14,PREF+".NRM",OUTPUT

       X=0 : INLINE="" : OUTLINE="" : DECODE=""

LOOP:
       XCALL FILEIN,2,AREA,BUFFER,L
       IF L<1 GOTO FINALE
       X=X+1 : Y=Y+1
       IF X>LEN(NUM'CODE) X=1
       B=ASC(BUFFER)
       IF CODE'TYPE="E" &
               CALL ROR &
       ELSE &
               CALL ROL

       PRINT #14,CHR(B);
       IF Y/10=INT(Y/10) PRINT TAB(15,5);Y USING "#,###,###";
       GOTO LOOP

ROR:
       FOR J = 1 TO VAL(NUM'CODE[X;1])
               IF B/2#INT(B/2) C=128 ELSE C=0
               B=INT(B/2)
               B=B+C
       NEXT J
       RETURN

ROL:
       FOR I = 1 TO VAL(NUM'CODE[X;1])
               IF B*2>255 C=255 ELSE C=0
               B=B*2
               B=B-C
       NEXT I
       RETURN

FINALE:
       XCALL FILEIN,3,AREA
       CLOSE #14
       PRINT
       IF CODE'TYPE="E" &
               PRINT TAB(23,1);CHR(7);"ENCODED FILE EXISTS ON DISK AS ";PREF;".CDE"; : &
               INPUT LINE ENTRY &
       ELSE &
               PRINT TAB(23,1);CHR(7);"DECODED FILE EXISTS ON DISK AS ";PREF;".NRM"; : &
               INPUT LINE ENTRY

       GOTO BEGIN

BACKOUT:
       PRINT TAB(-1,0);
       END