! 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