set display mode 1024, 786, 32 sync on : sync rate 0 randomize timer() set camera range 0, 0.1, 10000 `Create media CreateGrassTex(2, 128, 128) CreateWaterTex(3, 128, 128) CreateSkyTex(4, 128, 128) CreateSmogTex(5, 128, 5000, rgb(255, 255, 255)) `Create world CreateHeightMap() CreateWorld(1, 10.0, 200.0) set object collision to polygons 1 texture object 1, 2 `Water make object plain 2, 10000, 10000 xrotate object 2, 90 texture object 2, 3 scale object texture 2, 100, 100 position object 2, 320, 10, -320 set alpha mapping on 2, 75 set object light 2, 0 make object plain 3, 150, 150 xrotate object 3, 90 texture object 3, 3 scale object texture 3, 1, 1 position object 3, 200, 80, -195 set alpha mapping on 3, 75 set object light 3, 0 `Waterfall make object cylinder 4, 100 rotate object 4, 90, 0, 0 : scale object 4, 80, 70, 125 set object cull 4, 1 : texture object 4, 3 scale object texture 4, 3, 1 position object 4, 280, 18.5, -205 set alpha mapping on 4, 75 set object cull 4, 0 `Waterfall particles type particle x# as float y# as float z# as float xs# as float ys# as float zs# as float life as integer endtype #constant SPart = 100 Dim WaterFall(50) as particle for i = 1 to 50 make object plain SPart + i, 5, 5 texture object SPart + i, 5 `set object light SPart + i, 0 ghost object on SPart + i next i `Sky make object sphere 5, 5000 set object cull 5, 0 texture object 5, 4 scale object texture 5, 1, 0.5 set object light 5, 0 `Create trees for i = 1 to 50 CreateTree(5 + i, 6) scale object 5 + i, 300, 300, 300 repeat x# = rnd(640) z# = -rnd(640) y# = 50.0 position object 5 + i, x#, y#, z# : col = object collision(5 + i, 1) position object 5 + i, x#, 0, z# : col = object collision(5 + i, 1) + col until col = 0 repeat y# = y# - 1.0 position object 5 + i, x#, y#, z# col = object collision(5 + i, 1) until col > 0 or y# <= 0.0 next i `waterfall wy# = 0 `initialize camera position camera 640, 100, -640 point camera 320, 0, -320 hide mouse do `Display data ink rgb(255, 255, 255), 0 text 0, 0, str$(statistic(1)) text 0, 20, str$(screen fps()) `handle waterfall scroll object texture 4, -0.01, 0 scroll object texture 3, -0.005, 0 for p = 1 to 50 HandleParticle(p) next p `Handle sea scroll object texture 2, 0, 0.0001 `Control camera AngX# = wrapvalue(camera angle x() + (mousemovey()*0.2)) AngY# = wrapvalue(camera angle y() + (mousemovex()*0.2)) rotate camera AngX#, AngY#, 0 if upkey() = 1 then move camera 0.5 if downkey() = 1 then move camera -0.5 sync loop `************************************ `Functions `************************************ function HandleParticle(p) `Get particle life if Waterfall(p).life > 0 `Handle particle Waterfall(p).x# = Waterfall(p).x# + Waterfall(p).xs# Waterfall(p).y# = Waterfall(p).y# + Waterfall(p).ys# Waterfall(p).z# = Waterfall(p).z# + Waterfall(p).zs# `Gravity Waterfall(p).ys# = Waterfall(p).ys# - 0.02 `Decrease particle life dec Waterfall(p).life else `Reset particle Waterfall(p).life = 50 + rnd(150) Waterfall(p).x# = 320 Waterfall(p).y# = 10.0 Waterfall(p).z# = 205 - 35 + rnd(70) Waterfall(p).xs# = 0.2 + (rnd(20)*0.01) Waterfall(p).ys# = 0.2 + (rnd(75)*0.01) Waterfall(p).zs# = -0.2 + (rnd(40)*0.01) endif `update particle position object SPart + p, Waterfall(p).x#, Waterfall(p).y#, -Waterfall(p).z# point object SPart + p, camera position x(), camera position y(), camera position z() endfunction function CreateTree(nr, img) `Create leaf texture cls ink rgb(0, 150, 0), 0 for i = 1 to 100 step 2 line 50, i, 50 + (cos(i/1.2)*50), 10 + (sin(i/2.0)*100) line 50, i, 50 - (cos(i/1.2)*50), 10 + (sin(i/2.0)*100) next i get image img, 0, 0, 100, 100, 1 `Create bark texture cls rgb(150, 75, 0) ink rgb(100, 50, 0), 0 for i = 1 to 100 dot rnd(50), rnd(50) next i get image img + 1, 0, 0, 50, 50, 1 make object cube nr, 1 : color object nr, rgb(200, 100, 0) make mesh from object nr, nr texture limb nr, 0, img + 1 for i = 1 to 4 add limb nr, i, nr : offset limb nr, i, 0, i, 0 : rotate limb nr, i, 0, i*20, 0 : color limb nr, i, rgb(200, 100, 0) texture limb nr, i, img + 1 next i `leafs make object plain nr + 1, 2, 7 : xrotate object nr + 1, 90 : fix object pivot nr + 1 offset limb nr + 1, 0, 0, 4, 3 : rotate limb nr + 1, 0, 180, 0, 0 make mesh from object nr, nr + 1 delete object nr + 1 for i = 1 to 10 add limb nr, i + 4, nr : offset limb nr, i + 4, 0, 7.5, 0 : rotate limb nr, i + 4, 10 - rnd(30), i*36, -5 + rnd(10) texture limb nr, i + 4, img next i set object transparency nr, 1 set object cull nr, 0 set object light nr, 0 endfunction function CreateSmogTex(nr, size, dens, color) `create memblock make memblock nr, 12 + (size*size*4) write memblock dword nr, 0, size write memblock dword nr, 4, size write memblock dword nr, 8, 32 `Draw on memblock for i = 1 to dens repeat `Random data x = 1 + rnd(size-1) y = 1 + rnd(size-1) d = sqrt((x-(size/2))^2 + (y-(size/2))^2) until d < (size/2) pos = 12 + ((((y-1)*size) + x - 1) * 4) write memblock dword nr, pos, color next i `Blur for the smoggy effect BlurImage(nr, nr + 1) BlurImage(nr + 1, nr) make image from memblock nr, nr delete memblock nr delete memblock nr + 1 endfunction function CreateSkyTex(nr, width, height) cls box 0, 0, width, height, rgb(255, 255, 255), rgb(100, 100, 255), rgb(255, 255, 255), rgb(100, 100, 255) get image nr, 0, 0, width, height, 1 endfunction function CreateWaterTex(nr, width, height) `Create a memblock make memblock nr, 12 + (width*height*4) write memblock dword nr, 0, width write memblock dword nr, 4, height write memblock dword nr, 8, 32 `fill memblock with blue colors for y = 1 to height for x = 1 to width `Get position pos = 12 + (((y-1)*width + x - 1) * 4) write memblock dword nr, pos, rgb(50, 50, 100 + rnd(105)) next x next y BlurImage(nr, nr + 1) BlurImage(nr + 1, nr) make image from memblock nr, nr + 1 delete memblock nr delete memblock nr + 1 endfunction function CreateGrassTex(nr, Width, Height) `create a memblock make memblock nr, 12 + (Width*Height*4) `write header write memblock DWORD nr,0, Width write memblock DWORD nr,4, Height write memblock DWORD nr,8, 32 `write data for i = 1 to (Width*Height) green = rnd(105) write memblock byte nr, 12 + ((i-1)*4), 100 write memblock byte nr, 13 + ((i-1)*4), 150 + green write memblock byte nr, 14 + ((i-1)*4), 100 write memblock byte nr, 15 + ((i-1)*4), 255 next i `create an image from the memblock and delete memblock make image from memblock nr,nr delete memblock nr endfunction function CreateWorld(nr, vertS#, maxH#) `Setup if image exist(nr) = 1 and object exist(nr) = 0 `Get image data make memblock from image nr ,nr width = memblock dword(nr, 0) height = memblock dword(nr, 4) `Create mesh memblock make memblock nr + 1, 12 + (36*6 * width * height) write memblock dword nr + 1, 0, 338 write memblock dword nr + 1, 4, 36 write memblock dword nr + 1, 8, width * height * 6 else exitfunction endif `Create world for y = 1 to height - 1 for x = 1 to width - 1 `Calculate vertex position pos = ((y-1) * width) + x - 1 imgpos = 12 + (pos * 4) `Calculate height height1# = maxH# / 255.0 * memblock byte(nr, imgpos) height2# = maxH# / 255.0 * memblock byte(nr, imgpos + 4) height3# = maxH# / 255.0 * memblock byte(nr, imgpos + (width*4)) height4# = maxH# / 255.0 * memblock byte(nr, imgpos + (width*4) + 4) `Write vertex data `First vertex x1# = (x - 1) * vertS# : x2# = x * vertS# y1# = (y - 1) * vertS# : y2# = y * vertS# WriteVertex(nr + 1, (pos * 6) + 1, x1#, height1#, -y1#, x1#, height1# + 10.0, -y1#, rgb(255, 255, 255), 0, 0) WriteVertex(nr + 1, (pos * 6) + 2, x2#, height2#, -y1#, x2#, height2# + 10.0, -y1#, rgb(255, 255, 255), 1, 0) WriteVertex(nr + 1, (pos * 6) + 3, x1#, height3#, -y2#, x1#, height3# + 10.0, -y2#, rgb(255, 255, 255), 0, 1) WriteVertex(nr + 1, (pos * 6) + 4, x2#, height2#, -y1#, x2#, height2# + 10.0, -y1#, rgb(255, 255, 255), 1, 0) WriteVertex(nr + 1, (pos * 6) + 5, x2#, height4#, -y2#, x2#, height4# + 10.0, -y2#, rgb(255, 255, 255), 1, 1) WriteVertex(nr + 1, (pos * 6) + 6, x1#, height3#, -y2#, x1#, height3# + 10.0, -y2#, rgb(255, 255, 255), 0, 1) next x next y `Create mesh make mesh from memblock nr, nr + 1 delete memblock nr delete memblock nr + 1 make object nr, nr, 0 endfunction function CreateHeightMap() `Random terrain DrawRndBox(1, 1, 64, 64, 10, 20) `Draw waterfall mountain and river DrawRndBox(10, 10, 30, 30, 105, 10) DrawRndBox(15, 15, 23, 23, 80, 0) DrawRndBox(25, 20, 30, 23, 80, 0) `DrawRndBox(28, 28, 33, 33, 80, 10) `DrawRndBox(8, 9, 16, 13, 80, 10) DrawRndBox(7, 7, 28, 10, 30, 30) DrawRndBox(7, 7, 10, 28, 30, 30) ink rgb(0, 0, 0), 0 Box 30, 16, 40, 28 box 32, 14, 38, 30 box 38, 28, 40, 35 box 38, 35, 50, 37 box 50, 35, 52, 64 `Beach surroundings ink 0, 0 line 0,0,63,0 line 0,0,0,63 line 0,64,63,63 line 63,0,63,63 get image 1, 0, 0, 64, 64, 1 make memblock from image 1 ,1 BlurImage(1, 2) BlurImage(2, 1) make image from memblock 1, 1 delete memblock 1 delete memblock 2 endfunction function BlurImage(mem, retmem) `Get data width = memblock dword(mem, 0) height = memblock dword(mem, 4) `Create returned memblock if memblock exist(retmem) = 0 then make memblock retmem, get memblock size(mem) write memblock dword retmem, 0, width write memblock dword retmem, 4, height write memblock dword retmem, 8, 32 `Write data `No edges: for y = 2 to height - 1 for x = 2 to width - 1 `Get position pos = 12 + ((y-1)*width*4) + ((x-1)*4) `Initialize values blue# = memblock byte(mem, pos) * 0.5 green# = memblock byte(mem, pos+1) * 0.5 red# = memblock byte(mem, pos+2) * 0.5 `Get surrounding data `Left npos = pos - 4 blue# = blue# + (memblock byte(mem, npos)*0.08) green# = green# + (memblock byte(mem, npos+1)*0.08) red# = red# + (memblock byte(mem, npos+2)*0.08) `+-> Top Left npos = npos - (width*4) blue# = blue# + (memblock byte(mem, npos)*0.045) green# = green# + (memblock byte(mem, npos+1)*0.045) red# = red# + (memblock byte(mem, npos+2)*0.045) `Right npos = pos + 4 blue# = blue# + (memblock byte(mem, npos)*0.08) green# = green# + (memblock byte(mem, npos+1)*0.08) red# = red# + (memblock byte(mem, npos+2)*0.08) `+-> Bottom right npos = npos + (width*4) blue# = blue# + (memblock byte(mem, npos)*0.045) green# = green# + (memblock byte(mem, npos+1)*0.045) red# = red# + (memblock byte(mem, npos+2)*0.045) `Top npos = pos - (width*4) blue# = blue# + (memblock byte(mem, npos)*0.08) green# = green# + (memblock byte(mem, npos+1)*0.08) red# = red# + (memblock byte(mem, npos+2)*0.08) `+-> top right npos = npos + 4 blue# = blue# + (memblock byte(mem, npos)*0.045) green# = green# + (memblock byte(mem, npos+1)*0.045) red# = red# + (memblock byte(mem, npos+2)*0.045) `Bottom npos = pos + (width*4) blue# = blue# + (memblock byte(mem, npos)*0.08) green# = green# + (memblock byte(mem, npos+1)*0.08) red# = red# + (memblock byte(mem, npos+2)*0.08) `+-> Bottom left npos = npos - 4 blue# = blue# + (memblock byte(mem, npos)*0.045) green# = green# + (memblock byte(mem, npos+1)*0.045) red# = red# + (memblock byte(mem, npos+2)*0.045) `Write away data write memblock byte retmem, pos, int(blue#+0.5) write memblock byte retmem, pos+1, int(green#+0.5) write memblock byte retmem, pos+2, int(red#+0.5) write memblock byte retmem, pos+3, 255 next x next y `Edges for y = 1 to height step (height-1) for x = 1 to width `Get position pos = 12 + ((y-1)*width*4) + ((x-1)*4) `Initialize colors if x = 1 or x = width blue# = memblock byte(mem, pos) * 0.795 green# = memblock byte(mem, pos+1) * 0.795 red# = memblock byte(mem, pos+2) * 0.795 else blue# = memblock byte(mem, pos) * 0.67 green# = memblock byte(mem, pos+1) * 0.67 red# = memblock byte(mem, pos+2) * 0.67 endif `Get other colors if x > 1 npos = pos - 4 blue# = blue# + memblock byte(mem, npos) * 0.08 green# = green# + memblock byte(mem, npos+1) * 0.08 red# = red# + memblock byte(mem, npos+2) * 0.08 endif if x < width npos = pos + 4 blue# = blue# + memblock byte(mem, npos) * 0.08 green# = green# + memblock byte(mem, npos+1) * 0.08 red# = red# + memblock byte(mem, npos+2) * 0.08 endif if y > 1 then npos = pos - (width*4) else npos = pos + (width*4) blue# = blue# + memblock byte(mem, npos) * 0.08 green# = green# + memblock byte(mem, npos+1) * 0.08 red# = red# + memblock byte(mem, npos+2) * 0.08 if x > 1 mpos = npos - 4 blue# = blue# + memblock byte(mem, mpos) * 0.045 green# = green# + memblock byte(mem, mpos+1) * 0.045 red# = red# + memblock byte(mem, mpos+2) * 0.045 endif if x < width mpos = npos + 4 blue# = blue# + memblock byte(mem, mpos) * 0.045 green# = green# + memblock byte(mem, mpos+1) * 0.045 red# = red# + memblock byte(mem, mpos+2) * 0.045 endif `Write away data write memblock byte retmem, pos, int(blue#+0.5) write memblock byte retmem, pos+1, int(green#+0.5) write memblock byte retmem, pos+2, int(red#+0.5) write memblock byte retmem, pos+3, 255 next x next y `Left and right edges (no corners anymore) for x = 1 to width step (width-1) for y = 2 to height - 1 `Get position pos = 12 + ((y-1)*width*4) + ((x-1)*4) `Initialize colors blue# = memblock byte(mem, pos) * 0.67 green# = memblock byte(mem, pos+1) * 0.67 red# = memblock byte(mem, pos+2) * 0.67 `Get surrounding data npos = pos - (width*4) blue# = blue# + memblock byte(mem, npos) * 0.08 green# = green# + memblock byte(mem, npos+1) * 0.08 red# = red# + memblock byte(mem, npos+2) * 0.08 npos = pos + (width*4) blue# = blue# + memblock byte(mem, npos) * 0.08 green# = green# + memblock byte(mem, npos+1) * 0.08 red# = red# + memblock byte(mem, npos+2) * 0.08 if x > 1 then npos = pos - 4 else npos = pos + 4 blue# = blue# + memblock byte(mem, npos) * 0.08 green# = green# + memblock byte(mem, npos+1) * 0.08 red# = red# + memblock byte(mem, npos+2) * 0.08 mpos = npos - (width*4) blue# = blue# + memblock byte(mem, mpos) * 0.045 green# = green# + memblock byte(mem, mpos+1) * 0.045 red# = red# + memblock byte(mem, mpos+2) * 0.045 mpos = npos + (width*4) blue# = blue# + memblock byte(mem, mpos) * 0.045 green# = green# + memblock byte(mem, mpos+1) * 0.045 red# = red# + memblock byte(mem, mpos+2) * 0.045 `Write away data write memblock byte retmem, pos, int(blue#+0.5) write memblock byte retmem, pos+1, int(green#+0.5) write memblock byte retmem, pos+2, int(red#+0.5) write memblock byte retmem, pos+3, 255 next y next x endfunction function WriteVertex(mem, v, x#, y#, z#, nx#, ny#, nz#, color, uvx#, uvy#) start = 12 + ((v-1)*36) `write vertex 1 write memblock float mem,start, x# write memblock float mem,start+4, y# write memblock float mem,start+8, z# write memblock float mem,start+12, nx# write memblock float mem,start+16, ny# write memblock float mem,start+20, nz# write memblock dword mem,start+24, color write memblock float mem,start+28, uvx# write memblock float mem,start+32, uvy# endfunction function DrawRndBox(x1, y1, x2, y2, min, range) for y = y1 to y2 for x = x1 to x2 height = min + rnd(range) ink rgb(height, height, height), 0 dot x - 1, y - 1 next x next y endfunction