Under water distortion

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

Under water distortion by bytecode77

2006

this is a fast and flexible code for creating under water distorcion

with initunderwatercam() you can set a value(the higher, the more is the underwatercam distorced!)

have fun :)

Graphics3D 1024, 768, 32, 2
SetBuffer BackBuffer()
SeedRnd MilliSecs()

;Globs(UDW = Under Water Distortion)
Global UWD_ProjPlane, UWD_Texture, UWD_Detail#, UWD_Sharpens#
Dim UWD_Vertex#(100, 100, 1)

;Camera
Cam = CreateCamera()
CameraClsColor Cam, 0, 0, 255
CameraFogMode Cam, True
CameraFogColor Cam, 0, 0, 255

;Light
RotateEntity CreateLight(), 45, 45, 0

;Some Cubes
For i = 1 To 100
	Cube = CreateCube()
	PositionEntity Cube, Rnd(-20, 20), Rnd(-20, 20), Rnd(10, 50)
	RotateEntity Cube, Rand(-180, 180), Rand(-180, 180), Rand(-180, 180)
	EntityColor Cube, Rand(0, 255), Rand(0, 255), Rand(0, 255)
Next

;Init
InitUnderWaterCam(1)

While Not KeyHit(1)
	UpdateUnderWaterCam(Cam)
	RenderWorld
	Flip
Wend
End

Function MipMapSize(x)
If x <= 16 Then Return 16
If x => 2048 Then Return 2048
If x => 1024 Then Return 1024
If x => 512 Then Return 512
If x => 256 Then Return 256
If x => 128 Then Return 128
If x => 64 Then Return 64
If x => 32 Then Return 32
If x => 16 Then Return 16
End Function

Function InitUnderWaterCam(Detail# = 1, sharpens# = 0)
If sharpens# = 0 Then sharpens# = MipMapSize(GraphicsHeight())
If Detail < 1 Or Detail > 20 Then RuntimeError "<Underwatercam> Detail must be between 1 and 20."
If sharpens# <> 16 And sharpens# <> 32 And sharpens# <> 64 And sharpens# <> 128 And sharpens# <> 256 And sharpens# <> 512 And sharpens# <> 1024 And sharpens# <> 2048 Then RuntimeError "<Underwatercam> Sharpens must be between 16 and 2048 and square(16, 32, 64, 128...)."
If sharpens# > GraphicsHeight() Then RuntimeError "<Underwatercam> Sharpens must not be bigger then the monitor height."
UWD_Sharpens# = sharpens#
UWD_Texture = CreateTexture(UWD_Sharpens#, UWD_Sharpens#)
UWD_ProjPlane = CreateMesh()
Surf = CreateSurface(UWD_ProjPlane)
For x = 0 To 4 * Detail
	For y = 0 To 3 * Detail
		UWD_Vertex(x, y, 0) = AddVertex(Surf, x, y, 0)
	Next
Next
For x = 0 To 4 * Detail
	For y = 0 To 3 * Detail
		AddTriangle Surf, UWD_Vertex(x, y, 0), UWD_Vertex(x, y + 1, 0), UWD_Vertex(x + 1, y, 0)
		AddTriangle Surf, UWD_Vertex(x + 1, y + 1, 0), UWD_Vertex(x + 1, y, 0), UWD_Vertex(x, y + 1, 0)
		UWD_Vertex(x, y, 1) = Rand(0, 360)
	Next
Next
PositionMesh UWD_ProjPlane, -2 * Detail, -1.5 * Detail, 0
ScaleMesh UWD_ProjPlane, 4.0 / Detail, -4.0 / Detail, 0
EntityTexture UWD_ProjPlane, UWD_Texture
EntityFX UWD_ProjPlane, 1
EntityOrder UWD_ProjPlane, -9999999999999999
UWD_Detail = Detail
End Function

Function UpdateUnderWaterCam(Cam)
For x = 0 To 4 * UWD_Detail
	For y = 0 To 3 * UWD_Detail
		UWD_Vertex(x, y, 1) = UWD_Vertex(x, y, 1) + 4
		VertexTexCoords GetSurface(UWD_ProjPlane, 1), UWD_Vertex(x, y, 0), x / 4.0 / UWD_Detail + Sin(UWD_Vertex(x, y, 1)) * .01 - .005, y / 4.0 / UWD_Detail + Cos(UWD_Vertex(x, y, 1)) * .01 - .005, 0
	Next
Next
PositionEntity UWD_ProjPlane, EntityX(Cam), EntityY(Cam), EntityZ(Cam)
RotateEntity UWD_ProjPlane, EntityPitch(Cam), EntityYaw(Cam), EntityRoll(Cam)
MoveEntity UWD_ProjPlane, 0, 0, 7.5
HideEntity UWD_ProjPlane
CameraViewport Cam, 0, 0, UWD_Sharpens#, UWD_Sharpens#
RenderWorld
CopyRect 0, 0, UWD_Sharpens#, UWD_Sharpens#, 0, 0, BackBuffer(), TextureBuffer(UWD_Texture)
ShowEntity UWD_ProjPlane
CameraViewport Cam, 0, 0, GraphicsWidth(), GraphicsHeight()
End Function

Comments

BlitzSupport

2006

Nice one!

evil_1_24

2006

This is pretty cool

puki

2006

This is quite good.

I was a bit dissapointed that I had to add my own code to swim around the cubes. However, I like it.

bytecode77

2006

well, to include this into a game you have only to initialise the uwd/inder water distortion) and to update it when the cam is under the water(hide the plane, when not under water!)

b32

2006

this is very nice

Subirenihil

2006

Change this:

While Not KeyHit(1)
	UpdateUnderWaterCam(Cam)
	RenderWorld
	Flip
Wend

To this:

While Not KeyHit(1)
	If KeyDown(200) Then MoveEntity cam,0,0,.1
	If KeyDown(203) Then TurnEntity cam,0,5,0
	If KeyDown(205) Then TurnEntity cam,0,-5,0
	If KeyDown(208) Then MoveEntity cam,0,0,-.1
	UpdateUnderWaterCam(Cam)
	RenderWorld
	Flip
Wend

And now you can move!

Nicely done Devils Child!

bytecode77

2007

thx :)
and while i have your attention, i just implemented a freelook function and blur

Graphics3D 1024, 768, 32, 2
SetBuffer BackBuffer()
SeedRnd MilliSecs()

;Globs(UDW = Under Water Distortion)
Global UWD_ProjPlane, UWD_Texture, UWD_Detail#, UWD_Sharpens#
Dim UWD_Vertex#(100, 100, 1)

;Camera
Cam = CreateCamera()
CameraClsColor Cam, 0, 0, 255
CameraFogMode Cam, True
CameraFogColor Cam, 0, 0, 255

;Light
RotateEntity CreateLight(), 45, 45, 0

;Some Cubes
For i = 1 To 100
	Cube = CreateCube()
	PositionEntity Cube, Rnd(-20, 20), Rnd(-20, 20), Rnd(10, 50)
	RotateEntity Cube, Rand(-180, 180), Rand(-180, 180), Rand(-180, 180)
	EntityColor Cube, Rand(0, 255), Rand(0, 255), Rand(0, 255)
Next

;Init
InitUnderWaterCam(3, 256)

MoveMouse GraphicsWidth() / 2, GraphicsHeight() / 2
FlushMouse()
While Not KeyHit(1)
	FreeLook(Cam, .1)
	UpdateUnderWaterCam(Cam, 2, 5)
	RenderWorld
	Flip
Wend
End

Function MipMapSize(x)
If x <= 16 Then Return 16
If x => 2048 Then Return 2048
If x => 1024 Then Return 1024
If x => 512 Then Return 512
If x => 256 Then Return 256
If x => 128 Then Return 128
If x => 64 Then Return 64
If x => 32 Then Return 32
If x => 16 Then Return 16
End Function

Function InitUnderWaterCam(Detail# = 1, sharpens# = 0)
If sharpens# = 0 Then sharpens# = MipMapSize(GraphicsHeight())
If Detail < 1 Or Detail > 20 Then RuntimeError "<Underwatercam> Detail must be between 1 and 20."
If sharpens# <> 16 And sharpens# <> 32 And sharpens# <> 64 And sharpens# <> 128 And sharpens# <> 256 And sharpens# <> 512 And sharpens# <> 1024 And sharpens# <> 2048 Then RuntimeError "<Underwatercam> Sharpens must be between 16 and 2048 and square(16, 32, 64, 128...)."
If sharpens# > GraphicsHeight() Then RuntimeError "<Underwatercam> Sharpens must not be bigger then the monitor height."
UWD_Sharpens# = sharpens#
UWD_Texture = CreateTexture(UWD_Sharpens#, UWD_Sharpens#)
UWD_ProjPlane = CreateMesh()
Surf = CreateSurface(UWD_ProjPlane)
For x = 0 To 4 * Detail
	For y = 0 To 3 * Detail
		UWD_Vertex(x, y, 0) = AddVertex(Surf, x, y, 0)
	Next
Next
For x = 0 To 4 * Detail
	For y = 0 To 3 * Detail
		AddTriangle Surf, UWD_Vertex(x, y, 0), UWD_Vertex(x, y + 1, 0), UWD_Vertex(x + 1, y, 0)
		AddTriangle Surf, UWD_Vertex(x + 1, y + 1, 0), UWD_Vertex(x + 1, y, 0), UWD_Vertex(x, y + 1, 0)
		UWD_Vertex(x, y, 1) = Rand(0, 360)
	Next
Next
PositionMesh UWD_ProjPlane, -2 * Detail, -1.5 * Detail, 0
ScaleMesh UWD_ProjPlane, 4.0 / Detail, -4.0 / Detail, 0
EntityTexture UWD_ProjPlane, UWD_Texture
EntityFX UWD_ProjPlane, 1
EntityOrder UWD_ProjPlane, -9999999999999999
UWD_Detail = Detail
End Function

Function UpdateUnderWaterCam(Cam, blur_quality = 0, blur_rad# = 0)
For x = 0 To 4 * UWD_Detail
	For y = 0 To 3 * UWD_Detail
		UWD_Vertex(x, y, 1) = UWD_Vertex(x, y, 1) + 4
		VertexTexCoords GetSurface(UWD_ProjPlane, 1), UWD_Vertex(x, y, 0), x / 4.0 / UWD_Detail + Sin(UWD_Vertex(x, y, 1)) * .01 - .005, y / 4.0 / UWD_Detail + Cos(UWD_Vertex(x, y, 1)) * .01 - .005, 0
	Next
Next
PositionEntity UWD_ProjPlane, EntityX(Cam), EntityY(Cam), EntityZ(Cam)
RotateEntity UWD_ProjPlane, EntityPitch(Cam), EntityYaw(Cam), EntityRoll(Cam)
MoveEntity UWD_ProjPlane, 0, 0, 7.5
HideEntity UWD_ProjPlane
CameraViewport Cam, 0, 0, UWD_Sharpens#, UWD_Sharpens#
RenderWorld
CopyRect 0, 0, UWD_Sharpens#, UWD_Sharpens#, 0, 0, BackBuffer(), TextureBuffer(UWD_Texture)
ShowEntity UWD_ProjPlane
CameraViewport Cam, 0, 0, GraphicsWidth(), GraphicsHeight()
HideEntity Cam
BlurTexture(UWD_Texture, blur_quality, blur_rad#)
ShowEntity Cam
End Function

Function BlurTexture(tex, quality, radius#)
Local blur_mesh[64]
If quality > 0 Then
	blur_cam = CreateCamera()
	CameraViewport blur_cam, 0, 0, TextureWidth(tex), TextureHeight(tex)
	CameraRange blur_cam, .1, 100
	CameraZoom blur_cam, 8
	RotateEntity blur_cam, 90, 0, 0
	PositionEntity blur_cam, 65536, 65536, 0
	TextureBlend tex, 2
	BlurRadius# = radius# / 256.0
	BlurAngleStep# = 360.0 / Float(quality * 4)
	For i = 0 To quality * 4 - 1
		blur_mesh[i] = CreateSprite()
		EntityTexture blur_mesh[i], tex
		EntityFX blur_mesh[i], 9
		EntityAlpha blur_mesh[i], 1.0 / Float(i + 1)
		ScaleSprite blur_mesh[i], 2, 2
		BlurAngle# = BlurAngleStep# * i + 180 * (i Mod 2)
		PositionEntity blur_mesh[i], 65536 + BlurRadius# * Cos(BlurAngle#), 65536 - 16, BlurRadius# * Sin(BlurAngle#)
	Next
	RenderWorld
	CopyRect 0, 0, TextureWidth(tex), TextureHeight(tex), 0, 0, BackBuffer(), TextureBuffer(tex)
	For i = 0 To quality * 4 - 1
		FreeEntity blur_mesh[i]
	Next
	FreeEntity blur_cam
EndIf
End Function

Global FreeLookXS#, FreeLookZS#, FreeLookRotXS#, FreeLookRotYS#
Function FreeLook(camera, sp# = .1)
If sp# > 0 Then
	FreeLookXS# = (FreeLookXS# + ((KeyDown(32) Or KeyDown(205)) - (KeyDown(30) Or KeyDown(203))) * sp#) * .75
	FreeLookZS# = (FreeLookZS# + ((KeyDown(17) Or KeyDown(200)) - (KeyDown(31) Or KeyDown(208))) * sp#) * .75
	MoveEntity camera, FreeLookXS#, 0, FreeLookZS#
EndIf
FreeLookRotXS# = ((MouseXSpeed() - FreeLookRotXS#) * .35 + FreeLookRotXS#) * .75
FreeLookRotYS# = ((MouseYSpeed() - FreeLookRotYS#) * .35 + FreeLookRotYS#) * .75
If EntityPitch(camera) + FreeLookRotYS# < -85 pitch# = -85 ElseIf EntityPitch(camera) + FreeLookRotYS# > 85 pitch# = 85 Else pitch# = EntityPitch(camera) + FreeLookRotYS#
yaw# = -FreeLookRotXS# + EntityYaw(camera)
RotateEntity camera, pitch#, yaw#, 0
MoveMouse GraphicsWidth() / 2, GraphicsHeight() / 2
End Function

Trader3564

2007

Very nice!!
1 more thing you could add is, that everything that comes close to the camera is not blurred.
Cause i can imagine people have better vision in front then 100 miles ahead (if any). Maybe zoom-motion-blur would be the idea.

blade007

2007

very good

jfk EO-11110

2007

"sharpens must not be bigger than the monitor height" is making me headache. I suggest to remove this limitation in order to allow the effect in pixelperfect quality, eg: allow 1024*1024 on a 1024*768 monitor, simply don't use the entire texture, and position the quad in a way that shows only the used texels.

Other than that it's great.

Code Archives Forum