[RESOLVED] Help with simple PSET and looping
I'm trying to do a fairly crude (to start with) heightmap generator but unfortunately I'm not getting expected results :D
What I've tried to do is calculate a starting height for the first pixel and then the surrounding 8 pixels are set to a random height obtained by the average of the current pixel and the other pixel with a random number applied.
This way the heightmap blends together without too extreme differences. I'd have expected the final result to be a bit like the photoshop cloud effect.
But I've found that in the first few columns the value plotted onto a picture object can start at a height of 9000 and finish up around 2000.
Then from around the 10th column the rest of the map is just slight random variations of the start height.
Below is the code, can anyone see the problem, or suggest a better approach? I'm hoping to reach a fairly realistic final heightmap but it doesn't have to be too accurate.
Many thanks in advance.
Code:
Dim MyNHeight As Long
Dim MyHeight As Long, intCnt1 As Integer, intCnt2 As Integer, intCnt3 As Integer, intCnt4 As Integer
Randomize Timer
For intCnt1 = 1 To Picture1.Height - 1
For intCnt2 = 1 To Picture1.Width - 1
If intCnt1 = 1 And intCnt2 = 1 Then
MyHeight = Int(Rnd() * 2000) + 9000
Picture1.BackColor = MyHeight
Picture1.PSet (1, 1), MyHeight
Else
For intCnt3 = -1 To 1
For intCnt4 = -1 To 1
If intCnt3 <> 1 And intCnt4 <> 1 Then
MyNHeight = Picture1.Point(intCnt2 + intCnt3, intCnt1 + intCnt4)
MyNHeight = ((MyHeight + MyNHeight) / 2) + Int(Rnd() * 250 - 125)
If MyNHeight < 0 Then MyNHeight = 0
If MyNHeight > 20000 Then MyNHeight = 20000
Picture1.PSet (intCnt2 + intCnt3, intCnt1 + intCnt4), MyNHeight
End If
Next
Next
MyHeight = Picture1.Point(intCnt2, intCnt1)
End If
Next intCnt2
Next intCnt1
Re: Help with simple PSET and looping
Suggestion.
Build the starting pixels throughout the area, and then loop past each pixel of the area and if it is a pre-set pixel, set the randomised area around it.
I used this approach to build a 3D brick with a randomised pattern. I had a few white pixels randomly set, and then I iterate past each pixel, if I had a white one then i would place a different shade pixel (grey) randomly next to it building up a 3D effect. Then move on to the next pixel. Of course the blended coloured pixels are ignored as they are not white.
Re: Help with simple PSET and looping
Thanks. I had a similar idea to add enhanced features to the base "heightmap".
I think I've worked out in my mind how to fix the original problem.
For those interested, I'm just experimenting with an idea for a game I'm making. The heightmap will be for a planet, and then textured according to it's stats and basic assumptions (taking into account temperature (poles being colder then equator) and altitude).
Since the player can terraform worlds, I'm hoping this will produce an "accurate" visual representation of the terraforming process with ice caps and oceans growing/shrinking.
Then I can take this heightmap and with some code I've already got make it into a rotating sphere. Currently it just uses maths to turn it into a sphere, but it might look better if actually mapped to a Sphere 3D object (which I have no idea how to do :D )
I'll change the PSET command later to a faster function if this works great.
Re: Help with simple PSET and looping
Okay, I've tried a more simplier approach first which works as follows
X Y
Z
Value of Y and Z is the same as X but with a random value applied to it
Y then comes X, and a new Y and Z are calculated (i.e. we've moved one pixel along the image). It does 2 rows at a time, so when the next row is started, the start height is first set to Z.
After a bit of tweaking, I kinda get the result I'm after but it's very horizontal in the final results. I have a 2nd image that plots two different colours if the height is above and below a value, and instead of random blobs of colour, it's very stripey.
Any ideas what I'm doing wrong?
Code:
Dim MyNHeight As Long
Dim MyHeight As Long, intCnt1 As Integer, intCnt2 As Integer
Randomize Timer
For intCnt1 = 1 To Picture1.Height - 1 Step 2 'Step 2 since this calculates two rows of pixels at once
For intCnt2 = 1 To Picture1.Width - 1
If intCnt1 = 1 And intCnt2 = 1 Then
'MyHeight = Int(Rnd() * 2000) + 10000
MyHeight = 11000
Picture1.PSet (1, 1), MyHeight
Else
If intCnt2 = 1 Then
'If it's a start of a new row, obtain the height of the pixel on the row above
MyHeight = Picture1.Point(intCnt2, intCnt1 - 1)
Else
'Obtain the height of the current pixel
MyHeight = Picture1.Point(intCnt2, intCnt1)
End If
End If
MyNHeight = MyHeight + (Int(Rnd() * 2500) - 1250)
If MyNHeight < 0 Then MyNHeight = 0
If MyNHeight > 20000 Then MyNHeight = 20000
Picture1.PSet (intCnt2 + 1, intCnt1), MyNHeight
MyNHeight = MyHeight + (Int(Rnd() * 2500) - 1250)
If MyNHeight < 0 Then MyNHeight = 0
If MyNHeight > 20000 Then MyNHeight = 20000
Picture1.PSet (intCnt2, intCnt1 + 1), MyNHeight
Next intCnt2
Next intCnt1
Edit: I've replicated this approach in Excel and produced a landscape chart (of a much smaller area) and I'm getting the hortizontal stripes. Any insight would be appricated, but I'll keep playing with Excel until I establish the final product.
Edit: After mucking about in Excel, I've found a way that results in a diagonal result instead of horizontal, and if I make two images, flip one, and average the two I get the results I'm looking for. Just have to replicate this into VB now :D