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 hidden-line 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 re-calculates 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 co-ordinates 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%=334-2*xmax%
  yo%=80-2*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 Y-axis 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 co-ordinate 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 co-ordinates 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 co-ordinates 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 X-axis
      REM First erase hidden-lines 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 V-axis
      REM Calculate co-ordinates of 3rd corner at (x%,y%+1)
      y3%=yo%-INT (magn!*c%(x%,y%+1))+(x%+y%+1)*4
      REM Erase hidden-lines 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%+(1-xmax%)*7,yo%+(xmax%+1)*4-INT(magn!*ca%))-STEP(0,30+INT(magn!*ca%))
  LINE(xo%+(ymax%-xmax%)*7,yo%+(xmax%+ymax%)*4-INT(magn!*cb%))-
    STEP(0,30+INT(magn!*cb%))
  LINE(xo%+(ymax%-1)*7,yo%+(1+ymax%)*4-INT(magn!*cc%))-
    STEP(0,30+INT(magn!*cc%))
  REM Finally draw the two base lines
  LINE-STEP((1-xmax%)*7,(xmax%-1)*4)
  LINE-STEP((1-ymax%)*7,(1-ymax%)*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 co-ordinates 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%+(1-xmax%)*7,yo%+(xmax%+l)*4-INT(magn!*ca%))-
    STEP(0,30+INT(magn!*ca%))
  LINE(xo%+(ymax%-xmax%)*7,yo%+(xmax%+ymax%)*4-INT(magn!*cb%))-
    STEP(0,30+INT(magn!*cb%))
  LINE(xo%+(ymax%-1)*7,yo%+(l+ymax%)*4-INT(magn!*cc%))-
    STEP(0,30+INT(magn!*cc%))
  LINE-STEP((1-xmax%)*7,(xmax%- 1)*4)
  LINE-STEP((1-ymax%)*7,(1-ymax%)*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 Re-draw 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 Re-draw 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%)*4-maglev%
  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