1000	' File Compare / Edit utility v1.5

	'

	' Copyright (c) 1980 by John R. Burns

	'
1020	'

	'

	' Define all numeric variables as intergers for speed.

	'
1040 DIM MSG$(21)
1060 DEFINT A-Z
1080 WIDTH 255
1100 GOSUB 7060
1120 PRINT INIT$
1140 MASK$="   "+MASK$
1160 CLR$=CLR$+STRING$(NUL,0)
1180 EOL$=EOL$+STRING$(NUL,0)
1200 GOTO 1320
1220	'

	' Subroutine to perform row - column screen addressing.

	'

	' On entry:

	'

	' PX = Row.

	' PY = Column.

	'
1240 PRINT POS.XY$;
1260 IF R.C THEN PRINT CHR$(PY+BIASY-1) CHR$(PX+BIASX-1);: RETURN
1280 PRINT CHR$(PX+BIASX-1) CHR$(PY+BIASY-1);: RETURN
1300	'

	' Main Program Starts Here (sign-on with TOD & DATE).

	'
1320 PRINT CLR$ STRING$(10,0)
1340 PX=4: PY=1: GOSUB 1220: PRINT MSG$(1)
1360 PX=5: PY=1: GOSUB 1220: PRINT MSG$(2)
1380 RESET
1400	'

	' See if direct edit or compare request on file(s).

	'
1420 PX=9: PY=1: GOSUB 1220: PRINT EOL$ MSG$(3);
1440 E$ = CHR$(ASC(INPUT$(1)) AND &H5F)
1460 PRINT E$
1480 FOR PX=10 TO 18
1500 PY=1: GOSUB 1220: PRINT EOL$
1520 NEXT PX
1540 IF E$="C" THEN 1660
1560 IF E$="S" THEN 5980
1580 IF E$<>"E" THEN PRINT CHR$(7);: GOTO 1420
1600 PX=11: PY=1: GOSUB 1220: PRINT MSG$(4);: LINE INPUT A$
1620 GOTO 1700
1640	'

	' Prompt operator for required info:

	'

	' A$ = Source file drive:name.extent.

	' B$ = Cross  file drive:name.extent.

	' R$ = Starting record number in a$ & b$.

	'
1660 PX=11: PY=1: GOSUB 1220: PRINT MSG$(5) EOL$;: LINE INPUT A$
1680 PX=12: PY=1: GOSUB 1220: PRINT MSG$(6) EOL$;: LINE INPUT B$
1700 GOSUB 6700
1720	'

	' See if files are present on designated drive.

	'
1740 ON ERROR GOTO 4020
1760 OPEN "I",1,A$
1780 IF E$="E" THEN 1820
1800 OPEN "I",2,B$
1820 ON ERROR GOTO 0
1840 CLOSE
1860	'

	' Open files and make ready for processing.

	'
1880 OPEN "R",1,A$
1900 CHK$=A$: GOSUB 6040
1920 REC1=RECS: HD1$="'"
1940 IF LEFT$(FCB$,1)<>CHR$(0) THEN HD1$=HD1$+CHR$(ASC(LEFT$(FCB$,1))+64)+":"
1960 HD1$=HD1$+MID$(FCB$,2,12)+"'"
1980 IF E$="E" THEN 2100
2000 OPEN "R",2,B$
2020 CHK$=B$: GOSUB 6040
2040 REC2=RECS: HD2$="'"
2060 IF LEFT$(FCB$,1)<>CHR$(0) THEN HD2$=HD2$+CHR$(ASC(LEFT$(FCB$,1))+64)+":"
2080 HD2$=HD2$+MID$(FCB$,2,12)+"'"
2100 FIELD #1, 128 AS F1$
2120 IF E$="E" THEN 2220
2140 FIELD #2, 128 AS F2$
2160 PX=11: PY=50: GOSUB 1220: PRINT "Length =" REC1
2180 PX=12: PY=50: GOSUB 1220: PRINT "Length =" REC2
2200	'

	' Come here to retrive new record(s) from file(s).

	'
2220 IF REC<=0 THEN REC=1:PRINT CHR$(7);
2240 IF REC>REC1 THEN CLOSE: GOTO 1320
2260 GET #1, REC
2280 IF E$="E" THEN 2540
2300 IF REC>REC2 THEN CLOSE: GOTO 1320
2320 GET #2, REC
2340 IF E$="C" AND R$="E" AND H$<>"H" AND H$<>"A" THEN 2540
2360	'

	' Compare record of a$ with record of b$.

	'

	' If records are not the same branch to records printing subroutine.

	'
2380 FOR I = 1 TO 128
2400 IF MID$(F1$,I,1) <> MID$(F2$,I,1) THEN 2540
2420 NEXT I
2440 PX=15: PY=1: GOSUB 1220: PRINT USING REC$; REC;
2460 PRINT CHR$(13);
2480 REC = REC + 1
2500 GOTO 2220
2520	'

	' Subroutine to print source / cross records.

	'
2540 IF WRP=0 THEN PRINT CLR$;
2560 PRINT LO$
2580 NUM=REC: GOSUB 6600: NUM1$=NUM$
2600 NUM=REC1: GOSUB 6600: NUM2$=NUM$
2620 IF E$="C" THEN 2680
2640 PRINT CHR$(13) "Addr";:

	PRINT USING MASK$;MSK1$,HD1$,NUM1$,NUM2$;:

	PRINT TAB(64) "Ascii          "
2660 GOTO 2700
2680 PRINT CHR$(13) "Addr";:

	PRINT USING MASK$;MSK2$,HD1$,NUM1$,NUM2$;:

	PRINT TAB(64) "Ascii          "
2700 PRINT LIN$ "    "
2720 X$=F1$
2740 GOSUB 3400
2760 IF E$="E" THEN R$="E": GOTO 3000
2780 NUM=REC: GOSUB 6600: NUM1$=NUM$
2800 NUM=REC2: GOSUB 6600: NUM2$=NUM$
2820 PRINT LO$ CHR$(13) "Addr";:

	PRINT USING MASK$;MSK3$,HD2$,NUM1$,NUM2$;:

	PRINT TAB(64) "Ascii          "
2840 PRINT LIN$ "    "
2860 X$=F2$
2880 GOSUB 3400
2900 IF R$="E" AND H$<>"" THEN 3000
2920	'

	' Ask what operator wants to do about it.

	'
2940 PX=24: PY=1: GOSUB 1220: PRINT EOL$;
2960 PRINT HI$ MSG$(7);
2980 R$ = CHR$(ASC(INPUT$(1)) AND &H5F)
3000 PX=24: PY=1: GOSUB 1220: PRINT EOL$;
3020 IF R$ = "S" THEN 5980
3040 IF R$ = "R" THEN GOSUB 6700: GOTO 3320
3060 IF R$ = "N" THEN CLOSE: GOTO 1320
3080 IF R$ = "E" AND E$ = "E" AND JIVE = ESC THEN JIVE = 0: JIVE$=""
3100 IF R$ = "E" AND E$ = "E" AND (JIVE = CRT OR JIVE = CLF) THEN 3240
3120 IF R$ = "E" THEN PRINT MSG$(8);:

	H$=INPUT$(1):

	GOSUB 1220: PRINT EOL$;
3140 IF R$ = "E" AND H$="+" THEN REC=REC+1: BY.REC=1: GOTO 2220
3160 IF R$ = "E" AND H$="-" THEN REC=REC-1: BY.REC=1: GOTO 2220
3180 IF R$ = "E" THEN H$=CHR$(ASC(H$) AND &H5F)
3200 IF R$ = "E" AND H$="N" THEN GOTO 1320
3220 IF R$ = "E" THEN

	IF H$<>"H" AND H$<>"A" THEN PRINT CHR$(7);:

	GOTO 3120
3240 IF E$ = "E" THEN R$ = "S":

	IF JIVE = 0 THEN GOTO 5480 ELSE GOTO 4120
3260 IF R$ = "E" THEN PRINT MSG$(9);:

	R$ = CHR$(ASC(INPUT$(1)) AND &H5F):

	GOTO 4120
3280 PRINT CHR$(7);
3300 GOTO 2960
3320	'

	' Clear display & reposition cursor before reading next record.

	'
3340 PRINT CLR$
3360 GOTO 2220
3380	'

	' Subroutine to display Hex / Ascii contents of x$.

	'
3400 C = 1: O = 8: FOR L=1 TO 8
3420 IF COM=1 THEN ADR$ = HEX$(((REC * 128) - 16 * O) + &H100) ELSE

	ADR$ = HEX$((REC * 128) - 16 * O)
3440 IF O = 8 AND REC = 1 THEN PRINT LO$ ZER$ LO$ "   ";

	ELSE PRINT LO$ MID$(ZER$,1,4-LEN(ADR$)) ADR$ LO$ "   ";
3460 D = C
3480 FOR W=1 TO 16
3500 NUM = ASC(MID$(X$,C,1))
3520 IF E$="E" THEN 3560
3540 IF MID$(F1$,C,1) <> MID$(F2$,C,1) THEN PRINT HI$;
3560 IF NUM < 16 THEN PRINT "0";
3580 PRINT HEX$(NUM) LO$ " ";
3600 IF E$="E" THEN 3640
3620 IF MID$(F1$,C,1) <> MID$(F2$,C,1) THEN PRINT LO$;
3640 C=C+1
3660 NEXT W
3680 PRINT LO$ "   ";
3700 FOR W=1 TO 16
3720 NUM = ASC(MID$(X$,D,1))
3740 IF E$="E" THEN 3780
3760 IF MID$(F1$,D,1) <> MID$(F2$,D,1) THEN PRINT HI$;
3780 IF NUM < 32 OR NUM > 122 THEN PRINT "."; ELSE PRINT CHR$(NUM);
3800 IF E$="E" THEN 3840
3820 IF MID$(F1$,D,1) <> MID$(F2$,D,1) THEN PRINT LO$;
3840 D=D+1
3860 NEXT W
3880 PRINT LO$ "    "
3900 O=O-1
3920 NEXT L
3940 PRINT LO$ CHR$(13) TAB(78) " "
3960 PRINT HI$;
3980 RETURN
4000	'

	' Subroutine to handle missing files.

	'
4020 PX=15: PY=1: GOSUB 1220: PRINT "No such file" CHR$(7)
4040 CLOSE
4060 RESET
4080 RESUME 1380
4100	'

	' Routine to handle editing of record.

	'
4120 C=1: P=1: LP=0: RP=0
4140 PX=24: PY=1: GOSUB 1220: PRINT EOL$ MSG$(10);
4160 IF E$="C" THEN PRINT MSG$(11);
4180 IF WRP<>0 THEN X$=F1$: GOTO 5020
4200 IF E$="E" AND BY.REC=0 THEN

	P=VAL(RECD$)-(REC+1)*128:

	RP=INT(P/16):

	LP=((P/16)-RP)*16:

	P=P+1:

	T=35:

	X$=F1$:

	GOTO 5020
4220 IF H$ = "A" THEN A2 = 59 ELSE A2 = 8
4240 IF R$="S" THEN PX=4:  PY=A2: GOSUB 1220: T=35: X$=F1$: GOTO 4340
4260 IF R$="C" THEN PX=15: PY=A2: GOSUB 1220: T=46: X$=F2$: GOTO 4340
4280 R$=""
4300 GOTO 3000
4320	'

	' Get and decode edit command.

	'
4340 JIVE$ = INPUT$(1)
4360 JIVE = ASC(JIVE$)
4380 IF JIVE = ESC THEN 2940
4400 IF C=2 THEN 4640
4420 IF JIVE = REF THEN 5400
4440 IF JIVE = WRT THEN WRP=2:

	PX=24:PY=1:GOSUB 1220:PRINT EOL$ MSG$(12);:

	IF R$="S" THEN PRINT HD1$;:PUT #1,REC:FOR I=1 TO 19000:NEXT I:GOTO 4140

	ELSE PRINT HD2$;:PUT #2,REC:FOR I=1 TO 19000:NEXT I:GOTO 4140
4460 IF JIVE = &H11 THEN GOTO 5480
4480 IF JIVE = &H1 THEN H$="A": GOTO 5020
4500 IF JIVE = &H8 THEN H$="H": GOTO 5020
4520 IF JIVE = &H1A AND E$="C" THEN SWAP F1$,F2$:

	TP$=X$:

	X$=F1$:PX=4 :PY=1:GOSUB 1220:GOSUB 3400:

	X$=F2$:PX=15:PY=1:GOSUB 1220:GOSUB 3400:

	X$=TP$:C=1:

	GOTO 5020
4540 IF JIVE = CRT AND C=1 THEN LP=LP+1: P=P+1:  GOTO 5020
4560 IF E$="E" AND REC<=1 AND P=1 THEN 4600
4580 IF JIVE = CLF AND C=1 THEN LP=LP-1: P=P-1:  GOTO 5020
4600 IF JIVE = CDN AND C=1 THEN RP=RP+1: P=P+16: GOTO 5020
4620 IF JIVE = CUP AND C=1 THEN RP=RP-1: P=P-16: GOTO 5020
4640	'

	' Not movement/edit command, see if valid data for update.

	'
4660 IF H$ = "A" THEN 4780
4680 IF JIVE$ >= "0" AND JIVE$ <= "9" THEN 4780
4700 IF JIVE$ >= "A" AND JIVE$ <= "F" THEN 4780
4720 IF JIVE$ >= "a" AND JIVE$ <= "f" THEN JIVE$=CHR$(JIVE-32): GOTO 4780
4740 PRINT CHR$(7);: GOTO 4340
4760	'

	' Print value and convert to binary.

	'
4780 PRINT JIVE$;
4800 IF H$ = "A" AND JIVE$ < " " THEN PRINT CHR$(7);: GOTO 4340 ELSE

	IF H$ = "A" THEN V = JIVE: GOTO 4920
4820 JIVE = VAL("&H"+JIVE$)
4840	'

	' If first nibble of byte go get rest of byte before proceeding.

	'
4860 IF C=1 THEN V = JIVE*16: C=2: GOTO 4340
4880 IF C=2 THEN C=1: V=V+JIVE
4900	'

	' Place modified byte into buffer / disk io channel.

	' Update crt screen x,y pointer count.

	'
4920 MID$(X$,P,1) = CHR$(V)
4940 LP=LP+1
4960 IF R$="S" THEN LSET F1$=X$	ELSE LSET F2$=X$
4980 P=P+1
5000	'

	' Re-calculate screen x,y position based on buffer pointer.

	'
5020 IF WRP=1          THEN P=1:   LP=0:  RP=0
5040 IF WRP=-1         THEN P=128: LP=15: RP=7
5060 IF LP>15 AND RP=7 THEN P=1:   LP=0:  RP=0: WRP=1  ELSE WRP=0
5080 IF LP<0  AND RP=0 THEN P=128: LP=15: RP=7: WRP=-1
5100 IF LP<0           THEN        LP=15: RP=RP-1
5120 IF LP>15          THEN        LP=0:  RP=RP+1
5140 IF RP<0           THEN P=P+16:       RP=0: PRINT CHR$(7);
5160 IF RP>7           THEN P=P-16:       RP=7: PRINT CHR$(7);
5180	'

	' See if wrap around or record advance/receed.

	'
5200 IF WRP <> 0 THEN PX=1:PY=1:GOSUB 1220
5220 IF E$="E" AND WRP=1 THEN PUT #1,REC:

	REC=REC+1:

	BY.REC=0:

	GOTO 2220
5240 IF E$="E" AND WRP=-1 THEN PUT #1,REC:

	REC=REC-1:

	IF REC=0 THEN REC=1:

		PRINT CHR$(7);:

		CLOSE:

		F1$="":

		WRP=1:

		GOTO 1720

	ELSE GOTO 2220
5260	'

	' Display buffer pointer value in lower left corner of screen.

	' Position cursor to proper location on screen.

	'
5280 PX=24: PY=22: GOSUB 1220: PRINT USING "###";P-1;
5300 PX=24: PY=32: GOSUB 1220: PRINT USING "\\";HEX$(P-1);
5320 IF H$ = "A" THEN A1 = 1: A2 = 59 ELSE A1 = 3: A2 = 8
5340 PX=(T+RP)-31: PY=(LP*A1)+A2: GOSUB 1220
5360 GOTO 4340
5380	'

	' Position cursor at start of record area before refresh.

	'
5400 IF R$="S" THEN PX=4:  PY=1: GOSUB 1220
5420 IF R$="C" THEN PX=15: PY=1: GOSUB 1220
5440 GOSUB 3400: C=1: GOTO 5020
5460	'

	' Subroutine to Display Help Menu in lower Half of screen.

	'
5480 GOSUB 5900
5500 PX=15: PY=1: GOSUB 1220
5520 PRINT MSG$(13)
5540 PRINT
5560 PRINT MSG$(14)
5580 PRINT MSG$(15)
5600 PRINT MSG$(16)
5620 IF E$="E" THEN PRINT ELSE PRINT MSG$(17)
5640 PRINT
5660 IF E$ = "C" THEN PRINT MSG$(18); ELSE GOTO 5700
5680 JIVE$ = INPUT$(1)
5700 IF E$="E" THEN PX=22:PY=1:GOSUB 1220:PRINT EOL$;:

	PX=24:PY=40:GOSUB 1220:PRINT EOL$;:

	GOTO 5860
5720 GOSUB 5900
5740 TP$=X$
5760 X$=F2$
5780 PX=15:PY=1:GOSUB 1220
5800 GOSUB 3400
5820 C=1
5840 X$=TP$
5860 IF E$="E" AND JIVE$="" THEN GOTO 4120 ELSE GOTO 5020
5880	'

	' Subroutine to clear lower half of screen.

	'
5900 FOR I=0 TO 7
5920 PX=15+I: PY=1:GOSUB 1220: PRINT EOL$;
5940 NEXT I
5960 RETURN
5980	'

	' Branch here to terminate program execution.

	'
6000 PRINT DINIT$
6020 CALL EXIT
6040	'

	' soubroutine to get file length in 128 byte recs.

	'
6060 COLN=INSTR(CHK$,":")
6080 IF COLN<>2 THEN COLN=0
6100 FCB$=STRING$(36,0)
6120 IF COLN THEN MID$(FCB$,1,1)=CHR$(ASC(MID$(CHK$,COLN-1,1))-64):

	CHK$=MID$(CHK$,COLN+1)
6140 PERD=INSTR(CHK$,".")
6160 IN=10
6180 IF PERD THEN IF (LEN(CHK$)-PERD+1) > 3 THEN CHK$=LEFT$(CHK$,PERD+3)
6200 IF PERD THEN

	FOR IN2=PERD+1 TO LEN(CHK$):

	MID$(FCB$,IN,1)=MID$(CHK$,IN2,1):

	IN=IN+1:

	NEXT IN2:

	CHK$=LEFT$(CHK$,PERD-1)
6220 FOR IN2=IN TO 12
6240 MID$(FCB$,IN2,1)=" "
6260 NEXT IN2
6280 IN=2
6300 IF LEN(CHK$)>11 THEN CHK$=LEFT$(CHK$,11)
6320 FOR IN2=1 TO LEN(CHK$)
6340 MID$(FCB$,IN,1)=MID$(CHK$,IN2,1)
6360 IN=IN+1
6380 NEXT IN2
6400 FOR IN2=IN TO 9
6420 MID$(FCB$,IN2,1)=" "
6440 NEXT IN2
6460 FC%=35
6480 AD%=PEEK(VARPTR(FCB$)+1): POKE VARPTR(AD%)+1,PEEK(VARPTR(FCB$)+2)
6500 TP%=AD%
6520 CALL SYS(FC%,TP%)
6540 RCS$=CHR$(PEEK(AD%+33))+CHR$(PEEK(AD%+34))
6560 RECS=CVI(RCS$)
6580 RETURN
6600	'

	' Subroutine to make num into a 5 digit string /w leading '0'..

	'
6620 NUM$=STR$(NUM)
6640 NUM$=MID$(NUM$,2)
6660 NUM$=STRING$(5-LEN(NUM$),"0")+NUM$
6680 RETURN
6700	'

	' Subroutine to get new rec number.

	'
6720 PRINT MSG$(19);
6740 RECD$ = CHR$(ASC(INPUT$(1)) AND &H5F)
6760 PRINT CHR$(13);
6780 IF RECD$="R" THEN BY.REC=1: GOTO 6960
6800 IF RECD$<>"A" THEN PRINT CHR$(7);: GOTO 6720
6820 PRINT MSG$(20);: LINE INPUT RECD$
6840 BY.REC=0
6860 RECD$="&H"+RECD$
6880 REC=VAL(RECD$)
6900 IF INSTR(A$,".COM") <> 0 AND REC >= &H100 THEN REC = REC - &H100
6920 REC = INT(REC/128)+1
6940 GOTO 7020
6960 PRINT MSG$(21);: LINE INPUT RECD$
6980 REC = VAL(RECD$)
7000	'

	' See if .command file type and set base address accordingly.

	'
7020 IF INSTR(A$,".COM") <> 0 THEN ZER$=ONE$: COM=1 ELSE COM=0
7040 RETURN
7060	'

	' Subroutine to load parameter file.

	'
7080 DRV$=""
7100 ON ERROR GOTO 7160
7120 OPEN "I",1,DRV$+"FCMSGS.OVR"
7140 GOTO 7180
7160 CLOSE: IF DRV$="" THEN DRV$="A:": RESUME 7120 ELSE RESUME 7660
7180 ON ERROR GOTO 0
7200 INPUT #1,REC$
7220 INPUT #1,MASK$
7240 INPUT #1,MSK1$
7260 INPUT #1,MSK2$
7280 INPUT #1,MSK3$
7300 INPUT #1,LIN$
7320 INPUT #1,DUM
7340 INPUT #1,ZER$
7360 INPUT #1,ONE$
7380 INPUT #1,REF,ESC,WRT,CLF,CDN,CUP,CRT
7400 INPUT #1,CLR$
7420 INPUT #1,HI$
7440 INPUT #1,LO$
7460 INPUT #1,EOL$
7480 INPUT #1,INIT$
7500 INPUT #1,DINIT$
7520 INPUT #1,POS.XY$
7540 INPUT #1,NUL,R.C,BIASX,BIASY
7560 FOR I=1 TO 21
7580 LINE INPUT #1,MSG$(I)
7600 NEXT I
7620 CLOSE
7640 RETURN
7660	'

	' Branch here if overlay not found

	'
7680 PRINT: PRINT
7700 PRINT "*** RUN TIME ERR: 'FCMSGS.OVR'  not found"
7720 PRINT "                  'FCINSTL.COM' is used to build this file"
7740 PRINT: PRINT
7760 GOTO 5980
7780 END
 found"
7720 PRINT "                  'FCINSTL.COM' is used to build this f