Code archives/3D Graphics - Effects/Under water distortion

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

Download source code

Under water distortion by Devils Child
(Posted 21 years ago)
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
(Posted 21 years ago)
Nice one!

evil_1_24
(Posted 21 years ago)
This is pretty cool

puki
(Posted 21 years ago)
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.

Devils Child
(Posted 21 years ago)
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
(Posted 21 years ago)
this is very nice

Subirenihil
(Posted 20 years ago)
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!

Devils Child
(Posted 20 years ago)
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


P.Weijtenburg
(Posted 20 years ago)
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
(Posted 19 years ago)
very good

jfk EO-11110
(Posted 19 years ago)
"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