	subroutine deform(defanz)
#
# deformiert den Ring im Grauwertbild in Bank 1 an defanz Stellen.
#
# Verwendete externe Routinen, die nicht in FORLIB sind:
# Name		Bibliothek,File
# ibadr		RGEN		Berechnet Pixel-Adresse in Bank 1
# loadb		BANKLIB		schreibt ein Byte nach Bank 1
# storeb	BANKLIB		holt ein Byte aus Bank 1
# irand		RANFCT		liefert Integer-Zufallszahl
# rand		RANFCT		liefert Real-Zufallszahl
#
# Version 1.2	02.04.84
#
define	VB 60		# max.Versetzungsbreite=max.Radius
#
byte	g,gg		# Grauwerte
byte	char		# Input Character
#
integer	xanz,yanz,	# Bildgrenzen
	gwmax		# max.Grauwert
integer	adrb		# Adresse in Bank 1
integer	h		# Hilfsgroesse
integer	i,j,k		# Laufindizes
integer	ii
integer	r,s		# Radius, Fehler
integer	octant		# Oktant-Kennziffer
integer	x0,y0		# Mittelpunkt
integer	x1,y1		# Punktkoord.
integer	x2,y2
integer	xi,yi
integer pon,pof		# Plott-Pen on/off
integer	ibadr		# function, liefert Adresse in Bank 1
integer	irand		# function, liefert Zufallszahl
integer	def,defanz	# Nr. und Anzahl der Deformierungen
integer	breite,tiefe	# Ausdehnung der Deformierung
integer	jrand,jmitt	# Breite des Profils
integer	vers(VB)	# Versetzungstiefe ueber die Breite
# 
real	radian		# Winkel in Radiant
real	alpha		# Winkel in Grad
real	pi		# Kreiszahl
real	slope		# Geradensteigung
real	dx,dy		# Geradeninkremente
real	ddx,ddy		# - in entg'ges. Richtung
real	x,y		# Punktkoord.
real	xkeim,ykeim
real	rand		# function, liefert Zufallszahl
#
common	/algor/r,g,s,octant,x0,y0
common	/bild/adrb,xanz,yanz,gwmax
#
data	pon,pof/1,0/
data	pi/3.141592/
#
write(1,100) defanz
100 format('1DEFORM -',i4,' Deformierung(en)')
write(1,102)
102 format(' B C  =7')	# Fenster 0 auf 0,0 bis 29,24
#
# Plotte Bild rechts unten 
#
x1=158-xanz ; y1=0 ; x2=x1+xanz+1 ; y2=y1+yanz+1
call window(x1,y1,x2,y2)
call frame
do yi=1,yanz
[	i=yanz-yi+1
	do xi=1,xanz
	[	k=ibadr(xi,yi)
		call loadb(g,k)
		if (g==0) call putp(xi,i,pon)
]	]
for (def=1; def<=defanz; def=def+1)
[					# Waehle zuf.Punkt auf Ring
repeat
[	x1=irand(1,xanz) ; y1=irand(1,yanz)
	k=ibadr(x1,y1)
	call loadb(g,k)
] until (g==0)
write(1,110) x1,y1
110 format(/' zuf.Punkt ',2i4)
#
# Best. Winkel vom Mittelpunkt
#
i=x1-x0 ; j=y1-y0
if (i==0) 
[	if (j<<0) radian=-pi/2.
	else radian=pi/2.
]
else radian=atan(float(j)/float(i))
alpha=radian/pi*180.
write(1,120) radian,alpha
120 format(' Winkel =',2f8.3)
#
# Modifiziere Winkel zufaellig
#
radian=radian+rand(-pi/9.,pi/9.)
alpha=radian/pi*180.
write(1,122) radian,alpha
122 format(' mod.W. =',2f8.3)
#
# Geradensteigung
#
if (abs(pi/2.-abs(radian))<<0.001) [ dx=0. ; dy=1. ]
else [	slope=sin(radian)/cos(radian)
	write(1,124) slope
	124 format(' Steigg.=',f8.3)
	if (abs(slope)<=1.) [ dx=1. ; dy=slope ]
	else [ dx=1./slope ; dy=1. ]
]
write(1,126) dx,dy
126 format(' dx,dy =',2f7.3)
#
# Richtungen zum naechsten Bildrand (dx,dy) bzw. zur Mitte (ddx,ddy) hin
#
x2=x1-x0 ; y2=y1-y0
if (dx==1.)
[	ddx=sign(dx,float(x2))
	if (ddx<>dx) [ dy=-dy ; dx=ddx ]
]
else
[	ddy=sign(dy,float(y2))
	if (ddy<>dy) [ dx=-dx ; dy=ddy ]
]
ddx=-dx ; ddy=-dy
write(1,126) dx,dy
#
# Bereich und Tiefe der Versetzung
#
breite=int(float(xanz)/2.)
breite=irand(5,breite)
tiefe=irand(5,breite)
y=tiefe/(2*pi)
x=rand(y/2,y)
write(1,130) breite,tiefe,x,y
130 format(' Breite, Tiefe ',2i4/' Ampl.,max. ',2f8.4)
do ii=0,breite
[	i=ii+1
	y=tiefe-float(tiefe)/float(breite)*ii
	vers(i)=int(0.5+y+x*sin(2*pi/breite*ii))
#write(1,132) ii,vers(i)
#132 format(' Vers.',2i4)
]
#read(1,134) char	# Press key
#134 format(a1)
#
# Grauwertprofile aus Bild lesen und versetzen
#
for (i=-breite; i<=breite; i=i+1)	# neg. nach pos.Verschiebg.des Profils
[	if (abs(slope)>>1.) [ x2=x1+i ; y2=y1 ]
	else [ x2=x1 ; y2=y1+i ]
	if (x2>=1 && x2<=xanz && y2>=1 && y2<=yanz)
	[	k=ibadr(x2,y2)
		call loadb(g,k)
	]
	else g=-1
#write(1,140) x2,y2,g
#140 format(' Keimpunkt',3i4)
	#
	# Suche ggf. erst naechste dunkle Zone
	#
	xkeim=x2+0.5 ; ykeim=y2+0.5
	if (g>>0)		# ... zunaechst zum Rand hin (mit dx,dy)
	[	x=xkeim ; y=ykeim
		repeat
		[	xi=int(x) ; yi=int(y)
			if (xi<<1 !! xi>>xanz !! yi<<1 !! yi>>yanz) break
			k=ibadr(xi,yi)
			call loadb(g,k)
			x=x+dx ; y=y+dy
		] until (g==0)
		if (g==0)
		[	x2=xi ; y2=yi	# Gefunden,
			xkeim=x ; ykeim=y
		]
	]
	if (g<>0)			# sonst zur Mitte hin (mit ddx,ddy)
	[	x=xkeim ; y=ykeim
		while (g<<0)		# Ggf. erst mal zurueck ins Bild
		[	xi=int(x) ; yi=int(y)
			if (xi<<1 && ddx<=0.) break
			if (yi<<1 && ddy<=0.) break
			if (xi>>xanz && ddx>=0.) break
			if (yi>>yanz && ddy>=0.) break
			if (xi>=1 && xi<=xanz && yi>=1 && yi<=yanz) 
			[	k=ibadr(xi,yi)
				call loadb(g,k)
			]
			x=x+ddx ; y=y+ddy
		]
		while (g>>0)		# dann bis zum ersten dunklen Punkt
		[	x=x+ddx ; y=y+ddy
			xi=int(x) ; yi=int(y)
			if (xi<<1 !! xi>>xanz !! yi<<1 !! yi>>yanz) break
			k=ibadr(xi,yi)
			call loadb(g,k)
		]
		if (g==0)
		[	x2=xi ; y2=yi	# Gefunden,
			xkeim=x ; ykeim=y
		]
	]
	if (g<>0)			# sonst aussen vorbei
	[	#write(1,160)
		#160 format(' Vorbei!')
	]
	else
	[#write(1,162) x2,y2
	#162 format(' Im Dunklen bei',2i4)
		#
		# Dunklen Bereich des Profils best. und loeschen
		#
		jrand=0			# zum Rand hin
		x=xkeim ; y=ykeim
		repeat
		[	xi=int(x) ; yi=int(y)
			if (xi<<1 !! xi>>xanz !! yi<<1 !! yi>>yanz) break
			k=ibadr(xi,yi)
			call loadb(g,k)
			if (g==0)
			[	jrand=jrand+1
				call storeb(gwmax,k)
				h=yanz-yi+1
				call putp(xi,h,pof)
				x=x+dx ; y=y+dy
			]
		] until (g<>0)
		jmitt=0			# zur Mitte hin
		x=xkeim ; y=ykeim
		repeat
		[	x=x+ddx ; y=y+ddy
			xi=int(x) ; yi=int(y)
			if (xi<<1 !! xi>>xanz !! yi<<1 !! yi>>yanz) break
			k=ibadr(xi,yi)
			call loadb(g,k)
			if (g==0)
			[	jmitt=jmitt+1
				h=yanz-yi+1
				call putp(xi,h,pof)
				call storeb(gwmax,k)
			]
		] until (g<>0)
#	write(1,170) jrand,jmitt
#	170 format(' jrand,jmitt =',2i4)
		#
		# Keimpunkt versetzen
		#
		ii=iabs(i)+1			# Index der
		for (j=1; j<=vers(ii); j=j+1)	# Versetzung
		[	xkeim=xkeim+ddx		# zur Mitte hin
			ykeim=ykeim+ddy	
		]
		#
		# Ringzone versetzen
		#
		g=0
		x=xkeim ; y=ykeim
		for (j=1; j<=jrand; j=j+1)	# das aeussere Stueck
		[	xi=int(x) ; yi=int(y)
			if (xi>=1 && xi<=xanz && yi>=1 && yi<=yanz) 
			[	k=ibadr(xi,yi)
				call storeb(g,k)
				h=yanz-yi+1
				call putp(xi,h,pon)
			]
			x=x+dx ; y=y+dy
		]
		x=xkeim ; y=ykeim
		for (j=1; j<=jmitt; j=j+1)	# das innere Stueck
		[	x=x+ddx ; y=y+ddy
			xi=int(x) ; yi=int(y)
			if (xi>=1 && xi<=xanz && yi>=1 && yi<=yanz) 
			[	k=ibadr(xi,yi)
				call storeb(g,k)
				h=yanz-yi+1
				call putp(xi,h,pon)
		]	]
	]
]				# naechste Verschiebung
]				# naechste Deformierung
#
write(1,104)
104 format(' C  o7')		# Fenster 0 auf 0,0 bis 79,23
#
return
end
