20 REM MacFractal (c) Jack Weber - October 1985 30 REM Plots fractal landscapes as a 3D grid by taking a random straight line 40 REM across the grid and raising (or lowering) all points to one side of the 50 REM line by one level step. 60 REM Full hidden-line removal. 70 REM Landscape may be flooded to any level. 80 REM Adjustable vertical scale. 90 REM Rotation in 90 degree steps in either direction. 100 REM 110 REM This program runs on a 128k or 512k Apple Macintosh under MS Basic. 120 REM Passing this program through the Basic Compressor utility gives a speed 130 REM increase of about 15%. 140 REM 160 GOSUB Initialise 170 REM Main program loop prints current generation number in its own window 180 REM then re-calculates the grid and, if necessary, draws it 200 mainloop: 210 FOR g%=gs% TO gen% 220 WINDOW OUTPUT 3 230 CLS 240 CALL TEXTFONT(0) 250 PRINT USING "#####";g%; 260 GOSUB Calculate 270 IF (g% MOD plot%=0) OR (g%=gen%) THEN GOSUB Plot 280 NEXT 290 REM When all iterations done, offer user choice to continue or stop there 300 IF gen%>32000 THEN GOSUB Endless 310 WINDOW 2,,(20,280)-(140,320),2 320 BUTTON 1,1," Finished",(10,2)-(110,18),3 330 BUTTON 2,1," Continue", (10,20)-(110,40),3 340 WHILE DIALOG(0)<>1: WEND 350 REM If "Finished" pressed hold display in endless loop 360 IF DIALOG(1)=1 THEN WINDOW CLOSE 2: GOSUB Endless 370 REM "Continue" pressed so increment generation counter and do 500 more gs%=gen$+1 380 gen%=gen%+500 390 WINDOW CLOSE 2 400 GOTO mainloop 410 END 490 Initialise: 500 REM Open main output window 510 WINDOW 1,"MacFractal",(5,40)-(508,335),1 520 CLS 530 DIM c%(30,30), d%(30,30), poly%(12) 540 RANDOMIZE TIMER 550 REM Start with magnification=1, 1st generation and no flooding 560 magn!=1 570 gs%=1 580 flood%=0 590 REM Set up pattern array for shading flood water 600 FOR i%=0 TO 3 610 patt%(i%)=21930 620 NEXT 630 REM Open a window and enter size of grid and number of generations to be done 640 WINDOW 2,,(100,80)-(400,170),2 650 CALL TEXTFONT(0) 660 xin: 670 CALL MOVETO(25,20) 680 INPUT "Enter extent of X axis (max 30) - ", xmax% 690 IF xmax%>30 OR xmax%<2 THEN BEEP: GOTO xin 700 yin: 710 CALL MOVETO(25,45) 720 INPUT "Enter extent of Y axis (max 30) - ", ymax% 730 IF ymax%>30 OR ymax%<2 THEN BEEP: GOTO yin 740 genin: 750 CALL MOVETO(25,70) 760 INPUT "Enter number of iterations - ", gen% 770 IF gen%>32000 OR gen%<1 THEN BEEP: GOTO genin 780 REM Close that window and open new one to enter frequency of plots 790 WINDOW CLOSE 2 800 WINDOW 2,,(100,100)-(400,220),2 810 CALL TEXTFONT(0) 820 PRINT " How many iterations between plots?" 830 BUTTON 1,1,"1",(20,25)-(65,50),3 840 BUTTON 2,1,"10",(155,25)-(200,50),3 850 BUTTON 3,1,"50",(20,55)-(70,80),3 860 BUTTON 4,1,"100",(155,55)-(215,80),3 870 BUTTON 5,1,"Draw final surface only",(20,85)-(220,110),3 880 WHILE DIALOG(0)<> 1: WEND 890 press%=DIALOG(l) 900 plot%=1 910 IF press%=2 THEN plot%=10 920 IF press%=3 THEN plot%=50 930 IF press%=4 THEN plot%=100 940 IF press%=5 THEN plot%=gen% 950 WINDOW CLOSE 2 970 REM Calculate screen co-ordinates of grid origin according to size of grid 980 REM but they could just as easily be fixed near the centre top of the screen 990 xo%=334-2*xmax% 1000 yo%=80-2*ymax% 1010 REM Put plot manipulation options in menu bar 1020 MENU 6,0,1,"Landscape" 1030 MENU 6,1,1,"Rotate left" 1040 MENU 6,2,1,"Rotate right" 1050 MENU 6,3,1,"Magnify" 1060 MENU 6,4,1,"Flood" 1070 ON MENU GOSUB Menucheck 1080 REM Advise user if initial iterations are likely to take a long time 1090 IF plot%=1 AND (xmax%*ymax%)<400 GOTO ready 1100 WINDOW 2,,(150,100)-(350,190),4 1110 PRINT: PRINT " Performing initial iteration"; 1120 IF plot%>1 THEN PRINT "s" ELSE PRINT"???" 1130 CALL TEXTFONT(0) 1140 PRINT: PRINT TAB(8);"Please wait" 1150 ready: 1160 REM Open small window to display generation number 1170 WINDOW 3,,(10,50)-(60,66),4 1180 MENU ON 1190 RETURN 1210 Calculate: 1220 MENU STOP 1230 ortho%=0 1240 REM Select two sides which fault line will cross 1250 side%(1)=INT(RND*4) 1260 side2: 1270 side%(2)=INT(RND*4) 1280 IF side%(2)=side%(1) GOTO side2 1290 REM Pos subroutines select random positions where line will cross the sides 1300 FOR i%= 1 TO 2 1310 ON side%(i%)+1 GOSUB Pos1,Pos2,Pos3,Pos4 1320 NEXT 1330 REM Set flag if line parallel to Y-axis to avoid division by zero 1340 IF xx%(1)=xx%(2) THEN ortho%=1 : GOTO skipover 1350 REM Equation of straight line is y=m*x+k. Calculate m and k 1360 m=(yy%(2)-yy%(1))/(xx%(2)-xx%(1)) 1370 k=yy%(l)-m*xx%(1) 1380 skipover: 1390 REM Select whether points above line are to be raised or lowered 1400 q%=INT(RND*2): IF q%=0 THEN q%=-1 1450 REM Check all grid points. If above line raise (or lower) 1460 FOR x%=1 TO xmax% 1470 REM First find y co-ordinate of the line at that value of x 1480 yp%=INT(m*x%+k) 1490 FOR y%=l TO ymax% 1500 IF ortho%=0 AND y%>yp% THEN c%(x%,y%)=c%(x%,y%)+q%: GOTO nex 1510 IF ortho%=1 AND x%>xx%(1) THEN c%(x%,y%)=c%(x%,y%)+q% 1520 nex: 1530 NEXT 1540 NEXT 1550 MENU ON 1560 RETURN 1580 Pos1: 1590 xx%(i%)=1: yy%(i%)=INT(RND*ymax%)+1 1600 RETURN 1620 Pos2: 1630 xx%(i%)=INT(RND*xmax%)+1: yy%(i%)=ymax% 1640 RETURN 1660 Pos3: 1670 xx%(i%)=xmax%: yy%(i%)=INT(RND*ymax%) 1680 RETURN 1700 Pos4: 1710 xx%(i%)=INT(RND*xmax%): yy%(i%)=1 1720 RETURN 1740 Plot: 1750 MENU STOP 1760 WINDOW CLOSE 2 1770 WINDOW OUTPUT 1 1780 CLS 1790 REM Use separate plotting routines for flooding on or off 1800 IF flood%=0 THEN GOSUB Dryplot ELSE GOSUB Floodplot 1810 MENU ON 1820 RETURN 1930 Dryplot: 1940 REM Scan all grid points 1950 FOR x%= 1 TO xmax% 1960 FOR y%= 1 TO ymax% 1970 REM Calculate screen co-ordinates of first corner of grid square at (x%,y%) 1980 x1%=xo%+(y%-x%)*7 1990 y1%=yo%-INT(magn!*c%(x%,y%))+(x%+y%)*4 2000 REM Then calculate screen co-ordinates of second corner at (y%-1,y%) 2010 x2%=x1%+7 2020 y2%=yo%-INT(magn!*c%(x%-1,y%))+(x%-1+y%)*4 2030 REM Draw side of grid square parallel to X-axis 2040 REM First erase hidden-lines by drawing broad line in white 2050 CALL PENSIZE(1,30): CALL PENMODE(11) 2060 CALL MOVETO(x2%,y2%): CALL LINETO(x1%,y1%) 2070 REM Then draw new line 2080 IF x%>1 THEN LINE(x%,y1%)-(x2%,y2%) 2090 REM If end of row has been reached then second line riot needed so skip on 2100 IF y%=ymax% GOTO loopdry 2110 REM Draw side of grid square parallel to V-axis 2120 REM Calculate co-ordinates of 3rd corner at (x%,y%+1) 2130 y3%=yo%-INT (magn!*c%(x%,y%+1))+(x%+y%+1)*4 2140 REM Erase hidden-lines as before 2150 CALL LINETO(x2%,y3%) 2160 REM Draw new line 2170 LINE(x1%,y1%)-(x2%,y3%) 2180 loopdry: 2190 NEXT 2200 NEXT 2210 REM Draw base of grid 2220 CALL PENNORMAL 2230 REM First find altitudes of the three visible corners 2240 ca%=c%(xmax%,1): cb%=c%(xmax%,ymax%): cc%=c%(l,ymax%) 2250 REM Then draw three vertical lines down from these corners 2260 LINE(xo%+(1-xmax%)*7,yo%+(xmax%+1)*4-INT(magn!*ca%))-STEP(0,30+INT(magn!*ca%)) 2270 LINE(xo%+(ymax%-xmax%)*7,yo%+(xmax%+ymax%)*4-INT(magn!*cb%))- 2280 STEP(0,30+INT(magn!*cb%)) 2290 LINE(xo%+(ymax%-1)*7,yo%+(1+ymax%)*4-INT(magn!*cc%))- 2300 STEP(0,30+INT(magn!*cc%)) 2310 REM Finally draw the two base lines 2320 LINE-STEP((1-xmax%)*7,(xmax%-1)*4) 2330 LINE-STEP((1-ymax%)*7,(1-ymax%)*4) 2340 RETURN 2410 Floodplot: 2420 FOR x%= 1 TO xmax% 2430 FOR y%=l TO ymax% 2440 REM Check level to see if this point is flooded. 2450 REM If it is, draw it at water level 2460 IF c%(x%,y%)1 THEN LINE(xl%,y1%)-(x2%,y2%) 2560 IF y%=ymax% GOTO loopflood 2570 IF c%(x%,y%+l)6 THEN RETURN 2840 menuitem%=MENU(1) 2850 ON menuitem% GOSUB Rotateleft,Rotateright, Magnify, Flood 2860 RETURN 2890 Rotateleft: 2900 REM Rotate by reading c& array into dX array with axes interchanged 2910 FOR x%=1 TO xmax% 2920 FOR y%=l TO ymax%: d%(ymax%-y%+1,x%)=c%(x%,y%): NEXT 2930 NEXT 2940 REM Then return rotated data to c% array 2950 SWAP xmax%,ymax% 2960 FOR x%=0 TO xmax% 2970 FOR y%=1 TO ymax%: c%(x%,y%)=d%(x%,y%): NEXT 2980 NEXT 2990 GOSUB Plot 3000 MENU 3010 RETURN 3030 Rotateright: 3040 FOR x%=l TO xmax% 3050 FOR y%=1 TO ymax%: d%(y%,xmax%-x%+1)=c%(x%,y%): NEXT 3060 NEXT 3070 SWAP xmax%,ymax% 3080 FOR x%=0 TO xmax% 3090 FOR y%=0 TO ymax%: c%(x%,y%)=d%(x%,y%): NEXT 3100 NEXT 3110 GOSUB Plot 3120 MENU 3130 RETURN 3150 Magnify: 3160 REM Open window to enter desired vertical scale magnification 3170 WINDOW 2,,(80,100)-(420,220),2 3180 CALL TEXTFONT(0) 3190 PRINT SPC(4);"adjust vertical magnification as required" 3200 REM Draw magnification selection bar 3210 LINE(15,70)-(325,90),,b 3220 LINE(16,71)-(324,89),,b 3230 BUTTON 1,1,"OK",(240,25)-(290,55),1 3240 REM Put scale markings and labels onto selection bar 3250 FOR i%=20 TO 320 STEP 20: LINE(1%,90)-(i%,95): NEXT 3260 CALL TEXTFONT(1) 3270 CALL TEXTSIZE(9) 3280 FOR i%=20 TO 320 STEP 100 3290 CALL MOVETO(i%,108) 3300 PRINT .5*(1+(i%-20)/l00); 3310 LINE(i%,95)-(i%,100) 3320 NEXT 3370 REM Draw magnification pointer to show current magnification 3380 REM allow it to move with the mouse until the OK button is pressed 3390 LINE(20+(magn!-.5)*200,72)-STEP(0, 16) 3400 WHILE DIALOG(0)<> 1 3410 IF MOUSE(0)<>0 THEN GOSUB Mousemag 3420 WEND 3430 WINDOW CLOSE 2 3440 REM Re-draw grid with new magnification 3450 GOSUB Plot 3460 MENU 3470 RETURN 3490 Mousemag: 3500 REM Find position of mouse, if it is within selection bar then move pointer 3510 IF MOUSE(1)<15 OR MOUSE(1)>325 THEN RETURN 3520 IF MOUSE(2)<70 OR MOUSE(2)>90 THEN RETURN 3530 LINE(20+(magn!-.5)*200,72)-STEP(0,16),30 3540 magn!=.5+((MOUSE(1)-20)\20)/10 3550 LINE(20+(magn!-.5)*200,72)-STEP(0,16) 3560 RETURN 3580 Flood: 3590 REM Open a window 3600 WINDOW 2,,(80,100)-(420,220),2 3610 PRINT: PRINT: PRINT SPC(14);"Calculating levels" 3620 CALL TEXTFONT(0) 3630 PRINT: PRINT SPC(16);"Please wait" 3640 REM Find highest and lowest levels present within the array 3650 min%=10000 3660 max%=-10000 3670 FOR x%=1 TO xmax% 3680 FOR y%=l TO ymax% 3690 IF c%(x%,y%)max% THEN max%=c%(x%,y%) 3710 NEXT 3720 NEXT 3730 CLS 3740 CALL TEXTFONT(1) 3750 CALL TEXTSIZE(9) 3760 REM Draw flood level selection bar 3770 LINE(17,70)-(323,90),,b 3780 LINE(18,71)-(322,89),,b 3790 REM Put scale markings and labels on selection bar 3800 div%(max%-min%)\10: IF div%=0 THEN div%=l 3850 FOR i%=min% TO max% 3860 scalex%=20+(i%-min%)*300/(max%-min%) 3870 IF i% MOD div%=0 OR i%=max% THEN LINE(scalex%,90)-STEP(0,6) 3880 IF i% MOD (div%*5)=0 OR i%=min% OR i%=max% THEN 3890 CALL MOVETO(scalex%-10,110): PRINT i%; 3900 NEXT 3910 CALL TEXTSIZE(12) 3920 CALL TEXTFONT(0) 3930 CALL MOVETO(50,50): PRINT "Select required water level"; 3940 BUTTON 1,1,"OK",(270,10)-(320,40),1 3950 level%=ml%-min% 3960 REM If Flood had been previously selected, the old level may now be outside 3970 REM the present level range - adjust if necessary 3980 IF flood%=0 OR level%<0 THEN level%=0 3990 IF level%>max%-min% THEN level%=max%-min% 4000 REM Draw pointer on selection bar to show current water level 4010 REM allow it to move with the mouse until the OK button is pressed 4020 LINE(20+level%*300/(max%-min%),72)-STEP(0,16) 4030 WHILE DIALOG(0)<>1 4040 IF MOUSE(0)<>0 THEN GOSUB Mouseflood 4050 WEND 4060 ml%=min%+level% 4070 REM Set flood flag if chosen flood level is not zero 4080 IF level%>0 THEN flood%=1 4090 WINDOW CLOSE 2 4100 REM Re-draw grid with new flood level 4110 GOSUB Plot 4120 MENU 4130 RETURN 4150 Mouseflood: 4160 REM Find position of mouse, if it is within selection bar then move pointer 4170 IF MOUSE(1)<20 OR MOUSE(1)>320 THEN RETURN 4180 IF MOUSE(2)<70 OR MOUSE(2)>90 THEN RETURN 4190 LINE(20+level%*300/(max%-min%),72)-STEP(0,16),30 4200 level%=(MOUSE(1)-20)/(300/(max%-min%)) 4210 LINE(20+level%*300/(max%-min%),72)-STEP(0,16) 4220 RETURN 4330 Shade: 4340 IF x%=1 OR y%>=ymax% THEN RETURN 4350 REM Count number of corners in each grid square which are below flood level 4360 corner%=0 4370 maglev%=INT(magn!*ml%) 4380 IF c%(x%,y%)<=ml% THEN corner%=l 4390 IF c%(x%-1,y%)<=ml% THEN corner%=corner%+1 4400 IF c%(x%,y%+1)<=ml% THEN corner%=corner%+1 4410 IF c%(x%-1,y%+1)<=ml% THEN corner%=corner%+1 4420 REM No shading if less than 3 corners are below flood level 4430 IF corner%<3 THEN RETURN 4440 REM Prepare array for Toolbox FILLPOLY subroutine 4450 poly%(1)=yo%+(x%-1+y%)*4-maglev% 4460 poly%(2)=xo%+(y%-x%)*7 4470 poly%(3)=poly%(1)+8 4480 poly%(4)=poly%(2)+14 4490 REM If 3 corners wet shade triangle. If all 4 wet shade whole square 4500 IF corner%=3 THEN GOSUB Trishade ELSE GOSUB Squareshade 4510 CALL FILLPOLY(VARPTR(poly%(0)),VARPTR(patt%(O))) 4520 RETURN 4540 Trishade: 4550 poly%(0)=22 4560 REM Find which of 4 possible triangles needs shading 4570 IF c%(x%,y%)>ml% THEN GOSUB Tri1: RETURN 4580 IF c%(x%-1,y%)>ml% THEN GOSUB Tri2: RETURN 4590 IF c%(x%,y%+1)>ml% THEN GOSUB Tri3: RETURN 4600 GOSUB Tri4 4610 RETURN 4630 Tri1: 4640 poly%(5)=poly%(l) 4650 poly%(6)=poly%(2)+7 4660 poly%(7)=poly%(3) 4670 poly%(8)=poly%(6) 4680 poly%(9)=poly%(1)+4 4690 poly%(10)=poly%(4) 4700 poly%(2)=poly%(6) 4710 RETURN 4810 Tri2: 4820 poly%(5)=poly%(l)+4 4830 poly%(6)=poly%(2) 4840 poly%(7)=poly%(3) 4850 poly%(8)=poly%(2)+7 4860 poly%(9)=poly%(5) 4870 poly%(10)=poly%(4) 4880 poly%(l)=poly%(5) 4890 RETURN 4910 Tri3: 4920 poly%(5)=poly%(1)+4 4930 poly%(6)=poly%(2) 4940 poly%(7)=poly%(l) 4950 poly%(8)=poly%(2)+7 4960 poly%(9)=poly%(5) 4970 poly%(10)=poly%(4) 4980 poly%(3)=poly%(5) 4990 RETURN 5010 Tri4: 5020 poly%(5)=poly%(1)+4 5030 poly%(6)=poly%(2) 5040 poly%(7)=poly%(3) 5050 poly%(8)=poly%(2)+7 5060 poly%(9)=poly%(1) 5070 poly%(10)=poly%(a) 5080 poly%(4)=poly%(8) 5090 RETURN 5110 Squareshade: 5120 poly%(0)=26 5130 poly%(5)=poly%(1)+4 5140 poly%(6)=poly%(2) 5150 poly%(7)=poly%(3) 5160 poly%(8)=poly%(2)+7 5170 poly%(9)=poly%(5) 5180 poly%(1O)=poly%(4) 5190 poly%(11)=poly%(1) 5200 poly%(12)=poly%(8) 5210 RETURN 5230 Endless: 5240 WHILE 1<2: WEND 5250 RETURN