; White House Software, Inc, Extended Directory Program
;
;       TITLE	EDIR	
;
; THIS PROGRAM MAY BE FREELY DISTRIBUTED TO AMUS MEMBERS
; COURTESY OF WHITE HOUSE SOFTWARE, INC.
;
;Edit History:
;
; 8/19/86 1.0(0) - David Greene
;	Written
;
; To use you must link with WLDSCN.OBJ which you may also get off the network
;
;	LNKLIT	EDIR,WLDSCN
;
VEDIT=0.

	SEARCH	SYS
	SEARCH	SYSSYM
	SEARCH	TRM

; Define Version Information
VMAJOR=1.
VMINOR=0.
VSUB=0.
VWHO=0.

;dedicated registers

	WILD=A4				; wildscan DDB index

;impure area used by EDIR

.OFINI
.OFDEF	PBUF,22.			; print buffer
.OFDEF	DDB,D.DDB			; ddb used for comment line display
.OFDEF	LINBUF,512.			; file input buffer
.OFDEF	LSTDEV,2			; last device of last file accessed
.OFDEF	LSTDRV,2			; last drive of last file accessed
.OFDEF	LSTPPN,2			; last PPN of last file accessed
.OFDEF	COUNT,2				; count of number of files on screen
.OFDEF	BEGRTN,2			; return routine flag
.OFSIZ	IMPSIZ


;These macros are used to call WLDSCN, the wildcard directory scanner
;These are defined in WLDSCN.UNV as well

DEFINE	WINIT
	IF	NDF,W.INIT,EXTERN W.INIT
	CALL	W.INIT
	ENDM

DEFINE	WSPEC	EXT
	IF	NDF,W.SPEC,EXTERN W.SPEC
	CALL	W.SPEC
	IF	B,EXT,ASCII /???/
	IF	NB,EXT,ASCII /'EXT/
	BYTE	0
	ENDM

DEFINE	WSCAN
	IF	NDF,W.SCAN,EXTERN W.SCAN
	CALL	W.SCAN
	ENDM

; define various ascii codes
TAB	=11
LF	=12
CR	=15
SPACE	=40

; macro to perform a CRT function
DEFINE	ACRT	ROW,COL
IF	NB,COL,MOVW	#<ROW_8.>!COL,D1
IF	B,COL,MOVW	#177400!ROW,D1
	TCRT
	ENDM

;start of code

; Initial set up area
START:
	PHDR	-1,PV$RPD!PV$RSM,PH$REE!PH$REU	; program header
	GETIMP	IMPSIZ,A5		; allocate local memory
	CLRW	DDB(A5)			; not inited yet
	INIT	DDB(A5)			; now it is
	WINIT				; initialize WLDSCN (sets up A4)
	JOBIDX	A1			; A1 -> my jcb
	MOV	JOBTRM(A1),A1		; A1 -> my terminal status word
	ORW	#T$IMI!T$ECS,@A1	; set echo suppress and image mode
	ACRT	29.			; turn off cursor

; Set up things for the program and wildcard scanner
CMDLIN:
	BYP				; bypass leading cmd line spaces
	WSPEC				; process wildcard file specification
	JNE	EXIT			; branch on invalid spec
	CLRW	LSTDEV(A5)		; no last device yet
	CLRW	LSTDRV(A5)		; no last drive yet
	CLRW	LSTPPN(A5)		; no last ppn yet
	CLRW	COUNT(A5)		; no files on screen yet
	CLRW	BEGRTN(A5)		; flag no return first time through

; Main proceesing loop
LOOP:
	CTRLC	EXIT			; branch on ^C
	WSCAN				; get next file that matches spec
	JNE	EXIT

; Copy all pertinant info from wildcard scanner table
	MOVW	D.DEV(WILD),D.DEV+DDB(A5); copy spec
	MOVW	D.DRV(WILD),D.DRV+DDB(A5); from wildscan
	MOVW	D.PPN(WILD),D.PPN+DDB(A5);  DDB @A4 to
	MOV	D.FIL(WILD),D.FIL+DDB(A5);    our internal
	MOVW	D.EXT(WILD),D.EXT+DDB(A5);     table

; Check to see if screen is full
	CMMW	COUNT(A5),#20.		; is the screen full ?
	BLOS	10$			;  no - continue
5$:
	CALL	RETURN			;  yes - wait for user
	CALL	HEADER			; redisplay header and clear screen
	CLRW	COUNT(A5)		; no file now

; Check to see if we entered a new PPn
10$:
	CMMW	LSTDEV(A5),D.DEV+DDB(A5); are we still in the same account ?
	BNE	20$			;  no - we need to reset
	CMMW	LSTDRV(A5),D.DRV+DDB(A5);
	BNE	20$			;  no...
	CMMW	LSTPPN(A5),D.PPN+DDB(A5)
	BEQ	30$			;  yes - show this file
20$:
	MOVW	D.DEV+DDB(A5),LSTDEV(A5); set new current account number
	MOVW	D.DRV+DDB(A5),LSTDRV(A5)
	MOVW	D.PPN+DDB(A5),LSTPPN(A5)
	BR	5$

; Show file on screen
30$:
	CTRLC	EXIT			; allow ctrlc
	CALL	PFILE			; show file name
	CALL	SHWLIN			; show first comment line
	CRLF				; goto next line
	INCW	COUNT(A5)		; bump count
	JMP	LOOP			; and continue

; Exit program 
EXIT:
	JOBIDX	A1			; A1->my jcb
	ANDW	#^C<J.CCC>,JOBSTS(A1)	; clear any pending CTRLC's
	ACRT	24.,1			; cursor at row 24 col 1
	ACRT	9.			; delete to end of line
	ACRT	28.			; cursor on
	EXIT				; back to AMOS/L...

;****************
;*    PFILE	*
;****************
; This routine prints the current file name on the screen
; in lower intensity without a dot
PFILE:
	SAVE	D1,A1,A2		; save work registers
	LEA	A2,PBUF(A5)		; index print work area
	LEA	A1,D.FIL+DDB(A5)	; get filename
	UNPACK				; to ascii
	UNPACK
	MOVB	#40,(A2)+		; add a space
	UNPACK				; then extension
	CLRB	@A2			; terminate correctly
	ACRT	11.			; low intensity
	TTYL	PBUF(A5)		; display file name
	ACRT	12.			; back to high intensity
	REST	D1,A1,A2		; restore work registers
	RTN				; return

;****************
;*   SHWLIN	*
;****************
; This routine trys to locate a valid comment character.  It ignores
; blank lines.  If it hits any thing other than '!', ';', '.;', or 'REM'
; it stops processing for the current file.  If it finds a valid comment
; string in the first part of the file it will load that line into a buffer
; so it can show it to the user.  If a non-printable ascii character is
; fount it stops processing the current file.
SHWLIN:
	SAVE	D1,D2,A2		; save work register
	TYPE	<  >			; seperate from name

; Open file if possible
	ORB	#D$ERC!D$BYP,D.FLG+DDB(A5); no room for error messages
	OPENI	DDB(A5)			; open the file
	JNE	99$			;  no - mabey random or disk error

; Copy line into print buffer
10$:
	LEA	A2,LINBUF(A5)		; index the line buffer
	CLR	D2			; no characters in line yet

; Main input loop
20$:
	FILINB	DDB(A5)			; get a character
	TST	D.SIZ+DDB(A5)		; are we done ?
	JEQ	98$			;  yes - 
	INC	D2			;  no - bump file count
	CMP	D2,#69.			; are we full ?
	BGE	30$			;  yes - we're done with this file
	CMPB	D1,#CR			;  no - hit a CR ?
	BEQ	20$			;   yes - don't load this
	CMPB	D1,#LF			; hit a line feed yet?
	BEQ	30$			;  no - get another byte
	CMPB	D1,#TAB			; hit a TAB ?
	BNE	25$			;  no - all is peaches
	MOVB	#SPACE,D1		;  yes - replace with a space

; Check for validity and load into buffer
25$:
	ANDB	#177,D1			; limit to seven bits
	CMPB	D1,#40			; ASCII ?
	BLO	98$			;  no - forget displaying this one
	MOVB	D1,(A2)+		; set it into the buffer
	BR	20$			; get another character

; Terminate line and look for comment string
30$:
	CLRB	@A2			;  terminate properly
	LEA	A2,LINBUF(A5)		; A2 -> command
	BYP				; bypass spaces
	TSTB	@A2			;  no - blank line ?
	BEQ	10$			;   yes - get another one

; Check for ';'
	CMPB	@A2,#';			; commented out ?
	BEQ	50$			;  yes - get another line

; Check for '!'
	CMPB	@A2,#'!			; commented out ?
	BEQ	50$			;  yes - get another line

; Check for '.;' -- SuperVue file
	CMPB	(A2)+,#'.		; half a comment spec ?
	BNE	40$			;  no - check next one
	CMPB	@A2,#';			;  yes - is other half there ?
	BEQ	50$			;    yes - whoopee

; Check for 'REM' statement from BASIC
40$:
	DEC	A2			; back up to correct place
	MOVB	(A2)+,D1		; get a byte
	UCS				; to upper case
	CMPB	D1,#'R			; first part ?
	BNE	98$			;  no - we're done
	MOVB	(A2)+,D1		; check second one
	UCS
	CMPB	D1,#'E
	BNE	98$
	MOVB	@A2,D1			; and the thrird
	UCS
	CMPB	D1,#'M
	BNE	98$

; Valid comment string found display line
50$:	
	INC	A2			; bypass last comment character
	BYP				; ingnore leading spaces
	TTYL	@A2			; display line

; Close file
98$:
	CLOSE	DDB(A5)			; close file

; Return to main program
99$:
	REST	D1,D2,A2		; and return
	RTN

;****************
;*   HEADER	*
;****************
; This routine displays the header with the current account info
HEADER:
	CTRLC	EXIT			; allow exit
	SAVE	D1,A0			; save work registers
	ACRT	0			; clear screen
	ACRT	12.			; low intensity
	TYPE	<White House Software>	
	ACRT	11.			; high intensity
	TYPE	< Extended >
	ACRT	12.
	TYPE	<Directory>
	ACRT	11.
	TYPE	<..........................>
	ACRT	12.

; Save info we might modify
	PUSHW	D.DEV+DDB(A5)		; save info so we can use PFILE
	PUSHW	D.DRV+DDB(A5)		; and PRPPN to display the current
	PUSHW	D.PPN+DDB(A5)		; login
	PUSH	D.FIL+DDB(A5)
	CLR	D.FIL+DDB(A5)		; no file name will show only the dev:

; Check to make sure we have a device to pring
	JOBIDX	A0			; index my jcb
	TSTW	D.DEV+DDB(A5)		; is there a DDB specified ?
	BNE	10$			;  yes - use it
	MOVW	JOBDEV(A0),D.DEV+DDB(A5);  no - use default
	MOVW	JOBDRV(A0),D.DRV+DDB(A5)

; Print device
10$:
	PFILE	DDB(A5)			; display device
	POP	D.FIL+DDB(A5)		; restore file
	TYPE	<[>			; start of ppn area

; Check to se that we have a PPn to print
	TSTW	D.PPN+DDB(A5)		; is one loaded ?
	BNE	20$			;  yes - use it
	MOVW	JOBUSR(A0),D.PPN+DDB(A5);  no - use default

; Print our PPn
20$:
	PRPPN	D.PPN+DDB(A5)		; print the account number
	TYPECR	<]>			; end of PPn display
	POPW	D.PPN+DDB(A5)		; restore info
	POPW	D.DRV+DDB(A5)
	POPW	D.DEV+DDB(A5)
	REST	D1,A0
	RTN

;****************
;*   RETURN	*
;****************
; This routine waits for user input
RETURN:
	TSTW	BEGRTN(A5)		; is this the first time through ?
	BEQ	10$			;  yes - don't wait for user
	SAVE	D1			; save work register
	ACRT	24.,1.			; row 24 col 1
	ACRT	11.			; low
	TYPESP	<Press>			; 
	ACRT	12.
	TYPESP	<any key>
	ACRT	11.
	TYPESP	<to continue:>
	ACRT	12.
	ACRT	28.			; cursor on
	KBD				; wait for a key stroke
	ACRT	29.			; cursor off
	REST	D1			; restore work register
10$:
	MOVW	#-1,BEGRTN(A5)		; no longer first time through
	RTN


	END