07-06-2024, 10:01 AM
Hello, this is my first post. 
I don't know where to post this, this place looked likely.
I learnt WFC yesterday, and it seemed easy, so I thought I would code and share it as my first program on this new forum:
If anyone wants to change images, you can change it in LoadImage function.
I wanna see how people use this idea, please share your creative designs (if possible)
.
I don't know where to post this, this place looked likely.
I learnt WFC yesterday, and it seemed easy, so I thought I would code and share it as my first program on this new forum:
If anyone wants to change images, you can change it in LoadImage function.
I wanna see how people use this idea, please share your creative designs (if possible)
.Code: (Select All)
Screen _NewImage(640, 640, 32)
Type Tile
As _Byte Omit 'BULDR in bits
As _Byte STATE
End Type
Const TILE_STATE_BLANK = 1, TILE_STATE_UP = 2, TILE_STATE_LEFT = 3, TILE_STATE_DOWN = 4, TILE_STATE_RIGHT = 5
Dim As Tile Tile_Empty, Tiles(1 To 64, 1 To 64), Tile_Up, Tile_Down, Tile_Left, Tile_Right
Dim As Long TileImages(0 To 5): For I = 0 To 5: TileImages(I) = LoadImage(I): Next I
'Place a random tile at center'
Randomize Timer: RandomTile Tiles(16 + CInt(Rnd * 32), 16 + CInt(Rnd * 32))
'Start the loop
S = 1
Do
Cls
'_Limit 16
If S = 0 Or Stuck Then
If S = 0 Then _Title "Finished" Else _Title "Stuck"
Do
_Limit 60
If _KeyDown(32) Then Run
If _KeyDown(27) Then System
Loop
Else
S = 0
For I = 1 To 64
For J = 1 To 64
If J > 1 Then Tile_Up = Tiles(I, J - 1) Else Tile_Up = Tile_Empty
If J < 64 Then Tile_Down = Tiles(I, J + 1) Else Tile_Down = Tile_Empty
If I < 64 Then Tile_Right = Tiles(I + 1, J) Else Tile_Right = Tile_Empty
If I > 1 Then Tile_Left = Tiles(I - 1, J) Else Tile_Left = Tile_Empty
UpdateTile Tiles(I, J), Tile_Up, Tile_Down, Tile_Left, Tile_Right
If J > 1 Then Tiles(I, J - 1) = Tile_Up
If J < 64 Then Tiles(I, J + 1) = Tile_Down
If I < 64 Then Tiles(I + 1, J) = Tile_Right
If I > 1 Then Tiles(I - 1, J) = Tile_Left
If Tiles(I, J).STATE Then _Continue
If TryTile(Tiles(I, J)) = 0 Then Stuck = -1
S = S + 1
Next J, I
End If
_Title "Working"
For I = 1 To 64: For J = 1 To 64: _PutImage (I * 10 - 10, J * 10 - 10)-(I * 10 - 1, J * 10 - 1), TileImages(Tiles(I, J).STATE): Next J, I
_Display
Loop
System
'--------------
Sub RandomTile (T As Tile)
Dim __T As Tile
T.STATE = Int(Rnd * 5) + 1
UpdateTile T, __T, __T, __T, __T
End Sub
Sub UpdateTile (T As Tile, TU As Tile, TD As Tile, TL As Tile, TR As Tile)
Select Case T.STATE
Case TILE_STATE_BLANK
TU.Omit = TU.Omit Or &B00111
TD.Omit = TD.Omit Or &B01101
TL.Omit = TL.Omit Or &B01011
TR.Omit = TR.Omit Or &B01110
Case TILE_STATE_UP
TU.Omit = TU.Omit Or &B11000
TD.Omit = TD.Omit Or &B01101
TL.Omit = TL.Omit Or &B10100
TR.Omit = TR.Omit Or &B10001
Case TILE_STATE_DOWN
TU.Omit = TU.Omit Or &B00111
TD.Omit = TD.Omit Or &B10010
TL.Omit = TL.Omit Or &B10100
TR.Omit = TR.Omit Or &B10001
Case TILE_STATE_LEFT
TU.Omit = TU.Omit Or &B11000
TD.Omit = TD.Omit Or &B10010
TL.Omit = TL.Omit Or &B10100
TR.Omit = TR.Omit Or &B01110
Case TILE_STATE_RIGHT
TU.Omit = TU.Omit Or &B11000
TD.Omit = TD.Omit Or &B10010
TL.Omit = TL.Omit Or &B01011
TR.Omit = TR.Omit Or &B10001
End Select
End Sub
Function TryTile (T As Tile)
Options$ = "BULDR"
SetOptions$ = ""
If T.Omit And &B10000 Then Asc(Options$, 1) = 0
If T.Omit And &B01000 Then Asc(Options$, 2) = 0
If T.Omit And &B00100 Then Asc(Options$, 3) = 0
If T.Omit And &B00010 Then Asc(Options$, 4) = 0
If T.Omit And &B00001 Then Asc(Options$, 5) = 0
For I = 1 To 5
If Asc(Options$, I) > 0 Then SetOptions$ = SetOptions$ + Chr$(Asc(Options$, I))
Next I
If Len(SetOptions$) = 0 Then Exit Function
If Len(SetOptions$) < 4 Then STATE = Asc(SetOptions$, Int(Rnd * Len(SetOptions$)) + 1)
Select Case STATE
Case 66: T.STATE = TILE_STATE_BLANK
Case 85: T.STATE = TILE_STATE_UP
Case 76: T.STATE = TILE_STATE_LEFT
Case 68: T.STATE = TILE_STATE_DOWN
Case 82: T.STATE = TILE_STATE_RIGHT
End Select
TryTile = -1
End Function
Function LoadImage& (I)
Select Case I
Case 0: LoadImage& = load_Empty&
Case 1: LoadImage& = load_Blank&
Case 2: LoadImage& = load_Up&
Case 3: LoadImage& = load_Left&
Case 4: LoadImage& = load_Down&
Case 5: LoadImage& = load_Right&
End Select
End Function
Function load_Empty&
O& = _NewImage(5, 5, 32)
__Dest = _Dest: _Dest O&
Restore Empty_data
For __X = 0 To 4: For __Y = 0 To 5
Read __P&
PSet (__X, __Y), __P&
Next __Y, __X
_Dest __Dest
load_Empty = O&
Exit Function
Empty_data:
Data &HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,
End Function
Function load_Blank&
O& = _NewImage(5, 5, 32)
__Dest = _Dest: _Dest O&
Restore Blank_data
For __X = 0 To 4: For __Y = 0 To 5
Read __P&
PSet (__X, __Y), __P&
Next __Y, __X
_Dest __Dest
load_Blank = O&
Exit Function
Blank_data:
Data &HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,
Data &HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,
Data &HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,
Data &HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,
Data &HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,
End Function
Function load_Up&
O& = _NewImage(5, 5, 32)
__Dest = _Dest: _Dest O&
Restore Up_data
For __X = 0 To 4: For __Y = 0 To 5
Read __P&
PSet (__X, __Y), __P&
Next __Y, __X
_Dest __Dest
load_Up = O&
Exit Function
Up_data:
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
End Function
Function load_Left&
O& = _NewImage(5, 5, 32)
__Dest = _Dest: _Dest O&
Restore Left_data
For __X = 0 To 4: For __Y = 0 To 5
Read __P&
PSet (__X, __Y), __P&
Next __Y, __X
_Dest __Dest
load_Left = O&
Exit Function
Left_data:
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,
End Function
Function load_Down&
O& = _NewImage(5, 5, 32)
__Dest = _Dest: _Dest O&
Restore Down_data
For __X = 0 To 4: For __Y = 0 To 5
Read __P&
PSet (__X, __Y), __P&
Next __Y, __X
_Dest __Dest
load_Down = O&
Exit Function
Down_data:
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
End Function
Function load_Right&
O& = _NewImage(5, 5, 32)
__Dest = _Dest: _Dest O&
Restore Right_data
For __X = 0 To 4: For __Y = 0 To 5
Read __P&
PSet (__X, __Y), __P&
Next __Y, __X
_Dest __Dest
load_Right = O&
Exit Function
Right_data:
Data &HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,&HFF00CFD4,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
Data &HFF1D2B3A,&HFF1D2B3A,&HFF00CFD4,&HFF1D2B3A,&HFF1D2B3A,
End Function