	subroutine sprod(error)
#
# S-Produktion (Startproduktion)
#	SP1:	S	->	A A A A
#
# Vom Zentralpunkt vx,vy aus werden Leitstrahlen in die vier Achsenrichtungen
# geschickt. Falls einer der Strahlen keine Durchtrittstelle hat, d.h. die 
# Produktion nicht anwendbar ist, ist error=true, sonst =false.
#
# Fuer die (einmalige) Iteration des Zentralpunkts werden die Koordinaten
# der horizontalen und vertikalen Streckenmittelpunkte verwendet.
#
# Externe Routinen:
# Name		File, Bibliothek
# durchp	SUBS		bestimmt den Durchtrittspunkt
# iround	SUBS		liefert gerundete Integer-Zahl
#
# Version 0.1	15.05.85
#
include defsym.rat
include defstk.rat
#
define	EREXIT 999	# Label fuer Error-Routine
#
logical	error		# Error Flag
logical	show		# mit/ohne Bildschirm-Ausgabe
#
byte	gwmax		# max.Grauwert
#
integer	xanz,yanz	# Bildgrenzen
integer	zx,zy		# Zentralpunkt, wird evtl. veraendert
integer	px,py		# Durchtrittspunkt
integer	tx,ty,ux,uy,	# (Dummies wegen Common-Block)
	vx,vy,		# Zentralpunkt
	bb		# Bandbreite
integer	stack(TOPMAX,8)	# Stack mit Symbol und Punktkoord.
integer	top		# Top of Stack
integer	i,j,k		# Laufindizes
integer	lgth		# Strahllaenge
integer	iter		# zaehlt Iterationen
integer	iround		# function; liefert gerundete Integer-Zahl
#
common	/bild/xanz,yanz
common	/systck/top,stack
common	/punkte/tx,ty,ux,uy,vx,vy,bb
common	/zpunkt/zx,zy
common	/flags/show
#
iter=0
repeat
[	if (show) write(1,10) vx,vy
	10 format(' SPROD - Zentralpunkt',2i4)
	#
	if (show) write(1,20)
	20 format(' SPROD - 0 Grad')
	lgth=xanz-vx+1 ; call durchp(lgth,1,0,px,py,bb)	# Strahl nach 0 Grad
	if (px==0 !! py==0) goto EREXIT
	stack(top+4,AVX)=vx ; stack(top+4,AVY)=vy
	stack(top+4,ATX)=px ; stack(top+4,ATY)=py
	stack(top+4,ABR)=bb
	stack(top+1,AUX)=px ; stack(top+1,AUY)=py
	#
	if (show) write(1,30)
	30 format(' SPROD - 180 Grad')
	lgth=vx ; call durchp(lgth,-1,0,px,py,bb)	# Strahl nach 180 Grad
	if (px==0 !! py==0) goto EREXIT
	stack(top+2,AVX)=vx ; stack(top+2,AVY)=vy
	stack(top+2,ATX)=px ; stack(top+2,ATY)=py
	stack(top+2,ABR)=bb
	stack(top+3,AUX)=px ; stack(top+3,AUY)=py
	#
	if (show) write(1,40)
	40 format(' SPROD - 90 Grad')
	lgth=yanz-vy+1 ; call durchp(lgth,0,1,px,py,bb)	# Strahl nach 90 Grad
	if (px==0 !! py==0) goto EREXIT
	stack(top+3,AVX)=vx ; stack(top+3,AVY)=vy
	stack(top+3,ATX)=px ; stack(top+3,ATY)=py
	stack(top+3,ABR)=bb
	stack(top+4,AUX)=px ; stack(top+4,AUY)=py
	#
	if (show) write(1,50)
	50 format(' SPROD - 270 Grad')
	lgth=vy ; call durchp(lgth,0,-1,px,py,bb)	# Strahl nach 270 Grad
	if (px==0 !! py==0) goto EREXIT
	stack(top+1,AVX)=vx ; stack(top+1,AVY)=vy
	stack(top+1,ATX)=px ; stack(top+1,ATY)=py
	stack(top+1,ABR)=bb
	stack(top+2,AUX)=px ; stack(top+2,AUY)=py
	#
	if (iter==0)					# neuer Zentralpunkt
	[	zx=iround(float(stack(top+4,ATX)+stack(top+2,ATX))/2)
		zy=iround(float(stack(top+3,ATY)+stack(top+1,ATY))/2)
		#
		# ... Zentralpunkt wie in zpunkt testen ...
		# ... ggf. mit error=true aussteigen ...
		#
		vx=zx ; vy=zy
	]
	iter=iter+1
] until (iter>=2)
#
if (show) write(1,80)
80 format(' SPROD - S->AAAA')
do i=1,4					# 4 Stack-Elemente A
[	top=top+1 ; stack(top,SYM)=XA ]
error=.false.
return
#
EREXIT	write(1,90)
90 format(' SPROD - falscher Zentralpunkt')
error=.true.
return
end

