!*************************** AMUS Program Label ******************************
! Filename: LANPRT.BAS                                      Date: 05/06/96
! 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: lanset.run, sleep.sbr, logppn.sbr, READBL.sbr
! Min. Op. Sys.: AMOSL 1.0                     Expertise Level: none
!*****************************************************************************
! 04/01/96 mike sessi of birmingham data systems
! LANPRT USES LANSET FOR SET UP SPEC.
!
! THIS PROGRAM USES
!	XCALL READBL.SBR	! reads a single block
!	XCALL LOGPPN.SBR	! where am I logged into
!	xcall sleep.sbr		! sometimes I sleep 
 
   MAP1 DIR'FILE
	MAP2 DIR'PTR,B,2
	MAP2 D'SEQ,X,510
!   
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
250		MAP3 MFD3,B,2	! PASS WORD  ?
260		MAP3 MFD4,B,2	! ???
!
	MAP1 PPN0,S,9		! Hold p,pn number  [123,123]
270	MAP1 PPN1,S,3		! P,PN 1st 3 numbers
280	MAP1 PPN2,S,3		! 2nd 3 numbers
	MAP1 DIR'LNK,B,2	! stores LNK2
!

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)
440	MAP1 NAME,S,10		! the unpacked file name
!
!
510 !	MAP1 READBL
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
!

	MAP1 VARIABLE'LIST
		MAP2 X,F
		MAP2 R1,F
		MAP2 R2,F		
		MAP2 R3,F
		MAP2 X3,F
		MAP2 Q,F
		MAP2 D,F
		MAP2 R,F
		MAP2 WHERE,S,50		! DISK AND P,PN
		MAP2 W'DISK,S,7		! DISK WHERE LOGGED INTO (DSK000:)
		MAP2 W'PPN,S,9		! WHAT PPN ACCT ([000,000])
		MAP2 SPOOL,S,20
! LANSET UP PROGRAM
	MAP1 LANSET
		MAP2 LAN(20)
			MAP3 EXT,S,3
			MAP3 TRM,S,6
		MAP2 T'PPN,S,9			! P,PN NUMBER FOR COPIES TO
		MAP2 FIL,S,323			! EXP: [000,000]
	MAP1 FILE,S,10,"LANSET.UP"
!
	SIGNIFICANCE 11
	STRSIZ 80
!
	L1=0 : L2=0
	LOOKUP "MEM:LOGPPN.SBR",L1
	LOOKUP "RES:LOGPPN.SBR",L2
	IF L1 +L2 =0 THEN PRINT "LOGPPN.SBR NEEDS TO LOADED INTO MEMORY" : END
!
	L1=0 : L2=0
	LOOKUP "MEM:READBL.SBR",L1
	LOOKUP "RES:READBL.SBR",L2
	IF L1 +L2 =0 THEN PRINT "READBL.SBR NEEDS TO LOADED INTO MEMORY" : END
!
	L1=0 : L2=0
	LOOKUP "MEM:SLEEP.SBR",L1
	LOOKUP "RES:SLEEP.SBR",L2
	IF L1 +L2 =0 THEN PRINT "SLEEP.SBR NEEDS TO LOADED INTO MEMORY" : END
!
! Where am I (what logical block)
! scan that block for files to be spooled and then deleted
!

	XCALL LOGPPN,WHERE
	D=INSTR(1,WHERE,":")
	W'DISK=WHERE[1,D]
	P=INSTR(D,WHERE,"[")
	W'PPN=WHERE[P,LEN(WHERE)]
! now I know where I am, lets find my directory block number
!
START:
	CALL MFD		! SCAN MFD
!
! I have found my ppn; I now have my directory block number.
! set up for scaning of that directory block number.
!
	CALL LANSET		! LOAD PRINTER SPEC.
S1:	CALL DIR		! SCAN DIRECTORY BLOCK
	XCALL SLEEP,30		! IF no file found, sleep for 30 seconds
	GOTO S1

700 MFD:
710   !READING THE MFD
	DISK'DEVICE=W'DISK : BLOCK'NO=1		! MFD BLOCK
	CALL RD'DISK
630	MFDX=BUFFER : P'FOUND = 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		PPN0="["+PPN1+","+PPN2+"]"
!		PRINT PPN0		! TEST; PRINT P,PN
		IF W'PPN=PPN0 THEN P'FOUND=1 : DIR'LNK=LNK2(MD) : MD=64
OUT:	NEXT MD
	RETURN
LANSET:
!
! LOAD LANSET PRINTER SPEC.
!
	LOOKUP FILE,FOUND
	IF FOUND=0 THEN CHAIN "LANSET"
	OPEN #100,FILE,RANDOM,512,F1
	F1=0
	READ #100,LANSET
	CLOSE #100
	RETURN
820 DIR:
   	BLOCK'NO=DIR'LNK	! directory block to be scaned
   	CALL RD'DISK
   	UFD=BUFFER
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	! no file
930		CALL RAD50		! UNPACK THE FILE NAME
!
!		PRINT NAME;".";UNP	! TEST; PRINT FILE NAME
!
! 		is the file in my list? where does it go ?
! 		 scaning to see where to send file
!
		FOR A=1 TO 20
			IF UNP=EXT(A) THEN CALL SPOOL ! FOUND ONE
		 	IF EXT(A) = "" THEN A=20
		NEXT A
!		
DIR1:	NEXT A0
	RETURN	
SPOOL:
! Get ready to spool file. Run in silent mode.
! Copy  file to other p,pn. Then erase file from current P,Pn.
! Spool file to selected printer. When file has printed, delete it.
! return to this program

	SPOOL=NAME+"."+UNP
	open #14,"lanprt.cmd",output
	print #14,":S"
	PRINT #14,"COPY "+T'PPN+ "="+SPOOL	!* Could use MOVEIT here
	PRINT #14,"ERASE " + SPOOL
!
! PRINTER-NAME + FILE + PPN
!
	PRINT #14,"PRINT " + TRM(A) + SPOOL + T'PPN + "/DELETE"
	PRINT #14,"RUN LANPRT"
	CLOSE #14
	CHAIN "LANPRT.CMD"
! beeee  right backkkkkkk
!
	END
!
!
! READ  DISK
1250 RD'DISK:
1260	XCALL READBL, 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
!