| Boolean: ReLoad https://boolean.forumenko.com/ |
|
| Генератор КвазиСлучайных Лабиринтов https://boolean.forumenko.com/topic13.html |
Страница 1 из 1 |
| Автор: | impersonalis [ 11-02, 00:07 ] |
| Заголовок сообщения: | Генератор КвазиСлучайных Лабиринтов |
Код: Const Const_Line_Size_of_Labirint%=10000
Type TSector Field left_wall% Field up_wall% Field x_position% Field y_position% ;= Field system_flag1% End Type Type TLabirint Field MAP.TSector[Const_Line_Size_of_Labirint%] Field Labirint_x_size_private% Field Labirint_y_size_private% End Type Function WALL_CanGo(WALL_ID.TSector,L.TLabirint) Local A.TSector Local B.TSector ;= A=TLabirint_GET(L,WALL_ID\y_position,WALL_ID\x_position) ;= Local AX=A\x_position Local AY=A\y_position Local BX=AX Local BY=AY If WALL_ID\Left_wall=False BX=AX-1 Else BY=AY-1 EndIf B=TLabirint_GET(L,BY,BX) If B=Null Return False Return IsConnect%(A,B,L) End Function Function WALL_CRACK(WALL_ID.TSector,L.TLabirint) Local A.TSector A=TLabirint_GET(L,WALL_ID\y_position,WALL_ID\x_position) If WALL_ID\Left_wall=True A\left_wall=False Else A\up_wall=False EndIf End Function Function CONSTRUCTOR.TLabirint(x_size%,y_size%) L.TLabirint=New TLabirint L\Labirint_x_size_private%=x_size L\Labirint_y_size_private%=y_size For Q=1 To L\Labirint_x_size_private For W=1 To L\Labirint_y_size_private Local Index2d=(W-1)*L\Labirint_x_size_private+(Q-1) L\MAP[Index2d]=New TSector L\MAP[Index2d]\left_wall=True L\MAP[Index2d]\up_wall=True L\MAP[index2d]\x_position=Q L\MAP[index2d]\y_position=W Next Next Return L End Function Function GENERATOR.TLabirint(x_size%,y_size%) L.TLabirint=CONSTRUCTOR(x_size,y_size) Local Ast.TSector[Const_Line_Size_of_Labirint%*2] Local Bst%[Const_Line_Size_of_Labirint%*2] Local Iptr=0;10 For Q=2 To L\Labirint_x_size_private For W=1 To L\Labirint_y_size_private Ast[Iptr]=New TSector Ast[Iptr]\left_wall=True Ast[Iptr]\up_wall=False Ast[Iptr]\x_position=Q Ast[Iptr]\y_position=W Iptr=Iptr+1 Next Next For Q=1 To L\Labirint_x_size_private For W=2 To L\Labirint_y_size_private Ast[Iptr]=New TSector Ast[Iptr]\left_wall=False Ast[Iptr]\up_wall=True Ast[Iptr]\x_position=Q Ast[Iptr]\y_position=W Iptr=Iptr+1 Next Next Local WALL_COUNT%=Iptr For I=0 To WALL_COUNT-1 Bst[i]=Rand(-x_size*y_size*4,x_size*y_size*4) Next ;= ;сортировка вставками For I=0 To WALL_COUNT-1;0! Local X=Bst[i] Local Z.Tsector=Ast[i] Local J For J=I-1 To 1 Step -1 If Bst[J]<X Exit Bst[J+1]=Bst[J] Ast[J+1]=Ast[J] Next Bst[J+1]=X Ast[J+1]=Z Next ;=== Local LOCATIONS=x_size*y_size Local ITER=0 While LOCATIONS>1 Local CURRENT_WALL_ID.TSector=Ast[ITER] ITER=ITER+1 If WALL_CanGo(CURRENT_WALL_ID,L)=False WALL_CRACK(CURRENT_WALL_ID,L) LOCATIONS=LOCATIONS-1 EndIf Wend ;= ;= Return L End Function Function TLabirint_GET.TSector(L.TLabirint,SNumber,CNumber) If SNumber>L\Labirint_y_size_private Or SNumber<1 Return Null If CNumber>L\Labirint_x_size_private Or CNumber<1 Return Null Local Index2d=(SNumber-1)*L\Labirint_x_size_private+(CNumber-1) Return L\MAP[Index2d] End Function Function TSector_PosEqual%(A.TSector,B.TSector) If A=Null Return False If B=Null Return False If A\x_position=B\x_position And A\y_position=B\y_position Return True Else Return False EndIf End Function Function TSector_CanGo%(y1%,x1%,y2%,x2%,L.TLabirint) A.TSector=TLabirint_GET(L,y1,x1) If A=Null Return False B.TSector=TLabirint_GET(L,y2,x2) If B=Null Return False If x2=x1+1 Return Not(B\left_wall) ElseIf x2=x1-1 Return Not(A\left_wall) ElseIf y2=y1-1 Return Not(A\up_wall) ElseIf y2=y1+1 Return Not(B\up_wall) Else Return False EndIf End Function Function IsConnect%(A.TSector,B.TSector,Labirint.TLabirint) For Q=1 To Labirint\Labirint_x_size_private For W=1 To Labirint\Labirint_y_size_private S.TSector=TLabirint_GET(Labirint,W,Q) S\system_flag1=False Next Next A\system_flag1=True ;==== Local flag%=1 While True bool=False For Q=1 To Labirint\Labirint_x_size_private For W=1 To Labirint\Labirint_y_size_private S.TSector=TLabirint_GET(Labirint,W,Q) If S\system_flag1=flag ;= If TSector_CanGo(W,Q,W,Q+1,Labirint)=True C.TSector=TLabirint_GET(Labirint,W,Q+1) If C\system_flag1=False C\system_flag1=flag+1 If TSector_PosEqual%(C,B)=True Return True bool=True EndIf EndIf ;= ;= If TSector_CanGo(W,Q,W,Q-1,Labirint)=True C.TSector=TLabirint_GET(Labirint,W,Q-1) If C\system_flag1=False C\system_flag1=flag+1 If TSector_PosEqual%(C,B)=True Return True bool=True EndIf EndIf ;= ;= If TSector_CanGo(W,Q,W-1,Q,Labirint)=True C.TSector=TLabirint_GET(Labirint,W-1,Q) If C\system_flag1=False C\system_flag1=flag+1 If TSector_PosEqual%(C,B)=True Return True bool=True EndIf EndIf ;= ;= If TSector_CanGo(W,Q,W+1,Q,Labirint)=True C.TSector=TLabirint_GET(Labirint,W+1,Q) If C\system_flag1=False C\system_flag1=flag+1 If TSector_PosEqual%(C,B)=True Return True bool=True EndIf EndIf ;= EndIf Next Next If bool=False Exit flag=flag+1 Wend Return False End Function Function show(k.TLabirint) ssx=16 Rect 0,0,k\Labirint_x_size_private*ssx,k\Labirint_y_size_private*ssx,0 For Q=1 To k\Labirint_x_size_private For W=1 To k\Labirint_y_size_private S.TSector=TLabirint_GET(k,W,Q) If S\left_wall=True Line (Q-1)*ssx,(W-1)*ssx,(Q-1)*ssx,W*ssx EndIf If S\up_wall=True Line (Q-1)*ssx,(W-1)*ssx,Q*ssx,(W-1)*ssx EndIf Next Next End Function ;========================== demo code Graphics 800,600,32 SetBuffer BackBuffer() SetFont LoadFont("arial",20) SeedRnd(MilliSecs()) Global z.TLabirint=GENERATOR(20,20) While Not KeyHit(1) show(z) Flip Wend End |
|
| Страница 1 из 1 | Часовой пояс: UTC + 3 часа |
| Powered by phpBB® Forum Software © phpBB Group http://www.phpbb.com/ |
|