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)