	PROGRAM SCOPY
C Written by Tim Prince, June 1979
C using Microsoft FORTRAN
C READLB.Z80 accesses physical sectors using MCOS call
C Examine disk B by physical sectors, with ASCII viewing
C Optional copy to MCOS file on disk A
	INTEGER*1 BUF,STATUS,WQ,YES,TILDE,BLANK,CH
	INTEGER*1 LF,CR,TAB
	DIMENSION NAME(6),BUF(128)
	DATA LF/Z'0A'/,CR/Z'0D'/,TAB/Z'09'/
	DATA YES/'Y'/,BLANK/' '/,TILDE/'~'/
	DATA NAME/'SC','OP','YO',' ','OU','T '/
	WRITE(3,10)
10	FORMAT(1X,'Mount disk to be examined (which need not be'
     &/1X,'an MCOS disk) on drive B, and an MCOS disk with file'
     &/1X,'space available on drive A.  Choose output file'/
     &1X,'2 character code:')
	READ(3,20)NAME(4)
20	FORMAT(A2)
	CALL OPEN(6,NAME,1)
	WRITE(3,25)
25	FORMAT(1X,'Enter negative start block to stop')
	DO 600 IT=1,9999
	WRITE(3,30)
30	FORMAT(1X,'Starting physical block number (0-2001) ?')
	READ(3,35)NBLOK
35	FORMAT(I4)
	IF(NBLOK.LT.0)STOP
	WRITE(3,40)
40	FORMAT(1X,'Interleave (4 for MCOS) ?')
	READ(3,45)INTRLV
45	FORMAT(I1)
	WRITE(3,50)
50	FORMAT(1X,'Number of sectors to be read?')
	READ(3,35)NSECT
	WRITE(3,60)
60	FORMAT(1X,'Do you want them written on disk A (Y/N) ?')
	READ(3,70)WQ
70	FORMAT(A1)
C Call Z80 routines to read a sector and copy buffer to BUF
	LBLOK=(NSECT-1)*INTRLV+NBLOK
	DO 200 NB=NBLOK,LBLOK,INTRLV
	WRITE(3,95)NB
95	FORMAT(1X,'Block',I5)
	CALL READLB(NB,BUF,STATUS)
	IS1=STATUS+1
	GOTO (150,110,120,130),IS1
110	WRITE(3,115)
115	FORMAT(1X,'I/O error')
	GOTO 140
120	WRITE(3,125)
125	FORMAT(1X,'Illegal request')
	GO TO 140
130	WRITE(3,135)NB
135	FORMAT(1X,'Block number',I5,' illegal')
140	WQ='N'
150	CONTINUE
C Change uneditable chars to ~
	DO 180 I=1,128
	CH=BUF(I)
	IF(CH.GT.TILDE.OR.(CH.LT.BLANK.AND.
     &(CH.NE.CR.OR.BUF(I+1).NE.LF).AND.CH.NE.LF.AND.
     &CH.NE.TAB))BUF(I)=TILDE
180	CONTINUE
	WRITE(3,90)BUF
90	FORMAT(1X,32A1)
	IF(WQ.EQ.YES)WRITE(6)BUF
200	CONTINUE
600	CONTINUE
	STOP
	END
