Code archives/3D Graphics - Maths/Difference Clouds heightmap

This code has been declared by its author to be Public Domain code.

Download source code

Difference Clouds heightmap by Leadwerks
(Posted 18 years ago)
This is an implementation of the diamond-square fractal algorithm used to make difference clouds. A heightfield class was used for greater resolution. If BlitzMax had a PF_I16 format pixel map could be used. 
Strict

Type THeightField
	
	Field size
	Field height:Short[,]
	
	Function Create:THeightField(size)
		Local h:THeightfield=New THeightField
		Local height:Short[size,size]
		h.height=height
		h.size=size
		Return h
	EndFunction
	
	Method Copy:THeightField()
		Local h:THeightfield=New THeightField
		Local height:Short[size,size]
		Local x,y
		h.height=height
		h.size=size
		MemCopy h.height,height,size*size*2
		Return h
	EndMethod
	
	Method Blend(h:THeightfield,b#=0.5)
		Local x,y
		For x=0 To size-1
			For y=0 To size-1
				height[x,y]=height[x,y]*b+h.height[x,y]*(1.0-b)
			Next
		Next
	EndMethod
	
	Method Noise()
		Local x,y
		For x=0 To size-1
			For y=0 To size-1
				height[x,y]=Rand(65536)
			Next
		Next
	EndMethod
	
	Method Flatten(h#=0)
		Local x,y
		For x=0 To size-1
			For y=0 To size-1
				height[x,y]=h*65536
			Next
		Next
	EndMethod
	
	Method DiamondSquareFractal(blend#=0.5,featuresize#=64)
		Local x,y,res
		height[0,0]=Rand(0,65536)
		height[size-1,0]=Rand(0,65536)
		height[0,size-1]=Rand(0,65536)
		height[size-1,size-1]=Rand(0,65536)
		res=size
		Local iteration
		Local passes=1
		Local gridsize=size
		Repeat
			iteration:+1
			
			'Diamond
			For x=0 To passes-1
				For y=0 To passes-1
					DiamondFractal(x*(gridsize-1),y*(gridsize-1),res,blend,featuresize)
				Next
			Next
			
			'Square
			For x=0 To passes-1
				For y=0 To passes-1
					SquareFractal(x*(gridsize-1)+(res-1)/2,y*(gridsize-1),res,blend,featuresize)
					SquareFractal(x*(gridsize-1),y*(gridsize-1)+(res-1)/2,res,blend,featuresize)
					SquareFractal(x*(gridsize-1)+(res-1),y*(gridsize-1)+(res-1)/2,res,blend,featuresize)
					SquareFractal(x*(gridsize-1)+(res-1)/2,y*(gridsize-1)+(res-1),res,blend,featuresize)
				Next
			Next
			
			res=(res+1)/2
			passes:*2
			If res=2 Exit
			gridsize=(gridsize+1)/2
		Forever
	EndMethod

	Method DiamondFractal(x0,y0,d,blend#,featuresize#)
		Local hd,x1,y1
		x1=x0+d-1
		y1=y0+d-1
		hd=(d+1)/2
		Local i,avg#
		'Print x0+", "+y0+", "+x1+", "+y1
		Local distblend#=Min(Float(d)/featuresize,1.0)
		blend:*distblend
		
		height[x0+hd-1,y0+hd-1] = ( height[x0,y0] + height[x0,y1] + height[x1,y0] + height[x1,y1] ) / 4
	EndMethod
	
	Method SquareFractal(x0,y0,d,blend#,featuresize#)
		Local hd,x1,y1
		x1=x0+d-1
		y1=y0+d-1
		hd=(d-1)/2
		'Print x0+", "+y0+", "+x1+", "+y1
		Local i=0
		Local avg#=0.0
		
		If x0-hd=>0
			i:+height[x0-hd,y0]
			avg:+1
		EndIf

		If x0+hd<=size-1
			i:+height[x0+hd,y0]
			avg:+1
		EndIf

		If y0-hd=>0
			i:+height[x0,y0-hd]
			avg:+1
		EndIf

		If y0+hd<=size-1
			i:+height[x0,y0+hd]
			avg:+1
		EndIf
		
		Local distblend#=Min(Float(d)/featuresize,1.0)
		blend:*distblend
		height[x0,y0]=i/avg * (1.0 - blend) + Rand(65535) * blend
	EndMethod
	
	Method Multiply(m#)
		Local x,y
		For x=0 To size-1
			For y=0 To size-1
				height[x,y]:*m
			Next
		Next
	EndMethod
	
	Method ToPixmap:TPixmap()
		Local x,y,r
		Local p:TPixmap=CreatePixmap(size,size,PF_I8)
		For x=0 To size-1
			For y=0 To size-1
				r=height[x,y]/65536.0*255.0
				p.WritePixel x,y,r+(r Shl 8)+(r Shl 16)
			Next
		Next
		Return p
	EndMethod
	
	Method FromPixmap(pixmap:TPixmap)
		Local x,y,px,py
		For x=0 To size-1
			For y=0 To size-1
				px=Min(x,pixmap.width-1)
				py=Min(y,pixmap.height-1)			
				height[x,y]=((pixmap.ReadPixel(px,py) & $00FF0000) Shr 16)/255.0*65536
			Next
		Next
	EndMethod
	
EndType

Local h:THeightfield
h=THeightfield.Create(1025)
SeedRnd MilliSecs()
h.DiamondSquareFractal(1.0,256)

SavePixmapPNG h.topixmap(),"test.png"
OpenURL "test.png"