Code

Off[General::spell1];

(* Set up global variables and draw the button. *)
init[nn_]:= Module[{},
    n = nn;                                            (* size of map to generate; should be a power of 2 plus 1 *)
    initialHeight = 1.0 (n-1);                        (* arbitray choice *)
    terrain = Table[initialHeight,{n},{n}];            (* blank n by n map *)
    ];

(* Return a random number related to size *)
rand[size_]:= 2.0 Random[Real,{-size, size}];        (* ***** not sure what function this sould be *****  *)
    
(* Return the map value at the given point; if past map edges return the value at the edge *)
getTerrain[xx_, yy_]:= Module[{x=xx, y=yy},
    If[ x < 1 || x > n || y < 1 || y > n, Return[initialHeight]];
    Return[ terrain[[x,y]] ];
    ];

(* average of 4 cells in a square; input is bottom left and size of square *)
squareAverage[x_, y_, size_]:=
( terrain[[x,y]] + terrain[[x+size,y]] +
   terrain[[x,y+size]] + terrain[[x+size, y+size]] )/4.0;

(* average of 4 cells in a diamond; input is center and distance from center to vertex *)
diamondAverage[x_, y_, halfSize_]:=
( getTerrain[x, y+halfSize] + getTerrain[x, y-halfSize] +
   getTerrain[x+halfSize, y] + getTerrain[x-halfSize, y] )/4.0;

(* given the coordinates of the center of the diamond and the halfSize, set the terrain center accordingly *)
setDiamondCenter[x_, y_, halfSize_]:= terrain[[x,y]] = diamondAverage[x, y, halfSize] + rand[1.414 halfSize];

(* This was my second attempt:
    explicit loops, 1st over squares, then over diamods, at smaller and smaller scales. *)
doLoops := Module[{x,y,size,halfSize},
    size = n-1;
    While[ size > 1,
        halfSize = size/2;
        Do[
            (* Print[" x=",x, "; y=",y, "; size=",size]; *)   (* debugging *)
            terrain[[ x+halfSize, y+halfSize ]] = squareAverage[x,y,size] + rand[size],
            {x,1,n-1,size},
            {y,1,n-1,size}
            ];
    
        Do[
            setDiamondCenter[x+halfSize, y, halfSize];
            setDiamondCenter[x, y+halfSize, halfSize];
            setDiamondCenter[x+size, y+halfSize, halfSize];
            setDiamondCenter[x+halfSize, y+size, halfSize],
            {x,1,n-1,size},
            {y,1,n-1,size}
            ];
        size = halfSize;
        ];
    ];

(* This was my original attempt - which failed...
    Generate fractal terrain in terrain[[]] starting at (x,y) for square with given size.
   This routine is called recursively to generate the terrain at smaller and smaller scales.
   BUT IT GIVES ARTIFACTS ! *)
fractalTerrain[x_, y_, size_] := Module[{halfSize},
    If[ size==1, Return[] ];
    halfSize = size/2;
    terrain[[ x+halfSize, y+halfSize ]] = squareAverage[x,y,size] + rand[size];
    setDiamondCenter[x+halfSize, y, halfSize];
    setDiamondCenter[x, y+halfSize, halfSize];
    setDiamondCenter[x+size, y+halfSize, halfSize];
    setDiamondCenter[x+halfSize, y+size, halfSize];
    fractalTerrain[x, y, halfSize];
    fractalTerrain[x+halfSize, y, halfSize];
    fractalTerrain[x, y+halfSize, halfSize];
    fractalTerrain[x+halfSize, y+halfSize, halfSize];
    ];    
    
(* Show me what you got... *)
displayTerrain := Module[{},
    terrain = terrain / Max[terrain];
    Show[Graphics[Raster[terrain]], AspectRatio->1]; ListPlot3D[terrain];
    ];

(* THIS ONE DOESN'T WORK *)
(* fractalTerrain[1, 1, n-1]; *)

(* THIS ONE WORKS! *)
(* doLoops; *)


Created by Mathematica  (November 15, 2004)