Skip to content

Commit c984648

Browse files
PascalCorpsmanPascalCorpsman
committed
ADD: Speedup backtrack step evaluation
ADD: Show Grid option
1 parent 44e1b9f commit c984648

File tree

3 files changed

+125
-8
lines changed

3 files changed

+125
-8
lines changed

‎miniprojects/Wave_function_collapse/Tile_model/unit1.lfm

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -118,6 +118,7 @@ object Form1: TForm1
118118
Width = 50
119119
TabOrder = 4
120120
Text = 'Edit6'
121+
OnKeyPress = Edit6KeyPress
121122
end
122123
object Edit7: TEdit
123124
Left = 368
@@ -126,6 +127,7 @@ object Form1: TForm1
126127
Width = 50
127128
TabOrder = 5
128129
Text = 'Edit7'
130+
OnKeyPress = Edit6KeyPress
129131
end
130132
object Button4: TButton
131133
Left = 112
@@ -250,6 +252,36 @@ object Form1: TForm1
250252
TabOrder = 15
251253
OnClick = CheckBox3Click
252254
end
255+
object CheckBox4: TCheckBox
256+
Left = 332
257+
Height = 22
258+
Top = 547
259+
Width = 83
260+
Anchors = [akLeft, akRight, akBottom]
261+
Caption = 'show grid'
262+
TabOrder = 16
263+
OnClick = CheckBox4Click
264+
end
265+
object Button10: TButton
266+
Left = 440
267+
Height = 25
268+
Top = 544
269+
Width = 75
270+
Anchors = [akLeft, akBottom]
271+
Caption = 'Save Grid'
272+
TabOrder = 17
273+
OnClick = Button10Click
274+
end
275+
object Button11: TButton
276+
Left = 528
277+
Height = 25
278+
Top = 544
279+
Width = 75
280+
Anchors = [akLeft, akBottom]
281+
Caption = 'Load Grid'
282+
TabOrder = 18
283+
OnClick = Button11Click
284+
end
253285
object OpenDialog2: TOpenDialog
254286
DefaultExt = '.sys'
255287
Filter = 'System|*.sys|All|*.*'
@@ -275,4 +307,12 @@ object Form1: TForm1
275307
Left = 56
276308
Top = 184
277309
end
310+
object SaveDialog3: TSaveDialog
311+
Left = 464
312+
Top = 496
313+
end
314+
object OpenDialog1: TOpenDialog
315+
Left = 552
316+
Top = 496
317+
end
278318
end

‎miniprojects/Wave_function_collapse/Tile_model/unit1.pas

Lines changed: 75 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
(******************************************************************************)
22
(* Wave function collapse (tile model) 17.01.2024 *)
33
(* *)
4-
(* Version : 0.06 *)
4+
(* Version : 0.07 *)
55
(* *)
66
(* Author : Uwe Schächterle (Corpsman) *)
77
(* *)
@@ -29,6 +29,7 @@
2929
(* 0.04 - Add feature stop on miss *)
3030
(* 0.05 - Export as PNG *)
3131
(* 0.06 - Export of big images *)
32+
(* 0.07 - show grid option *)
3233
(* *)
3334
(******************************************************************************)
3435
// Inspired by https://www.youtube.com/watch?v=rI_y2GAlQFM
@@ -53,6 +54,8 @@
5354

5455
TForm1 = Class(TForm)
5556
Button1: TButton;
57+
Button10: TButton;
58+
Button11: TButton;
5659
Button2: TButton;
5760
Button3: TButton;
5861
Button4: TButton;
@@ -64,6 +67,7 @@
6467
CheckBox1: TCheckBox;
6568
CheckBox2: TCheckBox;
6669
CheckBox3: TCheckBox;
70+
CheckBox4: TCheckBox;
6771
Edit1: TEdit;
6872
Edit2: TEdit;
6973
Edit3: TEdit;
@@ -77,12 +81,16 @@
7781
Label1: TLabel;
7882
Label2: TLabel;
7983
Label3: TLabel;
84+
OpenDialog1: TOpenDialog;
8085
OpenDialog2: TOpenDialog;
8186
OpenPictureDialog1: TOpenPictureDialog;
8287
PaintBox1: TPaintBox;
8388
SaveDialog1: TSaveDialog;
8489
SaveDialog2: TSaveDialog;
90+
SaveDialog3: TSaveDialog;
8591
ScrollBox1: TScrollBox;
92+
Procedure Button10Click(Sender: TObject);
93+
Procedure Button11Click(Sender: TObject);
8694
Procedure Button1Click(Sender: TObject);
8795
Procedure Button2Click(Sender: TObject);
8896
Procedure Button3Click(Sender: TObject);
@@ -94,11 +102,13 @@
94102
Procedure Button9Click(Sender: TObject);
95103
Procedure CheckBox2Click(Sender: TObject);
96104
Procedure CheckBox3Click(Sender: TObject);
105+
Procedure CheckBox4Click(Sender: TObject);
97106
Procedure Edit1KeyUp(Sender: TObject; Var Key: Word; Shift: TShiftState);
98107
Procedure Edit2KeyUp(Sender: TObject; Var Key: Word; Shift: TShiftState);
99108
Procedure Edit3KeyUp(Sender: TObject; Var Key: Word; Shift: TShiftState);
100109
Procedure Edit4KeyUp(Sender: TObject; Var Key: Word; Shift: TShiftState);
101110
Procedure Edit5KeyUp(Sender: TObject; Var Key: Word; Shift: TShiftState);
111+
Procedure Edit6KeyPress(Sender: TObject; Var Key: char);
102112
Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
103113
Procedure FormCreate(Sender: TObject);
104114
Procedure FormDestroy(Sender: TObject);
@@ -138,7 +148,7 @@
138148

139149
Procedure TForm1.FormCreate(Sender: TObject);
140150
Begin
141-
caption := 'Wave Function Collapse Demo ver. 0.06';
151+
caption := 'Wave Function Collapse Demo ver. 0.07';
142152
// Aufräumen, der Entwickler Hilfen
143153
edit1.free;
144154
edit2.free;
@@ -240,6 +250,54 @@
240250
End;
241251
End;
242252

253+
Procedure TForm1.Button10Click(Sender: TObject);
254+
Var
255+
sl: TStringList;
256+
i, j: Integer;
257+
Begin
258+
If SaveDialog3.Execute Then Begin
259+
sl := TStringList.Create;
260+
sl.Clear;
261+
sl.add(edit6.text);
262+
sl.add(edit7.text);
263+
For i := 0 To high(wfc.Grid) Do Begin
264+
For j := 0 To high(wfc.Grid[i]) Do Begin
265+
If wfc.Grid[i, j].Forced Then Begin
266+
sl.Add(format('%d %d %d', [i, j, wfc.Grid[i, j].Index]));
267+
End;
268+
End;
269+
End;
270+
sl.SaveToFile(SaveDialog3.FileName);
271+
sl.free;
272+
End;
273+
End;
274+
275+
Procedure TForm1.Button11Click(Sender: TObject);
276+
Var
277+
sl: TStringList;
278+
i: Integer;
279+
sa: TStringArray;
280+
x, y, z: LongInt;
281+
Begin
282+
If OpenDialog1.Execute Then Begin
283+
sl := TStringList.Create;
284+
sl.LoadFromFile(OpenDialog1.FileName);
285+
edit6.Text := sl[0];
286+
edit7.Text := sl[1];
287+
Button3.Click;
288+
For i := 2 To sl.count - 1 Do Begin
289+
sa := sl[i].Split(' ');
290+
x := strtoint(sa[0]);
291+
y := strtoint(sa[1]);
292+
z := strtoint(sa[2]);
293+
wfc.Grid[x, y].Forced := true;
294+
wfc.Grid[x, y].Index := z;
295+
End;
296+
PaintBox1.Invalidate;
297+
sl.free;
298+
End;
299+
End;
300+
243301
Procedure TForm1.Button2Click(Sender: TObject);
244302
Begin
245303
// Load System
@@ -370,6 +428,11 @@
370428
PaintBox1.Invalidate;
371429
End;
372430

431+
Procedure TForm1.CheckBox4Click(Sender: TObject);
432+
Begin
433+
PaintBox1.Invalidate;
434+
End;
435+
373436
Procedure TForm1.Edit1KeyUp(Sender: TObject; Var Key: Word; Shift: TShiftState);
374437
Var
375438
index: integer;
@@ -410,6 +473,11 @@
410473
Images[index].Prop := strtointdef(Tedit(sender).Text, 0);
411474
End;
412475

476+
Procedure TForm1.Edit6KeyPress(Sender: TObject; Var Key: char);
477+
Begin
478+
If key = #13 Then button3.Click;
479+
End;
480+
413481
Procedure TForm1.FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
414482
Begin
415483
wfc.cancel := true;
@@ -630,14 +698,17 @@
630698
aCanvas.Draw(i * Images[0].Bitmap.Width, j * Images[0].Bitmap.Height, Images[wfc.Grid[i, j].Index].Bitmap);
631699
End;
632700
If (wfc.Grid[i, j].Forced And CheckBox2.Checked) Or
633-
(CheckBox3.Checked And (wfc.InvalidPos.X = i) And (wfc.InvalidPos.Y = j))
701+
(CheckBox3.Checked And (wfc.InvalidPos.X = i) And (wfc.InvalidPos.Y = j)) Or
702+
(CheckBox4.Checked)
634703
Then Begin
635704
aCanvas.Pen.Color := clred;
636705
If (CheckBox3.Checked And (wfc.InvalidPos.X = i) And (wfc.InvalidPos.Y = j)) Then Begin
637706
aCanvas.Pen.Color := clblue;
638707
End;
708+
If CheckBox4.Checked Then Begin
709+
aCanvas.Pen.Color := cllime;
710+
End;
639711
aCanvas.MoveTo((i + 0) * Images[0].Bitmap.Width, (j + 0) * Images[0].Bitmap.Height);
640-
641712
aCanvas.LineTo((i + 1) * Images[0].Bitmap.Width - 1, (j + 0) * Images[0].Bitmap.Height);
642713
aCanvas.LineTo((i + 1) * Images[0].Bitmap.Width - 1, (j + 1) * Images[0].Bitmap.Height - 1);
643714
aCanvas.LineTo((i + 0) * Images[0].Bitmap.Width, (j + 1) * Images[0].Bitmap.Height - 1);

‎miniprojects/Wave_function_collapse/Tile_model/uwfc.pas

Lines changed: 10 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,7 @@
7070
Function GetLeastProbList(): TPointList;
7171
Procedure InitGrid();
7272
Procedure PushGrid();
73-
Procedure PopGrid();
73+
Function PopGrid(): boolean;
7474
Procedure ClearGridstack();
7575

7676
public
@@ -259,16 +259,18 @@
259259

260260
End;
261261

262-
Procedure Twfc.PopGrid;
262+
Function Twfc.PopGrid: boolean;
263263
Var
264264
g: TGrid;
265265
i, j: Integer;
266266
Begin
267267
If gs.IsEmpty Then Begin
268268
// Der Jump ist derart Riesig, dass wir nichts mehr zum "popen" haben
269269
InitGrid();
270+
result := false;
270271
End
271272
Else Begin
273+
result := true;
272274
g := gs.Pop;
273275
For i := 0 To high(Grid) Do Begin
274276
For j := 0 To high(Grid[0]) Do Begin
@@ -384,7 +386,11 @@
384386
exit;
385387
End;
386388
For i := 0 To BackJumpCounter - 1 Do Begin
387-
PopGrid();
389+
If Not PopGrid() Then Begin
390+
// Der Stack war leer, also muss auch nicht mehr gepoppt werden ;)
391+
BackJumpCounter := 1;
392+
break;
393+
End;
388394
End;
389395
InvalidResult := false;
390396
WasInvalid := true;
@@ -412,7 +418,7 @@
412418
InvalidPos := point(-1, -1);
413419
End;
414420

415-
Procedure Twfc.ResetGrid();
421+
Procedure Twfc.ResetGrid;
416422
Var
417423
i, j: Integer;
418424
Begin

0 commit comments

Comments
 (0)