As a teenager I owned an Amiga 500 – that’s actually how I started (seriously) programming. Oh, the Motorola 68000 CPU was just great to write code on.
One of the neat things about the Amiga community were the “demos” that would come out. Demos are like a music video for your computer with emphasis on creating real-time graphic effects.
They were all about pushing the boundaries of what the architecture could achieve – quite a lot like the Excel community really.
One of the demos that really stuck in my head was a fractal landscape / terrain generator. I was fascinated that a computer could draw realistic mountains.
I’ve always wanted to make one – just for fun – so recently I set about learning how.
It came as a surprise when I discovered that a terrain generator could be developed using only worksheet functions and a Surface Chart.
Here is a sample picture. It’s actually a Surface Chart! Every time you press F9 a new picture is generated.
You can download it from my website:
http://www.vangelder.co.nz/excel/
Amgia demo’s!!! lol, Jesus on e’s – classic, there’s a whole world of emulators out there now… good fun if you have the time!
The Amiga was an awesome computer and years ahead of its time. The OS was an excellent example of what could be done with such minimal resources.
One of the best Amiga demos I ever saw was Phenomena Enigma.
As for terrain generation, I remember an application called Vista Pro that capable of generating very realistic mountainous scenery.
Steve,
I agree – absolutely years ahead.
I’m still very passionate about that computer.
Copper, Blitter, 3D gfx, 4ch Audio built-in from the start. Not to mention Motorola 68000 – which is a dream to write on. I dont think any other computer has had it’s capabilities explored more than Amiga.
Enough of that – I’m ranting…
I saw on J-Walk Blog the other day about a scenery generator called Terragen
Rob
Check out Excel 3D mesh and OpenGL:
http://www.mynl.com/varview/home.html
Hi, i want this file but website offline, please a copy of workbook Excel Terrain
https://web.archive.org/web/20080508160343/http://vangelder.orconhosting.net.nz:80/
https://web.archive.org/web/20080923045220fw_/http://vangelder.orconhosting.net.nz:80/excel/Terrain.zip
Hi Dick Kusleika the link not working to download the file Terrain.zip
cheers
hi Dick, the terrain.zip file broken link, please new link to donwload terrain file.
I don’t have anything that was stored on Rob’s site. If you can’t get it from webarchive.org, it can’t be got.
Hi, i am need the email of Rob Van Gelder, please.
Hi Dick,
you have the terrain.zip Excel file? the link is broken, not have in WebArchive.
or you hva the email of Rob van Gelder or someone people have this Excel file?
thank you.
Flavio
It’s a real pitty that Rob’s site is down for a long time right now. He has posted several codes quite interesting. I could not get my hands on this, but for the sake of future users, here’s a procedure that can do nearly the same thing.
It’s based on [URL]https://stackoverflow.com/questions/39252967/diamond-square-algorithm-in-vba-to-run-in-excel[/URL] which was previously based on
[URL]https://cis.temple.edu/~lakamper/courses/cis350_2004/sources/matlabFractal/createFractalTerrain.m[/URL]
Without relaying on VBA, I think this posts of beeheap on steemit, which is very informative can produce the same only with Excel functions, that was the original Rob Von Gelder concept: [URL]https://steemit.com/map/@beeheap/create-a-fantasy-grid-map-in-excel[/URL]
[CODE]Option Explicit
Private Const gSize As Long = 129 ‘ define the size of the grid
Private TR(1 To gSize, 1 To gSize) As Double ‘ terrain grid
Public Sub sDiamondSquare_ProceduralTerrainGeneration()
‘ https://stackoverflow.com/questions/39252967/diamond-square-algorithm-in-vba-to-run-in-excel
‘ https://cis.temple.edu/~lakamper/courses/cis350_2004/sources/matlabFractal/createFractalTerrain.m
‘
‘ create fractal terrain by midpoint displacement (diamond square algorithm)
‘ the algorithm is prepared for pre-initialization of terrainpoints,
‘ i.e. some first steps could have been preinitialized to give a basic shape.
‘ the terrain is created iteratively: for every level the diamond step is
‘ performed first for the full terrain, then the square step is performed.
‘ input: tSize: size of terrain, (must be [(power of 2) + 1] –> (2^x)+1 ), e.g. 257
‘ startRandRange: defines the overall elevation. size/2 gives natural images
‘ roughness H: (between 0.0 and 1.0), where:
‘ H=0.9 returns a natural value
‘ H=0: max. roughness
‘ optional: terrain T: T can be a predefined terrain,
‘ i.e. every matrix entry ~= inf will NOT be altered.
‘ This allows for preshaped terrain building
‘ output: terrain T
Dim Target As Excel.Range
Dim tSize As Long
Dim StartRandRange As Double
Dim H As Double
Set Target = ActiveSheet.[a1]
tSize = gSize
StartRandRange = 64.5 ‘?
H = 0.9 ‘?
Call createFractalTerrain(Target, tSize, StartRandRange, H)
Call PlotSurface(Target)
End Sub
Private Sub PlotSurface(ByVal Target As Excel.Range)
‘ Paste a 3D surface chart
Dim oxlWsh As Excel.Worksheet
Dim oxlChrtObj As Excel.ChartObject
Dim oxlChrt As Excel.Chart
Dim oxlShp As Excel.Shape
With oxlWsh.Parent
Set Target = .Range(Target, Target.SpecialCells(xlLastCell))
Set oxlShp = .Shapes.AddChart2(307, xlSurfaceWireframe, 0, 0, 500, 1000)
Set oxlChrt = oxlShp.Chart
Set oxlChrtObj = oxlChrt.Parent
oxlChrt.SetSourceData source:=.Range(“‘” & Target.Parent.Name & “‘!” & Target.Address(True, True))
With oxlChrtObj
‘.Chart.PlotArea
‘.Chart.ChartArea
End With
With oxlShp
.Left = 0
.Top = 0
‘ Chart Dimension & Location setting:
‘.IncrementLeft -500
‘.IncrementTop -100
‘.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
‘.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
.ThreeD.RotationX = -100 ’10
.ThreeD.RotationY = -170 ‘
‘ Top view: X:0 Y=-90
‘.ThreeD.RotationX = 0
‘.ThreeD.RotationY = 0
.ThreeD.FieldOfView = 0 ‘ ranges 0 to 120
.ThreeD.Visible = msoFalse
End With
End With
End Sub
Private Function createFractalTerrain(ByVal Target As Excel.Range, _
ByVal gSize As Long, _
ByVal StartRandRange As Double, _
ByVal H As Double) As Variant
‘ Function creates fractal terrain by midpoint displacement (diamond square algorithm)
‘ Outputs a [tsize by tsize] matrix
Dim i As Long, j As Long
Dim randRange As Double
Dim tSize As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For i = 1 To gSize
For j = 1 To gSize
TR(i, j) = 10000
Next
Next
‘ Set extremes to zero??
TR(1, 1) = 0 ‘?
TR(1, gSize) = 0 ‘?
TR(gSize, 1) = 0 ‘?
TR(gSize, gSize) = 0 ‘?
tSize = gSize – 1
randRange = StartRandRange
‘Main Loop
While tSize > 1
Call diamondStep(tSize, randRange)
Call squareStep(tSize, randRange)
tSize = tSize / 2
randRange = randRange * (1 / (2 ^ H))
Wend
Target.Resize(gSize, gSize).Value2 = TR()
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Function
Private Sub diamondStep(ByVal tSize As Long, ByVal randRange As Double)
Dim Sh As Long
Dim maxIndex As Long ‘ size of terrain
Dim RowVal As Long, ColVal As Long ‘ the indices of each diamond’s centerpoint
Dim ValueH As Double
Dim Displacement As Double
Sh = tSize \ 2
maxIndex = UBound(TR, 1)
RowVal = 1 + Sh
ColVal = 1 + Sh
While RowVal < maxIndex
While ColVal < maxIndex
'Average height value of 4 cornerpoints
ValueH = TR(RowVal – Sh, ColVal – Sh) _
+ TR(RowVal – Sh, ColVal + Sh) _
+ TR(RowVal + Sh, ColVal – Sh) _
+ TR(RowVal + Sh, ColVal + Sh)
ValueH = ValueH / 4
'Displacement
Displacement = Int((1 – 0 + 1) * Rnd + 0) * randRange – randRange / 2
ValueH = ValueH + Displacement
'Set diamond point
If TR(RowVal, ColVal) = 10000 Then TR(RowVal, ColVal) = ValueH
'Next square in same row
ColVal = ColVal + tSize
Wend
'Next row
ColVal = 1 + Sh
RowVal = RowVal + tSize
Wend
End Sub
Private Sub squareStep(ByVal tSize As Long, ByVal randRange As Double)
Dim Sh As Long
Dim maxIndex As Long
Dim RowVal As Long
Dim ColVal As Long
Dim colStart As Long
Dim ValueH As Double
Dim Displacement As Double
Dim NOP As Double
Sh = tSize \ 2
maxIndex = UBound(TR, 1)
colStart = 1 + Sh
RowVal = 1
ColVal = colStart
While (RowVal <= maxIndex)
While (ColVal 1 Then
ValueH = ValueH + TR(RowVal – Sh, ColVal)
Else
NOP = NOP – 1
End If
‘east
If ColVal < maxIndex Then
ValueH = ValueH + TR(RowVal, ColVal + Sh)
Else
NOP = NOP – 1
End If
'south
If RowVal 1 Then
ValueH = ValueH + TR(RowVal, ColVal – Sh)
Else
NOP = NOP – 1
End If
‘displacement
Displacement = Int((1 – 0 + 1) * Rnd + 0) * randRange – randRange / 2
ValueH = ValueH / NOP + Displacement
‘set square point (if not predefined)
If TR(RowVal, ColVal) = 10000 Then TR(RowVal, ColVal) = ValueH
‘next diamond in same row
ColVal = ColVal + Sh
Wend
‘next row
‘the starting column alternates between 1 and sh
If colStart = 1 Then
colStart = Sh + 1
Else
colStart = 1
End If
ColVal = colStart
RowVal = RowVal + Sh
Wend
End Sub
[/CODE]
Enjoy!