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.
............................................................
------------------------------------------------------------------------------------------