	program rgen
#
# generiert ein Grauwertbild mit Ringen.
#
# Externe Routinen, die nicht in FORLIB sind:
# Name		File,Bibliothek
# ibadr		RGEN		berechnet Pixel-Adresse in Bank 1
# ring		RING		generiert einen diskreten Ring
# deform	DEFORM		deformiert den Ring
# draw		DRAW		ein Bild malen
# thick		DRAW		das Bild verdicken
# window	PLOTLIB		setzt das Plott-Fenster
# putp		PLOTLIB		setzt einen Plott-Punkt
# loadb		BANKLIB		liest ein Byte aus Bank 1
# storeb	BANKLIB		schreibt ein Byte in Bank 1
# loadw		BANKLIB		liest ein Wort aus Bank 1
# storew	BANKLIB		schreibt ein Wort in Bank 1
# varptr	BANKLIB		liefert eine Variablenadresse
# irand		RANFCT		liefert Integer-Zufallszahl
# getrts	WANG		holt das RTS-Flag aus Bank 1
# sndpic	SNDPIC		sendet das Bild ueber die SIO-A
# inkey		RGEN		wartet auf Keyboard-Eingabe
#
# Entwurf und Programmierung	A.Herrmann
#
define	VERSION '2.0 vom 20.08.84'
#
define	BADR x'1000'	# Basisadresse in Bank 1
#
logical	auto		# automatischer Durchlauf
logical	wait		# Flag Wait for RTS
logical	inkey		# liefert Keyboard-Zeichen
#
byte	g,gg		# Grauwerte
byte	char,yes,bigyes
byte	rep(3),fmti(10)	# Ausgabe-Formate
byte	pixel(26)	# eine Bildzeile
#
integer	adrb		# Adresse des Bildes in Bank 1
integer	adrr		# Adresse der Zufallszahl in Bank 1
integer	arts		# Adresse der RTS-Flags in Bank 1
integer	iauto,imax	# Index fuer Auto-Durchlauf
integer	iseq(5)		# Kontrollsequenz fuer Auto-D.
integer	xanz,yanz,	# Bildgrenzen
	gwmax		# max.Grauwert
integer	axanz,ayanz,	# dto. Adressen in Bank 1
	agwmax
integer	h		# Hilfsgroesse
integer	i,j,k		# Laufindizes
integer	x,y		# Punktkoord.
integer	rad,s		# Radius, Fehler
integer	octant		# Oktant-Kennziffer
integer	x0,y0		# Mittelpunkt
integer pon,pof		# Plott-Pen on/off
integer	ranadr		# Startadresse der ran-Function
integer	radr		# Adresse der Variablen r
integer	varptr		# function; liefert eine Variablenadresse
#
real	r		# Real-Zahl
#
external ran		# Random number generator Function
#
common	/algor/rad,g,s,octant,x0,y0,x,y	# Daten fuer Ring-Algorithmus
common	/bild/adrb,xanz,yanz,gwmax	# Bild-Kenndaten
common	/flag/wait
#
data	fmti/'(','1','X',',','.','.','.','I','3',')'/
data	yes,bigyes/'y','Y'/
data	xanz,yanz,gwmax/0,0,15/
data	pon,pof/1,0/
data	imax/4/,iseq(1),iseq(2),iseq(3),iseq(4)/1,2,7,8/
#
#
adrr=BADR				# Variablenadressen in Bank 1
arts=adrr+7
axanz=arts+1 ; ayanz=axanz+2 ; agwmax=ayanz+2
adrb=BADR+x'100'
#
ranadr=varptr(ran)-7			# Adresse des Zuf'zahlenspeichers
radr=varptr(r)
do i=0,6				# vorige Zuf'zahl (7 Bytes) holen
[	k=adrr+i ; call loadb(g,k)
	k=ranadr+i ; call poke(k,g)
	if (i<<4) [ k=radr+i ; call poke(k,g) ]
]
#write(1,1) r
#1 format(' random = ',f8.7)
#call getrts				# RTS-Flag aus Bank 1 holen
#
auto=.false. ; iauto=1
#
#write(1,2)
#2 format(' Auto-Durchlauf ? (Y/N) ')
#char=inkey(.true.)
#if (char==yes !! char==bigyes)
#[	auto=.true. ; iauto=1 ]
#else	auto=.false.
#
# ******************** Main Loop ********************
#
repeat
[
write(1,10)
10 format('1RGEN - Version ',VERSION,/)
write(1,20)
write(1,21)
write(1,22)
write(1,23)
write(1,24)
write(1,25)
write(1,26)
write(1,27)
#write(1,28)
#write(1,29)
write(1,30)
20 format(' Menue'//)
21 format(' 1	Bildgroesse waehlen')
22 format(' 2	Bild loeschen')
23 format(' 3	Ring generieren')
24 format(' 4	Ring deformieren')
25 format(' 5	Bild eintippen')
26 format(' 6	Bild verdicken')
27 format(' 7	Bild binaer plotten')
28 format(' 8	Bildmatrix anzeigen')
29 format(' 9	Bild senden')
30 format('00	Ende')
#
if (auto)
[	h=iseq(iauto)
	iauto=iauto+1
	write(1,40) h
	40 format('0Auto-Durchlauf',i5)
]
else
[	write(1,42)
	42 format('0Bitte waehlen... ')
	char=inkey(.true.)
	write(1,43) char
	43 format(1x,a1)
	h=char-48
]
#
if (h==1)						# Bildgroesse waehlen
[	if (auto)
	[	xanz=irand(50,100) ; yanz=xanz
		gwmax=15
	]
	else
	[	write(1,54)
		54 format(' xanz,yanz,gwmax = ')
		read(1,56) xanz,yanz,gwmax
		56 format(3i4)
	]
	call storew(xanz,axanz)
	call storew(yanz,ayanz)
	call storew(gwmax,agwmax)
]
else if (h==2)						# Bild loeschen
[	if (xanz<>0 && yanz<>0)
	[	j=adrb+xanz*yanz-1
		do i=adrb,j	[ call storeb(gwmax,i) ]
]	]
else if (h==3)						# Ring generieren
[	if (xanz<>0 && yanz<>0)
	[	write(1,60)
		60 format(/' max.Mittelkreis ? (Y/N) ')
		char=inkey(.true.)
		if (char==yes !! char==bigyes)
		[	x0=xanz/2+1 ; y0=yanz/2+1
			rad=min0(x0,y0)-2
		]
		else
		[	write(1,62)
			62 format(' Zentrum x,y = ')
			read(1,63) x0,y0
			63 format(2i4)
			y0=yanz-y0+1
			write(1,64)
			64 format('+Radius = ')
			read(1,65) rad
			65 format(i4)
		]
		if (auto)
		[	j=int(float(rad)/4.)
			j=irand(5,j)
		]
		else
		[	write(1,66) 
			66 format('+Ringdicke = ')
			read(1,65) j
		]
		g=0
		for (i=1 ; i<=j ; i=i+1)
		[ rad=rad-1 ; call ring ]
]	]
else if (h==4)						# Ring deformieren
[	if (auto)
	[	j=ifix(xanz/10.)-2
		j=irand(2,j)
	]
	else
	[	write(1,82)
		82 format(' Wieviele Deformierungen ? ')
		read(1,84) j
		84 format(i3)
	]
	call deform(j)
	#
	do i=0,6
	[	k=ranadr+i ; g=peek(k) 
		k=adrr+i ; call storeb(g,k) 
		if (i<<4) [ k=radr+i ; call poke(k,g) ]
	]
	if (.not.auto)	[ char=inkey(.true.) ]
]
else if (h==5)						# Bild malen
[	call draw
]
else if (h==6)						# Bild verdicken
[	call thick
]
else if (h==7)						# Bild binaer plotten
[	#write(1,74)
	#74 format(' Schwelle bei g = ')
	#read(1,70) gg
	gg=1
	write(1,76) xanz,yanz,gg
	76 format('1Bildgrenzen ',2i4,' Schwelle bei g =',i3)
	x=0 ; y=0 
	call window(x,y,xanz,yanz)
	for (y=1 ; y<=yanz ; y=y+1)
	[	i=yanz-y+1
		for (x=1 ; x<=xanz ; x=x+1)
		[	k=ibadr(x,y)
			call loadb(g,k)
			if (g<=gg) call putp(x,i,pon)
	]	]
	char=inkey(.true.)
]
#else if (h==8)						# Bildmatrix anzeigen
#[	jj=min0(26,xanz)
#	encode(rep,70) jj
#	70 format(i3)
#	do i=1,3	[ fmti(i+4)=rep(i) ]
#	for (i=1 ; i<=yanz ; i=i+1)
#	[	for (j=1 ; j<=jj ; j=j+1)
#		[	k=ibadr(j,i)
#			call loadb(g,k)
#			pixel(j)=g
#		]
#		write(1,fmti) (pixel(j),j=1,jj)
#	]
#	char=inkey(.true.)
#]
#else if (h==9)						# Bild senden
#[	call sndpic
#]
#
] until (h==0 !! iauto>>imax)
#
# ******************** End Main Loop ********************
#
#write(1,1) r
write(1,90)
90 format(' *** RGEN - Ende ***')
end


	integer function ibadr(ix,iy)
#
# berechnet die Speicheradresse in Bank 1 fuer das Pixel ix,iy
# relativ zur Basisadresse adrb.
#
integer	ix,iy
integer	adrb,xanz,yanz
#
common	/bild/adrb,xanz,yanz
#
ibadr=adrb+(ix-1)*yanz+iy-1
return
end


	logical function inkey(wait)
#
# liefert ein Eingabezeichen direkt vom Keyboard.
#
logical	wait		# auf Eingabe warten/nicht warten
byte	b		# Byte
byte	cport,dport	# Keyboard Ports (Sio-B)
byte	inp		# internal function
#
data cport,dport/7,5/
#
repeat
	b=inp(cport)
until (.not.wait !! mod(b,2)==1)
inkey=inp(dport)
end
