diff --git a/pcfractal.bas b/pcfractal.bas new file mode 100644 index 0000000..c8b6927 --- /dev/null +++ b/pcfractal.bas @@ -0,0 +1,524 @@ +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