Перевод на ВБ

[Ariman]

Приветствую всех.
Я тут нашел один алгоритм генерации лабиринтов, реализован он ни СИ++ Я попробовал его перевести на ВБ - какая-то хреновина получается....... Может кто сможет?
(этот алгоритм я нашел на http://algolist.manual.ru/games/maze.php

Мне из этого алгоритма не неужна функция, делающая границу
и не нужен вывод на экран. Итогом должен быть массив с числами.
____________________________________________________________

FullFill - на сколько плотно заполнять лабиринт (делать ли холлы).

WallShort- на сколько короткие должны быть стены 0 - одни колонны.


#include <stdio.h>

#include <conio.h>

#include <stdlib.h>

const int size = 20;

const int fullfill = 100; // in %

const int wallshort= 50; // in %

char m[size+1][size+1];

// Random generator

int r[2][size/2*size/2];

int h; // How many number in array;

void initrandom ()

{

int j=0;

for (int y=2; y<size; y+=2)

for (int x=2; x< size; x+=2)

{

r[0][j] = x; r[1][j] = y; j++;

}

h=j-1;

}

int getrandom(int &x, int &y)

{

int i = random (h);

x = r[0][i]; y = r[1][i];

r[0][i] = r[0][h]; r[1][i] = r[1][h];

return h--;

}

// View labirint on screen

void view()

{

for (int y=0; y<=size; y++)

for (int x=0; x<=size; x++)

{

gotoxy (x*2+1,y+1);

if (m[y][x]==0) cprintf ("..");

if (m[y][x]==1) cprintf ("__");

}

}
int main(void)

{

printf ("\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\");
printf ("Labirint generator");

// Clear labirint

for (int c = 0; c < size*size; c++) ((char *)m)[c] = 0;

// Make border

for (int i = 0; i <= size; i++)

{

m[0][i] = 1; m[size][i] = 1;

m[i][0] = 1; m[i][size] = 1;

}

view ();

initrandom();

int startx, starty;

while (getrandom (startx, starty))

{

if (m[starty][startx]==1) continue;

if (random (100) > fullfill) continue;

int sx=0,sy=0;

do

{

sx=random (3)-1;

sy=random (3)-1;

} while (sx==0 && sy==0 || sx!=0 && sy!=0); //sx==0 and sy==0

while (m[starty][startx]==0)

{

if (random (100) > wallshort)

{m[starty][startx] = 1; break;}

m[starty][startx] = 1;

startx +=sx; starty+=sy;

m[starty][startx] = 1;

startx +=sx; starty+=sy;

}

}

view();

return 0;

}
______________________________________________________
Заранее благодарен.

[GSerg]

Код: Выделить всё

Option Explicit

Private Const Size As Long = 20
Private Const FullFill As Long = 100
Private Const WallShort As Long = 50

Private M() As Byte
Private R() As Long
Private h

Private Sub InitRandom()
  Dim j As Long, x As Long, y As Long
 
  ReDim R(0 To 1, 0 To Size / 2 * Size / 2 - 1) As Long
  For y = 2 To Size Step 2
    For x = 2 To Size Step 2
      R(0, j) = x
      R(1, j) = y
      j = j + 1
    Next
  Next
  h = j - 1
End Sub

Private Function GetRandom(ByRef outX As Long, ByRef outY As Long) As Long
  Dim i As Long
 
  i = Rnd * h
  outX = R(0, i): outY = R(1, i)
  R(0, i) = R(0, h): R(1, i) = R(1, h)
  GetRandom = h
  h = h - 1
End Function

Private Sub MakeMaze()
  Dim i As Long
  Dim StartX As Long, StartY As Long
  Dim sx As Long, sy As Long
 
  ReDim M(0 To Size, 0 To Size) As Byte
 
  'Make border
  For i = 0 To Size
    M(0, i) = 1: M(Size, i) = 1
    M(i, 0) = 1: M(i, Size) = 1
  Next
 
  InitRandom
 
  Do While GetRandom(StartX, StartY)
    If M(StartY, StartX) <> 1 And Rnd * 100 <= FullFill Then
      Do
        sx = Rnd * 3 - 1
        sy = Rnd * 3 - 1
      Loop While (sx = 0 And sy = 0) Or (sx <> 0 And sy <> 0)
      Do While M(StartY, StartX) = 0
        If Rnd * 100 > WallShort Then M(StartY, StartX) = 1: Exit Do
        M(StartY, StartX) = 1
        StartX = StartX + sx: StartY = StartY + sy
        M(StartY, StartX) = 1
        StartX = StartX + sx: StartY = StartY + sy
      Loop
    End If
  Loop
End Sub

Private Sub PrintMaze()
  Dim i As Long, j As Long
 
  For i = 0 To Size
    For j = 0 To Size
      Debug.Print M(i, j);
    Next
    Debug.Print
  Next
End Sub

[leaveIIIusion]

Спасибо за перевод! В свою очередь выкладываю версию для VB.NET. Вдруг кому пригодится . Необходимо создать консольное приложение (Console Application) и вставить следующий код:

Код: Выделить всё

Module Module1
    Private Const Size As Long = 20
    Private Const FullFill As Long = 100
    Private Const WallShort As Long = 50

    Private M(,) As Byte
    Private R(,) As Long
    Private h

    Sub Main()
        MakeMaze()
        PrintMaze()
    End Sub


    Private Sub InitRandom()

        Dim j As Long, x As Long, y As Long

        ReDim R(1, Size / 2 * Size / 2 - 1)

        For y = 2 To Size Step 2
            For x = 2 To Size Step 2
                R(0, j) = x
                R(1, j) = y
                j = j + 1
            Next
        Next
        h = j - 1
    End Sub

    Private Function GetRandom(ByRef outX As Long, ByRef outY As Long) As Long
        Dim i As Long

        i = Rnd() * h
        outX = R(0, i) : outY = R(1, i)
        R(0, i) = R(0, h) : R(1, i) = R(1, h)
        GetRandom = h
        h = h - 1
    End Function

    Private Sub MakeMaze()
        Dim i As Long
        Dim StartX As Long, StartY As Long
        Dim sx As Long, sy As Long

        ReDim M(Size, Size)

        'Make border
        For i = 0 To Size
            M(0, i) = 1 : M(Size, i) = 1
            M(i, 0) = 1 : M(i, Size) = 1
        Next

        InitRandom()

        Do While GetRandom(StartX, StartY)
            If M(StartY, StartX) <> 1 And Rnd() * 100 <= FullFill Then
                Do
                    sx = Rnd() * 3 - 1
                    sy = Rnd() * 3 - 1
                Loop While (sx = 0 And sy = 0) Or (sx <> 0 And sy <> 0)
                Do While M(StartY, StartX) = 0
                    If Rnd() * 100 > WallShort Then M(StartY, StartX) = 1 : Exit Do
                    M(StartY, StartX) = 1
                    StartX = StartX + sx : StartY = StartY + sy
                Loop
            End If
        Loop
    End Sub

    Private Sub PrintMaze()
        Dim i As Long, j As Long

        For i = 0 To Size
            For j = 0 To Size
                Console.Write(M(i, j))
            Next
            Console.WriteLine()
        Next
        Console.Read()
    End Sub
End Module


З.Ы. В скором времени может прокомментирую.