	subroutine fprod(error)
#
# F-Produktion 
# 	FP1:	F	->	b
#	FP2:	F	->	A A
#
# Falls der Abstand tu nicht zu gross ist, wird die Strecke als terminaler
# Defekt b toleriert. 
# Andernfalls wird im Mittelpunkt von tu ein Hilfs-Zentralpunkt installiert, 
# von dem die Leitstrahlen ueber die Halbebene von vt nach vu streichen sollen.
# Zunaechst wird aber von v aus ein Strahl im Winkel von +90 Grad zur 
# Gerade vt geschickt. Die Laenge des Strahls ist 2*tu.
# Falls dieser Strahl keinen Durchtrittspunkt hat, wird ebenfalls ein 
# terminaler Defekt (degener. Dreieck) ausgegeben.
# Bei Stack-Ueberlauf ist error=true, sonst =false.
#
# Externe Routinen:
# Name		File, Bibliothek
# durchp	SUBS		best. den Durchtrittspunkt
# 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
#
integer	prod		# Produktionsnummer
integer	xanz,yanz	# Bildgrenzen
integer	bog,minbog	# Bogenlaenge
integer	maxgap		# max. tolerierte Luecke
integer	dx,dy		# Koord'inkremente
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	/bild/xanz,yanz
common	/punkte/tx,ty,ux,uy,vx,vy,bb
common	/para/bog,minbog,maxgap
common	/flags/show
#
#	Segmentierung
#
laenge=idist(tx,ty,ux,uy)
if (show) write(1,10) laenge
10 format(' FPROD - Durchmesser',i4)
#
error=.false.
if (laenge<=maxgap) prod=FP1
else
[	vxx=vx ; vyy=vy				# alten Zentralpunkt retten
	vx=tx+ux ; vx=ifix(vx/2.0)		# Abschneiden verhindert 
	vy=ty+uy ; vy=ifix(vy/2.0)		# Winkelueberstreckung !
	call whalb(dx,dy)			# Steigung der Winkelhalb.
	laenge=2*laenge				# Strahl doppelter Durchm.
	call durchp(laenge,dx,dy,px,py,breite)
	if (px<>0) prod=FP2			# Peak gefunden?
	else	[ prod=FP1 ; vx=vxx ; vy=vyy ]
]
#
#	Anwendung der Produktion
#
if (prod==FP1)
[	if (show) write(1,20)
	20 format(' (F1) F->b')
	call push(XBT,tx,ty,ux,uy,vx,vy,bb,error)
]
else if (prod==FP2)
[	if (show) write(1,30)
	30 format(' (F2) F->AA')
	call push(XA,px,py,ux,uy,vx,vy,breite,error)
	call push(XA,tx,ty,px,py,vx,vy,bb,error)
]
else
[	error=.true.
	write(1,90) 
	90 format(' *** FPROD - nicht anwendbar ***')
]
return
end
