NBTExplorer/SubstrateVBNET/Examples/Maze/Module1.vb

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