forked from mirrors/NBTExplorer
332 lines
13 KiB
VB.net
332 lines
13 KiB
VB.net
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
|