.TITLE PINDX
	.IDENT	/M3.0X/

; PRINT INDEX COMMANDS
;
; AUTHOR: L. WADE 1-JUN-72
;
; MODIFIED BY:
;
;	E. POLLACK U. OF W. 19-DEC-73
;
;	D. N. CUTLER 22-SEP-75
;
;	C. H. Spalding, Unimation, Dec. '82
;
; MODIFICATIONS
;
;	chs03	Reduce blank lines from  DO INDEX
;	chs16	Use local symbols in place of constants
;	chs21d	Ignore repeat entries on same page
;	chs24	Fix  SKIP  at bottom of page
;	chs28a	Prevent blank line at top of continuation page
;	chs28b	Do a "TEST PAGE 3" before each letter group
;	chs37	Fix  FIGURE  to work as claimed; added queue
;	chs40	Expand  HEADER
;	chs41	Add control of blank lines between letter groups
;	chs47	Allow consecutive subpages
;	chs51	Add  ENTRY  & subindexing
;	chs52a	Correct spacing of underlined index entries
;	chs52b	Don't exceed right margin with page numbers
;	chs65	Ignore spec. chars. while ordering index
;	chs69	Consider line spacing in  TEST PAGE
;	chs75	Automatically do  DO INDEX  at end of file
;	chs78a	Add  BLOCK
;
; COMMAND ROUTINE IS ENTERED WITH:
;
;	R4 = Address of number conversion routine
;	R5 = Address of flag word F.1
;
; LOCAL DATA

   .IIF NZ XSPNG,  XSPCNG: .BLKW 1 ;SPACING BETWEEN LETTER GROUPS	;chs41
   .IIF NZ XENTRY, PAGOUT: .BLKB 1 ;FLAG FOR PAGE # ALREADY ON LINE	;chs51a
   .IIF NZ SUBIDX, XIDNT:  .BLKB 1 ;BUFFER FOR SUBINDEX INDENT		;chs51b
   .IF NZ IDXRM								;chs52b
XMID:	.BLKW	1		;BUFFER FOR RIGHT-HALF LENGTH		;chs52b
XPOS:	.BLKW	1		;BUFFER FOR SPACE REMAINING		;chs52b
   .ENDC ; NZ IDXRM							;chs52b

; OUTPUT TEXT

DOTXT:	.ASCIZ	/INDEX/		;INDEX HEADING
INDMG:	.ASCIZ	/ ./		;INDEX ELIPSIS TEXT
   .IF NZ SUBIDX							;chs51b
	.ENABL	LC							;chs51b
CONMSG:	.ASCIZ	/ (continued)/						;chs51b
   .ENDC ; NZ SUBIDX							;chs51b
	.EVEN

; DO INDEX COMMAND
;

DOINX::
   .IIF NZ FIGFIX, CALL FIGDMP	;PROCESS ALL PENDING FIGURES		;chs37
   .IIF NZ BLKCMD, CALL BLKDMP	;PROCESS ALL QUEUED TEXT BLOCKS		;chs78a
   .IIF NZ AUTODX, CMPEQ XTOP,XBOT,40$ ;QUIT IF INDEX EMPTY		;chs75
	MOV	TTLP1,TTLP2	;CLEAR TITLE BUFFER
	MOV	STTLP1,STTLP2	;CLEAR SUBTITLE BUFFER
	MOV	#ILMRG,LMARG	;SET LEFT MARGIN			;chs16
	MOV	PRMRG,RMARG	;SET RIGHT MARGIN
   .IIF NZ XSPNG, MOV NSPNG,XSPCNG ;SAVE CURRENT LINE SPACING		;chs41
   .IIF NZ SUBIDX, MOVB #XINDNT,XIDNT ;SET SUBINDEX INDENT		;chs51b
	MOV	#SPCNG,NSPNG	;SET INITIAL SPACING
	BIS	#FILLF!JUSTF!PJUSTF,(R5) ;SET FILL AND JUSTIFY FLAGS
	CLR	PAGENO		;CLEAR PAGE NUMBER
	TSTNE	LINEC,10$	;AT TOP OF PAGE ALREADY?
	INC	PAGENO		;INCREMENT PAGE NUMBER
10$:
   .IF NZ SBPFIX							;chs47
	CALL	ENDSBP		;BREAK CURRENT PAGE (END ANY SUBPAGE)	;chs47
   .IFF									;chs47
	CALL	PAGEC		;BREAK CURRENT PAGE
   .ENDC ; -NZ SBPFIX							;chs47
   .IF NZ BLSW			;USE CONTROLLABLE NO. BLANK LINES	;chs03
	MOV	CHPSKP,R2	;SET LINE COUNT				;chs03
	SUB	$HDRSW,R2	;DECREASE BY HEADER LENGTH		;chs40
	BLE	15$		;NOTHING TO DO?				;chs03
   .IFF				;... OR USE FIXED NO. BLANK LINES	;chs03
	MOV	#7.,R2		;SET LINE COUNT
   .ENDC ; -NZ BLSW							;chs03
	CALL	SKIPN		;SKIP LINES
15$:	CALL	SETTL		;MOVE TITLE TO TITLE BUFFER
	CMPNE	TTLP1,TTLP2,30$	;TITLE SPECIFIED?
	MOV	#DOTXT,R3	;POINT TO DEFAULT TEXT
20$:	MOVB	(R3)+,R1	;GET NEXT BYTE
	BEQ	30$		;IF EQ DONE
	MOV	#TTLP1,R4	;POINT TO TITLE DESCRIPTOR
	CALL	WCI		;WRITE CHARACTER IN BUFFER
	BR	20$		;
30$:	MOV	RMARG,R2	;CALCULATE SPACE COUNT TO CENTER TITLE TEXT
	SUB	LMARG,R2						;chs16
	ADD	TTLP1,R2	;
	SUB	TTLP2,R2	;
	ASR	R2		;
	ADD	LMARG,R2	;OFFSET BY COMPLETE LEFT MARGIN		;chs39
   .IF NZ LAYOUT							;chs39
	CALL	NSPACB		;SPACE OVER FROM BASE MARGIN		;chs39
   .IFF									;chs39
	CALL	NSPAC		;SPACE TO TEXT POSITION
   .ENDC ; -NZ LAYOUT							;chs39
	MOV	#TTLP1,R4	;SET ADDRESS OF LINE DESCRIPTOR
	CALL	PSTRPA		;OUTPUT NOTE TEXT
	MOV	#INDXBL,R2	;SET LINE COUNT				;chs16
	CALL	SKIPN		;SKIP LINES
	MOVB	APNDN,-(SP)	;SAVE CURRENT APPENDIX
	MOVB	#'I-'A+1,APNDN	;SET APPENDIX TO 'I' FOR INDEX
   .IF NZ XSPNG+SUBIDX							;chs41+
	CALL	PINDX0		;PRINT THE INDEX
   .IFF
	CALL	PINDX		;PRINT THE INDEX
   .ENDC ; -NZ XSPNG+SUBIDX						;chs41-
	MOVB	(SP)+,APNDN	;RESTORE APPENDIX NUMBER
40$:	RETURN								;chs75

; PRINT INDEX COMMAND
;

PINDX::
   .IF NZ SUBIDX							;chs51b+
	CALL	(R4)		;GET SUBINDEX INDENT AMOUNT
	  MOV	#XINDNT,R3	;DEFAULT VALUE
	MOVB	R3,XIDNT	;STORE FOR LATER USE
   .ENDC ; NZ SUBIDX							;chs51b-
   .IF NZ XSPNG								;chs41+
	CALL	(R4)		;GET EXTRA GROUP SPACING
	  MOV	#2,R3		;DEFAULT TO 2
	MOV	R3,XSPCNG	;STORE FOR LATER USE
PINDX0:
   .ENDC ; NZ XSPNG							;chs41-
	CLR	-(SP)		;CLEAR CURRENT LETTER
   .IIF NZ SKPFIX, MOV SP,$IDXAC ;SIGNAL INDEX BEING OUTPUT		;chs24
	MOV	XFIRST,R5	;GET FIRST ITEM IN INDEX
   .IF NZ IDXRM								;chs52b+
	BNE	PINDL1		;CONTINUE IF NOT ZERO
	JMP	PINDXX
   .IFF									;chs52b-
	BEQ	PINDXX		;IF EQ NONE
   .ENDC ; -NZ IDXRM							;chs52b
PINDL1:
   .IF NZ IDXPUN							;chs65+
	MOV	4(R5),R1	;POINT TO FIRST LETTER
5$:	MOVB	(R1)+,R2	;GET LETTER
	CALL	TSTCHR		;CHECK FOR PUNCTUATION
	BCS	5$		; C BIT => SKIP CHAR
	CMP	R2,#141		;LOWER CASE?
	BLT	10$
	BIC	#40,R2		;YES.  MAKE UPPER
10$:	CMPEQ	R2,(SP),PINDX1	;SAME AS PREVIOUS INITIAL LETTER?
	MOV	R2,(SP)		; NO, SAVE THIS CHARACTER
   .IFF									;chs65-
	MOVB	@4(R5),R1	;GET FIRST LETTER
	CMP	R1,#141		;LOWER CASE?
	BLT	10$
	BIC	#40,R1		;YES.  MAKE UPPER
10$:	CMPEQ	R1,(SP),PINDX1	;SAME AS INITIAL LETTER OF PREVIOUS ONE?
	MOV	R1,(SP)		;SAVE THIS CHARACTER
   .ENDC ; -NZ IDXPUN							;chs65
	CMP	LINEC,$HDRSW	;AT TOP OF PAGE?			;chs28a
	BLE	PINDX1		; YES, DON'T WANT A BLANK LINE		;chs28a
   .IF NZ XSPNG								;chs41+
	MOV	XSPCNG,R2	;SET SKIP COUNT
	CALL	SKIPN		;SKIP LINES
   .IFF									;chs41-
	CALL	SKIP1		;SKIP ONE LINE
   .ENDC ; -NZ XSPNG							;chs41
   .IF NZ IDXTP								;chs28b
	TSTEQ	(R5),PINDX1	;DON'T DO TEST PAGE IF LAST ENTRY	;chs28b
	MOV	#IDXTP,R3	;SET TEST COUNT				;chs28b
      .IF NZ XTSTPG							;chs69
	CALL	TESTL		;TEST IF PAGE SHOULD BE BROKEN		;chs69
      .IFF								;chs69
	CALL	TESTP		;TEST IF PAGE SHOULD BE BROKEN		;chs28b
      .ENDC ; -NZ XTSTPG						;chs69
   .ENDC ; NZ IDXTP							;chs28b
PINDX1:	MOV	LMARG,R2	;SPACE IN TO LEFT MARGIN
   .IIF NZ LAYOUT, ADD BASMRG,R2 ;INCLUDING BASE MARGIN			;chs39
   .IF NZ SUBIDX							;chs51b+
	MOV	4(R5),R3	;POINT TO ASCII STRING
   .IFTF
10$:	CALL	NSPAC		;SPACE IN
   .IFF									;chs51b-
	MOV	4(R5),S1	;..
   .IFT									;chs51b+
	MOV	R3,S1		;SET OUTPUT POINTER
20$:	TSTB	(R3)+		;SCAN FOR SUBINDEX FLAG
	BGT	20$
	BEQ	40$		;<NUL> MARKS END OF STRING		;chs51b-
	CMP	LINEC,$HDRSW	;AT TOP OF PAGE?			;chs51c+
	BGT	30$		; NO, CONTINUE
	CLRB	-1(R3)		; YES, MARK END OF MAIN ENTRY
	CALL	PSTRAZ		;OUTPUT IT
	MOV	#CONMSG,S1	; FOLLOWED BY " (continued)"
	CALL	PSTRAZ
	CALL	SKIPS		;START NEW LINE
	MOV	LMARG,R2	;SPACE IN TO LEFT MARGIN		;chs51c-
   .IF NZ LAYOUT							;chs39
	CALL	NSPACB		;SPACE OVER FROM BASE MARGIN		;chs39
   .IFF									;chs39
	CALL	NSPAC							;chs51c
   .ENDC ; -NZ LAYOUT							;chs39
30$:	MOVB	XIDNT,R2	;SET INDENT COUNT			;chs51b
	BR	10$		;OUTPUT THE SPACES			;chs51b
40$:									;chs51b
   .ENDC ; NZ SUBIDX							;chs51b
	CLR	XNSPCH		;CLEAR COUNT OF <BS>'S			;chs52a
   .IF NZ XENTRY							;chs51a
	TSTNE	6(R5),50$	;SKIP IF NOT JUST ENTRY			;chs51c+
	MOV	NLPG,R2		;CALCULATE SPACE LEFT ON PAGE
	SUB	LINEC,R2
	SUB	NSPNG,R2
	DEC	R2
	BGT	50$		;START NEW PAGE IF NO SPACE...
	MOV	S1,-(SP)
	CALL	PAGEC		; ...FOR AT LEAST ONE SUB ENTRY
	MOV	(SP)+,S1
	MOV	LMARG,R2	;SPACE IN TO LEFT MARGIN		;chs51c-
      .IF NZ LAYOUT							;chs39
	CALL	NSPACB		;SPACE OVER FROM BASE MARGIN		;chs39
      .IFF								;chs39
	CALL	NSPAC							;chs51c
      .ENDC ; -NZ LAYOUT						;chs39
   .IFTF								;chs51a
50$:	CALL	PSTRAZ		;OUTPUT STRING OF ASCIZ
   .IFT									;chs51a+
	CLRB	PAGOUT		;CLEAR PAGE-OUTPUT FLAG
	TSTEQ	6(R5),PINDX2	;SKIP IF NO PAGE NUMBER
PIND1:
   .ENDC ; NZ XENTRY							;chs51a-
	MOV	RMARG,R2	;NOW GO TO MIDDLE OF LINE
	SUB	LMARG,R2	;IF NOT THERE YET
	ROR	R2		; ..
   .IF NZ IDXRM								;chs52b+
	INC	R2		;SAVE WHERE WE ARE
	MOV	R2,XMID
	MOV	R2,XPOS
	DEC	R2
   .ENDC ; NZ IDXRM							;chs52b-
   .IIF NZ LAYOUT, ADD BASMRG,R2 ;INCLUDING BASE MARGIN			;chs39
	SUB	CPOS,R2		;MINUS CURRENT POSITION
	ADD	XNSPCH,R2	;ADJUST FOR ANY <BS>'S			;chs52a
	BLE	PIND2		;THERE ALREADY
	ASR	R2		;EVEN NUMBER OF SPACES AND DOTS?
	BCC	10$		;IF CC YES
	CALL	CCSPC		;OUTPUT A SPACE
10$:	MOV	#INDMG,S1	; ..
	CALL	FMSG		; ..
	DEC	R2		;MIDDLE OF LINE?
	BGT	10$		;IF GT NO
PIND2:	CALL	CCSPC		;OUTPUT A SPACE
   .IIF NZ IDXRM, CALL TSTRM	;NEED TO START NEW LINE?
	MOV	10(R5),R1	;CHAPTER/APPENDIX NUMBER?
	BEQ	30$		;IF EQ NO
	BMI	10$		;IF MI CHAPTER NUMBER
	ADD	#'A-1,R1	;CONVERT TO LETTER
	CALL	FOUT		;OUTPUT APPENDIX DESIGNATION
	BR	20$		;
10$:	CLR	R0		;GET CHAPTER NUMBER
	BISB	R1,R0		;
	CALL	DECPRT		;CONVERT CHAPTER NUMBER
20$:	MOV	#'-,R1		;OUTPUT A DASH
	CALL	FOUT		;
30$:	MOV	6(R5),R0	;GET PAGE NUMBER
   .IIF NZ XENTRY, INCB PAGOUT	;SET PAGE-OUTPUT FLAG			;chs51a
	CALL	DECPRT		;OUTPUT PAGE NUMBER
PINDX2: MOV	R5,R0		;GET SUCCESSOR OF THIS ENTRY
	MOV	(R0),R5		;
	BEQ	PINDXX		;END OF LIST?  JUMP IF SO.
	CMPNE	4(R5),4(R0),PINDX3 ;NEXT ITEM DIFFERENT FROM CURRENT?
;	CMPNE	6(R5),6(R0),10$	;;PAGE NUMBERS DIFFERENT?		;chs21d
;	CMPEQ	10(R5),10(R0),PINDX2 ;CHAPTER/APPENDIX MATCH?		;chs21d
10$:
   .IF NZ XENTRY							;chs51a+
	TSTEQ	6(R5),PINDX2	;SKIP IF NEW RECORD IS "ENTRY"
	TSTNE	6(R0),20$	;CONTINUE NORMALLY IF OLD NOT "ENTRY"
	TSTEQB	PAGOUT,PIND1	;OUTPUT DOTS IF FIRST NUMBER
20$:
   .ENDC ; NZ XENTRY							;chs51a-
	MOV	#',,R1		;PUT COMMA BETWEEN PAGE NUMBERS
	CALL	FOUT
	BR	PIND2		;AND THEN OUTPUT NUMBER
PINDX3:	CALL	SKIPS		; ..
   .IF NZ IDXRM								;chs52b
	JMP	PINDL1		;GO ON TO NEXT ITEM IN LIST		;chs52b
   .IFF									;chs52b
	BR	PINDL1		;GO ON TO NEXT ITEM IN LIST
   .ENDC ; -NZ IDXRM							;chs52b
PINDXX:	CALL	SKIPS		; ..
	MOV	XTOP,XBOT
	CLR	XFIRST
   .IIF NZ SKPFIX, CLR $IDXAC	;SIGNAL INDEX OUTPUT DONE		;chs24
	TST	(SP)+		;CLEAN STACK
	RETURN

; LOCAL SUBROUTINE TO MAKE SURE REFERENCES DO NOT EXCEED RIGHT MARGIN	;chs52b+

   .IF NZ IDXRM
TSTRM:	MOV	XPOS,R2		;GET CURRENT SPACE AVAILABLE
	SUB	#2,R2		;ADJUST FOR SPACE & COMMA
	MOV	10(R5),R1	;GET CHAPTER/APPENDIX NUMBER
	BEQ	30$		;SKIP IF NONE
	BMI	10$		;NEGATIVE INDICATES CHAPTER
	DEC	R2		;ADJUST FOR APPENDIX LETTER
	BR	20$
10$:	CLR	R0		;ADJUST FOR CHAPTER NUMBER
	BISB	R1,R0
	CALL	PPGNO
20$:	DEC	R2		;ADJUST FOR DASH
30$:	MOV	6(R5),R0	;GET PAGE NUMBER
	CALL	PPGNO		;ADJUST FOR IT
	MOV	R2,XPOS		;SAVE NEW SPACE AVAILABLE
	BGE	50$		;OKAY IF THERE IS SOME
	CALL	SKIP1		;ELSE, START NEW LINE
	MOV	XMID,R2		;FIGURE SPACING TO MIDDLE
	MOV	R2,XPOS
   .IF NZ LAYOUT							;chs39
	CALL	NSPACB		;SPACE OVER FROM BASE MARGIN		;chs39
   .IFF									;chs39
	CALL	NSPAC		;OUTPUT THAT MANY SPACES
   .ENDC ; -NZ LAYOUT							;chs39
	BR	TSTRM		;ADJUST FOR PENDING REFERENCE
50$:	RETURN
   .ENDC ; NZ IDXRM							;chs52b-

   .IF NZ IDXPUN							;chs65+
; CHECK IF CHARACTER IN R2 IS PUNCTUATION

TSTCHR:	CMPB	#SPC,R2		;CONTROL CHAR?
      .IF NZ IDXSPC
	BGE	20$		; YES, USE IT
      .IFF
	BGT	20$		; YES, USE IT
      .ENDC ; -NZ IDXSPC
	CALL	ALPH2		;CHECK FOR LETTER
	BCC	30$		; IF SO, USE IT
	CMPB	#'0,R2		;PUNCTUATION?				
	BGE	10$		; YES, SKIP IT
	CMPB	#'9,R2		;NUMBER?				
	BGE	20$		; YES, USE IT
10$:	SEC			;SIGNAL PUNCTUATION
	BR	30$
20$:	CLC			;SIGNAL GOOD CHARACTER
30$:	RETURN
   .ENDC ; NZ IDXPUN							;chs65-

	.END