	subroutine aprod(error)
#
# A-Produktionen 
# 	AP1:	A	->	a  
#	AP2:	A	->	a A
#	AP3:	A	->	B  
#	AP4:	A	->	B A
#	AP5:	A	->	C
#
# Bei Nichtanwendbarkeit bzw. Stack-Ueberlauf ist error=true, sonst =false.
#
# Externe Routinen:
# Name		File, Bibliothek
# durchp	SUBS		best. den Durchstrittspunkt
# mstuck	SUBS		testet auf Markscheidenstueck
# winkr		SUBS		Steigung nach Winkelinkrement
# 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	bog		# Bogenlaenge
integer	imin		# min.Laenge fuer term.Strecke
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	/punkte/tx,ty,ux,uy,vx,vy,bb
common	/para/bog
common	/tolrnc/imin
common	/flags/show
#
#	Segmentierung
#
if (show) write(1,10)
10 format(' APROD')
if (tx==ux && ty==uy) prod=0	# entartetes Segment?
else
[	error=.false.
	if (idist(tx,ty,ux,uy)<=bog+imin)
	[	px=ux ; py=uy ; breite=bb
		if (mstuck(tx,ty,px,py)) prod=AP1
		else prod=AP3
	]
	else
	[	call winkr(bog,dx,dy)		# Steigung nach Winkelinkrement
		if (dx==0 && dy==0) 
		[	px=ux ; py=uy ; breite=bb
			if (mstuck(tx,ty,px,py)) prod=AP1
			else prod=AP3
		]
		else
		[	i=idist(vx,vy,tx,ty) ; j=idist(vx,vy,ux,uy)
			laenge=max0(2*i,ifix(1.5*j))
			call durchp(laenge,dx,dy,px,py,breite)	# Leitstrahl
			if (px==0) prod=AP5
			else
			[	if (mstuck(tx,ty,px,py)) prod=AP2
				else prod=AP4
]	]	]	]
#
#	Anwendung der Produktion
#
if (prod==AP1)
[	if (show) write(1,20)
	20 format(' (A1) A->a')
	call push(XAT,tx,ty,ux,uy,vx,vy,breite,error)
]
else if (prod==AP2)
[	if (show) write(1,30)
	30 format(' (A2) A->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==AP3)
[	if (show) write(1,40)
	40 format(' (A3) A->B')
	call push(XB,px,py,ux,uy,vx,vy,breite,error)
]
else if (prod==AP4)
[	if (show) write(1,50)
	50 format(' (A4) A->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==AP5)
[	if (show) write(1,60)
	60 format(' (A5) A->C')
	call push(XC,tx,ty,ux,uy,vx,vy,bb,error)
]
else
[	error=.true.
	write(1,90) 
	90 format(' *** APROD - nicht anwendbar ***')
]
return
end

