!*! Updated on 13-Dec-95 at 8:46 AM by Jim Randazzo; edit time: 0:03:20
!*************************** AMUS Program Label ******************************
! Filename: FOLDER.BAS                                      Date: 11/25/95
! Category: UTIL         Hash Code: 000-000-000-000      Version: 1.0(100)
! Initials:   /AM        Name: Mike L. Sessi
! Company: Birmingham Data Systems Inc.            Telephone #: 707-795-1595
! Related Files: accept.sbr, noecho.sbr, 
!               
! Min. Op. Sys.: AMOSL 1.0                     Expertise Level: none
!*****************************************************************************
!*! Updated on 25-Nov-95 at 0:00 AM by Mike L. Sessi   IV; edit time: 0:00:00
!*************************** AMUS Program Label ******************************
!
100   PROGRAM folder,1.0(101)

! THIS PROGRAM USES
!       XCALL ACCEPT.SBR        ! to get single chr input
!	XCALL NOECHO.SBR
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	LAB9,S,260
	MAP2	LAB0,S,100

	MAP1 FLD'IN,S,100
	MAP1 FOLDER(23)			! DISK SPEC
		MAP2 FLD,S,30		! DSK02:FOLDER.FLD[001,002]
					! or/ DSK2:FOLDER.FLD[1,2]
	MAP1 FLD'RD,X,512
	MAP1 FLD'ROW,F,6,1
	MAP1 FLD'ROW'S,F,6,0
	MAP1 FLD'CT,F,6
!
MAP1 DIR'FILE
	MAP2 DIR'PTR,B,2
	MAP2 D'SEQ,X,510
!
MAP1 D'RAN,X,512,@DIR'FILE
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
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 next MFD block number (#64)
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
			MAP3 DIR'SIZ,B,2	! file size
			MAP3 DIR'TYP,B,2	! file type, or seq., ran.
			MAP3 DIR'LNK,B,2	! link to 1st block
!
	MAP1 HEAD'IN
		MAP2 ENTRY,S,70
		MAP2 H'FIL,S,442
!
	MAP1 VARIABLE'LIST
		MAP2 AM0S,S,50
		MAP2 SCR1$,S,100
490       SIGNIFICANCE 11
500	STRSIZ 80
MLS:	input "Instruction ? ",q$
	if ucs(q$) = "Y" then call INSTR : GOTO MLS

	LOOKUP "FOLDER.FIL",FOUND
	IF FOUND=0 THEN GOTO FLD'DIR	! file not found, output err message
	OPEN #14,"FOLDER.FIL",INPUT
FLD:	INPUT LINE #14,FLD'IN
	IF EOF(14) THEN GOTO FLD1
	FLD'CT=FLD'CT+1
	FLD(FLD'CT)=FLD'IN
	GOTO FLD
FLD1:
	CALL FLD'FILES		! display folder files
 	? TAB(-1,29);		! turn off cursor
	XCALL NOECHO
	FLD'ROW=1
FLD'COM:
	CALL FLD'MRK'ON
	XCALL ACCEPT,A
!
!                   <-      \/ ^  ->      
!                    H       J  K  L CR
!                    8  9   10 11 12 13
  	CALL FLD'MRK'OFF			! up & down arrows only
	IF A=27 THEN GOTO EXIT
	ON A-7 CALL NULL,NULL,FLD'LF,FLD'VT,NULL,FLD'CR
	GOTO FLD'COM
!
FLD'VT:	! UP ARROW
	FLD'ROW=FLD'ROW-1
	IF FLD'ROW=0 THEN FLD'ROW=FLD'CT
	RETURN

FLD'LF:	! DOWN ARROW
	FLD'ROW=FLD'ROW+1
	IF FLD'ROW > FLD'CT THEN FLD'ROW=1
	RETURN

FLD'CR:	
	CALL FLD'OPEN		! open folder file
	CALL MFD'SEC		! process the MFD section
	CALL FLD'CLOSE		! close folder file
	FLD'ROW'S=FLD'ROW	! save folder file pointer
	CALL FLD'FILES		! display all folder files
	FLD'ROW=FLD'ROW'S
	RETURN
FLD'MRK'ON:
	PRINT TAB(FLD'ROW+1,2); TAB(-1,32); FLD(FLD'ROW); TAB(-1,33);
	RETURN
FLD'MRK'OFF:
	PRINT TAB(FLD'ROW+1,2); TAB(-1,33); FLD(FLD'ROW); TAB(-1,33);
	RETURN
	
FLD'OPEN:	! open folder file & read
	OPEN #1,FLD(FLD'ROW),RANDOM,512,F1
	READ #1,FLD'RD
	RETURN
FLD'CLOSE:
	CLOSE #1
	RETURN
FLD'FILES: F1=0
 	PRINT TAB(-1,0); "FOLDER FILE SPEC                   FILE LABEL INFO"
	PRINT TAB(23,1); "COMMANDS: ESC: Exit program, ARROWS: move selection";
		print ", CR: opens folder File";
	FOR FLD'ROW=1 TO FLD'CT
		CALL FLD'OPEN		! open folder file and do a read
		CALL FLD'CLOSE		! close file
		for f=1 to 40	!lenth of vol'nam
			if FLD'RD[f,f] >= " " and FLD'RD[f,f] < "}" then &
				LABEL[f,f]=FLD'RD[f,f]
		next f
		LABEL=FLD'RD		! move into LABEL
		PRINT TAB(FLD'ROW+1,28); VOL'NAM	! print label info
		CALL FLD'MRK'OFF	! print file name
	NEXT FLD'ROW
	RETURN

!
MFD'SEC:
	print tab(2,1); tab(-1,10);
	CALL INIT	! clears mfd save area, reads ,loads & prints mfd
 	MFD'ROW=2	! start printing on this row
 	SCH'STR=1	! instr search starting point
	CALL FF		! get 1st mfd entry
MFD'COM:
	CALL MFD'MRK'ON	! re-print mfd entry
	PRINT TAB(23,1); "Commands: ESC: file selection, ARROWS to move";
		print ", CR: to make a selection";
	XCALL ACCEPT,A
!
!                   <-      \/ ^  ->      
!                    H       J  K  L CR
!                    8  9   10 11 12 13
  	CALL MFD'MRK'OFF
 	IF A=27 THEN RETURN		! return to FLD'CR
	ON A-7 CALL BS,NULL,LF,VT,FF,CR
 	COM$=UCS(CHR(A))		! convert to upercase
!	CALL HEADER			! print header (A.A)
	GOTO MFD'COM			! get keyboard input
!
NULL:	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
	CALL INIT
	MFD'ROW=MFD'TEMP : B=MFD'COL
	CALL FF
	RETURN
INIT:
	print tab(-1,0); FLD(FLD'ROW); TAB(1,28); VOL'NAM ! print label info
	FOR A=1 TO 64
		LNK(A)=SPACE(100)
		SCR(A)=CHR(0)
	NEXT A
	CALL MFD	! read and load and print the mfd
	RETURN
!
MFD'MRK'ON:	! display and print p,pn
13	MRK=INSTR(B,SCR'ROW(MFD'ROW),"]")
	? TAB(MFD'ROW,B-1); TAB(-1,32); SCR'ROW(MFD'ROW)[B,MRK]; TAB(-1,33);
	RETURN
!
MFD'MRK'OFF:
14	? TAB(MFD'ROW,B-1); TAB(-1,33); SCR'ROW(MFD'ROW)[B,MRK]; TAB(-1,33);
	RETURN
!
! *****************************************
!
700 MFD:	! read, load and print the mfd
!
	F1=1		! point to mfd in a folder file
	READ #1,MFDX	! get folder's mfd
630	MD1=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 print "%too many P,PNs"
!	IF PPNX(64)=0 AND LNK2(64) # 0 THEN F1=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 LNK(MFD'ROW)=0 THEN PRINT "NO FILES, CR TO CONTINUE" : INPUT "",A$ : RETURN	
   	F1=LNK(MFD'ROW)[B;5]		! get the next block (record) link
   	READ #1,UFD			! read ufd block (record)

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'BLKS : 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'BLKS
!
930		CALL RAD50		! UNPACK THE FILE NAME
!
		DIR'NAM(ROW1,C'CT)=NAME+SP[1,7-LEN(NAME)]+UNP+SP[1;3-LEN(UNP)]
		DIR'SIZ(ROW1,C'CT)=UFDBLKX(A0)		! file size
		DIR'TYP(ROW1,C'CT)=UFDACTX(A0)		! file type
		DIR'LNK(ROW1,C'CT)=UFDFPTX(A0)		! link to file
!
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
1010 DIR1:	NEXT A0

1020	IF PTR = 0 THEN CALL PRT'BLKS : CALL DIR'INP : RETURN
!
1030   	F1=PTR		! get another ufd block (record)
   	READ #1,UFD	! read it
1060	GOTO DIR2	! print files on screen
!
!
    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:
	ON ERROR GOTO EXIT
 	print tab(-1,29);
	print tab(24,1); "^T: next screen, Arrows: move around";
	print ", CR: read, SP: un/mark file, C: to copy"; tab(1,79);
	XCALL ACCEPT,A
	CALL DIR'MRK'OFF
	CALL SAVE'CT
!                      <-           \/      ^     ->      
!                       H            J      K      L     CR
!                       8   9       10     11     12     13
	IF A=27 THEN PRINT TAB(-1,0); : RETURN	! return to CR'MFD
	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=32 THEN CALL DIR'FILE'MARK		! un/mark file
	IF A=67 OR A=99 THEN CALL DIR'COPY'FILES : print tab(-1,29);
	CALL CK'DIR'NAM
    	CALL DIR'MRK'ON
	GOTO COM'DIR
!
! 27=esc, 20=^t, 32=sp, 67;99= c
!
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:
	CALL PRT'FILE'SCR
	CALL DIR'PRT
	CALL PRT'BLKS
	CALL PRT'HD
	RETURN
DIR'1:	ON ERROR GOTO EXIT
	CALL DIR'PRT
	PRINT TAB(-1,29);
	CALL PRT'HD
	CALL DIR'LF
	RETURN
!
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); STR(DIR'SIZ(R,C));
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);
	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);
	RETURN
!
PRT'BLKS:
	PRINT TAB(1,21); STR(FILES); " Files "; STR(T'BLOCKS);" Blocks";
	RETURN
!
PRT'HD:
	E=INSTR(B,SCR(MFD'ROW),"]")
	PRINT TAB(1,1);"Directory Utility";TAB(1,45); &
				FLD(FLD'ROW);" ";SCR(MFD'ROW)[B,E];
	RETURN
!
DIR'CLR:
831	PRINT TAB(-1,0);
832	ROW1=1 : COL=2 : C'CT=1
	CALL PRT'HD
	FOR A=1 TO 24
		DIR'ROW(A)=SPACE(50)
	NEXT A
	RETURN
DIR'FILE'MARK:
	MRK$="*"		! seq. file
	IF  DIR'TYP(ROW1,C'CT)= 65535 THEN MRK$="#"	! is it a random file?
	IF DIR'NAM(ROW1,C'CT)[7,7] = " " THEN DIR'NAM(ROW1,C'CT)[7,7] = MRK$ &
		ELSE  DIR'NAM(ROW1,C'CT)[7,7] = " "
	RETURN
DIR'COPY'FILES:
	COPY$=CHR(0)
	print tab(-1,28);	! cursor on
	PRINT TAB(24,1); TAB(-1,9); TAB(-1,32); "Copy File(s) To:"; 
	print " Exp: DSK0:[7,6]";
	PRINT TAB(24,39); "|_______________"; TAB(24,40);
DCF:	XCALL ACCEPT,F
! 27= esc, 8=bs, 127=del, 13=cr, 
	IF F=27 THEN RETURN			! rtn COM'DIR
	IF F=8 OR F=127 THEN CALL RUB'OUT
	IF F=13 THEN  CALL CHECK'FILE : RETURN	! rtn COM'DIR
	IF F < 43 OR F > 126 THEN GOTO DCF
	COPY$=COPY$+CHR(F)
	CALL PRT'NAME
	GOTO DCF
RUB'OUT:
	RO=LEN(COPY$)	
	IF RO-1 = 0 THEN COPY$=CHR(0) : CALL PRT'NAME : RETURN
	COPY1$=CHR(0)
	COPY1$=COPY$[1,RO-1]
	COPY$=COPY1$
	CALL PRT'NAME
	RETURN
PRT'NAME:
	PRINT TAB(24,40); TAB(-1,9); COPY$;
	RETURN
CHECK'FILE:
	ON ERROR GOTO NO'FILE
		! LOOKUP A FILE, OK, CONTINUE
	LOOKUP COPY$+"A.MLS",FOUND
	IF FOUND # 0 THEN GOTO FOR
	ALLOCATE COPY$+"A.MLS",1

FOR:	FOR C=1 TO 5
		FOR R=1 TO 23
			IF DIR'NAM(R,C)[7,7]="*" OR DIR'NAM(R,C)[7,7]="#" &
				THEN CALL COPY'FILE
		NEXT R
	NEXT C
	RETURN
NO'FILE:
	PRINT TAB(24,2); TAB(-1,9);
	IF ERR(0)=16 THEN PRINT "?File spec error";
	IF ERR(0)=22 THEN PRINT "?PPN not found ";
	IF ERR(0)=26 THEN PRINT "?Device does not exist";
	IF ERR(0)=23 THEN PRINT "?Protection violation";
	PRINT " %Error ";ERR(0); " "; COPY$; " ";
	XCALL ACCEPT,D
	RESUME FILE'RTN

FILE'RTN:
	RETURN	! rtn to DCF (DIR'COPY'FILES)
!
COPY'FILE:
	A$=DIR'NAM(R,C)			! get file name
	A$[7,7]=" "
	CS=INSTR(1,A$," ")		! find a space in file name
	F$=A$[1,CS-1]+"."+ A$[8,10]	! put dot in
	PRINT TAB(24,2); TAB(-1,9); FLD(FLD'ROW);" to "; COPY$;F$;
	R1=510
	F1=DIR'LNK(R,C)			! get first block link
	IF DIR'TYP(R,C) = 65535 THEN CALL COPY'RANDOM ELSE &
		CALL COPY'SEQ	
	RETURN
COPY'SEQ:
	CT=0
	OPEN #20,COPY$+F$,OUTPUT	! open file
COPY'S:
	READ #1,D'RAN
	F1=DIR'PTR		! get next link
	IF F1 = 0 THEN R1=DIR'TYP(ROW1,C'CT)	! bytes of last block
	PRINT #20,D'SEQ[1,R1];
	CT=CT+1
	PRINT TAB(24,50); CT;
	IF F1=0 THEN CLOSE #20 : RETURN
	GOTO COPY'S

COPY'RANDOM:
	F14=0
	LOOKUP COPY$+F$,FOUND
	IF FOUND < 0 THEN KILL COPY$+F$		! erase old file
1335	ALLOCATE COPY$+F$,DIR'SIZ(R,C)		! create new file
	OPEN #20,COPY$+F$,RANDOM,512,F14	! open file
	GOTO COPY'RAN
	PRINT "By Mike L. Sessi. 415/258-0102 .. 707/795-1596 11/24/95"
	print "Questions, call me"
COPY'RAN:
	READ #1,D'RAN
	WRITE #20,D'RAN
	F14=F14+1
	IF F14 =>  DIR'SIZ(R,C) THEN CLOSE #20 : RETURN
	F1=F1+1
	PRINT TAB(24,50); F14
	GOTO COPY'RAN

!
! 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

!	DIR'SIZ(ROW1,C'CT)=UFDBLKX(A0)		! file size
!	DIR'TYP(ROW1,C'CT)=UFDACTX(A0)		! file type
!	DIR'LNK(ROW1,C'CT)=UFDFPTX(A0)		! link to file

! check file type
PRT'FILE'SCR:
	PRINT TAB(-1,0);
	F1=DIR'LNK(ROW1,C'CT)		! get first block link
	IF DIR'TYP(ROW1,C'CT) = 65535 THEN GOTO RANDOM'PRT
	R1 = 510
!look
SEQ'PRT:
	R=1
1234	READ #1,D'RAN
	IF DIR'PTR = 0 THEN R1=DIR'TYP(ROW1,C'CT)	! bytes of last block
S1:	SEQ=ASC(D'SEQ[R,R])
	   IF SEQ > 31 AND SEQ < 126 THEN PRINT CHR(SEQ); : C=C+1
	   IF SEQ = 13 THEN PRINT CHR(13); CHR(10); : R=R+1 : C=0 : L=L+1
	   IF SEQ = 9 THEN PRINT CHR(9); : C=C+9
	IF C > 79 THEN C=0 : L=L+1
	IF L > 22 THEN CALL PRT'COM : IF B=27 THEN RETURN
	R=R+1 :	IF R < R1 THEN GOTO S1
	F1=DIR'PTR
	IF F1=0 THEN CALL PRT'COM : RETURN		! end of file
	GOTO SEQ'PRT
PRT'COM:
	PRINT TAB(24,1); TAB(-1,9);
	C=0 : L=0 
	PRINT TAB(24,1); TAB(-1,32); "CR to continue listing, ESC to return >";
	print tab(24,77); tab(-1,33);
	XCALL ACCEPT,B
	PRINT TAB(24,1); TAB(-1,9);
	RETURN

RANDOM'PRT:
	R=1
	READ #1,D'RAN
R1:	SEQ=ASC(D'SEQ[R,R])
	   IF SEQ > 31 AND SEQ < 126 THEN PRINT CHR(SEQ); : C=C+1
	   IF SEQ = 13 THEN PRINT CHR(13); CHR(10); : R=R+1 : C=0 : L=L+1
	   IF SEQ = 9 THEN PRINT CHR(9); : C=C+9
	IF C > 79 THEN C=0 : L=L+1
	IF L > 22 THEN CALL PRT'COM : IF B=27 THEN RETURN
	R=R+1 :	IF R < R1 THEN GOTO R1
	F1=F1+1
	IF F1+1 > DIR'SIZ(ROW1,C'CT) THEN CALL PRT'COM : RETURN	! size of file
	GOTO RANDOM'PRT
!
INSTR:
	PRINT "This program will extract files from a FOLDER file."
	print "It will overwrite any file that already exsist in"
	print "that account."
	print
	print "Do not try to look at an empty PPN,"
	print "the program will bounce you out to the dot."
	print
	print "Questions: call mike sessi @ 707/795-1595"
	print "As always, if this program as value to you,"
	print "you can always send me $."
	RETURN

FLD'DIR:
	PRINT "Need a file called FOLDER.FIL. Please create by the"
	print "following: ? DIR/D FOLDER.FIL=*.FLD whereas .FLD is"
	print "the name(s) of the folder files"
	
EXIT:
	? TAB(-1,28); TAB(23,1);
	END