' *** Fraktalokat rajzol es az adataikat tarolja. Leiras a lista vegen. ***
'Ez (frakta2l.bas) a fejlesztes csucsa 2007. III. 21-en, a tobbi elvetelt
'probalkozas.

DEFDBL U, Z
SCREEN 12
RANDOMIZE TIMER
en$ = "Nemeth Ferenc"
frvege$ = "      ----------           Fraktal vege            ------------"

konvergaloszin = 3
stabilpontszin = 6
orizmelyseg = hanyszormax
konvsuruseg = 20
konverghatar = .1

maxkozelites = 9
xfeltartomany = 2
yfeltartomany = 2

parlepes(1) = .001
parlepes(2) = .002
parlepes(3) = .005
parlepes(4) = .01
parlepes(5) = .02
parlepes(6) = .05
parlepes(7) = .1
parlepes(8) = .2
parlepes(9) = .5
parlepes(10) = 1

DIM ce$(5, 4)
ce$(1, 1) = "x" + CHR$(253)
ce$(1, 2) = "x"
ce$(1, 3) = "x" + CHR$(253)
ce$(1, 4) = "x"
ce$(2, 1) = "xy"
ce$(2, 2) = "y"
ce$(2, 3) = "xy"
ce$(2, 4) = "y"
ce$(3, 1) = "y" + CHR$(253)
ce$(3, 2) = "c"
ce$(3, 3) = "y" + CHR$(253)
ce$(3, 4) = "c"
ce$(4, 1) = "x^3"
ce$(4, 2) = "y^3"
ce$(4, 3) = "x^3"
ce$(4, 4) = "y^3"
ce$(5, 1) = "x" + CHR$(253) + "y"
ce$(5, 2) = "xy" + CHR$(253)
ce$(5, 3) = "x" + CHR$(253) + "y"
ce$(5, 4) = "xy" + CHR$(253)

DIM pal(15): DIM Piros(15): DIM Zold(15): DIM Kek(15)
DATA 55,55,55,55,55,40,25,11,11,11,11,11,33,55,55: 'piros
DATA 33,22,11,11,11,11,22,33,44,55,55,55,55,55,44: 'zold
DATA 11,11,11,33,55,55,55,55,55,55,33,11,11,11,11: 'kek

FOR i = 1 TO 15: READ Piros(i): NEXT
FOR i = 1 TO 15: READ Zold(i): NEXT
FOR i = 1 TO 15: READ Kek(i): NEXT
FOR i = 1 TO 15: pal(i) = 65536 * Kek(i) + 256 * Zold(i) + Piros(i): NEXT
FOR n = 0 TO 15
PALETTE n, pal(n)
LINE (n * 30, 440)-(n * 30 + 30, 460), n, BF
NEXT

tisztalap:

rakozelit = 0
REDIM xkor(0 TO 20)
REDIM ykor(0 TO 20)
xkor(0) = 0
ykor(0) = 0
xhossz = 2
yhossz = 2

xtartmin = -2
xtartmax = 2
ytartmin = -2
ytartmax = 2

kezd:
FOR i = 4 TO 7
LOCATE i, 50: PRINT "                              "
NEXT i

LOCATE 26, 52: PRINT "Kellenek-e kobos tagok? (i)"
yy: yy$ = INKEY$: IF yy$ = "" THEN GOTO yy
LOCATE 26, 52: PRINT "                             "
IF yy$ = "i" OR yy$ = "I" THEN menupozxmax = 5: hatar = 10 ^ 6 ELSE menupozxmax = 3: hatar = 10 ^ 8
menupozymax = 4
'hanyszormax = 36 - (menupozxmax - 3) * 9
'?????
hanyszormax = 56 - (menupozxmax - 3) * 9
orizmelyseg = hanyszormax

REDIM utolsoz1(orizmelyseg)
REDIM utolsoz2(orizmelyseg)

FOR j = 1 TO orizmelyseg
utolsoz1(j) = -222
utolsoz2(j) = -222
NEXT j




REDIM c(5, 4)

FOR menupozx = 1 TO menupozxmax
 FOR menupozy = 1 TO menupozymax
  c(menupozx, menupozy) = (RND - .6) * (RND + .6) * 2
  szin = 3: GOSUB cetkiir
 NEXT
NEXT

kezdkiir:

KEY(1) ON
FOR keyon = 11 TO 14: KEY(keyon) ON: NEXT keyon

LOCATE 1, 52: COLOR 3: PRINT "Jelmagy:";
COLOR 15: PRINT " F1";
COLOR 3: PRINT " Mozgas:";
COLOR 15: PRINT " nyilak"

LOCATE 2, 52: COLOR 15: PRINT "0";
COLOR 3: PRINT "-zas    ";
COLOR 3: PRINT "Param.leptetes:";
COLOR 15: PRINT " +";
COLOR 3: PRINT ",";
COLOR 15: PRINT "-"

'LOCATE 16, 60: COLOR 3: PRINT "Hozzarendeles:";
'FOR tablx = 1 TO menupozxmax
'FOR tably = 1 TO menupozymax
'LOCATE 16 + tably, 72 - menupozxmax * 6 + 6 * tablx: COLOR szin: PRINT ce$(tablx, tably)
'NEXT
'NEXT

LOCATE 11, 52: COLOR 3: PRINT "Ablakmozgatas:"; : COLOR 15: PRINT "  I J K L"
LOCATE 12, 52: COLOR 3: PRINT "Gyors:"; : COLOR 15: PRINT " szokoz"; : COLOR 3: PRINT ", teljes:"; : COLOR 15: PRINT " enter"
LOCATE 13, 52: COLOR 3: PRINT "Kozelites:"; : COLOR 15: PRINT " O"; : COLOR 3: PRINT ", Tavolitas:"; : COLOR 15: PRINT " P"
LOCATE 15, 52: COLOR 3: PRINT "Eltakaras:"; : COLOR 15: PRINT " Esc "; : COLOR 3: PRINT "Uj fraktal:"; : COLOR 15: PRINT " U"
LOCATE 16, 52: COLOR 3: PRINT "Mentes:"; : COLOR 15: PRINT " M"; : COLOR 3: PRINT "   Kilepes:"; : COLOR 15: PRINT " Q"
LOCATE 17, 52: COLOR 3: PRINT "Tarolt fraktal megnyitasa:"; : COLOR 15: PRINT " N"

parfinomsag = 4
LOCATE 9, 52: COLOR 3: PRINT "(";
COLOR 15: PRINT "* /";
COLOR 3: PRINT ")   Par.finomsag:";
COLOR 15: PRINT parlepes(parfinomsag)
menupozx = 1: menupozy = 1
szin = 9: GOSUB cetkiir

korx = xkor(rakozelit)
kory = ykor(rakozelit)
GOSUB korrajz

ON KEY(11) GOSUB menufel
ON KEY(12) GOSUB menubalra
ON KEY(13) GOSUB menujobbra
ON KEY(14) GOSUB menule
ON KEY(1) GOSUB help

nyomdmegagombot:

KEY(1) ON
FOR keyon = 11 TO 14: KEY(keyon) ON: NEXT keyon

naplonyitva = 0
valt$ = INKEY$: IF valt$ = "" THEN GOTO nyomdmegagombot
IF valt$ = "*" AND parfinomsag < 10 THEN parfinomsag = parfinomsag + 1
IF valt$ = "/" AND parfinomsag > 1 THEN parfinomsag = parfinomsag - 1

LOCATE 9, 52: COLOR 3: PRINT "(";
COLOR 15: PRINT "* /";
COLOR 3: PRINT ")   Par.finomsag:";
COLOR 15: PRINT parlepes(parfinomsag)

IF valt$ = "+" AND c(menupozx, menupozy) < 100 THEN c(menupozx, menupozy) = c(menupozx, menupozy) + parlepes(parfinomsag): szin = 9: GOSUB cetkiir
IF valt$ = "-" AND c(menupozx, menupozy) > -100 THEN c(menupozx, menupozy) = c(menupozx, menupozy) - parlepes(parfinomsag): szin = 9: GOSUB cetkiir
IF valt$ = " " THEN lepeskoz = .05: GOSUB fraktaltrajzol
IF valt$ = "0" THEN c(menupozx, menupozy) = 0: szin = 9: GOSUB cetkiir
IF valt$ = CHR$(13) THEN lepeskoz = .01: GOSUB fraktaltrajzol
IF valt$ = CHR$(27) THEN LINE (0, 0)-(402, 402), 0, BF: GOSUB korrajz
IF valt$ = "U" OR valt$ = "u" THEN LINE (0, 0)-(402, 402), 0, BF: GOTO kezd
IF valt$ = "M" OR valt$ = "m" THEN GOTO mentes
IF valt$ = "N" OR valt$ = "n" THEN GOTO megnyitas
IF valt$ = "Q" OR valt$ = "q" THEN END

SELECT CASE valt$
CASE IS = "j"
GOSUB korrajz
korx = korx - 1 / 2 ^ (rakozelit + 2)
IF korx < xtartmin + xhossz / 2 THEN korx = xtartmax - xhossz / 2
GOSUB korrajz

CASE IS = "J"
GOSUB korrajz
korx = korx - 1 / 2 ^ (rakozelit + 2)
IF korx < xtartmin + xhossz / 2 THEN korx = xtartmax - xhossz / 2
GOSUB korrajz

CASE IS = "L"
GOSUB korrajz
korx = korx + 1 / 2 ^ (rakozelit + 2)
IF korx > xtartmax - xhossz / 2 THEN korx = xtartmin + xhossz / 2
GOSUB korrajz

CASE IS = "l"
GOSUB korrajz
korx = korx + 1 / 2 ^ (rakozelit + 2)
IF korx > xtartmax - xhossz / 2 THEN korx = xtartmin + xhossz / 2
GOSUB korrajz

CASE IS = "i"
GOSUB korrajz
kory = kory - 1 / 2 ^ (rakozelit + 2)
IF kory < ytartmin + yhossz / 2 THEN kory = ytartmax - yhossz / 2
GOSUB korrajz

CASE IS = "I"
GOSUB korrajz
kory = kory - 1 / 2 ^ (rakozelit + 2)
IF kory < ytartmin + yhossz / 2 THEN kory = ytartmax - yhossz / 2
GOSUB korrajz

CASE IS = "k"
GOSUB korrajz
kory = kory + 1 / 2 ^ (rakozelit + 2)
IF kory > ytartmax - yhossz / 2 THEN kory = ytartmin + yhossz / 2
GOSUB korrajz

CASE IS = "K"
GOSUB korrajz
kory = kory + 1 / 2 ^ (rakozelit + 2)
IF kory > ytartmax - yhossz / 2 THEN kory = ytartmin + yhossz / 2
GOSUB korrajz
END SELECT

IF valt$ = "P" OR valt$ = "p" THEN GOTO mm
IF valt$ = "O" OR valt$ = "o" THEN GOTO nn
GOTO nyomdmegagombot

mm: ' ****** tagabb nezet **********
IF rakozelit < .5 THEN GOTO nyomdmegagombot

xhossz = xhossz * 2
yhossz = yhossz * 2
korx = xkor(rakozelit)
kory = ykor(rakozelit)
rakozelit = rakozelit - 1
xtartmin = xkor(rakozelit) - xhossz
xtartmax = xkor(rakozelit) + xhossz
ytartmin = ykor(rakozelit) - yhossz
ytartmax = ykor(rakozelit) + yhossz
lepeskoz = .05: GOSUB fraktaltrajzol

GOTO nyomdmegagombot

nn: ' ****** rakozelites ***********
IF rakozelit > maxkozelites THEN GOTO nyomdmegagombot

xhossz = xhossz / 2
yhossz = yhossz / 2
rakozelit = rakozelit + 1
xkor(rakozelit) = korx
ykor(rakozelit) = kory
xtartmin = korx - xhossz
xtartmax = korx + xhossz
ytartmin = kory - yhossz
ytartmax = kory + yhossz
lepeskoz = .05: GOSUB fraktaltrajzol

GOTO nyomdmegagombot

fraktaltrajzol:

LINE (0, 0)-(402, 402), 0, BF

FOR holtart = 0 TO 10
IF holtart <= rakozelit THEN korszin = 14 ELSE korszin = 0
FOR sugar = 0 TO 10
IF sugar > 5 THEN korszin = 7
FOR fi = 0 TO 2 * 3.15 STEP .05
dx = sugar * COS(fi)
dy = sugar * SIN(fi)
PSET (20 + holtart * 30 + dx, 420 + dy), korszin
NEXT fi
'CIRCLE (20 + holtart * 30, 420), sugar, korszin
NEXT sugar
NEXT holtart

xhanyadik = 0
FOR kiindx = xtartmin TO xtartmax STEP lepeskoz / 2 ^ rakozelit
xhanyadik = xhanyadik + 1
jj$ = INKEY$
IF jj$ = CHR$(27) AND naplonyitva = 0 THEN LINE (0, 0)-(402, 402), 0, BF: GOSUB korrajz: RETURN

yhanyadik = 0
FOR kiindy = ytartmin TO ytartmax STEP lepeskoz / 2 ^ rakozelit
yhanyadik = yhanyadik + 1
z1 = kiindx
z2 = kiindy

IF INT(yhanyadik / konvsuruseg) <> yhanyadik / konvsuruseg OR INT(xhanyadik / konvsuruseg) <> xhanyadik / konvsuruseg THEN konvvizsgal = 0: GOTO negyzetre

konvvizsgal = 1
konvergal = 0

negyzetre:
u1 = c(1, 1) * z1 ^ 2 + c(2, 1) * z1 * z2 + c(3, 1) * z2 ^ 2 + c(1, 2) * z1 + c(2, 2) * z2 + c(3, 2)
IF menupozxmax = 5 THEN u1 = u1 + c(4, 1) * z1 ^ 3 + c(5, 1) * z1 ^ 2 * z2 + c(4, 2) * z2 ^ 2 + c(5, 2) * z1 * z2 ^ 2
u2 = c(1, 3) * z1 ^ 2 + c(2, 3) * z1 * z2 + c(3, 3) * z2 ^ 2 + c(1, 4) * z1 + c(2, 4) * z2 + c(3, 4)
IF menupozxmax = 5 THEN u2 = u2 + c(4, 3) * z1 ^ 3 + c(5, 3) * z1 ^ 2 * z2 + c(4, 4) * z2 ^ 2 + c(5, 4) * z1 * z2 ^ 2

u = u1 ^ 2 + u2 ^ 2
IF u > hatar THEN pixelszin = hanyszor: GOTO szinez
'IF hanyszor > 36 - (menupozxmax - 3) * 9 THEN pixelszin = 0: GOTO szinez
IF hanyszor > hanyszormax THEN pixelszin = 0: GOTO szinez
z1 = u1: z2 = u2
hanyszor = hanyszor + 1

IF lepeskoz = .05 OR konvvizsgal = 0 THEN GOTO negyzetre
konvvizsgal = 1

'megorzi az utolso nehany iteracios elemet, hatha ki kell iratni.
'Az 1.-kent megorzott elem az utolso iteracios ertek.

FOR j = orizmelyseg TO 2 STEP -1
utolsoz1(j) = utolsoz1(j - 1)
utolsoz2(j) = utolsoz2(j - 1)
NEXT j
utolsoz1(1) = z1
utolsoz2(1) = z2

'Ha mar nagyon jol stabilizalodott az iteracio, akkor abbahagyja.
'IF SQR((utolsoz1(1) - utolsoz1(2)) ^ 2 + (utolsoz2(1) - utolsoz2(2)) ^ 2) < konverghatar / (2 ^ rakozelit) THEN konvergal = 1: GOTO szinez
IF SQR((utolsoz1(1) - utolsoz1(2)) ^ 2 + (utolsoz2(1) - utolsoz2(2)) ^ 2) < konverghatar THEN konvergal = 1: GOTO szinez
GOTO negyzetre

szinez:
'IF pixelszin < 1 THEN pixelszin = 15
IF pixelszin > 15 THEN pixelszin = pixelszin - 15
'IF lepeskoz = .01 AND konvergal = 0 AND pixelszin <> 0 THEN PSET ((kiindx - xtartmin) * 100 * 2 ^ rakozelit, (kiindy - ytartmin) * 100 * 2 ^ rakozelit), pixelszin
IF lepeskoz = .01 AND pixelszin <> 0 THEN PSET ((kiindx - xtartmin) * 100 * 2 ^ rakozelit, (kiindy - ytartmin) * 100 * 2 ^ rakozelit), pixelszin
IF lepeskoz = .05 THEN CIRCLE ((kiindx - xtartmin) * 100 * 2 ^ rakozelit, (kiindy - ytartmin) * 100 * 2 ^ rakozelit), 1, pixelszin

IF konvergal = 0 OR lepeskoz = .05 THEN GOTO nemkonvergal
FOR j = 2 TO orizmelyseg
IF utolsoz1(j) = -222 AND utolsoz2(j) = -222 THEN GOTO konvnemrajzol
zx = (utolsoz1(j) - xtartmin) * 100 * 2 ^ rakozelit
zy = (utolsoz2(j) - ytartmin) * 100 * 2 ^ rakozelit
zxe = (utolsoz1(j - 1) - xtartmin) * 100 * 2 ^ rakozelit
zye = (utolsoz2(j - 1) - ytartmin) * 100 * 2 ^ rakozelit

IF utolsoz1(j) = -222 AND utolsoz2(j) = -222 THEN GOTO konvnemrajzol


pp1 = (ABS(zx) + ABS(zxe) + ABS(ABS(zx) - ABS(zxe))) / 2
pp2 = (ABS(zy) + ABS(zye) + ABS(ABS(zy) - ABS(zye))) / 2
pp3 = (pp1 + pp2 + ABS(pp1 - pp2)) / 2

IF ABS(pp3) > 10 THEN GOTO konvnemrajzol

konvszin2 = INT(xhanyadik / konvsuruseg) - 15 * INT(INT(xhanyadik / konvsuruseg) / 15)
'PSET (zx, zy), konvergaloszin
LINE (zx, zy)-(zxe, zye), konvszin2
konvnemrajzol: NEXT j

CIRCLE ((utolsoz1(1) - xtartmin) * 100 * 2 ^ rakozelit, (utolsoz2(1) - ytartmin) * 100 * 2 ^ rakozelit), 2, stabilpontszin

nemkonvergal:

hanyszor = 0
pixelszin = 0

NEXT kiindy
NEXT kiindx

IF naplonyitva = 0 THEN GOSUB korrajz
RETURN

'  ************ Kiiro rutinok **********

menule:
szin = 3: GOSUB cetkiir
menupozy = menupozy + 1
IF menupozy > menupozymax THEN menupozy = 1
szin = 9: GOSUB cetkiir
RETURN

menufel:
szin = 3: GOSUB cetkiir
menupozy = menupozy - 1
IF menupozy = 0 THEN menupozy = menupozymax
szin = 9: GOSUB cetkiir
RETURN

menubalra:
szin = 3: GOSUB cetkiir
menupozx = menupozx - 1
IF menupozx = 0 THEN menupozx = menupozxmax
szin = 9: GOSUB cetkiir
RETURN

menujobbra:
szin = 3: GOSUB cetkiir
menupozx = menupozx + 1
IF menupozx > menupozxmax THEN menupozx = 1
szin = 9: GOSUB cetkiir
RETURN


cetkiir:
kiirc = c(menupozx, menupozy)
kiirc = SGN(kiirc) * INT(ABS(kiirc * 1000)) / 1000
kiirc$ = STR$(kiirc)
told: IF LEN(kiirc$) < 5 THEN kiirc$ = kiirc$ + " ": GOTO told
kiirc$ = LEFT$(kiirc$, 5)
LOCATE 3 + menupozy, 75 - menupozxmax * 6 + 6 * menupozx: COLOR szin: PRINT kiirc$
RETURN



help:
LOCATE 3 + menupozy, 75 - menupozxmax * 6 + 6 * menupozx: COLOR 8: PRINT LEFT$("  " + ce$(menupozx, menupozy) + "   ", 5)
a1$ = TIME$
a1: IF TIME$ = a1$ THEN GOTO a1
a2$ = TIME$
a2: IF TIME$ = a2$ THEN GOTO a2
GOSUB cetkiir
RETURN

korrajz:
korrajzx = (korx - xtartmin) * 100 * 2 ^ rakozelit
korrajzy = (kory - ytartmin) * 100 * 2 ^ rakozelit

j1 = korrajzy - 100
j2 = korrajzy + 100
FOR i = korrajzx - 100 TO korrajzx + 100
PSET (i, j1), 15 - POINT(i, j1)
PSET (i, j2), 15 - POINT(i, j2)
NEXT i

i1 = korrajzx - 100
i2 = korrajzx + 100
FOR j = korrajzy - 100 + 1 TO korrajzy + 100 - 1
PSET (i1, j), 15 - POINT(i1, j)
PSET (i2, j), 15 - POINT(i2, j)
NEXT j

'FOR i = korrajzx - 5 TO korrajzx + 5
'FOR j = korrajzy - 5 TO korrajzy + 5
'korszin = POINT(i, j)
'PSET (i, j), 15 - korszin
'NEXT j
'NEXT i
RETURN





mentes:
SOUND (1000), 1
LOCATE 26, 52: PRINT "Biztosan mented? (enter)"
zz: z$ = INKEY$
IF z$ = "" THEN GOTO zz
LOCATE 26, 52: PRINT "                             "
IF z$ <> CHR$(13) AND z$ <> "i" AND z$ <> "I" THEN GOTO nyomdmegagombot

LOCATE 26, 52: PRINT "Nev (nem kotelezo)"
LOCATE 27, 52: INPUT ujnev$
LOCATE 26, 52: PRINT "                             "
LOCATE 27, 52: PRINT "                             "
LOCATE 26, 52: PRINT "Megjegyzes (nem kotelezo)"
LOCATE 27, 52: INPUT megj$
LOCATE 26, 52: PRINT "                             "
LOCATE 27, 52: PRINT "                             "
IF nev$ <> "" THEN nev$ = ujnev$

OPEN "frakadat.bas" FOR INPUT AS #1

DO WHILE NOT EOF(1)
INPUT #1, be$
IF be$ = "SOR:" THEN INPUT #1, be1$: utolsosorszam$ = be1$
LOOP
CLOSE #1

ujsorszam$ = STR$(VAL(utolsosorszam$) + 1)
ido$ = RIGHT$(DATE$, 4) + ". " + LEFT$(DATE$, 2) + ". " + MID$(DATE$, 4, 2) + ". " + TIME$

OPEN "frakadat.bas" FOR APPEND AS #1
WRITE #1, "SOR:", ujsorszam$
WRITE #1, "KESZ:", en$
WRITE #1, "MEGJ:", megj$
WRITE #1, "IDO:", ido$
WRITE #1, "OSZL:", STR$(menupozxmax)

FOR i = 1 TO menupozxmax
WRITE #1, STR$(c(i, 1)), STR$(c(i, 2)), STR$(c(i, 3)), STR$(c(i, 4))
NEXT i

WRITE #1, "RAK:", STR$(rakozelit)
FOR k = 0 TO rakozelit
WRITE #1, STR$(xkor(k)), STR$(ykor(k))
NEXT k

WRITE #1, "HAT:", STR$(hatar)

WRITE #1, frvege$
CLOSE #1
GOTO nyomdmegagombot






megnyitas:
FOR torol = 1 TO 17
LOCATE torol, 52: PRINT "                            "
NEXT torol

LOCATE 20, 52: COLOR 3: PRINT "Megnyitas:"; : COLOR 15: PRINT " Enter"
LOCATE 21, 52: COLOR 3: PRINT "Torles:"; : COLOR 15: PRINT "    Nagy X"
LOCATE 22, 52: COLOR 3: PRINT "Kovetkezo:"; : COLOR 15: PRINT " Szokoz"
LOCATE 24, 52: COLOR 3: PRINT "Sajat fraktal:"; : COLOR 15: PRINT " S"
LOCATE 25, 52: COLOR 3: PRINT "Kilepes:"; : COLOR 15: PRINT " Q"

toroltutanisorszam = 1

ujranyit:
OPEN "frakadat.bas" FOR INPUT AS #1

olvas:
be1$ = ""
DO WHILE NOT EOF(1)
INPUT #1, be$
IF be$ = "SOR:" THEN INPUT #1, be1$: utolsosorszam = VAL(be1$)
LOOP
CLOSE #1

IF utolsosorszam > 0 THEN OPEN "frakadat.bas" FOR INPUT AS #1: GOTO vanmitmegnyitni

SOUND (200), 2
LOCATE 25, 52: PRINT "Nincs tarolt fraktal!"
naplonyitva = 0

FOR i = 19 TO 24
LOCATE i, 52: PRINT "                          "
NEXT i

aa1$ = TIME$
aa1: IF TIME$ = aa1$ THEN GOTO aa1
aa2$ = TIME$
aa2: IF TIME$ = aa2$ THEN GOTO aa2

LOCATE i, 52: PRINT "                          "
GOTO tisztalap

vanmitmegnyitni:
IF utolsosorszam < toroltutanisorszam THEN toroltutanisorszam = 1
ciklusveg = 3
IF EOF(1) THEN CLOSE #1: OPEN "frakadat.bas" FOR INPUT AS #1
INPUT #1, be$
SELECT CASE be$

CASE IS = frvege$
IF toroltutanisorszam = esorszam THEN GOTO felajanl

CASE IS = "SOR:"
INPUT #1, esor$
esorszam = VAL(esor$)

az$ = "a"
IF LEFT$(STR$(esorszam), 2) = " 5" THEN az$ = "az"
IF LEFT$(STR$(esorszam), 2) = " 1" AND (LEN(esor$) + 1) / 3 = INT((LEN(esor$) + 1) / 3) THEN az$ = "az"

CASE IS = "OSZL:"
INPUT #1, be2$
IF VAL(be2$) > ciklusveg THEN ciklusveg = VAL(be2$)

FOR i = 1 TO ciklusveg
INPUT #1, be2a$
INPUT #1, be2b$
INPUT #1, be2c$
INPUT #1, be2d$

c(i, 1) = VAL(be2a$)
c(i, 2) = VAL(be2b$)
c(i, 3) = VAL(be2c$)
c(i, 4) = VAL(be2d$)
NEXT i

CASE IS = "RAK:"
INPUT #1, be2$
rakozelit = VAL(be2$)
FOR i = 0 TO rakozelit
INPUT #1, be2a$
INPUT #1, be2b$
xkor(i) = VAL(be2a$)
ykor(i) = VAL(be2b$)
NEXT i

CASE IS = "HAT:"
INPUT #1, be2$
hatar = VAL(be2$)
END SELECT

GOTO vanmitmegnyitni

felajanl:

KEY(1) OFF
FOR keyoff = 11 TO 14: KEY(keyoff) OFF: NEXT keyoff
LOCATE 19, 52
COLOR 3: PRINT "Ez "; az$;
COLOR 13: PRINT esor$;
COLOR 3: PRINT ". fraktal.      "

naplonyitva = 1

xhossz = xfeltartomany / 2 ^ rakozelit
yhossz = yfeltartomany / 2 ^ rakozelit

xtartmin = xkor(rakozelit) - xhossz
xtartmax = xkor(rakozelit) + xhossz
ytartmin = ykor(rakozelit) - yhossz
ytartmax = ykor(rakozelit) + yhossz

lepeskoz = .05: GOSUB fraktaltrajzol

ss: s$ = INKEY$
IF s$ = "" THEN GOTO ss

SELECT CASE s$

CASE IS = " "
toroltutanisorszam = esorszam + 1
GOTO vanmitmegnyitni

CASE IS = "X"
SOUND (700), 1
LOCATE 26, 52: COLOR 1: PRINT "Biztosan"; : COLOR 5: PRINT " toroljem"
LOCATE 27, 52: COLOR 1: PRINT az$; esor$; ". fraktalt? (i)"
rr: r$ = INKEY$
IF r$ = "" THEN GOTO rr
LOCATE 26, 48: COLOR 1: PRINT "                                "
LOCATE 27, 48: COLOR 1: PRINT "                                "
IF r$ <> "i" AND r$ <> "I" THEN GOTO ss

CLOSE #1
OPEN "frakadat.bas" FOR INPUT AS #1
OPEN "frakada0.bas" FOR OUTPUT AS #2
OPEN "frakada1.bas" FOR OUTPUT AS #3

ujmasol:
DO WHILE NOT EOF(1)
INPUT #1, bbe$
WRITE #2, bbe$
IF bbe$ = "SOR:" THEN INPUT #1, bbe1$
IF VAL(bbe1$) = esorszam THEN GOTO ujmasol
WRITE #3, bbe$
IF VAL(bbe1$) > esorszam THEN bbe1$ = STR$(VAL(bbe1$) - 1)
IF bbe$ = "SOR:" THEN WRITE #3, bbe1$: bbe1$ = ""
GOTO ujmasol
LOOP

CLOSE #1
CLOSE #2
CLOSE #3

OPEN "frakada1.bas" FOR INPUT AS #1
OPEN "frakadat.bas" FOR OUTPUT AS #2

DO WHILE NOT EOF(1)
INPUT #1, aa$
WRITE #2, aa$
LOOP
CLOSE #1
CLOSE #2

OPEN "frakada1.bas" FOR OUTPUT AS #1
CLOSE #1
toroltutanisorszam = esorszam
GOTO ujranyit

CASE IS = CHR$(13)
naplonyitva = 0
CLOSE #1
FOR i = 19 TO 25
LOCATE i, 52: PRINT "                          "
NEXT i

FOR menupozx = 1 TO menupozxmax
FOR menupozy = 1 TO 4
szin = 3: GOSUB cetkiir
NEXT
NEXT

GOTO kezdkiir

CASE IS = "s"
naplonyitva = 0
CLOSE #1
FOR i = 19 TO 25
LOCATE i, 52: PRINT "                          "
NEXT i
LINE (0, 0)-(402, 402), 0, BF
GOTO tisztalap

CASE IS = "S"
naplonyitva = 0
CLOSE #1
LINE (0, 0)-(402, 402), 0, BF
FOR i = 19 TO 25
LOCATE i, 52: PRINT "                          "
NEXT i
GOTO tisztalap

CASE IS = "q"
CLOSE #1
END

CASE IS = "Q"
CLOSE #1
END

END SELECT
GOTO ss



'   ******************     Reszletes leiras     ********************

' 0. A sikbeli fraktalok mertani alakzatok, amleyek a vonalaknal valamivel
' "testesebbek". Jellemzo tulajdonsaguk, hogy vegtelenul fodrosak, azaz
' minden nagyitasban fodrosnak latszanak. Az egyik eloallitasi modszeruk a
' rajzolas, pl. egy Y betu, melynek ket aga ket-ket rovid hajtast noveszt,
' es igy tovabb, mig egy kaposztaszeru alakzat nem alakul ki belole. Vagy
' pl. egy bastyaszeru falszegely, melynek kiallo reszei kozelebbrol nezve
' szinten csipkezettekek. Ezt a tulajdonsagukat "onhasonlosagnak" nevezik.

' 1. A fraktalok a komplex szamok sikjanak reszhalmazai. A komplex szamokat
' ugy kapjuk, hogy a szokasos x szamokhoz hozzaadjuk az y*i jelu kepzetes
' szamokat. (Definicio szerint "i" az egyik szam, amelynek negyzete -1.)
' Bevezetesuk a harmadfoku egyenletek megoldasakor valt szuksegesse a XV.
' szazadban. A XVIII. szazadban Leibniz, Bernoulli Janos, majd Euler
' es Gauss munkassaga nyoman teljesedett ki a komplex szamok elmelete.
' Szerteagazo gyakorlati alkalmazasaik kozul talan a legfontosabb az
' aramlastani es egyeb differencialegyenletek megoldasa.

' 2. Benoit Mandelbrot a XX. szazad kozepen a valos es komplex szamokon
' megoldando x=xý-c tipusu egyenleteket vizsgalta. Ha ezeket nem keplettel,
' hanem iteracioval (egy x0 kezdoerteket a jobb oldalba valo behelyettesitve,
' majd a kapott erteket ismet, es igy tovabb) probaljuk megoldani, akkor a
' kezdoertek valasztasatol fuggoen fog az eljaras a celhoz erni (a valodi
' megoldashoz kozelitve) vagy a vegtelenbe tavozni. Mandelbrot fekete-feher
' abrara nyomtatta ki azon pontokat, amelyek az elso csoportba tartoznak.
'
' 3. A szines fraktalokban azon tulajdonsag szerint szinezzuk ki a komplex
' szamsik pontjait, hogy a beloluk indulo iteracio hany lepesben jut ki egy
' origo kozeppontu, adott (oriasi) sugaru koron. Ha a szukseges lepesek szama
' nyolc, akkor a pontot "nyolcas" szinnel festjuk be, ha pedig tiz, akkor
' "tizes" szinnel. A gyors szamitogepek es a meses grafikai eszkozok koraban
' mar nem nehez elerni, hogy sajat fraktaljaink legyenek. Tobb helyrol is
' letolthetok fraktalrajzolo programok, e mostaninal sokkal utokepesebbek.
'
' 4. Ez a program Quickbasic nyelven irodott, Nemeth Ferenc a szerzoje, aki
' matematika-fizika szakos tanar. Fellelesi helye http://iratok.fw.hu.
' Futtatasahoz szukseg van egy Quickbasic programra. Harom adatallomanyt
' kezel: a frakadat.bas-ban a fraktalok hatterparameterei talalhatok, a
' frakada0.bas ennek (torlesekkor hasznalt) idosebb peldanya, a frakada1.bas
' pedig egy utolag kiuritett ideiglenes allomany. Mindharmat a program hozza
' letre es kezeli, letolteni vagy kezzel megirni nem szukseges.
'
' 5. A kapott fraktalokat ketfele (vazlatos es reszletes) felbontasban lehet
' nezegetni. A parametereket veletlengenerator allitja elo, s a felhasznalo
' kedvere probalgathatja ugy modositani oket, hogy minel szebb abrat kapjon.
' A mentett fraktalokat csak ugyanez a program tudja olvasni (a frakadat.bas
' allomanybol, melyet hurcolni kell vele egyutt), de ha az Isten megsegit,
' idovel kepesse teszem arra, hogy tobb szinben es egy igazi kepformatumban
' is ki tudja oket bocsatani.
'
' 6. Egy fraktalnezo programnak az erosseget az adja, hany lepesig lehet ugy
' rakozeliteni az abra reszleteire, hogy nem valjon recesse vagy homalyossa.
' E program tiz lepest engedelyez (osszesen mintegy ezerszeres nagyitassal),
' utana elkezd pontsorokat kihagyni. Ennek oka az, hogy ilyenkor mar igen
' kozeli szamokbol indul ki (melyek kb. szazezrednyire vannak egymastol), es
' a valtozok kezdoertekei is kezdenek osszemosodni.
'
' 7. Remelem, a programban nincs eldugva vegzetes hiba. Virustevekenyseget
' nemigen fog produkalni, mert akar szovegszerkesztoval is bele lehet nezni.
' Egy 1988-as Microsoft Quickbasic (4.5) alkalmazassal keszitettem, tehat
' bizonyara minden gepen le tud futni, amelyen ez a rendszer megtalalhato.
' (1000 MHz-es processzorral kb. fel perc alatt keszul el meg egy abra.)
' Amikor a lemezt kapirgalja, csak az altala kezelt harom adatallomanyt
' nyitja-zarja, mashoz nem nyul. Ha a frakadat.bas allomany megserul vagy
' akaratlan torles esik benne, celszeru a frakada0.bas-t ilyenre atnevezni
' vagy a vegerol a serult bejegyzeseket kezzel kitorolni. Ezt a biztonsagi
' masolatot a program az elso torleskor magatol elkesziti.
'
' 8. Visszajelzest a nemo44@hotmail.com villanycimre varok; elsosorban a
' BMP vagy GIF kepformatumok ismeroitol azzal kapcsolatban, hogy milyen
' modon lehet egy ilyen kepet az adatok szekvencialis fajlba irasaval
' eloallitani. Erdekelne meg az is, hogy milyen kodolassal tarolhato ilyen
' kiterjesztesu allomanyokban nehany (16 vagy 256) sajat valasztasu szin,
' azaz hogy milyen manualis modszerrel lehet kicsinyiteni a kepek tarigenyet.
' Elorelathatolag valamikor halora is fogom alkalmazni, JAVA nyelven.
'
' Ez a program Nemeth Ferenc (nemo44hotmail.com, iratok.fw.hu, Bp. 233-2940)
' muve 2007. II. 3-an. Aki tovabbadja, kerem, e ket sort ne torolje ki.