.TITLE PINDX
	.IDENT	/BL1.1/
;
;	This program has been completely rewritten by:  J. CLEMENT
;
;
;
; PRINT INDEX command
; DO INDEX command
; RESET INDEX command
; DELETE INDEX command
;
;
;	The format of the INDEX table is
;	WORD 1	Points to first entry in table
;	Entry:	1	Word link to next entry (0 if end of table)
;		3	Byte status - bits
;		4 -	App/Chapter number (if X.AP,X.CH bit set)
;		5 -	Page number (if X.PAG bit set)
;		6 -	Subpage number (if X.SPG bit set)
;		7 -	Entry (if X.ENT bit set)
;		n -	byte=0
;	Status	X.ENT,X.AP,X.CH,X.PAG,X.SPG,X.SEN
;		X.SEN = 3 bits for subentry number (0=main entry)
;
	.psect	$TEMP,D,RW,GBL,OVR
NUMB:	.BLKW	1		; Counts numbers converted
FLINK:	.BLKW	1		; foreward link
LINK:	.BLKW	1		; Current link
BLINK:	.BLKW	1		; previous link
INSAV:	.BLKW	1		; temporary buffer index
OUSAV:	.BLKW	1		; Output buffer save
TABSAV:	.BLKW	1
CHSAV:	.BLKW	1		; Save chapter/appendix
PAGSAV:	.BLKW	1		; Last page number
SBPSAV:	.BLKW	1		; Last subpage number
STAKS:	.BLKW	1		; Stack save
FIRST:	.BLKB	1		; last leading character
LCHAR:	.BLKB	1		; current leading char
STAT:	.BLKB	1		; input status
STSAV:	.BLKB	1		; Previous status
SUBSZ=20.
SUBTXT:	.BLKB	SUBSZ+1		; Subindex heading to print
	.even
;
; DO INDEX COMMAND
;
	.psect	$TEXT,ro,d,lcl
INDXTX:	.ASCIZ	/INDEX/
	.even
	.PSECT	$CODE,RO,I,LCL
DOINX::	TSTEQB	$INXSW,5$	; INDEXING ENABLED?
	RETURN			; 			
5$:	MOV	#STLBF,R3	; CLEAR SUBTITLE
	CALL	CLRBF
	MOV	#TTLBF,R3	; CLEAR TITLE BUFFER
	CALL	CLRBF
	CALL	TXDMP		; Flust out all text
	BISB	#SW.TDS,$HDRSW	; Set temporary no header
	CALL	PAGRST		; New page
	CLRB	CHPTN
	MOVB	#<'X-'A+1>,APNDN	; Set up appendix number X
	CALL	LINBEG		; Start a new line
	BISB	#SW.TDS,$CENSW	; SET UP TO CENTER TEXT
	MOV	RMARG,R0
	ADD	LMARG,R0
	ASR	R0
	MOV	R0,CMARG	; Set up center margin
	BISB	#SW.IDS,$IFLSW+1; Prevent indexing
	BISB	#SW.IDS,$EQFSW+1; Prevent equations
	CALL	$FRCND
	CMPEQ	R1,#CR,25$	; End of line ?
	CALL	GCIN		; Get line
	CALL	BKSPI		; Backspace to LF
	BR	30$		; Any text ?
25$:	MOV	#INDXTX,R2	; POINT TO NOTE TEXT PROTOTYPE
	CALL	TMPIN		; Set up in buffer
	CALL	GCIN
30$:	BICB	#SW.IDS,$EQFSW+1; Allow equations
	BICB	#SW.IDS,$IFLSW+1; Now allow it again
	MOV	#4,R1
	CALL	MULSP		; Get line adjusted
	MOV	R1,EQBOT	; SET bottom LINE COUNT
	CALL	OUTNJ		; OUTPUT THE TEXT
	CLRB	SUBTXT		; Setup no subtext
	CLRB	STAT		; Setup no status
	JMP	PINDX1		; PRINT THE INDEX
;
;	DELETE INDEX comm
;
DLINDX::TSTNEB	$INXSW,40$	; INDEXING ENABLED?
	CALL	GETENT
	BCS	40$		; None ??
	TSTEQ	FLINK,40$	; At end of buffer ?
	TSTEQB	STAT,40$	; No entry found ?
	MOV	BLINK,R5	; Current entry
10$:	CALL	GPAG		; Get next entry
	BCS	20$		; None
	BITNEB	#X.SEN,R1,10$	; Subentry ?
	BITEQ	#X.ENT,R1,10$	; No entry ?
20$:	MOV	R5,R1		; Go back to entry
	CALL	FNDBF		; Go back to before entry to remove
	MOV	LINK,R1		; And zap it
	CALL	PWRD		; Remove entry
40$:	RETURN
;
;	RESET INDEX command
;
RSINDX::TSTEQB	$INXSW,5$	; INDEXING ENABLED?
	RETURN			; 			
5$:	MOV	#INXBF,R3	; get index buffer
	JMP	CLRBF		; clear buffer also
;
;	PRINT INDEX command
;
PINDX::	TSTEQB	$INXSW,5$	; INDEXING ENABLED?
1$:	RETURN			; 			
5$:	CALL	GETENT
	BCS	1$
PINDX1:	TSTNEB	STAT,45$	; And print it
	BR	20$
;
;	Here is main loop to print index
;
1$:	TSTEQB	SUBTXT,RSINDX	; Whole index printed ??
	RETURN
20$:	CALL	GPAG		; Get first page of data
	BCS	1$		; Nothing to index
	BITNE	#X.ENT,R1,25$	; entries?
	CALL	HLTER		; Bad index
25$:	BITNEB	#X.SEN,STAT,45$	; Is this subentry ?
	TSTNEB	SUBTXT,1$	; Selected entries only ??
	MOV	#INXBF,R3	; index buffer
	CALL	GBYT		; get first char
	CMPNEB	GCTABL(R1),#GC.LC,30$ ; first letter not lower case ?
	BIC	#40,R1		; no make upper
30$:	MOVB	R1,LCHAR	; save it
	MOV	BF.FUL(R3),R1	; Current index
	DEC	R1		; Now previous one
	CALL	FNDBF		; Backspace by 1 char
	MOVB	LCHAR,R1
	CMPEQB	R1,FIRST,45$	; SAME AS INITIAL LETTER OF PREVIOUS ONE?
	BGT	33$		; Not Illegal ?
	CALL	HLTER
33$:	MOVB	R1,FIRST	; SAVE THIS CHARACTER
	MOV	PARSP,R1	; Get spacing
	BEQ	35$		; None?
	CALL	OUTAD
	CALL	SKIPL		; Skip N lines
35$:	MOV	PARPT,R1	; Paragraph test page
	CALL	TESTT		; Check if enough lines available
45$:	CLR	R2
	CALL	INDEN2
	CALL	LINBEG		; Start a line
	CLR	TABSAV
	MOV	#INXBF,R2	; index buffer
	CALL	OUTCH		; Print it
	BCC	70$		; OK ?
	CALL	OUTAD
	CALL	OUTNJ		; Output this line
	BR	45$		; Continue till done
70$:	CALL	OUTAD
	MOV	#TABO,R1
	BITEQ	#FILLF,F.1,75$	; no ellipses ?
	MOV	#ELIP,R1
75$:	CALL	PBYT
	MOV	BF.FUL(R3),TABSAV; SAve tab address
	MOV	#1,R1
	CALL	PBYT		; Output count
	DEC	LINBK
	INC	SPCH
	CALL	NUMCV
120$:	MOV	#TTBF,R2
	CALL	OUTCH		; Output chars
	BCC	130$		; Done ??
	CALL	OUT
	MOV	PARIND,R2	; Indent non index item
	CALL	INDEN2		; Indent item
	CALL	OUTAD
	CALL	LINBEG		; Start new line
	MOV	#TABO,R1
	CALL	PBYT
	MOV	BF.FUL(R3),TABSAV; SAve tab address
	MOV	#1,R1
	CALL	PBYT		; Output count
	DEC	LINBK
	INC	SPCH
	BR	120$		; Output more numbers
130$:	CALL	OUT		; Output line
	TSTNE	LINK,140$	; Not done ?
	JMP	1$		; Now use new entry
140$:	JMP	25$		; Now get next entry
;
;	Output a line of text
;
OUT:	CALL	OUTAD
	MOV	TABSAV,R1
	BEQ	125$		; No tabs to expand
	BITEQ	#JUSTF,f.1,125$	; No justify ?
	CALL	FNDBF
	CALL	GBYT		; Get current count
	MOV	LINBK,R0	; Get extra spaces needed
	ADD	R0,R1		; Add on extra
	MOVB	R1,@BF.ADD(R3)	; New count
	ADD	R0,SPCH		; Add onto spacing chars
	CLR	LINBK	
	CLR	TABSAV
125$:	JMP	OUTNJ		; Output result
;
;	Indent the text
;
INDENT:	CLR	R2
INDEN2:	MOVB	STAT,R0		; Get extra indent for subindex
	BIC	#177770,R0	; Get subindex number
	ADD	R0,R2		; Extra indentation
	ADD	R0,R2		; Extra indentation
	MOV	RMARG,R0	; Check if too big ?
	SUB	LMARG,R0	; Line length
	SUB	#10.,R0		; Leave 10 spaces
	CMP	R2,R0		; Check size
	BGT	10$		; Too big ?
	MOV	R2,INDCT
10$:	RETURN
;
;	Subroutine to get initial params
;
GPAG:	MOV	#INXBF,R3	; get index buffer
	TSTNEB	STAT,10$	; Already set up ?
	CLRB	FIRST		; first letter
	CALL	BEGBF		; Start at beginning
	CALL	GWRD
	BCS	110$		; no index items?
	MOV	R1,FLINK
	CLR	LINK
	CLR	BLINK
10$:	MOV	FLINK,R1	; next entry
	MOV	LINK,BLINK	; Current is now backward link
	MOV	R1,LINK		; Foreward is now current
	BEQ	110$		; no more?
	CALL	FNDBF		; get it
	BCC	20$		; OK ?
15$:	CALL	HLTER		; No ?
20$:	CALL	GWRD		; get foreward link
	BCS	15$		; End of buffer
	MOV	R1,FLINK	; save it
	CALL	GBYT		; status
	BCS	15$		; End of buffer
	MOVB	R1,STAT		; save it
	BEQ	15$		; Bad status ?
100$:	CLC			; OK!
	RETURN
110$:	SEC			; mark it as end
	RETURN
;
;	Output a line of text
;
OUTCH:	CALL	OUTAD
	CALL	ENDBF
	CLR	INSAV
	CLR	OUSAV
1$:	CALL	GBYT2		; Get input byte
	BHI	5$
	CLC
	RETURN
5$:	CMPNEB	R1,#SPC,10$	; Not space ?
	MOV	BF.FUL(R2),INSAV	; set up to Rewind location
	MOV	BF.FUL(R3),OUSAV
	MOV	SPCH,LSPCH	; Spacing count
10$:	CALL	PBYT		; Save 1 byte
	INC	SPCH		; Count chars
	DEC	LINBK
	BGE	1$		; Continue till done
	MOV	OUSAV,R1	; Go back in output
	BNE	20$		; backup ?
	MOV	BF.FUL(R2),INSAV	; Rewind location
	DEC	INSAV
	MOV	SPCH,R0
	DEC	R0
	MOV	SPCH,LSPCH
	MOV	BF.FUL(R3),R1
	DEC	R1
20$:	CALL	RSTBF
	MOV	R2,R3
	MOV	INSAV,R1
	CALL	FNDBF		; Go back in input
	MOV	SPCH,R0		; Current char count
	SUB	LSPCH,R0	; - previous count
	ADD	R0,LINBK	; Restore LINBK
	MOV	LSPCH,SPCH	; Restore count
	CALL	OUTAD		; Get R3
	SEC
	RETURN
;
;	Subroutine to convert number to buffer
;
NUMCV:	CLR	NUMB		; No numbers converted
	CLR	PAGSAV		; Initially no page numbers
	MOV	#TTBF,R3
	CALL	CLRBF
	MOV	SP,STAKS
10$:	MOV	STAKS,SP
	CALL	GPAG
	BCS	15$		; finish up
	BITEQ	#X.ENT,R1,20$	; not new entry?
15$:	MOV	#TTBF,R3
	CALL	BEGBF
	RETURN
20$:	CLR	-(SP)		; end of numbers
	CLR	R5		; Initially no differences
	MOVB	STAT,R2
	CMPEQB	STSAV,R2,30$	; Status same ?
	INC	R5		; No
30$:	MOVB	R2,STSAV	; Save current status
	BITEQ	#X.AP,R2,50$	; no appendix?
	CALL	GBYT		; get appendix
	MOV	APNDSP,-(SP)	; set the format
	MOVB	R1,(SP)		; save it
	CMPEQ	R1,CHSAV,50$	; Appendix same ?
	INC	R5		; No
	MOV	R1,CHSAV
50$:	BITEQ	#X.CH,R2,60$	; no chapter?
	CALL	GBYT		; get chapter
	MOV	CHPDSP,-(SP)	; set the format
	MOVB	R1,(SP)		; save it
	CMPEQ	R1,CHSAV,60$	; Chapter same ?
	INC	R5		; No
	MOV	R1,CHSAV
60$:	BITEQ	#X.PAG,R2,70$	; no page ?
	CALL	GWRD		; get page number
	MOV	R1,-(SP)	; save it
	CMPEQ	R1,PAGSAV,70$	; Page same ?
	INC	R5		; No
	MOV	R1,PAGSAV
70$:	BITEQB	#X.SPG,R2,80$	; no subpage?
	CALL	GBYT		; get subpage
	MOV	SUBDSP,-(SP)	; set format
	MOVB	R1,(SP)		; save it
	CMPEQ	R1,SBPSAV,80$	; Subpage same ?
	INC	R5		; No
	MOV	R1,SBPSAV
80$:	TSTEQ	R5,90$		; Number not different
	MOV	#TTBF,R3	; Get temporary buffer
	MOV	#"  ,R1		; Blanks to pad
	TSTEQ	NUMB,85$	; No number yet ?
	MOV	#", ,R1		; comma between entries
85$:	CALL	PWRD		; Save , 'blank'
	INC	NUMB
	CALL	PAGCV		; Convert page number into buffer
90$:	JMP	10$
;
;	Subroutine to find index entry
;
GETENT:	CLRB	STAT
	MOV	#SUBTXT,R3	; Destination for literal
	CALL	GETLIT		; Get literal
	BCS	20$		; No literal ??
	TSTEQ	R1,20$		; Null literal ??
	CMP	R1,#SUBSZ	; Is it too big ?
	BLE	10$		; OK ?
	JMP	ILCM		; No bad params
10$:	MOVB	(R2)+,(R3)+	; Save literal
	SOB	R1,10$
20$:	CLRB	(R3)+
	CLC
	TSTEQB	SUBTXT,90$	; No subentry selected
;
;	Section to find proper entry
;
30$:	CALL	GPAG		; Get subentry
	BCS	100$		; Done ??
	BITEQB	#X.ENT,R1,30$	; No entry ?
	BITNEB	#X.SEN,R1,30$	; Subentry ?
	MOV	BF.FUL(R3),R5	; Save current entry begin
	MOV	#SUBTXT,R2	; Location of text to compare
40$:	CALL	GBYT		; Get entry
	BEQ	50$		; Done ?
	CMPEQB	(R2)+,R1,40$	; Is it same ??
	BR	30$		; No try next one
50$:	TSTNEB	(R2)+,30$	; End of input text
	MOV	R5,R1		; start at begin of entry
	CALL	FNDBF		; Now at beginning
90$:	CLC
100$:	RETURN
	.END