TheGameCreators - CodeBase

Return to the CodeBase listing

Category: 3D Effects

Version: 1.0

Information

Uploaded: 30th May 2012 21:15

Modified: 30th May 2012 21:22

Author: Webber

Summary

Makes a random seamless terrain of islands. No media needed.

Full Description

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

`Project: Random Islands

`Author: The Game Guy

Rem Setup

set display mode 640,480,32

Set window layout 0,0,0

maximize window

set camera range 0,0.1,500

Sync on

sync rate 30

hide mouse

Randomize Timer()

R = 32 `Circle radius

Rem Creates an image for a sprite for creating the random terrain

for i = R to 1 step -1

ink rgb((255+255/R)-i*(255/R),(255+255/R)-i*(255/R),(255+255/R)-i*(255/R)),0

FillCircle(R,R,i)

next i

get image 1,0,0,R*2,R*2,1

cls `Clears the screen

Rem Creates a sprite for drawing a random terrain

sprite 1,0,0,1

set sprite 1,0,1

set sprite alpha 1,8

offset sprite 1,16,16

hide sprite 1

Rem Creates an image for a random terrain

Seem = 256 `The size of the image

for i = 1 to 512

x = rnd(Seem)

y = rnd(Seem)

for j = 1 to 10

scale sprite 1,15+rnd(30)

Ran = (rnd(1)+1)*128-1

set sprite diffuse 1,Ran,Ran,Ran

Ran1 = rnd(20) : Ran2 = rnd(20)

Rem Draws a seamless random terrain

paste sprite 1,x+Ran1,y+Ran2

paste sprite 1,x+Ran1+Seem,y+Ran2

paste sprite 1,x+Ran1-Seem,y+Ran2

paste sprite 1,x+Ran1,y+Ran2+Seem

paste sprite 1,x+Ran1,y+Ran2-Seem

paste sprite 1,x+Ran1+Seem,y+Ran2+Seem

paste sprite 1,x+Ran1-Seem,y+Ran2+Seem

paste sprite 1,x+Ran1-Seem,y+Ran2-Seem

paste sprite 1,x+Ran1+Seem,y+Ran2-Seem

next j

next i

delete sprite 1

get image 1,0,0,Seem,Seem,1 `Gets an image for creating the terrain

Rem Creates a texture based on the height values of the terrain

lock pixels

for x = 0 to 255

for y = 0 to 255

Num = RGBR(Point(x,y))

Rem Separate colors for the terrain

if Num < 45 `Underwater

Red = Num*3.222  `145 `65

Green = Num*2.444  `110 `60

Blue = Num*1.778  `80 `55

endif

if Num >= 45 `Sand

Ran = rnd(40)

Red = 210-Ran

Green = 170-Ran

Blue = 135-Ran

endif

if Num > 50 `Green

Red = 64+(Num-50)*9.8

Green = 100+(Num-50)*2.8+rnd(20)

Blue = 40+(Num-50)*6

endif

if Num > 60 `Top

Red = 162-(Num-60)*0.68

Green = 128+(Num-60)*0.08+rnd(20)

Blue = 100+(Num-60)*0.8

endif

dot x,y,rgb(Red,Green,Blue) `Replaces grey dot with colored dot

next y

next x

unlock pixels

get image 2,0,0,256,256,1 `Gets the terrain texture

Size = 64

Rem Create the terrain

for Matrix = 1 to 9

make matrix Matrix,Size,Size,Size,Size

Rem texture the matrix

Num = 2

Gosub Texture_Matrix

rem Update the matrix Height

Gosub Terrain_Matrix

next Matrix

Rem Make the terrain seamless

position matrix 2,0,0,Size

position matrix 3,0,0,-Size

position matrix 4,Size,0,0

position matrix 5,-Size,0,0

position matrix 6,Size,0,Size

position matrix 7,Size,0,-Size

position matrix 8,-Size,0,Size

position matrix 9,-Size,0,-Size

Rem Color for the water

dot 0,0,rgb(32,64,128) : get image 3,0,0,1,1,1

Rem A plain for the water

make object plain 1,Size*3,Size*3

pitch object down 1,90

position object 1,Size/2,1.4,Size/2

texture object 1,3

ghost object on 1,2

set object light 1,0

Rem Variables

Ang# = 0

Ang2# = 90

Zoom# = Size/2

Shift = 0

Matrix = 1

Water = 1

ViewMode = 0

`L      OOOOO  OOOOO  PPPPP

`L      O   O  O   O  P   P

`L      O   O  O   O  PPPPP

`L      O   O  O   O  P

`LLLLL  OOOOO  OOOOO  P

while inkey$() = "" `Exits when the user presses a key

Rem Show/Hide the water surface

if mouseclick() = 2

inc Water,1

if Water = 2 then Water = 0

if Water = 1

show object 1

else

hide object 1

endif

while mouseclick() = 2 : endwhile

endif

Rem Change the terrain surface

if mouseclick() = 1

inc Shift,1

if Shift = 3 then Shift = 0

for Matrix = 1 to 9

If Shift = 0

set matrix wireframe off Matrix

Num = 2 `Normal texture

Gosub Texture_Matrix

endif

if Shift = 1

Num = 1 `Grey texture

Gosub Texture_Matrix

endif

If Shift = 2 then set matrix wireframe on Matrix `Wireframe mode

next Matrix

while mouseclick() = 1 : endwhile

endif

Rem Change the cameras view

if mouseclick() = 4

inc ViewMode,1

if ViewMode = 2 then ViewMode = 0

while mouseclick() = 4 : endwhile

endif

Rem Get the input from the mouse

MMX = MouseMoveX() : MMY = MouseMoveY() : MMZ = MouseMoveZ()

Rem Adjust the cameras motion with the mouse

if ViewMode = 1

inc Ang#,MMX/4.0

if Ang# < 0 then inc Ang#,360

if Ang# > 360 then dec Ang#,360

inc Ang2#,MMY/4.0

if Ang2# > 89 then Ang2# = 89

if Ang2# < 0 then Ang2# = 0

dec Zoom#,MMZ/40.0

if Zoom# < 10 then Zoom# = 10

if Zoom# > 256 then Zoom# = 256

position camera 0,Size/2+sin(Ang#)*Zoom#*Cos(Ang2#),0,Size/2+cos(Ang#)*Zoom#*Cos(Ang2#)

point camera 0,Size/2,0,Size/2

position camera 0,Camera position x(0),Sin(Ang2#)*Zoom#,Camera position z(0)

point camera 0,Size/2,0,Size/2

else `Move the camera over an endless terrain

inc Z#,0.3

if Z# > 32 then dec Z#,64

inc X#,0.1

if X# > 32 then dec X#,64

rotate camera 0,35,0,0

Position Camera X#+32,5,Z#+32

endif

Rem Text

Center text 320,5,"Left Click to change terrain surface  :  Right Click to hide/show water"

Center text 320,20,"Middle Click to change camera view : Press a key to exit"

Text 7,460,"FPS: "+STR$(Screen fps())

sync

endwhile

end

Rem Texture the matrix

Texture_Matrix:

prepare matrix texture Matrix,Num,Size,Size

tc=1

for z=Size-1 to 0 step -1

x=0

while x<=Size-1

set matrix tile Matrix,x,z,tc

inc tc,1 : inc x,1

endwhile

next z

update matrix Matrix

return

Rem Create the terrain for the matrix

Terrain_Matrix:

Paste image 1,0,0

a#=wrapvalue(a#+1)

for z=0 to Size

for x=0 to Size

if z < Size and x < Size then set matrix height Matrix,x,z,point(x*4,-z*4+Size*4)/2000000.0

if z = Size or z = 0 then set matrix height Matrix,x,z,point(x*4,0)/2000000.0

if x = Size then set matrix height Matrix,x,z,point(0,-z*4+Size*4)/2000000.0

if x = Size and z = Size then set matrix height Matrix,x,z,point(0,0)/2000000.0

next x

next z

update matrix Matrix

return

Rem The Fill Circle Function

Function FillCircle(x as integer , y as integer , Size# as float )

LastX = -1

if Size# <= 28 then Num = 90  : N# = 0.5

if Size# > 28  and Size# <= 57  : Num = 180  : N# = 1.0 : endif

if Size# > 57  and Size# <= 114 : Num = 360  : N# = 2.0 : endif

if Size# > 114 and Size# <= 229 : Num = 720  : N# = 4.0 : endif

if Size# > 229 and Size# <= 458 : Num = 1440 : N# = 8.0 : endif

if Size# > 458 and Size# <= 916 : Num = 2880 : N# = 16.0 : endif

if Size# > 916 : Num = 5760 : N# = 32.0 : endif

for i = 1 to Num

if LastX <> cos(i/N#)*Size#+x and LastX >= 0 and LastX < Screen Width()+1 then box cos(i/N#)*Size#+x,-sin(i/N#)*Size#+y,cos(i/N#)*Size#+x+1,sin(i/N#)*Size#+y

CodeBase - Random Islands

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	Webber
CodeBase Entries:	14