News:

Printed Amstrad Addict magazine announced, check it out here!

Main Menu

Mandelbrot with Amstrad

Started by litwr, 06:54, 05 October 16

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

litwr

The idea was imported from http://cbmandelbrot.blogspot.ru/  :D
I have just made a conversion for Amstrad CPC.
[attachimg=1]
Amstrad CPC ROM Basic makes it for 5 hours 27 minutes and about 12 seconds.  It is much faster than any Commodore of 80s.
I'm aware about http://www.cpcwiki.eu/forum/programming/mandelbrot-in-one-basic-line/ but  this is a bit different.
BTW it is also a thread at C+4 forum about this subject, it also mentions the Fibonacci Sunflower demo - http://plus4world.powweb.com/forum/32712
Commodore Basic original text

   10 x=0:y=0:x2=0:y2=0:xy=0:r=0:j=0
   11 dimd(2,319),r(319),j(199):a=0:b=1:c=2
   12 r0=-1.9:r1=+0.5:dr=(r1-r0)/320:fors=0to319:r(s)=r0+dr*s:next
   13 j0=-0.10:j1=+0.95:dj=(j1-j0)/200:fort=0to199:j(199-t)=j0+dj*t:next
   14 n=30
   15 color0,1:color1,4:graphic 1:ti$="000000":scnclr
   16 fort=0to199:j=j(t):fors=0to319:r=r(s):x=r:y=j
   17 fori=1ton:x2=x*x:y2=y*y:ifx2+y2<4thenxy=x*y:x=x2-y2+r:y=2*xy+j:next
   18 d(c,s)=i:ifi<=nthen:draw 1,s,t
   19 ifs<2ort<2then28
   20 locate s-1,t-1:if rdot(2)=0then28
   21 m=d(b,s-1)
   22 ifd(b,s-2)<mandd(b,s)<mthen27
   23 ifd(a,s-2)<mandd(c,s)<mthen27
   24 ifd(c,s-2)<mandd(a,s)<mthen27
   25 ifd(a,s-1)<mandd(c,s-1)<mthen27
   26 goto28
   27 draw 0
   28 nexts:z=a:a=b:b=c:c=z:next:printti:clk$=ti$
   29 getkeya$:graphic0:printclk$

Amstrad CPC Basic text (I am not sure that it can't be made faster.)

   10 x=0:y=0:x2=0:y2=0:xy=0:r=0:j=0
   11 DIM d(2,319),r(319),j(199):a=0:b=1:c=2
   12 r0=-1.9:r1=.5:dr=(r1-r0)/320:FOR s%=0 to 319:r(s%)=r0+dr*s%:NEXT
   13 j0=-0.10:j1=.95:dj=(j1-j0)/200:FOR t%=0 to 199:j(199-t%)=j0+dj*t%:NEXT
   14 n=30
   15 MODE 1:time0=TIME
   16 FOR t%=0 to 199:j=j(t%):FOR s%=0 to 319:r=r(s%):x=r:y=j
   17 FOR i=1 to n:x2=x*x:y2=y*y:IF x2+y2<4 THEN xy=x*y:x=x2-y2+r:y=2*xy+j:NEXT
   18 d(c,s%)=i:IF i<=n THEN:PLOT s%+s%,400-t%-t%,1
   19 IF s%<2 or t%<2 THEN 28
   20 IF TEST(s%+s%-2,402-t%-t%)=0 THEN 28
   21 m=d(b,s%-1)
   22 IF d(b,s%-2)<m AND d(b,s%)<m THEN 27
   23 IF d(a,s%-2)<m AND d(c,s%)<m THEN 27
   24 IF d(c,s%-2)<m AND d(a,s%)<m THEN 27
   25 IF d(a,s%-1)<m AND d(c,s%-1)<m THEN 27
   26 GOTO 28
   27 PLOT s%+s%-2,402-t%-t%,0
   28 NEXT s%:z=a:a=b:b=c:c=z:NEXT:clk=(TIME-time0)/300:hours=int(clk/3600):mins=int(clk/60-hours*60)
   29 a$=INKEY$:IF a$="" THEN 29
   30 CLS:PRINT hours;mins;int(clk-hours*3600-mins*60)

robcfg

Nice use of mode 2!


I would suggest using dither to create the illusion of a third color to improve the result.


I did that on the Dragon and the result is quite good!


[attachimg=1]

mr_lou

How long does it take to render?
I made a Mandelbrott BASIC listing as a kid too, and as far as I remember it took the CPC 4 days to draw the whole thing.
May not have been the smartest listing in the world though.

HAL6128

Oh yeah! I remember myself too. When I programmed as a kid my listing it took the whole night and half of the day for rendering. I started the program before I had gone to bed and covered the monitor to prevent glimmering the whole room. After had been coming back from school the picture was finished. :)
...proudly supported Schnapps Demo, Pentomino and NQ-Music-Disc with GFX

litwr

#4
Quote from: robcfg on 09:17, 05 October 16
I did that on the Dragon and the result is quite good!
Dragon 32/64?  The result is impressive.  It is interesting to look at the code.  Is it Basic?

SRS

#5
Well done :)

But: why monocolored in MODE 1 ?

I don't get why the very big (and slow) arrays are needed ? Maybe to late for me [attach=2] today ;)

Using 16 iterations per pixel, some y-symmetrics, four colors and saving 30 "empty" pixels left and right
a color mandel in 32 minutes.

using

10 MODE 1:time0=TIME
20 maxIteration = 16
30 px=70:py=0
40 FOR x0 = -1.6 TO 0.6 STEP 0.01
50 FOR y0 = -1 TO 0 STEP 0.01
60 x=0:y=0:iteration=0
70 x2=x*x:y2=y*y
80 WHILE (x2 + y2 <= (4) AND iteration < maxIteration)
90 xtemp = x2 - y2 + x0
100 y = 2 * x * y + y0
110 x = xtemp:iteration = iteration + 1
120 x2=x*x:y2=y*y:WEND
130 IF iteration<>maxIteration THEN c=iteration\4 ELSE c=0:GOTO 150
140 PLOT px,py,c:PLOT px,400-py,c
150 py=py+2
160 NEXT
170 px=px+2:py=0
180 NEXT:clk=(TIME-time0)/300:hours=INT(clk/3600):mins=INT(clk/60-hours*60)
190 a$=INKEY$:IF a$="" THEN 190
200 CLS:PRINT hours;mins;INT(clk-hours*3600-mins*60)


robcfg

Quote from: litwr on 20:52, 05 October 16
Dragon 32/64?  The result is impressive.  It is interesting to look at the code.  Is it Basic?


Sure!


Here you have my source code (the ASC file) and several nice screenshots.


It's a bit longer than the original code to support multiple screen resolutions, colors and dither (very much needed).


If you use the dither on mode 1, you should get pretty nice results.

SRS

@robcfg:

Try this (ugly colors, I know)

10 REM K3 FRACTALS FOR THE DRAGON COMPUTER
20 REM BY ROBCFG WITH HELP OF HABI AND SYX
25 REM Patched to AMSTRAD CPC by SRS
30 GOSUB 430
40 FT=0:SM=0:PA=0:FX=0:F2=0:FY=0:NI=0:MI=0:C=0:X=0:Y=0
50 VM=&c000:RX=320:RY=400:MX=0:MY=0:DX=0:DY=0
60 PRINT"PLEASE CHOOSE A FRACTAL TYPE:":PRINT
70 PRINT"<1> MANDELBROT"
80 PRINT"<2> JULIA":PRINT
90 INPUT"FRACTAL TYPE";FT
100 GOSUB 430
110 PRINT "PLEASE CHOOSE A SCREEN MODE:":PRINT
120 PRINT"<1> 320X200 4 COLORS"
130 PRINT"<2> 640X200 2 COLORS":PRINT
140 INPUT"SCREEN MODE";SM:SM=SM+2:IF SM=4 THEN RX=640
150 GOSUB 430
160 PRINT"PLEASE CHOOSE A COLOR PALETTE:":PRINT
170 IF SM=4 THEN GOTO 230
180 REM -- 4 COLOR PALETTE --
190 PRINT"<1> RED,GREEN,YELLOW,BLUE"
200 PRINT"<2> ORANGE,BUFF,CYAN,MAGENTA":PRINT
210 GOTO 260
220 REM -- 2 COLOR PALETTE --
230 PRINT"<1> GREEN,BLACK"
240 PRINT"<2> BUFF,BLACK"
250 IF SM<>4 THEN PRINT ELSE PRINT"<3> NTSC ARTIFACTS":PRINT
260 INPUT"COLOR PALETTE";PA:PA=PA-1:PRINT
270 GOSUB 430
280 IF FT=1 THEN PRINT"FOR FULL MANDELBROT USE":PRINT"X1=-2.4,X2=1.04,Y1=-1.3"
290 IF FT=2 THEN PRINT"FOR FULL JULIA USE":PRINT"X1=-1.666,X2=1.666,Y1=-1.25"
300 PRINT
310 PRINT"ENTER X1 COORDINATE:":INPUT FX
320 PRINT"ENTER X2 COORDINATE:":INPUT F2
330 PRINT"ENTER Y1 COORDINATE:":INPUT FY
340 PRINT"ENTER ITERATIONS:":INPUT NI:MI=NI-1:GOSUB 430
350 DX=F2-FX:DY=DX*(RY/RX):IF SM=3 THEN DY=DY/2
360 PRINT:PRINT"WHEN THE FRACTAL IS FINISHED,"
370 PRINT"PRESS A KEY TO CONTINUE.":PRINT
380 PRINT"YOU'LL BE ASKED TO SAVE":PRINT"YOUR IMAGE."
390 PRINT:PRINT"PRESS A KEY TO START.":GOSUB 460
400 MODE SM-2:IF PA=0 THEN ink 0,6:ink 1,18:ink 2,26:ink 3,1 ELSE ink 0,12:ink 1,13:ink 2,4:ink 3,16
410 CLS
420 ON FT GOTO 470,820
430 REM -- CLEAR SCREEN AND SHOW BANNER --
440 CLS:PRINT"      * K3 FRACTALS V1.0 *":PRINT:RETURN
450 REM -- WAIT FOR A KEY PRESS
460 IF INKEY$="" THEN GOTO 460 ELSE RETURN
470 REM -- MANDELBROT --
480 E=FY
490 Y=0:REM FOR Y=0 TO MY
500 D=FX
510 X=0:REM FOR X=0 TO MX
520 Z=0:I=0:A=0:z2=0:i2=0
530 S=(Z2)-(I2)+D:R=(2*I*Z)+E:Z=S:I=R:A=A+1:z2=z*z:i2=i*i
540 IF A<MI AND (Z2+I2)<4 THEN GOTO 530
550 IF SM=4 THEN C=0 ELSE C=3
560 IF A=MI THEN GOTO 760:REM EARLY OUT
570 IF SM=3 THEN GOTO 670:REM 4 COLOR PALETTE
580 IF PA=2 THEN GOTO 610
590 IF (A AND 1)=0 THEN GOSUB 1190 ELSE GOSUB 1210
600 GOTO 760
610 J=A AND 3
620 on J GOSUB 1190,1240,1190,1270
660 GOTO 760
670 K=(A/8)-INT(A/8)
680 J=K*8
690 ON J GOSUB 1300,1330,1350,1380,1400,1430,1450
760 IF SM=3 THEN plot X*2,Y,C ELSE plot X,Y,C
770 D=D+DX/RX:REM D=D+0.013437
780 X=X+1:IF X<RX THEN GOTO 520:REM NEXT X
790 E=E+DY/RY:REM E=E+0.013541
800 Y=Y+2:IF Y<RY THEN GOTO 500:REM NEXT Y
810 GOSUB 450:GOTO 1480
820 REM -- JULIA --
830 CR=-0.4:CI=0.6:MX=RX-1:MY=RY-1
840 E=FY
850 Y=0:REM FOR Y=0 TO MY
860 D=FX
870 X=0:REM FOR X=0 TO MX
880 Z=D:I=E:A=0:z2=0:i2=0
890 S=(Z2)-(I2)+CR:R=(2*I*Z)+CI:Z=S:I=R:A=A+1:i2=i*i:z2=z*z
900 IF A<MI AND (Z2+I2)<4 THEN GOTO 890
910 IF SM=4 THEN C=0 ELSE C=3
920 IF A=MI THEN GOTO 1120:REM EARLY OUT
930 IF SM=3 THEN GOTO 1030
940 IF PA=2 THEN GOTO 970
950 IF (A AND 1)=0 THEN GOSUB 1190 ELSE GOSUB 1210
960 GOTO 1120
970 J=A AND 3
980 ON J GOSUB 1190,1240,1190,1270
1020 GOTO 1120
1030 K=(A/8)-INT(A/8)
1040 J=K*8
1050 ON J GOSUB 1300,1330,1350,1380,1400,1430,1450
1120 IF SM=3 THEN plot X*2,Y,C ELSE plot X,Y,C
1130 D=D+DX/RX
1140 X=X+1:IF X<RX THEN GOTO 880:REM NEXT X
1150 E=E+DY/RY
1160 Y=Y+2:IF Y<RY THEN GOTO 860:REM NEXT Y
1170 GOSUB 450:GOTO 1480
1180 REM -- COLOR SELECTION AND DITHERING --
1190 REM -- WHITE STRIP --
1200 C=1:RETURN
1210 REM -- WHITE-BLACK PATTERN --
1220 IF (X AND 1)=(Y AND 1) THEN C=1
1230 RETURN
1240 REM -- WHITE-BLACK NTSC LINES --
1250 IF (X AND 1)=0 THEN C=1
1260 RETURN
1270 REM -- BLACK-WHITE NTSC LINES --
1280 IF (X AND 1)<>0 THEN C=1
1290 RETURN
1300 REM -- GREEN-YELLOW PATTERN --
1310 IF (X AND 1)=(Y AND 1) THEN C=3 ELSE C=1
1320 RETURN
1330 REM -- YELLOW --
1340 C=1:RETURN
1350 REM -- YELLOW-RED PATTERN --
1360 IF (X AND 1)=(Y AND 1) THEN C=1 ELSE C=2
1370 RETURN
1380 REM -- RED --
1390 C=2:RETURN
1400 REM -- RED-BLUE PATTERN --
1410 IF (X AND 1)=(Y AND 1) THEN C=2 ELSE C=0
1420 RETURN
1430 REM -- BLUE --
1440 C=0:RETURN
1450 REM -- BLUE-GREEN PATTERN --
1460 IF (X AND 1)=(Y AND 1) THEN C=0 ELSE C=3
1470 RETURN
1480 REM -- SAVE IMAGE MENU --
1600 IF FT=1 THEN SAVE"MANDELBR",b,VM,&3fff,VM ELSE SAVE"JULIA",b,VM,&3fff,VM
1610 GOTO 10


[attachimg=1]

robcfg

I hope you didn't think I forgot about you  ;)


I managed to fix the code and Mandelbrot renders quite good on mode 1 and mode 2:


[attach=2][attach=3]


Here's the code:
10 REM K3 FRACTALS FOR THE DRAGON COMPUTER
20 REM BY ROBCFG WITH HELP OF HABI AND SYX
25 REM Patched to AMSTRAD CPC by SRS
30 GOSUB 430
40 FT=0:SM=0:PA=0:FX=0:F2=0:FY=0:NI=0:MI=0:C=0:X=0:Y=0
50 VM=&c000:RX=320:RY=200:MX=0:MY=0:DX=0:DY=0
60 PRINT"PLEASE CHOOSE A FRACTAL TYPE:":PRINT
70 PRINT"<1> MANDELBROT"
80 PRINT"<2> JULIA":PRINT
90 INPUT"FRACTAL TYPE";FT
100 GOSUB 430
110 PRINT "PLEASE CHOOSE A SCREEN MODE:":PRINT
120 PRINT"<1> 320X200 4 COLORS"
130 PRINT"<2> 640X200 2 COLORS":PRINT
140 INPUT"SCREEN MODE";SM:SM=SM+2:IF SM=4 THEN RX=640
150 GOSUB 430
160 PRINT"PLEASE CHOOSE A COLOR PALETTE:":PRINT
170 IF SM=4 THEN GOTO 230
180 REM -- 4 COLOR PALETTE --
190 PRINT"<1> RED,GREEN,YELLOW,BLUE"
200 PRINT"<2> ORANGE,BUFF,CYAN,MAGENTA":PRINT
210 GOTO 260
220 REM -- 2 COLOR PALETTE --
230 PRINT"<1> GREEN,BLACK"
240 PRINT"<2> BUFF,BLACK"
250 IF SM<>4 THEN PRINT ELSE PRINT"<3> NTSC ARTIFACTS":PRINT
260 INPUT"COLOR PALETTE";PA:PA=PA-1:PRINT
270 GOSUB 430
280 IF FT=1 THEN PRINT"FOR FULL MANDELBROT USE":PRINT"X1=-2.4,X2=1.04,Y1=-1.3"
290 IF FT=2 THEN PRINT"FOR FULL JULIA USE":PRINT"X1=-1.666,X2=1.666,Y1=-1.25"
300 PRINT
310 PRINT"ENTER X1 COORDINATE:":INPUT FX
320 PRINT"ENTER X2 COORDINATE:":INPUT F2
330 PRINT"ENTER Y1 COORDINATE:":INPUT FY
340 PRINT"ENTER ITERATIONS:":INPUT NI:MI=NI-1:GOSUB 430
350 DX=F2-FX:DY=DX*(RY/RX)*2:IF SM=3 THEN DY=DY/2
360 PRINT:PRINT"WHEN THE FRACTAL IS FINISHED,"
370 PRINT"PRESS A KEY TO CONTINUE.":PRINT
380 PRINT"YOU'LL BE ASKED TO SAVE":PRINT"YOUR IMAGE."
390 PRINT:PRINT"PRESS A KEY TO START.":GOSUB 460
400 MODE SM-2:IF PA=0 THEN ink 0,6:ink 1,18:ink 2,26:ink 3,1 ELSE ink 0,12:ink 1,13:ink 2,4:ink 3,16
410 CLS
420 ON FT GOTO 470,820
430 REM -- CLEAR SCREEN AND SHOW BANNER --
440 CLS:PRINT"      * K3 FRACTALS V1.0 *":PRINT:RETURN
450 REM -- WAIT FOR A KEY PRESS
460 IF INKEY$="" THEN GOTO 460 ELSE RETURN
470 REM -- MANDELBROT --
480 E=FY
490 Y=0:REM FOR Y=0 TO MY
500 D=FX
510 X=0:REM FOR X=0 TO MX
520 Z=0:I=0:A=0:z2=0:i2=0
530 S=(Z2)-(I2)+D:R=(2*I*Z)+E:Z=S:I=R:A=A+1:z2=z*z:i2=i*i
540 IF A<MI AND (Z2+I2)<4 THEN GOTO 530
550 IF SM=4 THEN C=0 ELSE C=3
560 IF A=MI THEN GOTO 760:REM EARLY OUT
570 IF SM=3 THEN GOTO 670:REM 4 COLOR PALETTE
580 IF PA=2 THEN GOTO 610
590 IF (A AND 1)=0 THEN GOSUB 1190 ELSE GOSUB 1210
600 GOTO 760
610 J=A AND 3
620 on J GOSUB 1190,1240,1190,1270
660 GOTO 760
670 K=(A/8)-INT(A/8)
680 J=K*8
690 ON J GOSUB 1300,1330,1350,1380,1400,1430,1450
760 IF SM=3 THEN plot X*2,Y*2,C ELSE plot X,Y*2,C
770 D=D+DX/RX:REM D=D+0.013437
780 X=X+1:IF X<RX THEN GOTO 520:REM NEXT X
790 E=E+DY/RY:REM E=E+0.013541
800 Y=Y+1:IF Y<RY THEN GOTO 500:REM NEXT Y
810 GOSUB 450:GOTO 1480
820 REM -- JULIA --
830 CR=-0.4:CI=0.6:MX=RX-1:MY=RY-1
840 E=FY
850 Y=0:REM FOR Y=0 TO MY
860 D=FX
870 X=0:REM FOR X=0 TO MX
880 Z=D:I=E:A=0:z2=0:i2=0
890 S=(Z2)-(I2)+CR:R=(2*I*Z)+CI:Z=S:I=R:A=A+1:i2=i*i:z2=z*z
900 IF A<MI AND (Z2+I2)<4 THEN GOTO 890
910 IF SM=4 THEN C=0 ELSE C=3
920 IF A=MI THEN GOTO 1120:REM EARLY OUT
930 IF SM=3 THEN GOTO 1030
940 IF PA=2 THEN GOTO 970
950 IF (A AND 1)=0 THEN GOSUB 1190 ELSE GOSUB 1210
960 GOTO 1120
970 J=A AND 3
980 ON J GOSUB 1190,1240,1190,1270
1020 GOTO 1120
1030 K=(A/8)-INT(A/8)
1040 J=K*8
1050 ON J GOSUB 1300,1330,1350,1380,1400,1430,1450
1120 IF SM=3 THEN plot X*2,Y*2,C ELSE plot X,Y*2,C
1130 D=D+DX/RX
1140 X=X+1:IF X<RX THEN GOTO 880:REM NEXT X
1150 E=E+DY/RY
1160 Y=Y+1:IF Y<RY THEN GOTO 860:REM NEXT Y
1170 GOSUB 450:GOTO 1480
1180 REM -- COLOR SELECTION AND DITHERING --
1190 REM -- WHITE STRIP --
1200 C=1:RETURN
1210 REM -- WHITE-BLACK PATTERN --
1220 IF (X AND 1)=(Y AND 1) THEN C=1
1230 RETURN
1240 REM -- WHITE-BLACK NTSC LINES --
1250 IF (X AND 1)=0 THEN C=1
1260 RETURN
1270 REM -- BLACK-WHITE NTSC LINES --
1280 IF (X AND 1)<>0 THEN C=1
1290 RETURN
1300 REM -- GREEN-YELLOW PATTERN --
1310 IF (X AND 1)=(Y AND 1) THEN C=3 ELSE C=1
1320 RETURN
1330 REM -- YELLOW --
1340 C=1:RETURN
1350 REM -- YELLOW-RED PATTERN --
1360 IF (X AND 1)=(Y AND 1) THEN C=1 ELSE C=2
1370 RETURN
1380 REM -- RED --
1390 C=2:RETURN
1400 REM -- RED-BLUE PATTERN --
1410 IF (X AND 1)=(Y AND 1) THEN C=2 ELSE C=0
1420 RETURN
1430 REM -- BLUE --
1440 C=0:RETURN
1450 REM -- BLUE-GREEN PATTERN --
1460 IF (X AND 1)=(Y AND 1) THEN C=0 ELSE C=3
1470 RETURN
1480 REM -- SAVE IMAGE MENU --
1600 IF FT=1 THEN SAVE"MANDELBR",b,VM,&3fff,VM ELSE SAVE"JULIA",b,VM,&3fff,VM
1610 GOTO 10



Julia render seems to work ok, but there is a mistake in the formula computation. I'll try to fix it too.

SRS

Very nice :)

And it uses a new MODE for CPC - the CGA1.

C
olorfulGrafikAdvanced Mode 1 with 320x200 Pixel in 8 Colors :)  instead of 4. Ha ! In BASIC.


robcfg

Fixed Julia!


[attach=2][attach=3]


The Z*Z optimization is nice but you left the z2 and i2 vars set to 0 instead of the right values  ;)


Here's the code:


10 REM K3 FRACTALS FOR THE DRAGON COMPUTER
20 REM BY ROBCFG WITH HELP OF HABI AND SYX
25 REM Patched to AMSTRAD CPC by SRS
30 GOSUB 430
40 FT=0:SM=0:PA=0:FX=0:F2=0:FY=0:NI=0:MI=0:C=0:X=0:Y=0
50 VM=&c000:RX=320:RY=200:MX=0:MY=0:DX=0:DY=0
60 PRINT"PLEASE CHOOSE A FRACTAL TYPE:":PRINT
70 PRINT"<1> MANDELBROT"
80 PRINT"<2> JULIA":PRINT
90 INPUT"FRACTAL TYPE";FT
100 GOSUB 430
110 PRINT "PLEASE CHOOSE A SCREEN MODE:":PRINT
120 PRINT"<1> 320X200 4 COLORS"
130 PRINT"<2> 640X200 2 COLORS":PRINT
140 INPUT"SCREEN MODE";SM:SM=SM+2:IF SM=4 THEN RX=640
150 GOSUB 430
160 PRINT"PLEASE CHOOSE A COLOR PALETTE:":PRINT
170 IF SM=4 THEN GOTO 230
180 REM -- 4 COLOR PALETTE --
190 PRINT"<1> RED,GREEN,YELLOW,BLUE"
200 PRINT"<2> ORANGE,BUFF,CYAN,MAGENTA":PRINT
210 GOTO 260
220 REM -- 2 COLOR PALETTE --
230 PRINT"<1> GREEN,BLACK"
240 PRINT"<2> BUFF,BLACK"
250 IF SM<>4 THEN PRINT ELSE PRINT"<3> NTSC ARTIFACTS":PRINT
260 INPUT"COLOR PALETTE";PA:PA=PA-1:PRINT
270 GOSUB 430
280 IF FT=1 THEN PRINT"FOR FULL MANDELBROT USE":PRINT"X1=-2.4,X2=1.04,Y1=-1.3"
290 IF FT=2 THEN PRINT"FOR FULL JULIA USE":PRINT"X1=-1.666,X2=1.666,Y1=-1.25"
300 PRINT
310 PRINT"ENTER X1 COORDINATE:":INPUT FX
320 PRINT"ENTER X2 COORDINATE:":INPUT F2
330 PRINT"ENTER Y1 COORDINATE:":INPUT FY
340 PRINT"ENTER ITERATIONS:":INPUT NI:MI=NI-1:GOSUB 430
350 DX=F2-FX:DY=DX*(RY/RX)*2:IF SM=3 THEN DY=DY/2
360 PRINT:PRINT"WHEN THE FRACTAL IS FINISHED,"
370 PRINT"PRESS A KEY TO CONTINUE.":PRINT
380 PRINT"YOU'LL BE ASKED TO SAVE":PRINT"YOUR IMAGE."
390 PRINT:PRINT"PRESS A KEY TO START.":GOSUB 460
400 MODE SM-2:IF PA=0 THEN ink 0,6:ink 1,18:ink 2,26:ink 3,1 ELSE ink 0,12:ink 1,13:ink 2,4:ink 3,16
410 CLS
420 ON FT GOTO 470,820
430 REM -- CLEAR SCREEN AND SHOW BANNER --
440 CLS:PRINT"      * K3 FRACTALS V1.0 *":PRINT:RETURN
450 REM -- WAIT FOR A KEY PRESS
460 IF INKEY$="" THEN GOTO 460 ELSE RETURN
470 REM -- MANDELBROT --
480 E=FY
490 Y=0:REM FOR Y=0 TO MY
500 D=FX
510 X=0:REM FOR X=0 TO MX
520 Z=0:I=0:A=0:z2=0:i2=0
530 S=(Z2)-(I2)+D:R=(2*I*Z)+E:Z=S:I=R:A=A+1:z2=z*z:i2=i*i
540 IF A<MI AND (Z2+I2)<4 THEN GOTO 530
550 IF SM=4 THEN C=0 ELSE C=3
560 IF A=MI THEN GOTO 760:REM EARLY OUT
570 IF SM=3 THEN GOTO 670:REM 4 COLOR PALETTE
580 IF PA=2 THEN GOTO 610
590 IF (A AND 1)=0 THEN GOSUB 1190 ELSE GOSUB 1210
600 GOTO 760
610 J=A AND 3
620 on J GOSUB 1190,1240,1190,1270
660 GOTO 760
670 K=(A/8)-INT(A/8)
680 J=K*8
690 ON J GOSUB 1300,1330,1350,1380,1400,1430,1450
760 IF SM=3 THEN plot X*2,Y*2,C ELSE plot X,Y*2,C
770 D=D+DX/RX:REM D=D+0.013437
780 X=X+1:IF X<RX THEN GOTO 520:REM NEXT X
790 E=E+DY/RY:REM E=E+0.013541
800 Y=Y+1:IF Y<RY THEN GOTO 500:REM NEXT Y
810 GOSUB 450:GOTO 1480
820 REM -- JULIA --
830 CR=-0.4:CI=0.6:MX=RX-1:MY=RY-1
840 E=FY
850 Y=0:REM FOR Y=0 TO MY
860 D=FX
870 X=0:REM FOR X=0 TO MX
880 Z=D:I=E:A=0:z2=Z*Z:i2=I*I
890 S=(Z2)-(I2)+CR:R=(2*I*Z)+CI:Z=S:I=R:A=A+1:i2=i*i:z2=z*z
900 IF A<MI AND (Z2+I2)<4 THEN GOTO 890
910 IF SM=4 THEN C=0 ELSE C=3
920 IF A=MI THEN GOTO 1120:REM EARLY OUT
930 IF SM=3 THEN GOTO 1030
940 IF PA=2 THEN GOTO 970
950 IF (A AND 1)=0 THEN GOSUB 1190 ELSE GOSUB 1210
960 GOTO 1120
970 J=A AND 3
980 ON J GOSUB 1190,1240,1190,1270
1020 GOTO 1120
1030 K=(A/8)-INT(A/8)
1040 J=K*8
1050 ON J GOSUB 1300,1330,1350,1380,1400,1430,1450
1120 IF SM=3 THEN plot X*2,Y*2,C ELSE plot X,Y*2,C
1130 D=D+(DX/RX)
1140 X=X+1:IF X<RX THEN GOTO 880:REM NEXT X
1150 E=E+(DY/RY)
1160 Y=Y+1:IF Y<RY THEN GOTO 860:REM NEXT Y
1170 GOSUB 450:GOTO 1480
1180 REM -- COLOR SELECTION AND DITHERING --
1190 REM -- WHITE STRIP --
1200 C=1:RETURN
1210 REM -- WHITE-BLACK PATTERN --
1220 IF (X AND 1)=(Y AND 1) THEN C=1
1230 RETURN
1240 REM -- WHITE-BLACK NTSC LINES --
1250 IF (X AND 1)=0 THEN C=1
1260 RETURN
1270 REM -- BLACK-WHITE NTSC LINES --
1280 IF (X AND 1)<>0 THEN C=1
1290 RETURN
1300 REM -- GREEN-YELLOW PATTERN --
1310 IF (X AND 1)=(Y AND 1) THEN C=3 ELSE C=1
1320 RETURN
1330 REM -- YELLOW --
1340 C=1:RETURN
1350 REM -- YELLOW-RED PATTERN --
1360 IF (X AND 1)=(Y AND 1) THEN C=1 ELSE C=2
1370 RETURN
1380 REM -- RED --
1390 C=2:RETURN
1400 REM -- RED-BLUE PATTERN --
1410 IF (X AND 1)=(Y AND 1) THEN C=2 ELSE C=0
1420 RETURN
1430 REM -- BLUE --
1440 C=0:RETURN
1450 REM -- BLUE-GREEN PATTERN --
1460 IF (X AND 1)=(Y AND 1) THEN C=0 ELSE C=3
1470 RETURN
1480 REM -- SAVE IMAGE MENU --
1600 IF FT=1 THEN SAVE"MANDELBR",b,VM,&3fff,VM ELSE SAVE"JULIA",b,VM,&3fff,VM
1610 GOTO 10



Cheers,
Rob

SRS

#11
;)

P.S.: compiling with FABACOMgives 14k binary but not very much faster.(It uses firmware afaik for floating point calculation so ...)

AMSDOS

Did you want me to try and write something like that up in Pascal Rob?
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

robcfg

Sure! It should be quite straightforward to translate the code to Pascal and would be nice to see the performance increase.

Isn't it funny that the original code is the Mandelbrot one liner published here, ported to Dragon and back to CPC? :D

AMSDOS

Quote from: robcfg on 22:31, 21 October 16
Sure! It should be quite straightforward to translate the code to Pascal and would be nice to see the performance increase.


Actually, this code has beaten me to a pulp. I don't know how to write it structurally.  :'(


QuoteIsn't it funny that the original code is the Mandelbrot one liner published here, ported to Dragon and back to CPC? :D


Greetings Dragon users.  :)
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

litwr

#15
I am a bit confused by a fact of impossibility to convert the Basic code from the initial post to Pascal or even modern Basic.  So the modern programming languages lost some power of their ancestors...  RESUME NEXT may also be added to the list of the lost Basic features.
It is curious to have an interactive Mandelbrot builder in ML.  A BBC Micro enthusiast has just made one.  It draws a screen in about 2 minutes.

AMSDOS

Quote from: litwr on 17:00, 01 November 16
I am a bit confused by a fact of impossibility to convert the Basic code from the initial post to Pascal or even modern Basic.  So the modern programming languages lost some power of their ancestors...  RESUME NEXT may also be added to the list of the lost Basic features.


I wouldn't go as far as to say it's impossible, but the problem I'm having here is writing it structurally, it's structurally complicated. Unfortunately this is not the 1st BASIC program I've stumbled over, I have tried to structurally write a Snow Flake Graphical program, unfortunately without any success.


The obvious solution is to throw away the structured principals and surrender to the GOTO command! In BASIC a GOTO can go anywhere, but in Pascal it cannot, labels have to be declared at the beginning of a PROCEDURE and GOTO is restricted to within a PROCEDURE.
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

SRS


AMSDOS


Thanks


I've done some hard work on the BASIC version to produce a Pascal version which looks similar to that Pascal Example on Rosetta code, but I haven't been able to created that rendered effect to make it look more colourful.


The problem I think is in Turbo Pascal you can have an "arithmetic and" or a "logical and". Locomotive BASIC also allows arithmetic or logical and to produce that result. Hisoft Pascal on the other hand only allows "logical and", but it maybe possible to code some inline m/c function, though I'm unsure.


In assembly there is:


and <data> - which takes what's in the Accumulator and the data & puts the result in the Accumulator
and reg - as above, but involves the specified register and the Accumulator and puts the result in the Accumulator.
and (hl) - which takes the contents of HL with the contents of the Accumulator and returns a result in the Accumulator.


In the BASIC something like this is carried out:


IF (x and 1)=(y and 1) THEN C=3 ELSE C=1


unfortunately I'm unsure how that can be applied in Hisoft Pascal. x & y are Integers, so I'm wondering if the arithmetic and operates differently from the Assembly AND instructions?
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

robcfg

You can try to use the modulus operation to achieve the result of:
QuoteIF (x and 1)=(y and 1) THEN C=3 ELSE C=1


That line basically says that if x and y are both even, then the color is 3, 1 otherwise.


In C++ it would be:
Quoteif( (x%2 == 1) && (y%2 == 1) )
    c = 3;
else
    c = 1;


Using arithmetic and would be faster than modulus though.

AMSDOS

Hmm ok. There's a function in pascal called ODD that can be used in a similar fashion I think.
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

AMSDOS

Okay so earlier I went through the BASIC Mandelbrot which was posted in here, but I've stripped it right back, no menu, no Julia Set and just a set bunch of values, which gave me this structured routine:




40 FT=1:SM=3:PA=0:FX=0:F2=0:FY=0:NI=0:MI=0:C=0:X=0:Y=0
50 RX=320:RY=200:DX=0:DY=0
60 MODE 1:INK 0,6:INK 1,18:INK 2,26:INK 3,1
70 FX=-2.4:F2=1.04:FY=-1.3:NI=16:MI=NI-1
80 DX=F2-FX:DY=DX*(RY/RX)*2:IF SM=3 THEN DY=DY/2
480 E=FY
490 Y=0
495 WHILE Y<RY
500   D=FX
510   X=0:REM FOR X=0 TO MX
515   WHILE X<RX
516 LOCATE 1,1:PRINT (Z2+I2)
520     Z=0:I=0:A=0:z2=0:i2=0
525     WHILE ((A<MI)) AND ((Z2+I2)<4)
530       S=(Z2)-(I2)+D:R=(2*I*Z)+E:Z=S:I=R:A=A+1:z2=z*z:i2=i*i
540     WEND
550     IF SM=4 THEN C=0 ELSE C=3
570       IF SM=3 THEN GOSUB 2000:REM 4 COLOR PALETTE
590   '    IF (A AND 1)=0 THEN GOSUB 1190 ELSE GOSUB 1210
770     D=D+DX/RX:REM D=D+0.013437
780     X=X+1
785     WEND
790   E=E+DY/RY:REM E=E+0.013541
800   Y=Y+1
805   WEND
810 END
1190 REM -- WHITE STRIP --
1200 C=1:RETURN
1210 REM -- WHITE-BLACK PATTERN --
1220 IF (X AND 1)=(Y AND 1) THEN C=1
1230 RETURN
1300 REM -- GREEN-YELLOW PATTERN --
1310 IF (X AND 1)=(Y AND 1) THEN C=3 ELSE C=1
1320 RETURN
1330 REM -- YELLOW --
1340 C=1:RETURN
1350 REM -- YELLOW-RED PATTERN --
1360 IF (X AND 1)=(Y AND 1) THEN C=1 ELSE C=2
1370 RETURN
1380 REM -- RED --
1390 C=2:RETURN
1400 REM -- RED-BLUE PATTERN --
1410 IF (X AND 1)=(Y AND 1) THEN C=2 ELSE C=0
1420 RETURN
1430 REM -- BLUE --
1440 C=0:RETURN
1450 REM -- BLUE-GREEN PATTERN --
1460 IF (X AND 1)=(Y AND 1) THEN C=0 ELSE C=3
1470 RETURN
2000 K=(A/8)-INT(A/8)
2010 J=K*8
2020 ON J GOSUB 1300,1330,1350,1380,1400,1430,1450
2025 PLOT X*2,Y*2,C
2030 RETURN



I had a few goes trying to get this to run in Hisoft Pascal, as I posted earlier the trouble with the arithmetic AND. I've overcome that problem by setting up two Boolean types (rst1 & rst2), and as I mentioned in my previous post I've used odd to determine if "xpos" or "ypos" are odd numbers. Once I've tested those I can test if rst1 & rst2 are the same to alternate the colours. My first result was close to the original BASIC but lacked the Dark Blue in the Mandelbrot as this screenshot shows:


[attach=2]


In the BASIC it has another IF, so IF SM=4 THEN C=0 ELSE C=3, in my Pascal program SM always equals 3, which I defined as a CONSTant, so have just put col:=3; in the appropriate spot which gets me the right result:


[attach=3]


So here's the Pascal code I came up with:




   10 PROGRAM Mandelbrot;
   20
   30 CONST ft=1; sm=3; pa=0; mi=15; ni=16;
   40       fx=-2.4; f2=1.04; fy=-1.3;
   50       rx=320; ry=200;
   60
   70 PROCEDURE mode(num : integer);
   80 BEGIN
   90   ra:=chr(num);
  100   user(#bc0e)
  110 END;
  120
  130 PROCEDURE ink(num,col1 : integer);
  140 BEGIN
  150   ra:=chr(num);
  160   rb:=chr(col1);
  170   rc:=chr(col1);
  180   user(#bc32)
  190 END;
  200
  210 PROCEDURE border(col : integer);
  220 BEGIN
  230   rb:=chr(col);
  240   rc:=chr(col);
  250   user(#bc38)
  260 END;
  270
  280 PROCEDURE plot(xpos,ypos,col : integer);
  290 BEGIN
  300   ra:=chr(col);
  310   user(#bbde);
  320   rde:=xpos;
  330   rhl:=ypos;
  340   user(#bbea)
  350 END;
  360
  370 PROCEDURE drawbolt;
  380 VAR xpos : integer;
  390     ypos : integer;
  400     col  : integer;
  410     dx   : real;
  420     dy   : real;
  430     d    : real;
  440     a    : integer;
  450     s    : real;
  460     z2   : real;
  470     z    : real;
  480     i2   : real;
  490     i    : real;
  500     e    : real;
  510     k    : real;
  520     j    : integer;
  530     r    : real;
  540     rst1 : boolean;
  550     rst2 : boolean;
  560 BEGIN
  570   dx:=0.0; dy:=0.0;
  580   dx:=f2-fx;
  590   dy:=dx*(ry/rx)*2;
  600   dy:=dy/2;
  610   e:=fy;
  620   ypos:=0;
  630   WHILE ypos<ry DO
  640   BEGIN
  650     d:=fx;
  660     xpos:=0;
  670     WHILE xpos<rx DO
  680     BEGIN
  690       z:=0.0; i:=0.0; a:=0; z2:=0.0; i2:=0.0;
  700       WHILE ((a<mi)) AND ((z2+i2)<4.0) DO
  710       BEGIN
  720         s:=(z2)-(i2)+d;
  730         r:=(2*i*z)+e;
  740         z:=s;
  750         i:=r;
  760         a:=a+1;
  770         z2:=z*z;
  780         i2:=i*i
  790       END;
  800       col:=3;
  810       rst1:=odd(xpos);
  820       rst2:=odd(ypos);
  830       k:=(a/8)-trunc(a/8);
  840       j:=entier(k*8);
  850       CASE j OF
  860        1   : IF (rst1=rst2) THEN col:=1 ELSE col:=3;
  870        2   : col:=1;
  880        3   : IF (rst1=rst2) THEN col:=2 ELSE col:=1;
  890        4   : col:=2;
  900        5   : IF (rst1=rst2) THEN col:=0 ELSE col:=2;
  910        6   : col:=0;
  920        7   : IF (rst1=rst2) THEN col:=3 ELSE col:=0
  930       END;
  940       plot(xpos*2,ypos*2,col);
  950       IF col=1 THEN col:=1 ELSE col:=1;
  960       d:=d+dx/rx;
  970       xpos:=xpos+1
  980       END;
  990     e:=e+dy/ry;
1000     ypos:=ypos+1
1010   END;
1020 END;
1030 BEGIN
1040 mode(1); border(6); ink(0,6); ink(1,18); ink(2,26); ink(3,1);
1050 drawbolt
1060 END.






* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

litwr

Quote from: AMSDOS on 02:08, 05 November 16
I wouldn't go as far as to say it's impossible, but the problem I'm having here is writing it structurally, it's structurally complicated. Unfortunately this is not the 1st BASIC program I've stumbled over, I have tried to structurally write a Snow Flake Graphical program, unfortunately without any success.

The obvious solution is to throw away the structured principals and surrender to the GOTO command! In BASIC a GOTO can go anywhere, but in Pascal it cannot, labels have to be declared at the beginning of a PROCEDURE and GOTO is restricted to within a PROCEDURE.
So we need to rewrite Basic sources at first.  It is impossible to work with unbalanced NEXT with the popular modern PL.
It is interesting, how much faster Pascal code is?
Color Mandelbrot is ok but higher resolution mono picture is ok too.  ;) BTW the mentioned program BBC Micro builds color Mandelbrot (184x272, 8 colors) with infinite zoom in feature.

AMSDOS

#23
Quote from: litwr on 16:19, 07 November 16
So we need to rewrite Basic sources at first.  It is impossible to work with unbalanced NEXT with the popular modern PL.
It is interesting, how much faster Pascal code is?
Color Mandelbrot is ok but higher resolution mono picture is ok too.  ;) BTW the mentioned program BBC Micro builds color Mandelbrot (184x272, 8 colors) with infinite zoom in feature.

Sorry I'm not quite following your comments at the moment.

There's a binary file on the attached DSk image you can run to see how fast it runs. Sorry I didn't include the BASIC version with it. It could possibly be made faster if some compiler operatives are used even. If you take the BASIC version, paste it into winape enable turbo mode and increase speed to 150% that will produce something close to the pascal version.


EDIT:I've done some rough stopwatch timings between the BASIC and Pascal programs I posted earlier, which roughly shows the BASIC took 3 hours 22 Minutes & 42 Seconds to complete. The translation to Pascal meant it was complete in 27 Minutes & 51 Seconds. But I suspect a BASIC compiler could even things up.


I don't think I'll ever get it down to 2 Minutes unless it's a screen dump, even my precompiled colour data one that is used by my earlier Turbo Pascal version isn't even that fast.
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

AMSDOS

Quote from: SRS on 21:20, 05 October 16
Well done :)

But: why monocolored in MODE 1 ?

I don't get why the very big (and slow) arrays are needed ? Maybe to late for me [attach=2] today ;)

Using 16 iterations per pixel, some y-symmetrics, four colors and saving 30 "empty" pixels left and right
a color mandel in 32 minutes.


I like this one and it's approach, but it took something like 1h24mins to complete, but that was in BASIC 1.0, unfortunately I didn't see the process complete itself, so I don't know if TIME was passing was being added, while the keypress routine was holding it there, though I checked it around the 40 minute mark and it was still drawing. Unsure. BASIC 1.1 would have improved the timing of it, though 32 minutes sounds awfully impressive improvement.


I'm just wondering on the back of the Mandelbrot is that Gap, in your code the plot that's plotting from the top for the ypos starts at 400 with a variable (which I don't remember what it's called) starts at 0. 398 is the very top line (400 is offscreen), just wondered if that was the fault causing that gap to occur? Unfortunately I didn't have time to test this.  :o
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Powered by SMFPacks Menu Editor Mod