Nice one!
Code archives/3D Graphics - Effects/Under water distortion
This code has been declared by its author to be Public Domain code.
Download source code
| 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
This is pretty cool
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.
I was a bit dissapointed that I had to add my own code to swim around the cubes. However, I like it.
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!)
this is very nice
Change this:
And now you can move!
Nicely done Devils Child!
While Not KeyHit(1) UpdateUnderWaterCam(Cam) RenderWorld Flip WendTo 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!
thx :)
and while i have your attention, i just implemented a freelook function and blur
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
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.
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.
very good
"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.
Other than that it's great.