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!









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
Listing downloads
Copyright holder