SuperStrict '------------Vars/Consts------------ Const w:Float = 1024 Const h:Float = 768 Global fpscounter:Int Global fpstime:Int Global fps:Int Global cam:TCamera = New TCamera Global voxel:TVboVoxel = New TVboVoxel Global noise:SimplexNoise = New SimplexNoise Global scale:Float = 0.005 Global position1:Float Ptr = [-5.0, 8.0,-2.5, 0.0] Global position2:Float Ptr = [ 4.0,-2.5, 4.5, 0.0] Global ambient:Float Ptr = [ 0.4, 0.4, 0.3, 1.0] Global diffuse:Float Ptr = [ 0.8, 0.8, 0.8, 0.8] '----------------------Init--------------------------- GLGraphics w, h glEnable GL_DEPTH_TEST glEnable GL_CULL_FACE glCullFace GL_BACK glEnable GL_BLEND glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA glEnable GL_LIGHTING glEnable GL_LIGHT0 glEnable GL_LIGHT1 glEnable GL_COLOR_MATERIAL glMatrixMode GL_PROJECTION glLoadIdentity() gluPerspective 45.0, w/h, 1.0, 2000.0 glMatrixMode GL_MODELVIEW glLoadIdentity() glClearColor 0.3, 0.3, 0.3, 1.0 voxel.width = 400 voxel.height = 100 voxel.depth = 400 voxel.randomterrain(10, 100) voxel.calculatevolume() voxel.init() cam.x = 125 cam.y = 30 cam.z = 50 SeedRnd MilliSecs() HideMouse() '----------------------------------Hauptschleife----------------------------------- Repeat glClear GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT getfps() If fps > 0 Then cam.Control() glEnableClientState GL_VERTEX_ARRAY glBindBuffer GL_ARRAY_BUFFER, voxel.vertexbuffer glVertexPointer 3, GL_FLOAT, 0, Null glEnableClientState GL_NORMAL_ARRAY glBindBuffer GL_ARRAY_BUFFER, voxel.normalbuffer glNormalPointer GL_FLOAT, 0, Null glEnableClientState GL_COLOR_ARRAY glBindBuffer GL_ARRAY_BUFFER, voxel.colorbuffer glColorPointer 3, GL_FLOAT, 0, Null glEnable GL_LIGHTING glLightfv GL_LIGHT0, GL_AMBIENT, ambient glLightfv GL_LIGHT0, GL_DIFFUSE, diffuse glLightfv GL_LIGHT0, GL_POSITION, position1 glLightfv GL_LIGHT1, GL_AMBIENT, ambient glLightfv GL_LIGHT1, GL_DIFFUSE, diffuse glLightfv GL_LIGHT1, GL_POSITION, position2 glTranslatef 0.0, 0.0,-300.0 glDrawArrays GL_QUADS, 0, voxel.vcnt glLoadIdentity() glDisableClientState GL_VERTEX_ARRAY glDisableClientState GL_NORMAL_ARRAY glDisableClientState GL_COLOR_ARRAY glDisable GL_LIGHTING glPolygonMode GL_FRONT_AND_BACK, GL_FILL glColor3f 1.0, 1.0, 1.0 GLDrawText fps+" FPS", 10, 10 GLDrawText voxel.voxelcnt+" Cubes", 10, 30 GLDrawText (voxel.vcnt/3)+" Vertices", 10, 45 GLDrawText "Kamera Position: "+Int(cam.x)+" X "+Int(cam.y)+" Y "+Int(cam.z)+" Z", 10, 65 GLDrawText "Bewegen: W,A,S,D", 10, 90 GLDrawText "Heben/Senken: R,F", 10, 105 GLDrawText "Umschauen: Maus", 10, 120 GLDrawText "Schneller: Leertaste", 10, 135 GLDrawText "Wireframe: X", 10, 150 Flip 0 Until KeyHit(KEY_ESCAPE) Or AppTerminate() End '-----------------------------------------Types-------------------------------------------- Type TVboVoxel Global vbo:Float Ptr Global nbo:Float Ptr Global cbo:Float Ptr Global vertexbuffer:Int Global normalbuffer:Int Global colorbuffer:Int Global voxelcnt:Int Global vcnt:Int Global ncnt:Int Global ccnt:Int Field width:Int Field height:Int Field depth:Int Field vertices:Float[100000000] Field normals:Float[100000000] Field colors:Float[100000000] Field volume:Int[400, 100, 400] Method init() glewInit() glGenBuffers 1, Varptr(vertexbuffer) glBindBuffer GL_ARRAY_BUFFER, vertexbuffer vbo = Float Ptr(glMapBuffer(GL_ARRAY_BUFFER, GL_WRITE_ONLY)) vbo = vertices glUnMapBuffer GL_ARRAY_BUFFER glBufferData GL_ARRAY_BUFFER, vcnt*4, vbo, GL_STATIC_DRAW glGenBuffers 1, Varptr(normalbuffer) glBindBuffer GL_ARRAY_BUFFER, normalbuffer nbo = Float Ptr(glMapBuffer(GL_ARRAY_BUFFER, GL_WRITE_ONLY)) nbo = normals glUnMapBuffer GL_ARRAY_BUFFER glBufferData GL_ARRAY_BUFFER, ncnt*4, nbo, GL_STATIC_DRAW glGenBuffers 1, Varptr(colorbuffer) glBindBuffer GL_ARRAY_BUFFER, colorbuffer cbo = Float Ptr(glMapBuffer(GL_ARRAY_BUFFER, GL_WRITE_ONLY)) cbo = colors glUnMapBuffer GL_ARRAY_BUFFER glBufferData GL_ARRAY_BUFFER, ccnt*4, cbo, GL_STATIC_DRAW End Method Method randomterrain(minheight:Int, maxheight:Int) For Local i:Int = 0 To 5 For Local z:Int = 0 To depth-1 For Local x:Int = 0 To width-1 If i = 0 Then For Local y:Float = 0 To minheight + (noise.Noise_2D(Float(x)*scale, Float(z)*scale)+1)*(maxheight/3) volume[x, Int(y), z] = 1 voxelcnt:+1 Next Else scale = 0.005+(i*0.004) For Local y:Int = 0 To maxheight-1 If volume[x, y, z] = 0 Then For Local y2:Float = y To y + noise.Noise_2D(Float(x)*scale, Float(z)*scale)*(12-i*2) If y2 < 100 Then volume[x, Int(y2), z] = 1 voxelcnt:+1 End If Next Exit End If Next End If Next Next Next End Method Method calculatevolume:Float[]() For Local z:Int = 0 To depth-1 For Local y:Int = 0 To height-1 For Local x:Int = 0 To width-1 If volume[x, y, z] = 1 Then 'Vorne If z < depth-1 Then If volume[x, y, z+1] = 0 Then createface(x, y, z, 0) Else createface(x, y, z, 0) End If 'Hinten If z > 0 Then If volume[x, y, z-1] = 0 Then createface(x, y, z, 1) Else createface(x, y, z, 1) End If 'Rechts If x < width-1 Then If volume[x+1, y, z] = 0 Then createface(x, y, z, 2) Else createface(x, y, z, 2) End If 'Links If x > 0 Then If volume[x-1, y, z] = 0 Then createface(x, y, z, 3) Else createface(x, y, z, 3) End If 'Oben If y < height-1 Then If volume[x, y+1, z] = 0 Then createface(x, y, z, 4) Else createface(x, y, z, 4) End If 'Unten If y > 0 Then If volume[x, y-1, z] = 0 Then createface(x, y, z, 5) Else createface(x, y, z, 5) End If End If Next Next Next End Method Method createface(x:Int, y:Int, z:Int, face:Int) Local cnt:Int Local num:Int[][] = [[0, 11], [12, 23], [24, 35], [36, 47], [48, 59], [60, 71]] Local cvt:Float[] = [-0.5, 0.5, 0.5, -0.5,-0.5, 0.5, 0.5,-0.5, 0.5, 0.5, 0.5, 0.5,.. 'Vorne 0.5, 0.5,-0.5, 0.5,-0.5,-0.5, -0.5,-0.5,-0.5, -0.5, 0.5,-0.5,.. 'Hinten 0.5, 0.5, 0.5, 0.5,-0.5, 0.5, 0.5,-0.5,-0.5, 0.5, 0.5,-0.5,.. 'Rechts -0.5, 0.5,-0.5, -0.5,-0.5,-0.5, -0.5,-0.5, 0.5, -0.5, 0.5, 0.5,.. 'Links -0.5, 0.5,-0.5, -0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,-0.5,.. 'Oben -0.5,-0.5, 0.5, -0.5,-0.5,-0.5, 0.5,-0.5,-0.5, 0.5,-0.5, 0.5 ] 'Unten Local cnl:Float[][] = [[ 0.0, 0.0, 1.0],.. 'Vorne [ 0.0, 0.0,-1.0],.. 'Hinten [ 1.0, 0.0, 0.0],.. 'Rechts [-1.0, 0.0, 0.0],.. 'Links [ 0.0, 1.0, 0.0],.. 'Oben [ 0.0,-1.0, 0.0] ] 'Unten For Local i:Int = num[face][0] To num[face][1] cnt:+1 Select cnt Case 1 vertices[vcnt] = cvt[i]+x Case 2 vertices[vcnt] = cvt[i]+y Case 3 vertices[vcnt] = cvt[i]+z cnt = 0 End Select vcnt:+1 Next For Local i:Int = 0 To 3 normals[ncnt] = cnl[face][0]; ncnt:+1 normals[ncnt] = cnl[face][1]; ncnt:+1 normals[ncnt] = cnl[face][2]; ncnt:+1 Next For Local i:Int = 0 To 3 colors[ccnt] = Float(y)/(height*1.5)+0.1; ccnt:+1 colors[ccnt] = Float(y)/(height*1.5)+0.1; ccnt:+1 colors[ccnt] = Float(y)/(height*1.5)+0.1; ccnt:+1 Next End Method End Type Type TCamera Global x:Float Global y:Float Global z:Float Global pitch:Float Global yaw:Float Global roll:Float Global speed:Float Global wf:Byte Function Control() Local mxs:Float = MouseXSpeed() Local mys:Float = MouseYSpeed() MoveMouse w/2, h/2 MouseXSpeed() MouseYSpeed() yaw:+mxs/25 If yaw< 0 yaw:+360 If yaw >360 yaw:-360 pitch:+mys/25 If pitch< 0 pitch:+360 If pitch >360 pitch:-360 If KeyDown(KEY_W) Then x:-speed*Cos(yaw+90)/fps z:-speed*Sin(yaw+90)/fps End If If KeyDown(KEY_S) Then x:+speed*Cos(yaw+90)/fps z:+speed*Sin(yaw+90)/fps End If If KeyDown(KEY_D) Then x:+speed*Cos(yaw)/fps z:+speed*Sin(yaw)/fps EndIf If KeyDown(KEY_A) Then x:-speed*Cos(yaw)/fps z:-speed*Sin(yaw)/fps End If If KeyDown(KEY_R) Then y:+speed/fps End If If KeyDown(KEY_F) Then y:-speed/fps End If If KeyDown(KEY_SPACE) Then speed = 200 Else speed = 50 End If If KeyHit(KEY_X) Then If wf = True Then wf = False Else wf = True End If End If If wf = True Then glPolygonMode GL_FRONT_AND_BACK, GL_LINE Else glPolygonMode GL_FRONT_AND_BACK, GL_FILL End If glloadidentity glrotatef cam.pitch, 1.0, 0.0, 0.0 glrotatef cam.yaw, 0.0, 1.0, 0.0 glrotatef cam.roll, 0.0, 0.0, 1.0 gltranslatef cam.x-cam.x*2, cam.y-cam.y*2, cam.z-cam.z*2 EndFunction End Type 'Simplex noise in 2D and 3D Type SimplexNoise 'Gradient table Field grad3:grad[] = [New Grad.Create(1, 1, 0), New Grad.Create(-1, 1, 0), New Grad.Create(1,-1, 0), New Grad.Create(-1,-1, 0), .. New Grad.Create(1, 0, 1), New Grad.Create(-1, 0, 1), New Grad.Create(1, 0,-1), New Grad.Create(-1, 0,-1), .. New Grad.Create(0, 1, 1), New Grad.Create( 0,-1, 1), New Grad.Create(0, 1,-1), New Grad.Create( 0,-1,-1)] 'Permutation table. Field perm:Int[] = New Int[512] 'Permutation table containing precomputed, mod12'd perm table. Field permMod12:Int[] = New Int[512] 'Precomputed skew factors. Field F2:Float = 0.5 * (Sqr(3.0) - 1.0) Field G2:Float = (3.0 - Sqr(3.0)) / 6.0 Field F3:Float = 1.0 / 3.0 Field G3:Float = 1.0 / 6.0 Method New() 'Randomize the permutation tables. For Local I:Int = 0 To 511 perm[I] = Rand (0, 255) permMod12[I] = perm[I] Mod 12 Next End Method 'Re-Randomize the permutation tables. Method Randomize() For Local I:Int = 0 To 511 perm[I] = Rand (0, 255) permMod12[I] = perm[I] Mod 12 Next End Method 'Should be faster than Floor() Method FastFloor:Int(x:Float) Local y:Int If x > 0 y = Int (x) Else y = Int (x - 1) End If Return y End Method 'Dot product for 3D Noise Method Dot3D:Float (g:Grad, x:Float, y:Float, z:Float) Return g.x * x + g.y * y + g.z * z EndMethod 'Dot product for 2D Noise Method Dot2D:Float (g:Grad, x:Float, y:Float) Return g.x * x + g.y * y EndMethod ' 2D simplex noise Method Noise_2D:Float (xin:Float, yin:Float) ' Noise contributions from the three corners Local n0:Float, n1:Float, n2:Float ' Skew the input space to determine which simplex cell we're in Local s:Float = (xin + yin) * F2 ' Hairy factor for 2D Local I:Int = FastFloor(xin + s) Local j:Int = FastFloor(yin + s) Local t:Float = (I + j) * G2 ' Unskew the cell origin back to (x,y) space Local X0:Float = I - t Local Y0:Float = j - t ' The x,y distances from the cell origin X0 = xin - X0 Y0 = yin - Y0 'For the 2D case, the simplex shape is an equilateral triangle. 'Determine which simplex we are in. 'Offsets for second (middle) corner of simplex in (i,j) coords Local i1:Int, j1:Int If X0 > Y0 Then ' lower triangle, XY order: (0,0)->(1,0)->(1,1) i1 = 1 j1 = 0 Else ' upper triangle, YX order: (0,0)->(0,1)->(1,1) i1 = 0 j1 = 1 EndIf ' A step of (1,0) in (i,j) means a step of (1-c,-c) in (x,y), and ' a step of (0,1) in (i,j) means a step of (-c,1-c) in (x,y), where ' c = (3-sqrt(3))/6 ' Offsets for middle corner in (x,y) unskewed coords Local x1:Float = x0 - i1 + G2 Local y1:Float = y0 - j1 + G2 ' Offsets for last corner in (x,y) unskewed coords Local x2:Float = x0 - 1.0 + 2.0 * G2 Local y2:Float = y0 - 1.0 + 2.0 * G2 ' Work out the hashed gradient indices of the three simplex corners Local ii:Int = I & 255 Local jj:Int = j & 255 Local gi0:Int = permMod12[ii + perm[jj]] Local gi1:Int = permMod12[ii + i1 + perm[jj + j1]] Local gi2:Int = permMod12[ii + 1 + perm[jj + 1]] ' Calculate the contribution from the three corners Local t0:Float = 0.5 - X0 * X0 - Y0 * Y0 If t0 < 0 Then n0 = 0.0 Else t0 = t0 * t0 n0 = t0 * t0 * Dot2D(grad3[gi0], X0, Y0) ' (x,y) of grad3 used for 2D gradient EndIf Local t1:Float = 0.5 - x1 * x1 - y1 * y1 If t1 < 0 Then n1 = 0.0 Else t1 = t1 * t1 n1 = t1 * t1 * Dot2D(grad3[gi1], x1, y1) EndIf Local t2:Float = 0.5 - x2 * x2 - y2 * y2 If t2 < 0 Then n2 = 0.0 Else t2 = t2 * t2 n2 = t2 * t2 * Dot2D(grad3[gi2], x2, y2) EndIf ' Add contributions from each corner to get the final noise value. ' The result is scaled to return values in the interval [-1,1]. Return 70.0 * (n0 + n1 + n2) EndMethod ' 3D simplex noise Method Noise_3D:Float(xin:Float, yin:Float, zin:Float) ' Noise contributions from the four corners Local n0:Float, n1:Float, n2:Float, n3:Float ' Skew the input space to determine which simplex cell we're in Local s:Float = (xin + yin + zin) * F3 ' Very nice And simple skew factor For 3D Local I:Int = fastfloor(xin + s) Local j:Int = fastfloor(yin + s) Local k:Int = fastfloor(zin + s) Local t:Float = (I + j + k) * G3 ' Unskew the cell origin back to (x,y,z) space Local X0:Float = I - t Local Y0:Float = j - t Local Z0:Float = k - t ' The x,y,z distances from the cell origin X0 = xin - X0 Y0 = yin - Y0 Z0 = zin - Z0 ' For the 3D case, the simplex shape is a slightly irregular tetrahedron. ' Determine which simplex we are in. ' Offsets for second corner of simplex in (i,j,k) coords Local i1:Int, j1:Int, k1:Int ' Offsets for third corner of simplex in (i,j,k) coords Local i2:Int, j2:Int, k2:Int If X0 >= Y0 Then If Y0 >= Z0 Then i1 = 1; j1 = 0; k1 = 0; i2 = 1; j2 = 1; k2 = 0 ' X Y Z order Else If X0 >= Z0 i1 = 1; j1 = 0; k1 = 0; i2 = 1; j2 = 0; k2 = 1 ' X Z Y order Else i1 = 0; j1 = 0; k1 = 1; i2 = 1; j2 = 0; k2 = 1 ' Z X Y order EndIf Else ' x0