Imports System.Collections.Generic

Imports Substrate

Module Module1

Sub Main()

Dim world As BetaWorld = BetaWorld.Open("F:\Minecraft\test")

Dim bm As BlockManager = world.GetBlockManager()

bm.AutoLight = False

Dim grid As New Grid()

grid.BuildInit(bm)

Dim gen As New Generator()

Dim edges As List(Of Generator.Edge) = gen.Generate()

For Each e As Generator.Edge In edges

Dim x1 As Integer

Dim y1 As Integer

Dim z1 As Integer

gen.UnIndex(e.node1, x1, y1, z1)

Dim x2 As Integer

Dim y2 As Integer

Dim z2 As Integer

gen.UnIndex(e.node2, x2, y2, z2)

grid.LinkRooms(bm, x1, y1, z1, x2, y2, z2)

Next

' Entrance Room

grid.BuildRoom(bm, 2, 5, 2)

grid.LinkRooms(bm, 2, 5, 2, 1, 5, 2)

grid.LinkRooms(bm, 2, 5, 2, 3, 5, 2)

grid.LinkRooms(bm, 2, 5, 2, 2, 5, 1)

grid.LinkRooms(bm, 2, 5, 2, 2, 5, 3)

grid.LinkRooms(bm, 2, 4, 2, 2, 5, 2)

' Exit Room

grid.BuildRoom(bm, 2, -1, 2)

grid.LinkRooms(bm, 2, -1, 2, 2, 0, 2)

grid.AddPrize(bm, 2, -1, 2)

Console.WriteLine("Relight Chunks")

Dim cm As BetaChunkManager = world.GetChunkManager()

cm.RelightDirtyChunks()

world.Save()

End Sub

Class Grid

Private originx As Integer

Private originy As Integer

Private originz As Integer

Private xlen As Integer

Private ylen As Integer

Private zlen As Integer

Private cellxlen As Integer

Private cellylen As Integer

Private cellzlen As Integer

Private wallxwidth As Integer

Private wallywidth As Integer

Private wallzwidth As Integer

Public Sub New()

originx = 0

originy = 27

originz = 0

xlen = 5

ylen = 5

zlen = 5

cellxlen = 5

cellylen = 5

cellzlen = 5

wallxwidth = 2

wallywidth = 2

wallzwidth = 2

End Sub

Public Sub BuildInit(bm As BlockManager)

For xi As Integer = 0 To xlen - 1

For yi As Integer = 0 To ylen - 1

For zi As Integer = 0 To zlen - 1

BuildRoom(bm, xi, yi, zi)

Next

Next

Next

End Sub

Public Sub BuildRoom(bm As BlockManager, x As Integer, y As Integer, z As Integer)

Dim ox As Integer = originx + (cellxlen + wallxwidth) * x

Dim oy As Integer = originy + (cellylen + wallywidth) * y

Dim oz As Integer = originz + (cellzlen + wallzwidth) * z

' Hollow out room

For xi As Integer = 0 To cellxlen - 1

Dim xx As Integer = ox + wallxwidth + xi

For zi As Integer = 0 To cellzlen - 1

Dim zz As Integer = oz + wallzwidth + zi

For yi As Integer = 0 To cellylen - 1

Dim yy As Integer = oy + wallywidth + yi

bm.SetID(xx, yy, zz, CInt(BlockType.AIR))

Next

Next

Next

' Build walls

For xi As Integer = 0 To cellxlen + (2 * wallxwidth - 1)

For zi As Integer = 0 To cellzlen + (2 * wallzwidth - 1)

For yi As Integer = 0 To wallywidth - 1

bm.SetID(ox + xi, oy + yi, oz + zi, CInt(BlockType.BEDROCK))

bm.SetID(ox + xi, oy + yi + cellylen + wallywidth, oz + zi, CInt(BlockType.BEDROCK))

Next

Next

Next

For xi As Integer = 0 To cellxlen + (2 * wallxwidth - 1)

For zi As Integer = 0 To wallzwidth - 1

For yi As Integer = 0 To cellylen + (2 * wallywidth - 1)

bm.SetID(ox + xi, oy + yi, oz + zi, CInt(BlockType.BEDROCK))

bm.SetID(ox + xi, oy + yi, oz + zi + cellzlen + wallzwidth, CInt(BlockType.BEDROCK))

Next

Next

Next

For xi As Integer = 0 To wallxwidth - 1

For zi As Integer = 0 To cellzlen + (2 * wallzwidth - 1)

For yi As Integer = 0 To cellylen + (2 * wallywidth - 1)

bm.SetID(ox + xi, oy + yi, oz + zi, CInt(BlockType.BEDROCK))

bm.SetID(ox + xi + cellxlen + wallxwidth, oy + yi, oz + zi, CInt(BlockType.BEDROCK))

Next

Next

Next

' Torchlight

bm.SetID(ox + wallxwidth, oy + wallywidth + 2, oz + wallzwidth + 1, CInt(BlockType.TORCH))

bm.SetID(ox + wallxwidth, oy + wallywidth + 2, oz + wallzwidth + cellzlen - 2, CInt(BlockType.TORCH))

bm.SetID(ox + wallxwidth + cellxlen - 1, oy + wallywidth + 2, oz + wallzwidth + 1, CInt(BlockType.TORCH))

bm.SetID(ox + wallxwidth + cellxlen - 1, oy + wallywidth + 2, oz + wallzwidth + cellzlen - 2, CInt(BlockType.TORCH))

bm.SetID(ox + wallxwidth + 1, oy + wallywidth + 2, oz + wallzwidth, CInt(BlockType.TORCH))

bm.SetID(ox + wallxwidth + cellxlen - 2, oy + wallywidth + 2, oz + wallzwidth, CInt(BlockType.TORCH))

bm.SetID(ox + wallxwidth + 1, oy + wallywidth + 2, oz + wallzwidth + cellzlen - 1, CInt(BlockType.TORCH))

bm.SetID(ox + wallxwidth + cellxlen - 2, oy + wallywidth + 2, oz + wallzwidth + cellzlen - 1, CInt(BlockType.TORCH))

End Sub

Public Sub LinkRooms(bm As BlockManager, x1 As Integer, y1 As Integer, z1 As Integer, x2 As Integer, y2 As Integer, z2 As Integer)

Dim xx As Integer = originx + (cellxlen + wallxwidth) * x1

Dim yy As Integer = originy + (cellylen + wallywidth) * y1

Dim zz As Integer = originz + (cellzlen + wallzwidth) * z1

If x1 <> x2 Then

xx = originx + (cellxlen + wallxwidth) * Math.Max(x1, x2)

For xi As Integer = 0 To wallxwidth - 1

Dim zc As Integer = zz + wallzwidth + (cellzlen \ 2)

Dim yb As Integer = yy + wallywidth

bm.SetID(xx + xi, yb, zc - 1, CInt(BlockType.AIR))

bm.SetID(xx + xi, yb, zc, CInt(BlockType.AIR))

bm.SetID(xx + xi, yb, zc + 1, CInt(BlockType.AIR))

bm.SetID(xx + xi, yb + 1, zc - 1, CInt(BlockType.AIR))

bm.SetID(xx + xi, yb + 1, zc, CInt(BlockType.AIR))

bm.SetID(xx + xi, yb + 1, zc + 1, CInt(BlockType.AIR))

bm.SetID(xx + xi, yb + 2, zc, CInt(BlockType.AIR))

Next

ElseIf z1 <> z2 Then

zz = originz + (cellzlen + wallzwidth) * Math.Max(z1, z2)

For zi As Integer = 0 To wallxwidth - 1

Dim xc As Integer = xx + wallxwidth + (cellxlen \ 2)

Dim yb As Integer = yy + wallywidth

bm.SetID(xc - 1, yb, zz + zi, CInt(BlockType.AIR))

bm.SetID(xc, yb, zz + zi, CInt(BlockType.AIR))

bm.SetID(xc + 1, yb, zz + zi, CInt(BlockType.AIR))

bm.SetID(xc - 1, yb + 1, zz + zi, CInt(BlockType.AIR))

bm.SetID(xc, yb + 1, zz + zi, CInt(BlockType.AIR))

bm.SetID(xc + 1, yb + 1, zz + zi, CInt(BlockType.AIR))

bm.SetID(xc, yb + 2, zz + zi, CInt(BlockType.AIR))

Next

ElseIf y1 <> y2 Then

yy = originy + (cellylen + wallywidth) * Math.Max(y1, y2)

For yi As Integer = 0 - cellylen + 1 To wallywidth

Dim xc As Integer = xx + wallxwidth + (cellxlen \ 2)

Dim zc As Integer = zz + wallzwidth + (cellzlen \ 2)

bm.SetID(xc, yy + yi, zc, CInt(BlockType.BEDROCK))

bm.SetID(xc - 1, yy + yi, zc, CInt(BlockType.LADDER))

bm.SetData(xc - 1, yy + yi, zc, 4)

bm.SetID(xc + 1, yy + yi, zc, CInt(BlockType.LADDER))

bm.SetData(xc + 1, yy + yi, zc, 5)

bm.SetID(xc, yy + yi, zc - 1, CInt(BlockType.LADDER))

bm.SetData(xc, yy + yi, zc - 1, 2)

bm.SetID(xc, yy + yi, zc + 1, CInt(BlockType.LADDER))

bm.SetData(xc, yy + yi, zc + 1, 3)

Next

End If

End Sub

Public Sub AddPrize(bm As BlockManager, x As Integer, y As Integer, z As Integer)

Dim ox As Integer = originx + (cellxlen + wallxwidth) * x + wallxwidth

Dim oy As Integer = originy + (cellylen + wallywidth) * y + wallywidth

Dim oz As Integer = originz + (cellzlen + wallzwidth) * z + wallzwidth

Dim rand As New Random()

For xi As Integer = 0 To cellxlen - 1

For zi As Integer = 0 To cellzlen - 1

If rand.NextDouble() < 0.1 Then

bm.SetID(ox + xi, oy, oz + zi, CInt(BlockType.DIAMOND_BLOCK))

End If

Next

Next

End Sub

End Class

Class Generator

Public Structure Edge

Public node1 As Integer

Public node2 As Integer

Public Sub New(n1 As Integer, n2 As Integer)

node1 = n1

node2 = n2

End Sub

End Structure

Private xlen As Integer

Private ylen As Integer

Private zlen As Integer

Private _edges As List(Of Edge)

Private _cells As Integer()

Public Sub New()

xlen = 5

ylen = 5

zlen = 5

_edges = New List(Of Edge)()

_cells = New Integer(xlen * zlen * ylen - 1) {}

For x As Integer = 0 To xlen - 1

For z As Integer = 0 To zlen - 1

For y As Integer = 0 To ylen - 1

Dim n1 As Integer = Index(x, y, z)

_cells(n1) = n1

Next

Next

Next

For x As Integer = 0 To xlen - 2

For z As Integer = 0 To zlen - 1

For y As Integer = 0 To ylen - 1

Dim n1 As Integer = Index(x, y, z)

Dim n2 As Integer = Index(x + 1, y, z)

_edges.Add(New Edge(n1, n2))

Next

Next

Next

For x As Integer = 0 To xlen - 1

For z As Integer = 0 To zlen - 2

For y As Integer = 0 To ylen - 1

Dim n1 As Integer = Index(x, y, z)

Dim n2 As Integer = Index(x, y, z + 1)

_edges.Add(New Edge(n1, n2))

Next

Next

Next

For x As Integer = 0 To xlen - 1

For z As Integer = 0 To zlen - 1

For y As Integer = 0 To ylen - 2

Dim n1 As Integer = Index(x, y, z)

Dim n2 As Integer = Index(x, y + 1, z)

_edges.Add(New Edge(n1, n2))

Next

Next

Next

End Sub

Public Function Generate() As List(Of Edge)

Dim rand As New Random()

Dim passages As New List(Of Edge)()

' Randomize edges

Dim redges As New Queue(Of Edge)()

While _edges.Count > 0

Dim index As Integer = rand.[Next](_edges.Count)

Dim e As Edge = _edges(index)

_edges.RemoveAt(index)

redges.Enqueue(e)

End While

While redges.Count > 0

Dim e As Edge = redges.Dequeue()

If _cells(e.node1) = _cells(e.node2) Then

Continue While

End If

passages.Add(e)

Dim n1 As Integer = _cells(e.node2)

Dim n2 As Integer = _cells(e.node1)

For i As Integer = 0 To _cells.Length - 1

If _cells(i) = n2 Then

_cells(i) = n1

End If

Next

End While

Return passages

End Function

Public Function Index(x As Integer, y As Integer, z As Integer) As Integer

Return (x * zlen + z) * ylen + y

End Function

Public Sub UnIndex(index As Integer, ByRef x As Integer, ByRef y As Integer, ByRef z As Integer)

x = index \ (zlen * ylen)

Dim xstr As Integer = index - (x * zlen * ylen)

z = xstr \ ylen

Dim ystr As Integer = xstr - (z * ylen)

y = ystr

End Sub

End Class

End Module