	subroutine bprod(error)
#
# B-Produktionen 
# 	BP1:	B	->	a A
#	BP2:	B	->	B A
#	BP3:	B	->	C
#	BP4:	B	->	F
# Bei Nichtanwendbarkeit bzw. Stack-Ueberlauf ist error=true, sonst =false.
#
# Externe Routinen:
# Name		File, Bibliothek
# durchp	SUBS		best. den Durchtrittspunkt
# mstuck	SUBS		testet auf Markscheidenstueck
# whalb		SUBS		Steigung der Winkelhalbierenden
# idist		SUBS		Integer-Abstand
# push		SUBS		bringt Element in den Stack
#
# Version 0.1	15.05.85
#
include defsym.rat
#
logical	error		# Error Flag
logical	show		# mit/ohne Bildschirm-Ausgabe
logical	mstuck		# function, entscheidet ueber Markscheidenstueck
#
integer	prod		# Produktionsnummer
integer	dx,dy		# Koord'differenzen
integer	laenge		# Strahllaenge
integer	px,py,		# Durchtrittspunkt
	tx,ty,ux,uy,	# Anf. und Endpunkt des Kurvensegments
	vx,vy		# Strahl ab v
integer	bb,breite	# alte und ggf. neue Bandbreite
integer	idist		# function; liefert Punktabstand
#
common	/punkte/tx,ty,ux,uy,vx,vy,bb
common	/para/bog
common	/flags/show
#
#	Segmentierung
#
if (show) write(1,10)
10 format(' BPROD')
#
error=.false.
call whalb(dx,dy)			# Steigung der Winkelhalbierenden
if (dx==0 && dy==0) prod=BP4		# Winkel zu klein
else
[	i=idist(vx,vy,tx,ty) ; j=idist(vx,vy,ux,uy)	# Teststrahl
	laenge=max0(2*i,j)
	call durchp(laenge,dx,dy,px,py,breite)
	if (px==0) prod=BP3
	else
	[	if (mstuck(tx,ty,px,py)) prod=BP1
		else if (px==ux && py==uy) prod=BP4
		else prod=BP2
]	]
#
#	Anwendung der Produktion
#
if (prod==BP1)
[	if (show) write(1,20)
	20 format(' (B1) B->aA')
	call push(XA,px,py,ux,uy,vx,vy,breite,error)
	call push(XAT,tx,ty,px,py,vx,vy,bb,error) 
]
else if (prod==BP2)
[	if (show) write(1,30)
	30 format(' (B2) B->BA')
	call push(XA,px,py,ux,uy,vx,vy,breite,error)
	call push(XB,tx,ty,px,py,vx,vy,bb,error)
]
else if (prod==BP3)
[	if (show) write(1,40)
	40 format(' (B3) B->C')
	call push(XC,tx,ty,ux,uy,vx,vy,bb,error)
]
else if (prod==BP4)
[	if (show) write(1,50)
	50 format(' (B4) B->F')
	call push(XF,tx,ty,ux,uy,vx,vy,bb,error)
]
else
[	error=.true.
	write(1,90) 
	90 format(' *** BPROD - nicht anwendbar ***')
]
return
end

