Random software
Random game
Random game
  • 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 ------------------------------	

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!