.title	EQATN
	.ident	/BL1.0/
;
;	This is an equation writing routine
;	It will parse fractions written in the form:
;		{ . . . }/{. . .}
;	and using standard letter quality printer escape sequences
;	generate factions.
;
	.psect	$TABL,RO,LCL,CON,D
EQTAB:	.ASCIZ	\{}\
EQER3:	.ASCIZ	/RNO -- Too many nested fractions/
EQER4:	.ASCIZ	/RNO -- Syntax error in equation/
	.even
	.PSECT	$CODE,I,RO,LCL,CON
;
;	The first left brace generates:
;		1. Shift up
;		2. Multiple spaces = 0
;
;	The numerator right brace ( }/{ )
;		1. Shift down
;		2. Multiple BS
;		3. Multiple underscore
;		4. Multiple BS
;		5. Shift down
;
;	Denominator right brace
;		1. Multiple spaces ?
;		2. Shift up
;
;	EQSTK contains the following
;		Word 0	= 0
;		. . . . . . .
;		1+N = Index points to beginning of numerator
;		2+N = Shift up count
;		3+N = Vertical space occupied
;		3+N = Current spacing
;		4+N = Type (1 = Numerator, 2 = Denom.)
;		. . . . . . .
;
EQ.HS=-2		; Offset from type
EQ.VSZ=-4		; Offset to vertical size
EQ.VSP=-6		; Offset from type for horiz spacing param
EQ.AD=-8.		; Offset from type for address of output
EQ.NX=-10.		; Offset to next stack entry
;
;	ENABLE EQUATION
;
ENEQU::	BICB	#SW.DIS,$EQUSW		; Enable equations
	CALL	(R4)			; Get equation index
	JMP	50$			; No params
	CMP	R3,#6			; Too big ?
	BHI	EQERR0			; Yes ?
	MOV	R3,EQSPC		; Set equation spacing
50$:	RETURN
;
;	DISABLE EQUATION
;
DSEQU::	BISB	#SW.DIS,$EQUSW		; Disable equations
	RETURN
;
;	EQUATION/END EQUATION commands
;
BEGEQ::	BISB	#SW.DIS,$SEQSW		; Enable separated equations
	RETURN
ENDEQ::	BICB	#SW.DIS,$SEQSW		; Disable separated equations
	RETURN
;
;	FLAGS EQUATION
;
EQERR0:	JMP	ILCM			; Illegal command error
FLEQU::	MOV	#EQTAB,R0		; Equation character table
	TST	$EQFSW			; Flags already enabled ?
	BGE	50$			; Yes ?
10$:	MOVB	(R0)+,R1		; First character
	BEQ	20$			; Done ?
	BITNEB	#CH.FLG,CHTABL(R1),60$	; Already in use ?
	BR	10$			; Try next
20$:	MOV	#EQTAB,R0		; Table again
30$:	MOVB	(R0)+,R1		; Character
	BEQ	40$			; Done ?
	BISB	#CH.FLG,CHTABL(R1)	; Set it as flag character
	BR	30$
40$:	MOV	#EQTAB,R0		; Now set up first character as trigger
	MOVB	(R0)+,R1		; Left braces
	MOVB	#GC.EQ1,GCTABL(R1)	; First flag character
	MOVB	(R0),R1			; right braces
	MOVB	#GC.EQ2,GCTABL(R1)	; second flag character
	BIC	#100000,$EQFSW
50$:	RETURN
60$:	MOV	#25.,R0			; Error message
	JMP	ILCMA
NFLEQ::	TST	$EQFSW			; Flag set ?
	BLT	50$			; No
	BIS	#100000,$EQFSW		; Set equation flag off
	MOV	#EQTAB,R0		; Get character table
10$:	MOVB	(R0)+,R1		; Get character
	BEQ	50$			; Done ?
	BICB	#CH.FLG,CHTABL(R1)	; Reset flag characters
	MOVB	#GC.MSC,GCTABL(R1)	; And pointers
	BR	10$
50$:	RETURN
STACK:	CMP	EQSTK,#EQSEN-2		; Past end of stack ?
	BHIS	EQERR3			; Yes ?
	ADD	#2,EQSTK		; Incrment stack pointer
	MOV	R0,@EQSTK		; Save value
	RETURN
EQERR3:	MOV	#EQER3,R0
	CALL	EROUT
	CALL	ONLIN
	JMP	GCIN
;
;
;	Routine to alter shifts if necessary
;
SHIFT:	CMP	R1,EQ.VSP(R5)		; Extra shift needed
	BLE	10$			; No extra needed
	MOV	R1,EQ.VSP(R5)
10$:	MOV	EQ.VSP(R5),R1		; New shift count
	CMP	R2,EQ.VSZ(R5)		; Check vertical size
	BLE	20$			; Not larger than saved ?
	MOV	R2,EQ.VSZ(R5)		; Save new one
20$:	MOV	EQ.VSZ(R5),R2		; New vertical size
	RETURN
;
;	Found left brace {
;
GCEQ1::	MOVB	#'(,R1			; Just in case no flag
	TSTNEB	$EQUSW,NOEQ		; Equation disabled ?
	MOVB	#SW.EDS,R0		; Get bit to set
	BISB	R0,$NOSPC		; Set for no expandable spaces
	BISB	R0,$TABSW		; Set for no tabs
	BISB	R0,$HFLSW+1		; Set no hyphenation flag
	BISB	R0,$AUBRK		; Set no autobreak
	BISB	R0,$UFLSW+1		; Set no underline flag
	BISB	R0,$BRFSW+1		; No break flag
	BISB	R0,$HYPSW		; No hyphenation
	CALL	PADIT			; Check for subscripts/superscripts
	MOV	BF.FUL(R3),R0		; And current buffer pointer
	INC	R0
	CALL	STACK			; EQ.AD
	MOV	#1,R2
	ADD	EQSPC,R2		; Plust extra
	MOV	R2,R0			; Save on stack
	CALL	STACK			; EQ.VSP
	CALL	UP			; Shift up
	CLR	R0			; Vertical size
	CALL	STACK			; EQ.VSZ
	MOV	SPCH,R0			; Save the current spacing chars
	CALL	STACK			; EQ.HS
	MOV	#1,R0			; And now the type
	CALL	STACK			; EQ.TYP
	MOV	#NXS,R4			; Character to store
	CLR	R2			; Number of times
	CALL	REPEAT
CONTIN:	JMP	GCIN			; Continue
NOEQ:	JMP	GCINR			; No char formation
;
;	Found right brace }
;
GCEQ2::	MOVB	#'),R1			; In case no equation
	TSTNEB	$EQUSW,NOEQ		; Equation disabled ?
	CALL	PADIT			; Check for subscripts/superscripts
	MOV	EQSTK,R5		; Get current stack
	CMPNE	(R5),#1,10$		; End of denominator ?
	JMP	GCEQ3			; Parse End of numerator
10$:	CMPEQ	(R5),#2,11$		; End of denom ?
	JMP	EQERR4
11$:	MOV	EQ.VSP(R5),R2		; Shift back up
	CALL	UP
	MOV	SPCH,R2			; Current spacing
	SUB	EQ.NX+EQ.HS(R5),R2	; - previous spacing
	BGT	12$			; OK ?
	JMP	EQERR4			; Bad ?
12$:	SUB	EQ.HS(R5),R2		; Subtract numerator spacing
	BEQ	50$			; Done ?
	BGT	40$			; Denom bigger ?
	NEG	R2
	ADD	R2,SPCH			; Adjust spacing char count
	SUB	R2,LINBK
	MOV	R2,-(SP)		; Save
	ASR	R2			; Divide by 2
	BEQ	20$			; No spaces at end
	MOV	#NXS,R4			; Add on spaces at end
	CALL	REPEAT
20$:	SUB	R2,(SP)			; Now spacing at beginning of line
	MOV	(SP)+,R2		; Get result
	BEQ	50$			; None at beginning
	MOV	EQ.AD(R5),R1		; Buffer index for spacing
	CALL	FNDBF
30$:	CALL	ENDREP			; Skip shift down 1.
	CALL	ENDREP			; Skip BS 2.
	CALL	ENDREP			; Skip underline 3.
	MOV	EQ.HS(R5),R1		; Previous spacing
	SUB	R2,R1			; New Backspace count
	CALL	PBYT			; Save the space count
	BR	50$			; Now handle vertical spacing
40$:	MOV	R2,-(SP)		; Save count
	ASR	R2			; Divide by 2
	BEQ	45$			; No count
	MOV	EQ.NX+EQ.AD(R5),R1	; left brace output index
	CALL	FNDBF
	CALL	ENDREP			; Now have spacing count
	MOV	R2,R1			; Actual number of spaces
	CALL	PBYT
45$:	MOV	EQ.AD(R5),R1		; Get index
	CALL	FNDBF			; Get location
	CALL	ENDREP			; Skip shift param
	MOV	EQ.HS(R5),R1		; Backspace count
	ADD	R2,R1			; + spaces at beginning
	CALL	PBYT			; And save it
	CALL	ENDREP			; Now have underline repeat
	ADD	EQ.HS(R5),(SP)		; Total number of char in denom
	MOV	(SP),R1			; Actual underline size
	CALL	PBYT
	CALL	ENDREP			; Next BS
	MOV	(SP)+,R1		; Number to do
	CALL	PBYT
50$:	MOV	EQ.NX+EQ.AD(R5),R1	; Adjust the vertical spacing
	CALL	FNDBF			; Get vertical spacing repeat
	MOV	EQ.NX+EQ.VSP(R5),R1	; Adjusted vertical spacing
	MOV	R1,R2			; Save
	CALL	PBYT
	MOV	EQ.AD(R5),R1		; Denominator
	CALL	FNDBF
	DEC	R2			; 
	MOV	R2,R1			; Back to line vs
	CALL	PBYT
	MOV	#4,R4			; Skip 4 params
60$:	CALL	ENDREP
	SOB	R4,60$
	MOV	EQ.VSP(R5),R1
	INC	R1			; Plus 1
	CALL	PBYT			; New vertical spacing
	MOV	EQSTK,R0		; Current stack address
	MOV	EQ.VSZ(R0),R1		; Denominator
	ADD	EQ.VSP(R0),R1		; Total denom size
	ADD	#EQ.NX,R0		; Next entry
	MOV	EQ.VSZ(R0),R2		; Numerator size
	ADD	EQ.VSP(R0),R2		; Total numerator size
	ADD	#EQ.NX,R0		; Next entry
	MOV	R0,EQSTK
	TSTNE	(R0),80$		; Equation not ended ?
	TSTEQB	$SEQSW,70$		; No separated equations ?
	BITNE	#FOTF,F.1,70$		; Footnote in progress ?
	TST	LINBK			; Past end of line ?
	BLT	70$			; Do not save size
	DEC	R1			; Size -1/2 line already accounted for
	DEC	R2			; Ditto
	CMP	R1,EQBOT		; Compare with current value
	BLE	65$			; Smaller ?
	MOV	R1,EQBOT		; Save size
65$:	CMP	R2,EQTOP		; Compare with current value
	BLE	68$			; Smaller ?
	MOV	R2,EQTOP		; Save top size
68$:	CALL	BRKSV			; Put line break here
70$:	MOV	#SW.EDS,R0		; Bits to set
	BICB	R0,$NOSPC		; Restore expandable spaces
	BICB	R0,$TABSW		; Restore tabs
	BICB	R0,$HFLSW+1		; Restore hyphenation flag
	BICB	R0,$AUBRK		; Restore autobreak
	BICB	R0,$UFLSW+1		; Restore underline flag
	BICB	R0,$BRFSW+1		; Restore break flag
	BICB	R0,$HYPSW		; No hyphenation
	BR	80$
80$:	CALL	ENDBF			; Back at end of buffer
	JMP	GCIN			; Continue
;
;	Error during text processing
;
EQERR4:	MOV	#EQER4,R0
	CALL	EROUT
	CALL	ONLIN
	JMP	GCIN
;
;	End numerator
;
GCEQ3:	CALL	CCIN			; Get next char (look for /)
	CMPEQB	R1,#SPC,GCEQ3		; Space ?
	CMPEQB	R1,#TAB,GCEQ3		; Tab ?
	CMPNEB	R1,#'/,EQERR4		; Error in parsing ? not slash ?
10$:	CALL	CCIN			; Get next char (look for } )
	CMPEQB	R1,#SPC,10$		; Space ?
	CMPEQB	R1,#TAB,10$		; Tab ?
	CMPNEB	R1,#'{,EQERR4		; Error in parsing ? not left brace ?
	MOV	BF.FUL(R3),R0		; And current buffer pointer
	INC	R0
	CALL	STACK			; EQ.AD
	MOV	EQ.VSP(R5),R2		; Previous vertical shift
	DEC	R2			; - 1
	CALL	DOWN			; Now execute a shift down
	MOV	#1,R0
	ADD	EQSPC,R0		; Vertical shift for stack
	CALL	STACK			; EQ.VSP Save shift on stack
	CLR	R0			; Vertical size
	CALL	STACK			; EQ.VSZ
	MOV	SPCH,R0			; Current spacing
	SUB	EQ.HS(R5),R0		; Horizontal movement
	MOV	R0,R2			; Save
	BLE	EQERR4			; Bad ?
	SUB	R0,SPCH
	ADD	R0,LINBK		; Set back to old spacing char
	CALL	STACK			; EQ.HS Save it for convenience
	MOV	#2,R0			; And now the type
	CALL	STACK			; EQ.TYP
	MOV	#BS,R4			; Repeat backspace
	CALL	REPEAT
	MOV	#'_,R4			; Repeat underline
	CALL	REPEAT
	MOV	#10,R4			; Back space again
	CALL	REPEAT
	MOV	#2,R2			; Down shift to execute
	CALL	DOWN			; Now shift down
	JMP	GCIN
;
;	Pad the equation with 1/2 lines as necessary
;
PADIT:	MOV	EQSTK,R5		; Get stack location
	TSTEQ	(R5),100$		; First time thru ?
	MOV	MINVS,R2		; Subscripts
	NEG	R2			; Correct sign
	MOV	MAXVS,R1		; Plus Superscripts
	INC	R1			; Account for 1/2 line
	INC	R2			; Ditto
5$:	CMPEQ	(R5),#1,10$		; Numerator ?
	MOV	R2,-(SP)
	MOV	R1,R2			; Reverse order
	MOV	(SP)+,R1
10$:	TSTEQ	(R5),100$		; Done ?
	CALL	SHIFT			; Check if spacing is correct
	CMPEQ	(R5),#1,30$		; Current is numerator ?
	ADD	#EQ.NX,R5		; Next entry
	ADD	R2,R1			; Now is shift up
	MOV	EQ.VSZ(R5),R2		; Get size above numerator
	ADD	EQ.VSP(R5),R2		; Add shift up
	ADD	#EQ.NX,R5		; Next entry
	BR	5$
30$:	ADD	#EQ.NX,R5		; Next entry
	CMPEQ	(R5),#1,40$		; Another numerator?
	ADD	R2,R1			; Add size to shift
	CLR	R2			; Clear shift
	BR	10$
40$:	ADD	R1,R2			; Add shift to spacing
	CLR	R1
	BR	10$
100$:	CLR	MAXVS			; Maximum vertical spacing
	CLR	MINVS			; Minimum vertical spacing
	CLR	CURVS			; And clear current
	RETURN
;
;	Enter repeating char into output
;		R4=Char to repeat
;		R2=Repeat count
;
REPEAT:	MOV	#REPO,R1		; Set for repeat
	CALL	PBYT
	MOV	R2,R1			; Repeat count
	CALL	PBYT
	MOV	R4,R1			; Char to repeat
	CALL	PBYT			; Now output character
	CLR	R1			; Null marks end of repeat
	CALL	PBYT
	RETURN
;
;	Put up/down shifts into output
;
UP:	MOV	#REPO,R1		; Get repeat char
	CALL	PBYT			; To output
	MOV	R2,R1			; Number of shifts
	CALL	PBYT
10$:	MOV	#UPTAB,R2		; Characters to transfer
20$:	MOVB	(R2)+,R1		; Get char
	BEQ	30$			; End of buffer
	CALL	PBYT			; Into output buffer
	BR	20$
30$:	CALL	PWRD			; Terminate escape + repeat
	RETURN
DOWN:	MOV	#REPO,R1		; Get repeat char
	CALL	PBYT			; To output
	MOV	R2,R1			; Number of shifts
	CALL	PBYT
10$:	MOV	#DNTAB,R2		; Characters to transfer
20$:	MOVB	(R2)+,R1		; Get char
	BEQ	30$			; End of buffer
	CALL	PBYT			; Into output buffer
	BR	20$
30$:	CALL	PWRD			; Terminate sequence
	RETURN
;
;	Subroutine to find end of repeat function
;
ENDREP:	CALL	GBYT			; Get next char in output buffer
1$:	CALL	GBYT
	BNE	1$			; Not at end of repeat
20$:	CALL	GBYT			; Begin next param
	BEQ	20$			; Another null ?
	RETURN
;
;	End equation by end of line
;
GCEQN::					; End of equation by end of line
	CALL	BKSPI			; Again ?
	CMPNE	EQSTK,#EQSTK+2,10$	; Not at end of stack
;	CALL	ENDEQ			; End equation mode
	JMP	GCIN
10$:	;CALL	ENDEQ			; End eq mode
	JMP	EQERR4			; Bad equation
	.END