!*! Updated on 18-Dec-95 at 11:31 AM by Jim Randazzo; edit time: 0:01:16
!*************************** AMUS Program Label ******************************
! Filename: DKLOOK.BAS                                      Date: 11/03/95
! Category: UTIL         Hash Code: 000-000-000-000      Version: 1.0(106)
! Initials:   /AM        Name: Mike L. Sessi     
! Company: Birmingham Data Systems Inc.            Telephone #: 707-795-1595
! Related Files: accept.sbr, noecho.sbr, norton.sbr, infld.sbr,amos.sbr, &
!                look.lit
! Min. Op. Sys.: AMOSL 1.0                     Expertise Level: none
!*****************************************************************************
!*! Updated on 02-Nov-95 at 0:00 AM by Mike L. Sessi   IV; edit time: 0:00:00
!*************************** AMUS Program Label ******************************
!
! 11/09/95 added code so this will run under d-run (RUNDOS)
! 11/05/95 esc now works in dir print
! 11/02/95 change screen output so Norton works on both type of terminals
! 11/01/95 Mike Sessi (mls) First release
!
100   PROGRAM norton,1.0(106)
!
! THIS PROGRAM USES
!	XCALL ACCEPT.SBR	! to get single chr input
!	XCALL NOECHO.SBR	! for accept.sbr
!	XCALL NORTON.SBR	! reads a single block
!	XCALL INFLD.SBR		! input line for header info
!       XCALL AMOS.SBR		! to excute look.lit
!	LOOK.LIT		! displays any kind of file
 
101 ! RENUMBERED ON 09/12/95
110 MAP1  LABEL			! block 0, disk label information
120 	MAP2 FIL,B,4
130 	MAP2	VOL'NAM,S,40
140 	MAP2	VOL'ID,S,10
150 	MAP2	CREATOR,S,30
160 	MAP2	INSTALL,S,30
170 	MAP2	SYSTEM,S,30
	MAP2	LAB1,B,1	! last access
	MAP2	LAB2,B,1
	MAP2	LAB3,B,1
	MAP2	LAB4,B,1
	MAP2	LAB5,B,1	! created on
	MAP2	LAB6,B,1
	MAP2	LAB7,B,1
	MAP2	LAB8,B,1
180 	MAP2	FIL2,S,364
190
!   
200
210  MAP1 MFDX			! master file directory
220      MAP2 MFD0(64)		! 64 p'pn in 1 disk block
230		MAP3 PPNX,B,2	! p'pn number
240		MAP3 LNK2,B,2	! Points to the UFD block, also
				! the MFD block number
250		MAP3 MFD3,B,2	! PASS WORD  ?
260		MAP3 MFD4,B,2	! ???
!
	MAP1 PPN0,S,3		! Hold p,pn number  [123,123]
270	MAP1 PPN1,S,3		! P,PN 1st 3 numbers
280	MAP1 PPN2,S,3		! 2nd 3 numbers
!

290  MAP1  UFD				! USER FILE DIRECTORY (42 ENTRYS/BLK)
300 	MAP2 PTR,B,2			! Next UFD block number
310 	MAP2 UFDENT(42)
320 		MAP3	UFDNAM1,B,2	! 1ST 3 CHR'S
330 		MAP3	UFDNAM2,B,2	! 2ND 3 CHR'S
340 		MAP3	UFDNAMX,B,2	! 3RD 3 CHR'S (EXT)
350 		MAP3	UFDBLKX,B,2	! FILE SIZE
360 		MAP3	UFDACTX,B,2	! FILE TYP. IF 65503 THEN CONTIG
370 		MAP3	UFDFPTX,B,2	! LINK TO 1ST BLOCK of file
380  	MAP2 FIL3,X,6
!
390   MAP1 RAD5O
400		MAP2 RAD5,S,1
410		MAP2 RADX,S,50,"ABCDEFGHIJKLMNOPQRSTUVWXYZ   0123456789   "
450	RAD5=CHR(0)
!
420	MAP1 UNP,S,3		! unpacked UFD file chars (3)
430	MAP1 SP,S,20,"                    "
440	MAP1 NAME,S,10		! the unpacked file name
!
460	MAP1 SCR'ROW(128)	! store the MFD screen
470		MAP2 SCR,S,80	! MFD's ([123,123])
		MAP2 LNK,S,80	! the link to the UFD
!
	MAP1 DIR'ROW(24)	! screen of the UFD block
		MAP2 DIR'COL(5)
			MAP3 DIR'NAM,S,10	! file name.ext blocks
!
	MAP1 R'DRIVE(09)		! DISK DEVICES NAMES
		MAP2 C'DRIVE(10)
			MAP3 DISKS,S,6	! disks names (dsk00:)
!
510 !	MAP1 NORTON
520		MAP1 DISK'DEVICE,S,7	! give disk spec (dsk000:
530		MAP1 BLOCK'NO,B,4	! give block number to read
540		MAP1 BUFFER,X,512	! returns block info
560		MAP1 ERR'CODE,B,1	! any problems
!
!	This info is stored in the A.A file in every P,PN
!
	MAP1 HEAD'IN
		MAP2 ENTRY,S,70
		MAP2 H'FIL,S,442
!
	MAP1 HEAD'HOLD,S,510		! hold header info
! user defined info
! if you add more, change H'LOOP
	MAP1 HEAD'INFO(06),S,70
		HEAD'INFO(1)="No Information for this directory"
		HEAD'INFO(2)="DSK00:[1,2]Operator acct."
		HEAD'INFO(3)="DSK00:[1,4]System Acct."
		HEAD'INFO(4)="DSK00:[1,6]System Drivers"
		HEAD'INFO(5)="DSK00:[2,2]System commands files"
		HEAD'INFO(6)="DSK00:[7,6]System .bas files"
	MAP1 H'LOOP,B,1,6	! NUMBER OF HEAD'INFO LINES

	MAP1 VARIABLE'LIST
		MAP2 AM0S,S,50
		MAP2 BS,F
		MAP2 MFD'ROW,F
		MAP2 SCH'STR,F
		MAP2 PPN'CT,F	
		MAP2 B,F
		MAP2 A,F
		MAP2 MD,F
		MAP2 SCR1$,S,50
		MAP2 LEN'SCR,F
		MAP2 COL,F
		MAP2 BLOCKS,F
		MAP2 T'BLOCKS,F
		MAP2 FILES,F
		MAP2 ROW1,F
		MAP2 E,F
		MAP2 A0,F
		MAP2 X,F
		MAP2 R1,F
		MAP2 R2,F		
		MAP2 R3,F
		MAP2 X3,F
		MAP2 Q,F
		MAP2 D,F
		MAP2 R,F
 
490       SIGNIFICANCE 11
500	STRSIZ 80
MLS:	input "Instruction ? ",q$
	if ucs(q$) = "T" then tst=1
	if ucs(q$) = "Y" then call INSTR

!
BEGIN:	INPUT "%Enter Disk Device (cr=DSK)? ",A$
	IF A$="" THEN 	A$="DSK"
	IF LEN(A$) # 3 THEN ? "ONLY 3 LETTERS" : GOTO BEGIN
	XCALL NOECHO
!
START:
	ON ERROR GOTO EXIT
	CALL DISK'DEVICE
	CALL INIT
	CALL MFD
 	MFD'ROW=2
 	SCH'STR=1
	CALL FF
 	CALL HEADER
 	? TAB(-1,29);		! turn off cursor

COM:
	CALL MFD'MRK'ON
	PRINT TAB(23,1); "COMMANDS: (H)eader, The arrows (to move), CR";
	PRINT " (to make a selection)";
	XCALL ACCEPT,A
!
!                   <-      \/ ^  ->      
!                    H       J  K  L CR
!                    8  9   10 11 12 13
  	CALL MFD'MRK'OFF
	ON A-7 CALL BS,NULL,LF,VT,FF,CR
	IF A=27 THEN A$="DSK" : GOTO START		! START OVER
 	CALL HEADER
 	COM$=UCS(CHR(A))
 	IF COM$="H" THEN CALL UP'DATE'HD
	GOTO COM
!
NULL:	RETURN
!
HEADER:
	BH=INSTR(B,SCR'ROW(MFD'ROW),"]")	! find end of p,pn in table
10	SCR1$= DISK'DEVICE+SCR'ROW(MFD'ROW)[B,BH]+"A.A"	! create file name
							! exp: DSK00:[1,6]A.A
20	LOOKUP SCR1$,FOUND
			! if file type is ok, then, read and print
	IF FOUND < 0 THEN CALL OPEN'HEAD : CALL CLOSE'HEAD : &
		PRINT TAB(1,1); TAB(-1,9);DISK'DEVICE; TAB(1,8); ENTRY; : &
			ELSE CALL HEAD'CNG	! if file is wrong type
						! or doesn't exist,
	RETURN					! change or create it

HEAD'CNG:
	CALL LOG12	! log to 1,2 to get operator status

			! check if file is exist or wrong type
			! if wrong type, copy into right type,
			! then erase wrong type
70	IF FOUND > 0 THEN OPEN #14,SCR1$,INPUT : INPUT LINE #14,HEAD'HOLD : &
		CLOSE #14 : KILL SCR1$

71	ALLOCATE SCR1$,1	! create new file
	CALL OPEN'HEAD		! open file
	HEAD'IN=CHR(0)
	IF FOUND > 0 THEN HEAD'IN=HEAD'HOLD	! move old file type into new
						! keeping only 1st 70 chars.
		! if file is empty, check for header infor.
	FOR HL=1 TO H'LOOP
		IF SCR1$[1,11] = HEAD'INFO(HL)[1,11] THEN &
			ENTRY=HEAD'INFO(HL)[12,LEN(HEAD'INFO(HL))]
	NEXT HL
		! if no header info, get default info.
	IF ENTRY="" THEN ENTRY=HEAD'INFO(1)
	CALL WRITE'HEAD
	CALL CLOSE'HEAD
	CALL LOGBK				! return to current P,PN
75	print tab(1,1); TAB(-1,9); DISK'DEVICE; TAB(1,8);ENTRY;
	RETURN
!
UP'DATE'HD:			! change header information
	CALL LOG12		! log 1,2 to get operator status
	CALL OPEN'HEAD		! open A.A file and read it
	XCALL INFLD,01,08,70,00,"*35]",ENTRY,INXCTL,1,1,EXITCODE
	CALL WRITE'HEAD		! write file
	CALL CLOSE'HEAD
	CALL LOGBK		! return to current P,PN
 	? TAB(-1,29);		! turn off cursor
	RETURN
!

BS:	! BACK SPACE
	IF B-1 < 2 THEN MFD'ROW=MFD'ROW-1 : B=100
	IF MFD'ROW=1 THEN MFD'ROW=PPN'CT : B=100
	FOR BS=B-1 TO 1 STEP -1
		IF SCR'ROW(MFD'ROW)[BS,BS] = "[" THEN B=BS : BS=1
    	NEXT BS

	SCH'STR=B+1
	RETURN

FF:	! RIGHT ARROW
FF1:	B=INSTR (SCH'STR,SCR'ROW(MFD'ROW),"[")
	IF B=0 AND MFD'ROW > PPN'CT THEN MFD'ROW=2 : SCH'STR=1 : GOTO FF
	IF B=0 THEN MFD'ROW=MFD'ROW+1 : SCH'STR=1 : GOTO FF:
	SCH'STR=B+1
	RETURN

VT:	! UP ARROW
	MFD'ROW=MFD'ROW-1
	IF MFD'ROW=1 THEN MFD'ROW=PPN'CT
	SCH'STR=1
	CALL FF1
	RETURN

LF:	! DOWN ARROW
	MFD'ROW=MFD'ROW+1
	IF MFD'ROW > PPN'CT THEN MFD'ROW=2 : SCH'STR=1 : CALL FF1
	SCH'STR=1	
	CALL FF1
	RETURN

CR:	MFD'TEMP=MFD'ROW : MFD'COL=B
	CALL DIR
	print tab(-1,0);
	CALL INIT
	CALL MFD
	MFD'ROW=MFD'TEMP : B=MFD'COL
	CALL FF
	RETURN
INIT:
	FOR A=1 TO 64
		LNK(A)=SPACE(100)
		SCR(A)=CHR(0)
	NEXT A
	RETURN
MFD'MRK'ON:
 13 !	PRINT TAB(MFD'ROW,B-1); TAB(-1,32); 
	MRK=INSTR(B,SCR'ROW(MFD'ROW),"]")
!						*THIS IS FIELD CRT'S ?
	? TAB(MFD'ROW,B-1); TAB(-1,32); SCR'ROW(MFD'ROW)[B,MRK]; TAB(-1,33);

!	PRINT TAB(23,1); LNK(MFD'ROW)[B;5];"@";
! 	PRINT TAB(MFD'ROW,B); "!"; 
	RETURN
MFD'MRK'OFF:
14 !	? TAB(MFD'ROW,B-1); TAB(-1,33);
	? TAB(MFD'ROW,B-1); TAB(-1,33); SCR'ROW(MFD'ROW)[B,MRK]; TAB(-1,33);
	RETURN

700 MFD:
710   !READING THE MFD
	BLOCK'NO=1
620	CALL RD'DISK
630	MFDX=BUFFER : MD1=0
570  	? TAB(-1,0)
720	FOR MD=1 TO 64		! 64 ppn's per block
730		IF PPNX(MD)=0 THEN MD=64 : GOTO OUT
740		CALL PPN'UNPACK
750		IF MD1=0 AND MD=1 THEN PPN0=PPN1 : MFD'ROW=2 : : COL=2
760		IF PPN1 # PPN0 THEN PPN0=PPN1 : ? : MFD'ROW=MFD'ROW+1 : &
			: COL=2

		IF LEN(SCR(MFD'ROW)) > 70 THEN MFD'ROW=MFD'ROW+1 : COL=2 : &
			PRINT

		SCR1$= " ["+PPN1+","+PPN2+"] "
765		SCR(MFD'ROW)=SCR(MFD'ROW) +SCR1$
     		LNK(MFD'ROW)[COL;5] = LNK2(MD) USING "#ZZZZ"
		LEN'SCR=LEN(SCR1$)
                COL=COL+LEN'SCR

775		PRINT TAB(-1,33); "["+PPN1+","+PPN2+"]";TAB(-1,33);
800 OUT:	NEXT MD
	IF PPNX(64)=0 AND LNK2(64) # 0 THEN BLOCK'NO=LNK2(64) : CALL RD'DISK : &
		 MFDX=BUFFER : MD1=1 : GOTO 720
	 PPN'CT=MFD'ROW 		! NO MORE ENTRY'S
810	RETURN
!********************* DIR *************
820 DIR:
	
	IF BLOCK'NO=0 THEN ? "NO FILES" : RETURN
   	BLOCK'NO=LNK(MFD'ROW)[B;5]
   	CALL RD'DISK
   	UFD=BUFFER
830	BLOCKS=0 : T'BLOCKS=0 : FILES=0
	CALL DIR'CLR
840	CALL DIR2	
860	RETURN		! RTN TO CALLER
870  DIR2:
880	FOR A0=1 TO 42 
		NAME=CHR(0)
900		UNP=CHR(0)
910	 	IF UFDBLKX(A0)=0 THEN A0=42 : GOTO DIR1
920		IF UFDNAM1(A0)=65535 THEN GOTO DIR1
		ROW1=ROW1+1
!
		IF COL>64 AND ROW1 > 23 THEN CALL PRT'FILES : CALL DIR'INP : &
			IF A=27 THEN RETURN	! rtn to mfd early
		IF ROW1>23 THEN ROW1=2 : COL=COL+16 : C'CT=C'CT+1 : CALL PRT'FILES
!
930		CALL RAD50		! UNPACK THE FILE NAME
!
		DIR'NAM(ROW1,(C'CT))=NAME+SP[1,7-LEN(NAME)]+UNP+SP[1;3-LEN(UNP)]
!
940		FILES=FILES+1
950		PRINT TAB(ROW1,COL-1); TAB(-1,33); NAME;SP[1,7-LEN(NAME)]; &
					UNP ; SP[1;3-LEN(UNP)]; TAB(-1,33);
960		BLOCKS=UFDBLKX(A0)
970  		PRINT STR(BLOCKS);       !    SP[1,4-LEN(STR(BLOCKS))+1];
980		T'BLOCKS = T'BLOCKS + BLOCKS
!
990		! SIZE OF FILE
!		PRINT UFDACTX(A0);"   " 	! ACTIVE LINK OR TYPE
!		PRINT UFDFPTX(A0);		! LINK TO BLOCK
1010 DIR1:	NEXT A0

1020	IF PTR = 0 THEN CALL PRT'FILES : CALL DIR'INP : RETURN
!
1030   	BLOCK'NO=PTR
   	CALL RD'DISK
   	UFD=BUFFER

1060	GOTO DIR2
!
   PRT'FILES:
	PRINT TAB(1,30); STR(FILES); " Files In "; STR(T'BLOCKS);" Blocks On";
	RETURN
!
    DIR'INP:
	ROW1=2 : C'CT=1
	SCR1$=DIR'NAM(ROW1,C'CT)
	CALL DIR'MRK'ON
	PRINT TAB(-1,29);	! CURSOR OFF	
COM'DIR:
	print tab(24,1); "Commands: ^T, next screen, arrows (to";
	print " move from file to file), CR: read"; tab(1,1);
	XCALL ACCEPT,A
	CALL DIR'MRK'OFF
	CALL SAVE'CT
!                      <-           \/      ^     ->      
!                       H            J      K      L     CR
!                       8   9       10     11     12     13
	ON A-7 CALL DIR'BS,NULL,DIR'LF,DIR'VT,DIR'FF,DIR'CR
	IF A=20 THEN CALL DIR'CLR : ROW1=2 : RETURN	! ^T
	IF A=27 THEN : RETURN	! ESC to exit 'dir'
	CALL CK'DIR'NAM
    	CALL DIR'MRK'ON
	GOTO COM'DIR
!
DIR'BS:	! BACK SPACE (LEFT ARROW)
	C'CT=C'CT-1
	IF C'CT=0 THEN C'CT=5 : ROW1=ROW1-1
	IF ROW1=1 AND C'CT=5 THEN ROW1=23 : C'CT=5
	RETURN

DIR'FF:	! RIGHT ARROW
	C'CT=C'CT+1	
	IF C'CT=6 AND ROW1 = 23 THEN ROW1=2 : C'CT=1
	IF C'CT=6 THEN ROW1=ROW1+1 : C'CT=1
	RETURN

DIR'VT:	! UP ARROW
	ROW1=ROW1-1
	IF ROW1=1 AND C'CT=1 THEN ROW1=23 : C'CT=5	
	IF ROW1=1 THEN C'CT=C'CT-1 : ROW1=23
	RETURN

DIR'LF:	! DOWN ARROW
	ROW1=ROW1+1
	IF ROW1 > 23 THEN ROW1=2 : C'CT=C'CT+1
	IF C'CT=6 THEN ROW1=2 : C'CT=1
	RETURN

DIR'CR:
	DCR$=SCR1$[1,6]
	XCALL STRIP,DCR$
	AM0S="LOOK "+DISK'DEVICE+DCR$[1,LEN(DCR$)]+"."+SCR1$[8,10]+ SCR(MFD'ROW)[B,E]
	if tst=1 then print tab(-1,0); tab(12,10); AM0S : INPUT A$
!	PRINT TAB(1,1); SCR1$;
! check to see if we running under DRAVIC run (DRUN)
!
	ON ERROR GOTO AMOS
	F$=RAD50("123")
!
! ok, no error. we must be running d-run
!
	RUNDOS=AM0S
!
! back to normal processing
!
DIR'1:	ON ERROR GOTO EXIT
	CALL DIR'PRT
	PRINT TAB(-1,29);
	CALL UFD'LN
	CALL DIR'LF
	RETURN
AMOS:
!	? ERR(0),ERR(1),ERR(2)
	RESUME AMOS1
AMOS1:	XCALL AMOS,AM0S
	GOTO DIR'1
!
SAVE'CT:
	C'CT'S=C'CT : ROW1'S=ROW1
	RETURN
RESTORE'CT:
	C'CT=C'CT'S : ROW1=ROW1'S
	RETURN

CK'DIR'NAM:
	IF DIR'NAM(ROW1,C'CT) = "" THEN CALL RESTORE'CT
	RETURN
!
DIR'PRT:
	PRINT TAB(-1,0);
	FOR C=1 TO 5
		CCT=C * 16 - 15
		FOR R=1 TO 23
			IF DIR'NAM(R,C)="" THEN GOTO NXR
			PRINT TAB(R,CCT); TAB(-1,33);DIR'NAM(R,C); TAB(-1,33);
NXR:		NEXT R
	NEXT C
	RETURN
!
DIR'MRK'ON:
! Need to re-print file name again. This will allow it to work on all crts
	CCT=C'CT * 16 - 15
	IF CCT <= 0 THEN CCT=1
	SCR1$=DIR'NAM(ROW1,C'CT)
	PRINT TAB(ROW1,CCT); TAB(-1,32); SCR1$; TAB(-1,33);
!	PRINT TAB(15,16); ROW1;C'CT;CCT;SCR1$;
!  	PRINT TAB(ROW1,CCT); TAB(-1,32); 
!  	PRINT TAB(ROW1,CCT); "!";
	RETURN
DIR'MRK'OFF:
	CCT=C'CT * 16 - 15
	IF CCT <= 0 THEN CCT=1
	PRINT TAB(ROW1,CCT); TAB(-1,33);SCR1$; TAB(-1,33);
 !	PRINT TAB(ROW1,CCT); "@";
	RETURN
!
!
UFD'LN:
833	E=INSTR(B,SCR(MFD'ROW),"]")
834	PRINT TAB(1,1);"PC Directory Utility";TAB(1,65); &
    			    DISK'DEVICE ; SCR(MFD'ROW)[B,E];
	RETURN
DIR'CLR:
831	PRINT TAB(-1,0);
832	ROW1=1 : COL=2 : C'CT=1
	CALL UFD'LN
	FOR A=1 TO 24
		DIR'ROW(A)=SPACE(50)
	NEXT A
	RETURN

DISK'DEVICE:
	A=0 : DEV'R=1 : DEV'C=0
	? TAB(-1,0)
DD2:	B$= STR(A) USING "#Z"
	DISK'DEVICE=A$+B$+":"
	BLOCK'NO=0
	CALL RD'DISK

	IF ERR'CODE # 0 THEN GOTO NEXT
	IF DEV'C+1 > 10 THEN DEV'R=DEV'R+1 : DEV'C=0 : PRINT TAB(-1,33)
	DISKS(DEV'R,DEV'C+1)=DISK'DEVICE 
	PRINT TAB(-1,33);DISK'DEVICE;
	DEV'C = DEV'C +1
	A=A+1
	GOTO DD2
NEXT:
	PRINT TAB(70); TAB(-1,33)
	PRINT TAB(23,1); "Select Disk by using the arrows, then CR";

	DEV'ROW=1 : DEV'COL=1
	? TAB(-1,29);
DEV'COM:
 	CALL DEV'MRK'ON
	CALL DEV'CR
	CALL LABEL
	XCALL ACCEPT,A
!
!                   <-      \/ ^  ->      
!                    H       J  K  L CR
!                    8  9   10 11 12 13
    	CALL DEV'MRK'OFF
	CALL SAVE'DEV
	ON A-7 CALL DEV'BS,NULL,DEV'LF,DEV'VT,DEV'FF,DEV'CR
	IF A=27 THEN GOTO EXIT
	IF A=13 THEN RETURN		! return to 'START'
	CALL CK'DEV	
	GOTO DEV'COM
SAVE'DEV:
	DEV'COL'S=DEV'COL : DEV'ROW'S=DEV'ROW
	RETURN
RESTORE'DEV'CT:
	DEV'COL=DEV'COL'S : DEV'ROW=DEV'ROW'S
	RETURN
CK'DEV:
	IF DISKS(DEV'ROW,DEV'COL)="" THEN CALL RESTORE'DEV'CT
	RETURN
DEV'BS:	! BACK SPACE
  	DEV'COL=DEV'COL-1
	IF DEV'COL   < 1 THEN DEV'ROW=DEV'ROW-1 : DEV'COL=10
	IF DEV'ROW < 1 THEN DEV'ROW=DEV'R : DEV'COL=10
	RETURN

DEV'FF:	! RIGHT ARROW
  	DEV'COL=DEV'COL+1
	IF DEV'COL  > 10 THEN DEV'ROW=DEV'ROW+1 : DEV'COL=1
	IF DEV'ROW > DEV'R THEN DEV'ROW=1 : DEV'COL=1
	RETURN

DEV'VT:	! UP ARROW
  	DEV'ROW=DEV'ROW-1
	IF DEV'ROW  < 1  THEN DEV'ROW=DEV'R
	RETURN

DEV'LF:	! DOWN ARROW
  	DEV'ROW=DEV'ROW+1
	IF DEV'ROW > DEV'R THEN DEV'ROW=1
	RETURN

DEV'CR:
23	DISK'DEVICE=DISKS(DEV'ROW,DEV'COL)
!	PRINT TAB(1,1); DISK'DEVICE;  DEV'ROW;DEV'COL;
	RETURN

DEV'MRK'ON:
!	PRINT TAB(DEV'ROW+1,(DEV'COL*7)-7+1); TAB(-1,32); 
! 	PRINT TAB(DEV'ROW+1,(DEV'COL*7)-7+1); "!"; 
!
	PRINT TAB(DEV'ROW+1,(DEV'COL*7)-7+1); TAB(-1,32);
	PRINT DISKS(DEV'ROW,DEV'COL); TAB(-1,33);
	RETURN

DEV'MRK'OFF:
!	PRINT TAB(DEV'ROW+1,(DEV'COL*7)-7+1); TAB(-1,33);
!	PRINT TAB(DEV'ROW+1,(DEV'COL*7)-7+1); "@";
!
	PRINT TAB(DEV'ROW+1,(DEV'COL*7)-7+1); TAB(-1,33);
	PRINT DISKS(DEV'ROW,DEV'COL); TAB(-1,33);
	RETURN

LABEL:	! READ THE LABEL OF DISK
	CALL RD'DISK
	LABEL=BUFFER
	PRINT TAB(19,1);TAB(-1,9);  "Vol Nam"; TAB(19,41); "Vol Id"; tab(19,51); "Install";
	PRINT TAB(20,1);TAB(-1,9);  VOL'NAM; TAB(20,41);VOL'ID; tab(20,51); INSTALL;
	PRINT TAB(21,1);TAB(-1,9);  "SYSTEM";TAB(21,32); "CREATOR";
	PRINT TAB(22,1);TAB(-1,9);  SYSTEM; TAB(22,32);CREATOR;

! READ  DISK
1250 RD'DISK:
1260	XCALL NORTON, DISK'DEVICE, BLOCK'NO, BUFFER,ERR'CODE
1270	RETURN
!
! FILE NAMES UNPACK
!
1330 RAD50:	D=40
1340	X=UFDNAM1(A0) : CALL UNPACK : CALL RAD51 : NAME=UNP
1350	X=UFDNAM2(A0) : CALL UNPACK : CALL RAD51 : NAME=NAME+UNP
1360	X=UFDNAMX(A0) : CALL UNPACK : CALL RAD51 : NAME=NAME ! +"."+UNP
1370	RETURN	
1380 RAD51:
1390	UNP=RAD5O[R1+1,R1+1]+RAD5O[R2+1,R2+1]+RAD5O[R3+1,R3+1]
1400	RETURN
1070 PPN'UNPACK:	
1080	PPN1=CHR(0) : PPN2=CHR(0) : X=PPNX(MD)
1090	D=256 : CALL UNPACK		! CONVERT TO OCTAL
1100	D=8 : X=R2 : X3=R3 : CALL UNPACK 
1110	IF R1 > 0 THEN PPN1=STR(R1)+STR(R2)+STR(R3) : GOTO PPN2
1120	IF R2 > 0 THEN PPN1=STR(R2)+STR(R3) : GOTO PPN2
1130	PPN1=STR(R3)
1140 PPN2:	
1150	D=8 : X=X3 : CALL UNPACK
1160	IF R1 > 0 THEN PPN2=STR(R1)+STR(R2)+STR(R3) : GOTO PPN9
1170	IF R2 > 0 THEN PPN2=STR(R2)+STR(R3) : GOTO PPN9
1180	PPN2=STR(R3)
1190 PPN9:	RETURN
!
1200 UNPACK:
1210	Q=INT(X/D) : R=X-Q*D : X=Q : R3=R
1220	Q=INT(X/D) : R=X-Q*D : X=Q : R2=R
1230	Q=INT(X/D) : R=X-Q*D : X=Q : R1=R
! ?	D,R1;"-";R2;"/";R3
1240	RETURN
!
OPEN'HEAD:
	ZZ=0
30	OPEN #1,SCR1$,RANDOM,512,ZZ
40	READ #1,HEAD'IN
	RETURN
CLOSE'HEAD:
	CLOSE #1
	RETURN
WRITE'HEAD:
	WRITE #1,HEAD'IN
	RETURN
LOG12:
	JOBCUR=WORD(1052)*65536+WORD(1054)	! GET JOB ADDRESS(LONG WORD)
	LOGIN=WORD(JOBCUR+20)		! SAVE WHERE USER IS LOGGED INTO
	WORD(JOBCUR+20)=258		! LOG 1,2
	RETURN
LOGBK:
	WORD(JOBCUR+20)=LOGIN		! LOG BACK TO WHERE WE WERE
	RETURN
INSTR:
	print tab(-1,0)
	print "This program will read the disks on this system."
	print "Then read the MFD's on that disk. Allowing you"
	print "to create an A.A file in each of the P,PNs."
	print "you will Also be able to look at any file on"
	print "that disk."
	PRINT
	print "while looking at a UFD, you can not ESC back to the MFD."
	print "You must read all of the UFD."
	print
	print "THIS only reads the old directory format."
	print
	print "yes, it does need some help."
	print "Any questions, call Mike at 707-795-1595"
	print
	return
EXIT:
	IF FOUND # 0 THEN CALL LOGBK
	? TAB(-1,28); TAB(23,1);
	END