News Games Software Hardware Books Demos Graphics Source code Disks Fonts Ref. cards PC tools Links My projects Atari family Collection Guestbook Contact
Random software
Random demo
Random game
Back button image

Atari 8-bit Source code
  • Entry name:
     Mandelbrotovy obrazce 
  • Category:
    Graphics
  • Publisher/Developer:
    Flop 4
  • Year:
    1989
  • Code:
    J. Nemec
  • Media format:
    Diskette
  • Programming language:
    Turbo Basic XL
  • Entry name:
    Mandelbrotovy obrazce
  • Category:
    Graphics
  • Publisher/Developer:
    Flop 4
  • Year:
    1989
Mandelbrotovy obrazce Mandelbrotovy obrazce Mandelbrotovy obrazce Mandelbrotovy obrazce Mandelbrotovy obrazce Mandelbrotovy obrazce Mandelbrotovy obrazce Mandelbrotovy obrazce Mandelbrotovy obrazce
Listing 1 
10 REM MANDELBROTOVY OBRAZCE/J.NEMEC
20 REM VTM 18/89,​ T5/88,​ VESMIR 8/88
30 DIM A$(20),​B$(7680),​C$(100)
40 B$(1)="":​B$(7679)=B$:​B$(3)=B$
50 EXEC MENU
60 END
70 PROC ITERUJ
80 ZR=0:​ZI=0
90 ZR2=0:​ZI2=0
100 POCET=0
110 REPEAT
120 ZRPOM=ZR2-ZI2+CR
130 ZI=2*ZR*ZI+CI
140 ZR=ZRPOM
150 POCET=POCET+%1
160 ZR2=ZR*ZR:​ZI2=ZI*ZI
170 UNTIL POCET=LIMIT OR ZR2+ZI2>=HRANICE
180 ENDPROC
190 ------------------------------
200 PROC OBARVI
210 IF POCET=LIMIT THEN COLOR 2
220 IF POCET>LIMIT-10 AND POCET<LIMIT THEN COLOR 3
230 IF POCET<LIMIT-9 THEN COLOR (POCET MOD 3)
240 PLOT I,​MAXY-J-%1
250 ENDPROC
260 ------------------------------
270 PROC POCITEJ
280 GRAPHICS 31:​EXEC BARVY
290 KROKX=VEL/MAXX:​KROKY=KROKX/POMYX
300 REPEAT
310 CR=XSOUR+I*KROKX
320 REPEAT
330 CI=YSOUR+J*KROKY
340 EXEC ITERUJ
350 EXEC OBARVI
360 IF PEEK(732) THEN 410
370 J=J+%1
380 UNTIL J=MAXY
390 I=I+%1:​J=%0
400 UNTIL I=MAXX
410 ENDPROC
420 ------------------------------
430 PROC INIT
440 MAXX=160:​MAXY=192
450 POMYX=2:​REM 
460 LIMIT=100:​HRANICE=4
470 REM LEVY 
480 XSOUR=0:​YSOUR=0:​VEL=0
490 CR=0:​CI=0
500 ZR=0:​ZI=0:​POKE 732,​0
510 ENDPROC
520 ------------------------------
530 PROC BARVY
540 SETCOLOR 0,​12,​8
550 SETCOLOR 1,​3,​4
560 SETCOLOR 2,​0,​14
570 SETCOLOR 4,​8,​0
580 ENDPROC
590 ------------------------------
600 PROC SOUR
610 PUT 125
620 POSITION 8,​5:​? "MANDELBROTOVA MNOZINA"
630 TRAP 630:​INPUT "X-OVA SOURADNICE:​";XSOUR
640 TRAP 640:​INPUT "Y-OVA SOURADNICE:​";YSOUR
650 TRAP 650:​INPUT "ZADEJ LIMIT";LIMIT
660 TRAP 660:​INPUT "VELIKOST:​";VEL
670 IF VEL<0 THEN 660
680 TRAP 40000
690 ENDPROC
700 ------------------------------
710 PROC HLAVNI
720 EXEC INIT
730 EXEC SOUR
740 EXEC POCITEJ
750 MOVE DPEEK(88),​ADR(B$),​7680
760 ENDPROC
770 ------------------------------
780 PROC SAVE:​PUT 125:​? "* SAVE OBRAZU *":​PUT 29:​IF LEN(B$)=0
790 ? "V PAMETI NENI ZADNY OBRAZ !":​PUT 29:​? "STISKNI KLAVESU":​GET A:​GOTO 830:​ENDIF
800 TRAP 800:​INPUT "ZADEJ ZARIZENI A JMENO";A$
810 CLOSE #1
820 OPEN #1,​8,​128,​A$:​BPUT #1,​ADR(B$),​7680:​%PUT #1,​XSOUR:​%PUT #1,​YSOUR:​%PUT #1,​LIMIT:​%PUT #1,​VEL:​CLOSE #1
830 TRAP 40000:​ENDPROC
840 ------------------------------
850 PROC LOAD:​PUT 125:​? "* LOAD OBRAZU *":​PUT 29
860 TRAP 860:​INPUT "ZADEJ NAZEV ZARIZENI";A$
870 CLOSE #1
880 OPEN #1,​4,​128,​A$:​BGET #1,​ADR(B$),​7680
890 TRAP 920
900 %GET #1,​XSOUR:​%GET #1,​YSOUR:​%GET #1,​LIMIT:​%GET #1,​VEL:​CLOSE #1
910 TRAP 40000:​ENDPROC
920 IF ERR<>136 THEN 860
930 PUT 29:​? "POZOR ! OBRAZ NEMA ZADANY PARAMETRY":​PUT 29:​? "STISKNI KLAVESU":​GET A
940 TRAP 40000:​ENDPROC
950 ------------------------------
960 PROC HLEDEJ:​DIM C$(300)
970 RESTORE 1000:​B=1
980 READ A:​IF A<>-1 THEN C$(B,​B)=CHR$(A):​B=B+1:​GOTO 980
990 ENDPROC
1000 DATA 165,​24,​133,​85,​165,​25,​133,​84,​162,​96,​169,​7,​157,​66,​3,​169,​0,​157,​72,​3,​157,​73,​3,​133,​86
1010 DATA 32,​86,​228,​168,​208,​9,​230,​26,​208,​2,​230,​27,​24,​144,​32,​201,​1,​208,​9,​230,​67,​208,​2,​230,​68
1020 DATA 24,​144,​19,​201,​2,​208,​9,​230,​69,​208,​2,​230,​70,​24,​144,​6,​230,​71,​208,​2,​230,​72,​230,​24,​165
1030 DATA 24,​201,​160,​208,​176,​230,​25,​165,​25,​201,​192,​240,​6,​169,​0,​133,​24,​240,​162,​104,​96,​-1
1040 ------------------------------
1050 PROC H1
1060 PUT 125:​? "* HARDCOPY 1B *":​PUT 29:​IF LEN(B$)=0
1070 ? "V PAMETI NENI ZADNY OBRAZ !":​PUT 29:​? "STISKNI KLAVESU":​GET A:​ENDPROC
1080 ENDIF
1090 ? "PRIPRAV ALFIKA a STISKNI 2x KLAVESU":​GET A:​CLOSE #6:​OPEN #6,​12,​15+16,​"S:​":​EXEC BARVY
1100 MOVE ADR(B$),​DPEEK(88),​7680:​GET A:​POKE 732,​0
1110 OPEN #1,​8,​1,​"A"
1120 REPEAT
1130 FOR A=0 TO 159
1140 LOCATE A,​X,​BARVA:​BARVA=BARVA+1
1150 ON BARVA GOSUB 1320,​1330,​1340,​1350
1160 ? #1;"MR1 0"
1170 IF PEEK(732) THEN 1280
1180 NEXT A
1190 X=X+1:​? #1;"MR-1-0.875"
1200 FOR A=159 TO 0 STEP -1
1210 LOCATE A,​X,​BARVA:​BARVA=BARVA+1
1220 ON BARVA GOSUB 1320,​1330,​1340,​1350
1230 ? #1;"MR-1 0"
1240 IF PEEK(732) THEN 1280
1250 NEXT A
1260 X=X+1:​? #1;"MR1-0.875"
1270 UNTIL X=192
1280 CLOSE #1
1290 ENDPROC
1300 ------------------------------
1310 ------------------------------
1320 RETURN
1330 ? #1;"MR0.375 0PDMR0-0.375PUMR-0.375 0.375":​RETURN
1340 ? #1;"PDMR0.75-0.375PUMR-0.75 0.375":​RETURN
1350 ? #1;"MR0.75 0PDMR-0.75-0.375PUMR0 0.375":​RETURN
1360 ------------------------------
1370 # CHYBA
1380 ? "Chyba c.";ERR;" na radce ";ERL
1390 ? "stiskni klavesu":​GET A
1400 GOTO 1430
1410 ------------------------------
1420 PROC MENU
1430 GRAPHICS 0:​POKE 53248,​0:​POKE 702,​64:​PUT 29:​POKE 732,​0
1440 ? "* HLAVNI MENU *":​PUT 29
1450 ? "YPOCET FRAKTALU":​PUT 29
1460 ? "AVE OBRAZKU":​PUT 29
1470 ? "OAD OBRAZKU":​PUT 29
1480 ? "EDNOBAREVNE HARDCOPY":​PUT 29
1490 ? "RIBAREVNE HARDCOPY":​PUT 29
1500 ? "ROHLIZENI OBRAZU":​PUT 29
1510 ? "VYBER PODLE INVERZNICH PISMEN"
1520 GET A
1530 A=(A=ASC("V"))*1+(A=ASC("S"))*2+(A=ASC("L"))*3+(A=ASC("J"))*4+(A=ASC("T"))*5+(A=ASC("P"))*6
1540 ON AEXEC HLAVNI,​SAVE,​LOAD,​H1,​H3,​OBRAZ
1550 GOTO 1430
1560 ------------------------------
1570 PROC OBRAZ
1580 PUT 125:​? "XSOUR:​";XSOUR:​PUT 29:​? "YSOUR:​";YSOUR:​PUT 29
1590 ? "LIMIT:​";LIMIT:​PUT 29:​? "VEL:​";VEL:​PUT 29
1600 ? "SOUHLASI PARAMETRY A/N":​GET A:​IF A=ASC("A") THEN 1620
1610 EXEC INIT:​EXEC SOUR:​KROKX=VEL/MAXX:​KROKY=KROKX/POMYX
1620 PUT 29:​? "NAVRAT K MENU - ":​PAUSE 50
1630 POKE 106,​176:​POKE 176*256,​0:​MOVE 176*256,​176*256+1,​4095
1640 GRAPHICS 15+16:​EXEC BARVY:​EXEC DL
1650 MOVE ADR(B$),​DPEEK(88),​7680
1660 POKE 559,​58:​POKE 623,​1:​POKE 54279,​184
1670 RESTORE #PMG:​FOR A=0 TO 5:​READ B:​POKE A+48348,​B:​NEXT A
1680 # PMG:​DATA 4,​8,​144,​160,​192,​240
1690 POKE 704,​255:​POKE 53277,​2:​POKE 53256,​0
1700 POKE 703,​4:​DPOKE 660,​45064:​POKE 53248,​48
1710 X=48:​Y=0:​POKE 764,​255:​PUT 125:​POKE 752,​1
1720 ? "X:​";XSOUR+KROKX*(X-48);" Y:​";(Y*SGN(Y))*KROKY+YSOUR:​PUT 28
1730 PM=48348+Y:​DY=0
1740 A=PEEK(764):​IF A=255 THEN 1740
1750 IF A=12 THEN POKE 764,​255:​ENDPROC
1760 IF A=7 THEN X=X+1
1770 IF A=6 THEN X=X-1
1780 IF X<48 THEN X=48
1790 IF X>207 THEN X=207
1800 POKE 53248,​X
1810 IF A=14 THEN DY=-1
1820 IF A=15 THEN DY=+1
1830 IF DY+Y>0 OR DY+Y<-191 THEN DY=0
1840 IF DY>0 THEN -MOVE PM,​PM+1,​6:​POKE PM,​0
1850 IF DY<0 THEN MOVE PM,​PM-1,​6:​POKE PM+5,​0
1860 Y=Y+DY
1870 ? "X:​";XSOUR+KROKX*(X-48);" Y:​";(Y*SGN(Y))*KROKY+YSOUR;" ":​PUT 28
1880 POKE 764,​255:​GOTO 1730
1890 ------------------------------
1900 PROC DL
1910 RESTORE #DLU
1920 # DLU:​DATA 112,​66,​8,​176,​112,​1,​57,​144
1930 FOR A=0 TO 7:​READ B:​POKE A+176*256,​B:​NEXT A
1940 POKE DPEEK(560),​1:​DPOKE DPEEK(560)+1,​176*256
1950 ENDPROC
1960 ------------------------------
References
http://flop.atariportal.cz/dir1_27.htm
Listing downloads

Copyright holder
This is non-commercial site, its content is based on Atari 8-bit home computer contents and references.
If you feel your rights are violated by showing/using any part of contents of your product represented on this page, please contact me immediatelly so I can remove it!