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

                                    ` 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
LastX = cos(i/N#)*Size#+x
next i
endfunction