Original
as seen in PCW March 1986 as program of the week
This commit is contained in:
parent
c5a70fabd5
commit
c505ca8c8d

@ 0,0 +1,473 @@


REM MacFractal (c) Jack Weber  October 1985


REM Plots fractal landscapes as a 3D grid by taking a random straight line


REM across the grid and raising (or lowering) all points to one side of the


REM line by one level step.


REM Full hiddenline removal.


REM Landscape may be flooded to any level.


REM Adjustable vertical scale.


REM Rotation in 90 degree steps in either direction.


REM


REM This program runs on a 128k or 512k Apple Macintosh under MS Basic.


REM Passing this program through the Basic Compressor utility gives a speed


REM increase of about 15%.


REM




GOSUB Initialise


REM Main program loop prints current generation number in its own window


REM then recalculates the grid and, if necessary, draws it




mainloop:


FOR g%=gs% TO gen%


WINDOW OUTPUT 3


CLS


CALL TEXTFONT(0)


PRINT USING "#####";g%;


GOSUB Calculate


IF (g% MOD plot%=0) OR (g%=gen%) THEN GOSUB Plot


NEXT


REM When all iterations done, offer user choice to continue or stop there


IF gen%>32000 THEN GOSUB Endless


WINDOW 2,,(20,280)(140,320),2


BUTTON 1,1," Finished",(10,2)(110,18),3


BUTTON 2,1," Continue", (10,20)(110,40),3


WHILE DIALOG(0)<>1: WEND


REM If "Finished" pressed hold display in endless loop


IF DIALOG(1)=1 THEN WINDOW CLOSE 2: GOSUB Endless


REM "Continue" pressed so increment generation counter and do 500 more gs%=gen$+1


gen%=gen%+500


WINDOW CLOSE 2


GOTO mainloop


END




Initialise:


REM Open main output window


WINDOW 1,"MacFractal",(5,40)(508,335),1


CLS


DIM c%(30,30), d%(30,30), poly%(12)


RANDOMIZE TIMER


REM Start with magnification=1, 1st generation and no flooding


magn!=1


gs%=1


flood%=0


REM Set up pattern array for shading flood water


FOR i%=0 TO 3


patt%(i%)=21930


NEXT


REM Open a window and enter size of grid and number of generations to be done


WINDOW 2,,(100,80)(400,170),2


CALL TEXTFONT(0)


xin:


CALL MOVETO(25,20)


INPUT "Enter extent of X axis (max 30)  ", xmax%


IF xmax%>30 OR xmax%<2 THEN BEEP: GOTO xin


yin:


CALL MOVETO(25,45)


INPUT "Enter extent of Y axis (max 30)  ", ymax%


IF ymax%>30 OR ymax%<2 THEN BEEP: GOTO yin


genin:


CALL MOVETO(25,70)


INPUT "Enter number of iterations  ", gen%


IF gen%>32000 OR gen%<1 THEN BEEP: GOTO genin


REM Close that window and open new one to enter frequency of plots


WINDOW CLOSE 2


WINDOW 2,,(100,100)(400,220),2


CALL TEXTFONT(0)


PRINT " How many iterations between plots?"


BUTTON 1,1,"1",(20,25)(65,50),3


BUTTON 2,1,"10",(155,25)(200,50),3


BUTTON 3,1,"50",(20,55)(70,80),3


BUTTON 4,1,"100",(155,55)(215,80),3


BUTTON 5,1,"Draw final surface only",(20,85)(220,110),3


WHILE DIALOG(0)<> 1: WEND


press%=DIALOG(l)


plot%=1


IF press%=2 THEN plot%=10


IF press%=3 THEN plot%=50


IF press%=4 THEN plot%=100


IF press%=5 THEN plot%=gen%


WINDOW CLOSE 2


REM Calculate screen coordinates of grid origin according to size of grid


REM but they could just as easily be fixed near the centre top of the screen


xo%=3342*xmax%


yo%=802*ymax%


REM Put plot manipulation options in menu bar


MENU 6,0,1,"Landscape"


MENU 6,1,1,"Rotate left"


MENU 6,2,1,"Rotate right"


MENU 6,3,1,"Magnify"


MENU 6,4,1,"Flood"


ON MENU GOSUB Menucheck


REM Advise user if initial iterations are likely to take a long time


IF plot%=1 AND (xmax%*ymax%)<400 GOTO ready


WINDOW 2,,(150,100)(350,190),4


PRINT: PRINT " Performing initial iteration";


IF plot%>1 THEN PRINT "s" ELSE PRINT"???"


CALL TEXTFONT(0)


PRINT: PRINT TAB(8);"Please wait"


ready:


REM Open small window to display generation number


WINDOW 3,,(10,50)(60,66),4


MENU ON


RETURN




Calculate:


MENU STOP


ortho%=0


REM Select two sides which fault line will cross


side%(1)=INT(RND*4)


side2:


side%(2)=INT(RND*4)


IF side%(2)=side%(1) GOTO side2


REM Pos subroutines select random positions where line will cross the sides


FOR i%= 1 TO 2


ON side%(i%)+1 GOSUB Pos1,Pos2,Pos3,Pos4


NEXT


REM Set flag if line parallel to Yaxis to avoid division by zero


IF xx%(1)=xx%(2) THEN ortho%=1 : GOTO skipover


REM Equation of straight line is y=m*x+k. Calculate m and k


m=(yy%(2)yy%(1))/(xx%(2)xx%(1))


k=yy%(l)m*xx%(1)


skipover:


REM Select whether points above line are to be raised or lowered


q%=INT(RND*2): IF q%=0 THEN q%=1


REM Check all grid points. If above line raise (or lower)


FOR x%=1 TO xmax%


REM First find y coordinate of the line at that value of x


yp%=INT(m*x%+k)


FOR y%=l TO ymax%


IF ortho%=0 AND y%>yp% THEN c%(x%,y%)=c%(x%,y%)+q%: GOTO nex


IF ortho%=1 AND x%>xx%(1) THEN c%(x%,y%)=c%(x%,y%)+q%


nex:


NEXT


NEXT


MENU ON


RETURN




Pos1:


xx%(i%)=1: yy%(i%)=INT(RND*ymax%)+1


RETURN




Pos2:


xx%(i%)=INT(RND*xmax%)+1: yy%(i%)=ymax%


RETURN




Pos3:


xx%(i%)=xmax%: yy%(i%)=INT(RND*ymax%)


RETURN




Pos4:


xx%(i%)=INT(RND*xmax%): yy%(i%)=1


RETURN




Plot:


MENU STOP


WINDOW CLOSE 2


WINDOW OUTPUT 1


CLS


REM Use separate plotting routines for flooding on or off


IF flood%=0 THEN GOSUB Dryplot ELSE GOSUB Floodplot


MENU ON


RETURN




Dryplot:


REM Scan all grid points


FOR x%= 1 TO xmax%


FOR y%= 1 TO ymax%


REM Calculate screen coordinates of first corner of grid square at (x%,y%)


x1%=xo%+(y%x%)*7


y1%=yo%INT(magn!*c%(x%,y%))+(x%+y%)*4


REM Then calculate screen coordinates of second corner at (y%1,y%)


x2%=x1%+7


y2%=yo%INT(magn!*c%(x%1,y%))+(x%1+y%)*4


REM Draw side of grid square parallel to Xaxis


REM First erase hiddenlines by drawing broad line in white


CALL PENSIZE(1,30): CALL PENMODE(11)


CALL MOVETO(x2%,y2%): CALL LINETO(x1%,y1%)


REM Then draw new line


IF x%>1 THEN LINE(x%,y1%)(x2%,y2%)


REM If end of row has been reached then second line riot needed so skip on


IF y%=ymax% GOTO loopdry


REM Draw side of grid square parallel to Vaxis


REM Calculate coordinates of 3rd corner at (x%,y%+1)


y3%=yo%INT (magn!*c%(x%,y%+1))+(x%+y%+1)*4


REM Erase hiddenlines as before


CALL LINETO(x2%,y3%)


REM Draw new line


LINE(x1%,y1%)(x2%,y3%)


loopdry:


NEXT


NEXT


REM Draw base of grid


CALL PENNORMAL


REM First find altitudes of the three visible corners


ca%=c%(xmax%,1): cb%=c%(xmax%,ymax%): cc%=c%(l,ymax%)


REM Then draw three vertical lines down from these corners


LINE(xo%+(1xmax%)*7,yo%+(xmax%+1)*4INT(magn!*ca%))STEP(0,30+INT(magn!*ca%))


LINE(xo%+(ymax%xmax%)*7,yo%+(xmax%+ymax%)*4INT(magn!*cb%))


STEP(0,30+INT(magn!*cb%))


LINE(xo%+(ymax%1)*7,yo%+(1+ymax%)*4INT(magn!*cc%))


STEP(0,30+INT(magn!*cc%))


REM Finally draw the two base lines


LINESTEP((1xmax%)*7,(xmax%1)*4)


LINESTEP((1ymax%)*7,(1ymax%)*4)


RETURN




Floodplot:


FOR x%= 1 TO xmax%


FOR y%=l TO ymax%


REM Check level to see if this point is flooded.


REM If it is, draw it at water level


IF c%(x%,y%)<ml% THEN ca%=ml% ELSE ca%=c%(x%,y%)


IF c%(x%1,y%)<ml% THEN cb%=ml% ELSE cb%=c%(x%1,y%)


REM Calculate coordinates and plot as for dry


x1%=xo%+(y%x%)*7


y1%=yo%INT(magn!*ca%)+(x%+y%)*4


x2%=x1%+7


y2%=yo%INT(magn!*cb%)+(x%1+y%)*4


CALL PENSIZE(1,30): CALL PENMODE(11)


CALL MOVETO(x2%,y2%): CALL LINETO(xl%,yl%)


IF x%>1 THEN LINE(xl%,y1%)(x2%,y2%)


IF y%=ymax% GOTO loopflood


IF c%(x%,y%+l)<ml% THEN cc%=ml% ELSE cc%=c%(x%,y%+l)


y3%=yo%INT(magn!*cc%)+(x%+y%+1)*4


CALL LINETO(x2%,y3%)


LINE(x1%,y1%)(x2%,y3%)


loopflood:


REM Shade any part of square which is flooded


GOSUB Shade


NEXT


NEXT


CALL PENNORMAL


REM Draw base as for dry


IF c%(xmax%,1)<ml% THEN ca%=ml% ELSE ca%=c%(xmax%,l)


IF c%(xmax%,ymax%)<ml% THEN cb%=ml% ELSE cb%=c%(xmax%,ymax%)


IF c%(l,ymax%)<ml% THEN cc%=ml% ELSE cc%=c%(l,ymax%)


LINE(xo%+(1xmax%)*7,yo%+(xmax%+l)*4INT(magn!*ca%))


STEP(0,30+INT(magn!*ca%))


LINE(xo%+(ymax%xmax%)*7,yo%+(xmax%+ymax%)*4INT(magn!*cb%))


STEP(0,30+INT(magn!*cb%))


LINE(xo%+(ymax%1)*7,yo%+(l+ymax%)*4INT(magn!*cc%))


STEP(0,30+INT(magn!*cc%))


LINESTEP((1xmax%)*7,(xmax% 1)*4)


LINESTEP((1ymax%)*7,(1ymax%)*4)


RETURN




Menucheck: A menu selection has been detected  find what it is


menunumber%=MENU(0)


IF menunumber%<>6 THEN RETURN


menuitem%=MENU(1)


ON menuitem% GOSUB Rotateleft,Rotateright, Magnify, Flood


RETURN




Rotateleft:


REM Rotate by reading c& array into dX array with axes interchanged


FOR x%=1 TO xmax%


FOR y%=l TO ymax%: d%(ymax%y%+1,x%)=c%(x%,y%): NEXT


NEXT


REM Then return rotated data to c% array


SWAP xmax%,ymax%


FOR x%=0 TO xmax%


FOR y%=1 TO ymax%: c%(x%,y%)=d%(x%,y%): NEXT


NEXT


GOSUB Plot


MENU


RETURN




Rotateright:


FOR x%=l TO xmax%


FOR y%=1 TO ymax%: d%(y%,xmax%x%+1)=c%(x%,y%): NEXT


NEXT


SWAP xmax%,ymax%


FOR x%=0 TO xmax%


FOR y%=0 TO ymax%: c%(x%,y%)=d%(x%,y%): NEXT


NEXT


GOSUB Plot


MENU


RETURN




Magnify:


REM Open window to enter desired vertical scale magnification


WINDOW 2,,(80,100)(420,220),2


CALL TEXTFONT(0)


PRINT SPC(4);"adjust vertical magnification as required"


REM Draw magnification selection bar


LINE(15,70)(325,90),,b


LINE(16,71)(324,89),,b


BUTTON 1,1,"OK",(240,25)(290,55),1


REM Put scale markings and labels onto selection bar


FOR i%=20 TO 320 STEP 20: LINE(1%,90)(i%,95): NEXT


CALL TEXTFONT(1)


CALL TEXTSIZE(9)


FOR i%=20 TO 320 STEP 100


CALL MOVETO(i%,108)


PRINT .5*(1+(i%20)/l00);


LINE(i%,95)(i%,100)


NEXT


REM Draw magnification pointer to show current magnification


REM allow it to move with the mouse until the OK button is pressed


LINE(20+(magn!.5)*200,72)STEP(0, 16)


WHILE DIALOG(0)<> 1


IF MOUSE(0)<>0 THEN GOSUB Mousemag


WEND


WINDOW CLOSE 2


REM Redraw grid with new magnification


GOSUB Plot


MENU


RETURN




Mousemag:


REM Find position of mouse, if it is within selection bar then move pointer


IF MOUSE(1)<15 OR MOUSE(1)>325 THEN RETURN


IF MOUSE(2)<70 OR MOUSE(2)>90 THEN RETURN


LINE(20+(magn!.5)*200,72)STEP(0,16),30


magn!=.5+((MOUSE(1)20)\20)/10


LINE(20+(magn!.5)*200,72)STEP(0,16)


RETURN




Flood:


REM Open a window


WINDOW 2,,(80,100)(420,220),2


PRINT: PRINT: PRINT SPC(14);"Calculating levels"


CALL TEXTFONT(0)


PRINT: PRINT SPC(16);"Please wait"


REM Find highest and lowest levels present within the array


min%=10000


max%=10000


FOR x%=1 TO xmax%


FOR y%=l TO ymax%


IF c%(x%,y%)<min% THEN min%=c%(x%,y%)


IF c%(x%,y%)>max% THEN max%=c%(x%,y%)


NEXT


NEXT


CLS


CALL TEXTFONT(1)


CALL TEXTSIZE(9)


REM Draw flood level selection bar


LINE(17,70)(323,90),,b


LINE(18,71)(322,89),,b


REM Put scale markings and labels on selection bar


div%(max%min%)\10: IF div%=0 THEN div%=l


FOR i%=min% TO max%


scalex%=20+(i%min%)*300/(max%min%)


IF i% MOD div%=0 OR i%=max% THEN LINE(scalex%,90)STEP(0,6)


IF i% MOD (div%*5)=0 OR i%=min% OR i%=max% THEN


CALL MOVETO(scalex%10,110): PRINT i%;


NEXT


CALL TEXTSIZE(12)


CALL TEXTFONT(0)


CALL MOVETO(50,50): PRINT "Select required water level";


BUTTON 1,1,"OK",(270,10)(320,40),1


level%=ml%min%


REM If Flood had been previously selected, the old level may now be outside


REM the present level range  adjust if necessary


IF flood%=0 OR level%<0 THEN level%=0


IF level%>max%min% THEN level%=max%min%


REM Draw pointer on selection bar to show current water level


REM allow it to move with the mouse until the OK button is pressed


LINE(20+level%*300/(max%min%),72)STEP(0,16)


WHILE DIALOG(0)<>1


IF MOUSE(0)<>0 THEN GOSUB Mouseflood


WEND


ml%=min%+level%


REM Set flood flag if chosen flood level is not zero


IF level%>0 THEN flood%=1


WINDOW CLOSE 2


REM Redraw grid with new flood level


GOSUB Plot


MENU


RETURN




Mouseflood:


REM Find position of mouse, if it is within selection bar then move pointer


IF MOUSE(1)<20 OR MOUSE(1)>320 THEN RETURN


IF MOUSE(2)<70 OR MOUSE(2)>90 THEN RETURN


LINE(20+level%*300/(max%min%),72)STEP(0,16),30


level%=(MOUSE(1)20)/(300/(max%min%))


LINE(20+level%*300/(max%min%),72)STEP(0,16)


RETURN




Shade:


IF x%=1 OR y%>=ymax% THEN RETURN


REM Count number of corners in each grid square which are below flood level


corner%=0


maglev%=INT(magn!*ml%)


IF c%(x%,y%)<=ml% THEN corner%=l


IF c%(x%1,y%)<=ml% THEN corner%=corner%+1


IF c%(x%,y%+1)<=ml% THEN corner%=corner%+1


IF c%(x%1,y%+1)<=ml% THEN corner%=corner%+1


REM No shading if less than 3 corners are below flood level


IF corner%<3 THEN RETURN


REM Prepare array for Toolbox FILLPOLY subroutine


poly%(1)=yo%+(x%1+y%)*4maglev%


poly%(2)=xo%+(y%x%)*7


poly%(3)=poly%(1)+8


poly%(4)=poly%(2)+14


REM If 3 corners wet shade triangle. If all 4 wet shade whole square


IF corner%=3 THEN GOSUB Trishade ELSE GOSUB Squareshade


CALL FILLPOLY(VARPTR(poly%(0)),VARPTR(patt%(O)))


RETURN




Trishade:


poly%(0)=22


REM Find which of 4 possible triangles needs shading


IF c%(x%,y%)>ml% THEN GOSUB Tri1: RETURN


IF c%(x%1,y%)>ml% THEN GOSUB Tri2: RETURN


IF c%(x%,y%+1)>ml% THEN GOSUB Tri3: RETURN


GOSUB Tri4


RETURN




Tri1:


poly%(5)=poly%(l)


poly%(6)=poly%(2)+7


poly%(7)=poly%(3)


poly%(8)=poly%(6)


poly%(9)=poly%(1)+4


poly%(10)=poly%(4)


poly%(2)=poly%(6)


RETURN




Tri2:


poly%(5)=poly%(l)+4


poly%(6)=poly%(2)


poly%(7)=poly%(3)


poly%(8)=poly%(2)+7


poly%(9)=poly%(5)


poly%(10)=poly%(4)


poly%(l)=poly%(5)


RETURN




Tri3:


poly%(5)=poly%(1)+4


poly%(6)=poly%(2)


poly%(7)=poly%(l)


poly%(8)=poly%(2)+7


poly%(9)=poly%(5)


poly%(10)=poly%(4)


poly%(3)=poly%(5)


RETURN




Tri4:


poly%(5)=poly%(1)+4


poly%(6)=poly%(2)


poly%(7)=poly%(3)


poly%(8)=poly%(2)+7


poly%(9)=poly%(1)


poly%(10)=poly%(a)


poly%(4)=poly%(8)


RETURN




Squareshade:


poly%(0)=26


poly%(5)=poly%(1)+4


poly%(6)=poly%(2)


poly%(7)=poly%(3)


poly%(8)=poly%(2)+7


poly%(9)=poly%(5)


poly%(1O)=poly%(4)


poly%(11)=poly%(1)


poly%(12)=poly%(8)


RETURN




Endless:


WHILE 1<2: WEND


RETURN

Loading…
Reference in New Issue