Listing 9 :

Bild Engel

berechnet Gleichung (A5) mit k=3 , doppelt genommen wie in (A2) und Verkopplung (A4)
blaue Teile betreffen die Zeilen zum Austauschen für Listing 10

-----------------------------------------------------------------------------

in AMIGA-BASIC:

DEFINT i,j: DEFDBL a-h,k-z: DIM r(31),g(31),b(31)
INPUT " Bildgroesse (10..1) : ",groesse :REM 10=300*180, 1=30*30
INPUT " ab Zeile (1..180) : ",iy: iy=iy-1 :REM fuer Fortsetzung

bry=.3829: brx=bry: vsx=0: vsy=4.103
param=.25: norm=20: teiler=1

ianzmax=200: maxabs=100000! : genau=200
ispalten=groesse*30: iye=ispalten: IF iye>180 THEN iye=180
IF groesse>6 THEN brx=brx*ispalten/iye :REM Bild rechteckig
swx=brx/ispalten:swy=bry/iye:panf=-brx/2-swx+vsx :REM panf=Abszisse
tanf=bry/2+swy+vsy-iy*swy: genau=(swx+swy)/genau :REM tanf=Ordinate

SCREEN 1,320,200,5,1: pastr$=STR$(param#)
WINDOW 2,pastr$,(0,0)-(310,180),16,1

f5=29/31: br=6: y1=0: y2=br: s=1/16: r(1)=1: g(1)=-s
r(18)=0: g(18)=1: b(18)=0: PALETTE 0,0,0,0: PALETTE 1,1,1,1

FOR ic=2 TO 31 :REM Farbkeil senkrecht
IF ic<18 THEN r(ic)=r(ic-1)-s: g(ic)=g(ic-1)+s: b(ic)=0
IF ic>18 THEN g(ic)=g(ic-1)-s: b(ic)=b(ic-1)+s: r(ic)=0
PALETTE ic,r(ic),g(ic),b(ic)
COLOR ic : LINE(302,y1)-(311,y2),,Bf: y1=y1+br: y2=y2+br
NEXT: PALETTE 18,.6,1,.6

r(0)=0:g(0)=0:b(0)=0:g(1)=1:b(1)=1:r(18)=.6:g(18)=1:b(18)=.6

WHILE iy < iye

iy=iy+1: tanf=tanf-swy: ix=0: panf=-brx/2-swx+vsx
ky$="a"

punkt:
ix=ix+1: panf=panf+swx: ianz=0: ianzf=0: iL=0
x=0: y=0: p=x: t=y :REM Anfangswerte

iterat:
ianzf=ianzf+1: ky$=INKEY$: IF ky$="s" THEN GOTO end1
ianz=ianz+1: IF ianz > ianzmax THEN gr1!=15: GOTO abbruch
xalt=x: yalt=y: palt=p: talt=t :REM "a"=param, C=a+ib
a=panf*(1+param*p): b=tanf*(1-param*t) :REM Zwilling 1
qx=x*x-y*y: qy=2*x*y: q3x=qx*x-qy*y: q3y=qx*y+qy*x
u=x+a: v=y+b: d=a*q3x-b*q3y+1: e=a*q3y+b*q3x: fsb=d*d+e*e
IF fsb < 1E-10 THEN GOTO code1
xrett=(u*d+v*e)/fsb: yrett=(v*d-u*e)/fsb :REM Zwilling 2
a=panf*(1+param*x): b=tanf*(1-param*y): x=p: y=t
qx=x*x-y*y: qy=2*x*y: q3x=qx*x-qy*y: q3y=qx*y+qy*x
u=x+a: v=y+b: d=a*q3x-b*q3y+1: e=a*q3y+b*q3x: fsb=d*d+e*e
IF fsb < 1E-10 THEN GOTO code1
p=(u*d+v*e)/fsb:t=(v*d-u*e)/fsb: x=xrett:y=yrett :REM Ende der Glg.

IF ABS(x)+ABS(y)+ABS(p)+ABS(t)>maxabs THEN GOTO code1
IF ianzf<50 THEN
dd=ABS(xalt-x)+ABS(yalt-y)+ABS(palt-p)+ABS(talt-t)
IF dd>genau THEN GOTO iterat
GOTO code2 :REM evtl. gr1!=0
ELSE
  IF iL>0 AND iL<16 THEN
  iL=iL+1
  dd=ABS(xx1-x)+ABS(yy1-y)+ABS(pp1-p)+ABS(tt1-t)
  IF dd>genau THEN GOTO iterat
  ELSE
  xx1=x: yy1=y: pp1=p: tt1=t: iL=1: GOTO iterat
  END IF
gr1!=iL: IF iL=2 THEN ianzf=1: GOTO iterat
GOTO code2 :REM evtl.GOTO abbruch od. GOTO code1
END IF

code1: gr1!=31: GOTO abbruch :REM evtl. gr1!=ianz/teiler
code2: gr1!=(ABS(x)+ABS(y)+ABS(p)+ABS(t))*norm
IF gr1!>30 THEN gr1!=30
IF gr1!<2 THEN gr1!=2

abbruch:
ic=INT(gr1!): PALETTE ic,r(ic),g(ic),b(ic)
COLOR ic: LINE(ix,iy)-(ix,iy),,Bf
IF ix < ispalten THEN GOTO punkt

WEND

end1: ky$="a": WHILE ky$<>"e" : ky$=INKEY$: WEND
ende: WINDOW CLOSE 2: SCREEN CLOSE 1

END

----------------------------------------------------------------------------------------------------------------------

Listing 10:

Bild Teufel

Bitte Listing 9 verwenden und blau markierte Anteile austauschen
berechnet Gleichung (A5) mit k=2 , doppelt genommen wie in (A2) und Verkopplung (A3)

.........................................................................................

bry=10: brx=bry: vsx=0: vsy=0: param=.5:
norm=10: teiler=2
.........................................................................................

iterat:
ianz=ianz+1: ianzf=ianzf+1: ky$=INKEY$
IF ky$="s" THEN GOTO end1
IF ianz > ianzmax THEN gr1!=15: gr2!=15: GOTO abbruch
xalt=x: yalt=y: palt=p: talt=t :REM "a"=param, C=a+ib
h1=1+param*p: h2=param*t :REM Zwilling 1
a=panf*h1-tanf*h2: b=tanf*h1+panf*h2
qx=x*x-y*y: qy=2*x*y
u=x+a: v=y+b: d=a*qx-b*qy+1: e=a*qy+b*qx: fsb=d*d+e*e
IF fsb < 1E-10 THEN GOTO divergent
xrett=(u*d+v*e)/fsb: yrett=(v*d-u*e)/fsb
h1=1-param*x: h2=-param*y :REM Zwilling 2
a=panf*h1-tanf*h2: b=tanf*h1+panf*h2: x=p: y=t
qx=x*x-y*y: qy=2*x*y
u=x+a: v=y+b: d=a*qx-b*qy+1: e=a*qy+b*qx: fsb=d*d+e*e
IF fsb < 1E-10 THEN GOTO divergent
p=(u*d+v*e)/fsb: t=(v*d-u*e)/fsb
x=xrett: y=yrett :REM Ende Glg.
............................................................

------------------------------------------------------------------------------------------