+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Wave Function Collapse (/showthread.php?tid=2853)
Wave Function Collapse - aadityap0901 - 07-06-2024
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)
.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 FunctionRE: Wave Function Collapse - bplus - 07-06-2024
Welcome again @aadityap0901
a little introduction:
I think Aaditya is rising star like Ashish, only 18 years old from India. I had to invite here because of the work I've seen at the other forum and just about to start college.
I haven't tried the code yet but am sure it will be interesting
RE: Wave Function Collapse - bplus - 07-06-2024
Ah cool, luv it!
Nice graphic, now to study it to see what makes it tick
This is way different than other bit of code I'd seen under Wave Collapse Function title.
RE: Wave Function Collapse - a740g - 07-06-2024
Welcome to the QB64-PE forum Aaditya.
RE: Wave Function Collapse - bplus - 07-06-2024
Ah there's a guy whose brain you might wanna pick!
RE: Wave Function Collapse - aadityap0901 - 07-06-2024
Added a new tile and increased the size of the grid
WaveFunctionCollapse.zip (Size: 2.87 KB / Downloads: 150)
RE: Wave Function Collapse - bplus - 07-06-2024
Nice you cut the LOC by half by replacing DATA with images looks like it tiles in trapazoid screen fills now also.
RE: Wave Function Collapse - aadityap0901 - 07-10-2024
WFC based Sudoku Solver, cannot solve hard sudokus unfortunately
An example sudoku is loaded, but you can use arrow keys and numbers from 0 to 9 (0 to clear) to input in grid...
Hit enter and see the magic
Code: (Select All)
Screen _NewImage(18, 11, 0)
DefLng A-Z
Dim Grid(1 To 9, 1 To 9) As _Unsigned _Byte
Dim Omit(1 To 9, 1 To 9) As _Unsigned _Bit * 9
For I = 1 To 9: For J = 1 To 9
Read Grid(J, I)
Next J, I
Color 15, 0
PX = 1: PY = 1
Do
Cls , 0
_Limit 60
K$ = InKey$: Select Case K$
Case "0" To "9": Grid(PX, PY) = Val(K$): PX = PX + 1: If PX = 10 Then PX = 1: PY = PY + 1
If PY = 10 Then PY = 1
Case Chr$(13): Exit Do
Case Chr$(27): System
Case Chr$(0) + "H": If PY > 1 Then PY = PY - 1
Case Chr$(0) + "P": If PY < 9 Then PY = PY + 1
Case Chr$(0) + "K": If PX > 1 Then PX = PX - 1
Case Chr$(0) + "M": If PX < 9 Then PX = PX + 1
End Select
For I = 1 To 9
For J = 1 To 9
If PX = J And PY = I Then Color , 3 Else Color , 0
If Grid(J, I) Then Print Str$(Grid(J, I)); Else Print " ";
If J = 9 Then Print
Next J, I
_Display
Loop
_Title "Working"
Do
S = 0
Cls , 0
_Limit 10
GoSub UpdateOmit
For I = 1 To 9
For J = 1 To 9
'-------Solve-------
If Grid(J, I) = 0 Then
S = S + 1
End If
If Omit(J, I) Then
For K = 1 To 9
If _SetBit(Omit(J, I), K - 1) = 511 Then
Grid(J, I) = K
Exit For
End If
Next K
End If
'-------------------
'------Display------
If Grid(J, I) Then Print Str$(Grid(J, I)); Else Print " ";
If J = 9 Then Print
'-------------------
Next J, I
_Display
Loop While S
_Title "Done"
_Delay 1
Sleep
System
UpdateOmit:
For I = 1 To 9
For J = 1 To 9
For K = 1 To 9
If K = I Then _Continue
If Grid(K, J) Then Omit(I, J) = _SetBit(Omit(I, J), Grid(K, J) - 1)
Next K
For K = 1 To 9
If K = J Then _Continue
If Grid(I, K) Then Omit(I, J) = _SetBit(Omit(I, J), Grid(I, K) - 1)
Next K
__I = 3 * ((I - 1) \ 3)
__J = 3 * ((J - 1) \ 3)
For II = __I + 1 To __I + 3
For JJ = __J + 1 To __J + 3
If II = I And JJ = J Then _Continue
If Grid(II, JJ) Then Omit(I, J) = _SetBit(Omit(I, J), Grid(II, JJ) - 1)
Next JJ, II
Next J, I
Return
Data 9,0,6,3,4,0,8,1,0
Data 0,5,1,7,0,0,3,0,0
Data 4,7,0,0,9,1,0,0,5
Data 0,0,0,9,0,3,0,0,2
Data 0,0,2,0,8,7,0,0,0
Data 1,0,7,2,0,0,6,0,0
Data 0,8,5,0,0,9,1,0,0
Data 0,3,4,0,6,0,0,0,9
Data 0,1,0,5,0,8,7,0,6RE: Wave Function Collapse - bplus - 07-10-2024
Yeah I tried an Intermediate puzzle from my Sudoku app
Code: (Select All)
Data 0,0,4,0,0,7,5,0,0
Data 0,6,0,0,0,0,0,0,0
Data 0,8,7,9,2,0,3,0,0
Data 0,0,0,0,5,0,0,3,2
Data 0,2,0,0,0,0,1,0,4
Data 1,0,0,0,4,0,8,0,5
Data 8,0,0,0,7,2,0,0,3
Data 0,5,0,0,0,0,6,1,0
Data 7,0,0,1,6,5,0,2,0It got a couple lines solved but stopped
What is encouraging is that the numbers it did fill in were correct.