	.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 = Current spacing
;		4+N = Type (1 = Numerator, 2 = Denom.)
;		. . . . . . .
;
EQ.HS=-2		; Offset from type
EQ.VS=-4		; Offset from type for horiz spacing param
EQ.AD=-6		; Offset from type for address of output
EQ.NX=-8.		; Offset to next stack entry
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
DSEQU::	BISB	#SW.DIS,$EQUSW		; Disable equations
	RETURN
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
	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:	MOV	R2,R0			; Spacing
	SUB	EQ.VS(R5),R0		; Extra needed
	BLE	10$			; No extra needed
	MOV	R2,EQ.VS(R5)
10$:	RETURN
;
;	Found left brace {
;
GCEQ1::	MOVB	#'(,R1			; Just in case no flag
	TSTNEB	$EQUSW,NOEQ		; Equation disabled ?
	BISB	#20,$NOSPC		; Set for no expandable spaces
	BISB	#20,$TABSW		; Set for no tabs
	CALL	PADIT			; Check for subscripts/superscripts
	MOV	BF.FUL(R3),R0		; And current buffer pointer
	INC	R0
	CALL	STACK
	MOV	#1,R2
	ADD	EQSPC,R2		; Plust extra
	MOV	R2,R0			; Save on stack
	CALL	STACK
	CALL	UP			; Shift up
	MOV	SPCH,R0			; Save the current spacing chars
	CALL	STACK
	MOV	#1,R0			; And now the type
	CALL	STACK
	MOV	#SPC,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$:	MOV	EQ.VS(R5),R2		; Shift back up
	CALL	UP
	MOV	SPCH,R2			; Current spacing
	SUB	EQ.NX+EQ.HS(R5),R2	; - previous spacing
	BLE	EQERR4			; Bad ?
	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	#SPC,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
	MOV	#3,R4			; Skip 1 to 3
30$:	CALL	ENDREP
	SOB	R4,30$
	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 ouutput 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.VS(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.VS(R5),R1
	INC	R1			; Plus 1
	CALL	PBYT			; New vertical spacing
	ADD	#EQ.NX,EQSTK		; Next entry
	ADD	#EQ.NX,EQSTK		; Next entry
	TSTNE	@EQSTK,70$		; Equation not ended ?
	BICB	#20,$NOSPC		; Equation ended so end space limit
	BICB	#20,$TABSW		; Enable tabs
70$:	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 ?
	CMPNE	(R5),#1,EQERR4		; Previous not numerator ?
	MOV	BF.FUL(R3),R0		; And current buffer pointer
	INC	R0
	CALL	STACK
	MOV	EQ.VS(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			; Save shift on stack
	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			; Save it for convenience
	MOV	#2,R0			; And now the type
	CALL	STACK
	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 ?
	CMPEQ	(R5),#2,10$		; Currently Denominator ?
	MOV	MAXVS,R2		; Add on maximum
	BR	15$
10$:	MOV	MINVS,R2
	NEG	R2
15$:	INC	R2
	MOV	EQSPC,MAXVS		; Now set MaxVS
	INC	MAXVS			; Normal spacing + 1
	CMP	R2,MAXVS		; Compare subscripted with normal
	BGT	16$			; Subscipted Bigger ?
	MOV	MAXVS,R2
16$:	CALL	SHIFT
	SUB	MAXVS,R2		; Subtract normal spacing
	ADD	MAXVS,MAXVS		; Now set up double spacing
	CLR	R4
	BR	25$
20$:	ADD	MAXVS,R2
	CMPEQ	R4,(R5),30$		; Last type same as current ?
	CALL	SHIFT
25$:	MOV	(R5),R4
30$:	CMPEQ	(R5),#1,40$		; Numerator ?
	TSTEQ	(R5),100$		; Done ?
	ADD	#EQ.NX,R5		; Next param
40$:	ADD	#EQ.NX,R5		; Next entry
	TSTEQ	(R5),100$		; Done ?
	BR	20$
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	PBYT			; Terminate sequence
	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	PBYT			; 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
	CALL	GBYT			; Begin next param
	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
