Random Carpet Designs: Lazzed Conversion from JavaScript gives incorrect pattern

[Boleeman]

Hi All.

Tried converting an interesting random carpet design made in JavaScript to Lazarus.
I get the rendering happening but the overall carpet design is not correct.

The Lazarus version has an incorrect uniform pattern.
The JavaScript has much more "Carpet-like" geometry.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   Math, Generics.Collections;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     btnRefresh: TButton;
17.     PaintBox1: TPaintBox;
18.     Panel1: TPanel;
19.     procedure btnRefreshClick(Sender: TObject);
20.     procedure FormCreate(Sender: TObject);
21.     procedure PaintBox1Paint(Sender: TObject);
22.   private
23.     procedure DrawRect(x, y: Integer; AColor: TColor);
24.     procedure DrawPattern(x, y, RecIndex: Integer; Seeds: array of TColor);
25.     function ShuffleArray(const Colors: array of TColor): specialize TArray<TColor>;
26.   public
27.  
28.   end;
29.  
30. var
31.   Form1: TForm1;
32.   Size, RecCount: Integer;
33.   K: Double;
34.   Pattern: array[0..4, 0..4] of Integer = (
35.     (0, 1, 2, 1, 0),
36.     (1, 3, 4, 3, 1),
37.     (2, 4, 5, 4, 2),
38.     (1, 3, 4, 3, 1),
39.     (0, 1, 2, 1, 0)
40.   );
41.   Colors: array[0..5] of TColor = (clBlue, clSkyBlue, clCream, clYellow, clRed, clMaroon);
42.  
43. implementation
44.  
45. {$R *.lfm}
46.  
47. { TForm1 }
48.  
49. function TForm1.ShuffleArray(const Colors: array of TColor): specialize TArray<TColor>;
50. var
51.   i, j: Integer;
52.   Temp: TColor;
53.   ResultArray: specialize TArray<TColor>;
54. begin
55.   SetLength(ResultArray, Length(Colors));
56.   for i := 0 to High(Colors) do
57.     ResultArray[i] := Colors[i];
58.  
59.   for i := High(ResultArray) downto 1 do
60.   begin
61.     j := Random(i + 1);
62.     Temp := ResultArray[i];
63.     ResultArray[i] := ResultArray[j];
64.     ResultArray[j] := Temp;
65.   end;
66.   Result := ResultArray;
67. end;
68.  
69. procedure TForm1.FormCreate(Sender: TObject);
70. begin
71.   Size := 5;
72.   RecCount := 5;
73.   K := 0.6;
74.   Randomize;
75.   PaintBox1.Width := Round(Power(Size, RecCount + 1) * K);
76.   PaintBox1.Height := Round(Power(Size, RecCount + 1) * K);
77. end;
78.  
79. procedure TForm1.PaintBox1Paint(Sender: TObject);
80. begin
81.   btnRefreshClick(Sender);
82. end;
83.  
84. procedure TForm1.DrawPattern(x, y, RecIndex: Integer; Seeds: array of TColor);
85. var
86.   i, j, NewX, NewY: Integer;
87. begin
88.   for i := 0 to Size - 1 do
89.     for j := 0 to Size - 1 do
90.     begin
91.       NewX := x + i * Round(Power(Size, RecIndex + 1));
92.       NewY := y + j * Round(Power(Size, RecIndex + 1));
93.       if RecIndex = 0 then
94.         DrawRect(NewX, NewY, Seeds[Pattern[i, j]])
95.       else
96.         DrawPattern(NewX, NewY, RecIndex - 1, Seeds[Pattern[i, j]]);
97.     end;
98. end;
99.  
100. procedure TForm1.btnRefreshClick(Sender: TObject);
101. var
102.   i, j, Seed: Integer;
103.   Seeds: array of TColor;
104. begin
105.   with PaintBox1.Canvas do
106.   begin
107.     Brush.Color := clWhite;
108.     FillRect(PaintBox1.ClientRect);
109.   end;
110.  
111.   SetLength(Seeds, 6);
112.   for Seed := 0 to High(Seeds) do
113.     Seeds[Seed] := Colors[Seed];
114.     Seeds := ShuffleArray(Seeds);
115.  
116.   for i := 0 to Size - 1 do
117.     for j := 0 to Size - 1 do
118.       if Pattern[i, j] <> -1 then
119.         DrawPattern(i * Size * Size * Size, j * Size * Size * Size, 1, Seeds);
120. end;
121.  
122. procedure TForm1.DrawRect(x, y: Integer; AColor: TColor);
123. begin
124.   with PaintBox1.Canvas do
125.   begin
126.     Brush.Color := AColor;
127.     FillRect(Rect(Round(x * K), Round(y * K), Round((x + Size) * K), Round((y + Size) * K)));
128.   end;
129. end;
130.  
131.  
132. end.
133.  

Not sure where the error is?

The JavaScript and Lazarus version uses a fixed array of 6 colours which are shuffled.
It then should draw symmetrical patterns using squares using  FillRect(Rect but somehow this is where it messes up.

[majolika]

DrawPattern just draws the same pattern all the time.
As I suppose (I'm not familiar with JS), this is there JavaScript get the different pattern every time:

JavaScript: drawPattern(newX, newY, seeds[ pattern [ i ] [ j ] ], recIndex - 1);

Pascal: DrawPattern(NewX, NewY, RecIndex - 1, Seeds;

I don't know how array works in JS but pattern seems shifted by i and j indices on every iteration.
You can debug this script step by step in your browser to see if my supposition correct or not.

[majolika]

As you can see in JS it's the recursion of patterns:
every carpet is the pattern of patterns, and every pattern is pattern of rectangles.
But now your carpet is a simple array of patterns so the recursion is broken somewhere.

[Boleeman]

You are correct of thinking every carpet is the pattern of patterns.

Ah, in the Lazzed version seeds just has the color array shuffled;

procedure TForm1.DrawCarpet;
var
  Seed, pi, pj, X, Y: Integer;
  Seeds: specialize TArray<TColor>;

In JavaScript we also have an array with patternsize with the shuffled colors, but that was not included in the Lazarus version.

const draw = () => {
  for (let seed = 0; seed < patternSize; seed++) {
    const seeds = [...Array(patternSize).keys()].map(() => shuffleArray(colors));

[Boleeman]

Getting closer to seeing patterns, but the colors seem to be quite dark.

Not entirely sure how seeds = [...Array(patternSize).keys()].map(() => shuffleArray(colors));  works in JavaScript ?

What does keys()].map(() do?

Somehow the pixels on the TPaintbox are way too dark and need to be lightened.
Are the colors perhaps being added together to darken them more or is the color mapping in the wrong order, as the googled definitopn of map.keys is that the keys (index values) are returned in the order they were inserted to make each fill pattern symmetrical?

I Googled:
The Map.keys() method is used to extract the keys from a given map object and return the iterator object of keys.
The keys are returned in the order they were inserted.



I made changes to procedure TForm1.DrawCarpet;

Code: Pascal  [Select][+][-]

1.  unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   Math;
10.  
11. type
12.   { TForm1 }
13.   TForm1 = class(TForm)
14.     btnRefresh: TButton;
15.     PaintBox1: TPaintBox;
16.     Panel1: TPanel;
17.     procedure btnRefreshClick(Sender: TObject);
18.     procedure FormCreate(Sender: TObject);
19.     procedure PaintBox1Paint(Sender: TObject);
20.   private
21.     procedure DrawCarpet;
22.     procedure DrawPattern(x, y, RecIndex: Integer; Seeds: array of TColor);
23.     procedure DrawRect(x, y: Integer; AColor: TColor);
24.     function ShuffleArray(Colors: array of TColor): specialize TArray<TColor>;
25.   end;
26.  
27. var
28.   Form1: TForm1;
29.   //Colors: array[0..5] of TColor = (clBlue, clSkyBlue, clCream, clOlive, clRed, clMaroon);
30.   Colors: array[0..5] of TColor = (clBlue, clSkyBlue, clCream, clOlive, clRed, clMaroon);
31.   Pattern: array[0..4, 0..4] of Integer = (
32.     (0, 1, 2, 1, 0),
33.     (1, 3, 4, 3, 1),
34.     (2, 4, 5, 4, 2),
35.     (1, 3, 4, 3, 1),
36.     (0, 1, 2, 1, 0)
37.   );
38.   SizeFactor: Integer = 5;
39.   RecCount: Integer = 5;
40.   k: Double = 0.6;
41.  
42. implementation
43.  
44. {$R *.lfm}
45.  
46. { Shuffle an array to randomize colors }
47. function TForm1.ShuffleArray(Colors: array of TColor): specialize TArray<TColor>;
48. var
49.   i, j: Integer;
50.   Temp: TColor;
51. begin
52.   SetLength(Result, Length(Colors));
53.   for i := 0 to High(Colors) do
54.     Result[i] := Colors[i];
55.  
56.   // Fisher-Yates shuffle
57.   for i := High(Result) downto 1 do
58.   begin
59.     j := Random(i + 1);
60.     Temp := Result[i];
61.     Result[i] := Result[j];
62.     Result[j] := Temp;
63.   end;
64. end;
65.  
66. procedure TForm1.DrawRect(x, y: Integer; AColor: TColor);
67. begin
68.   with PaintBox1.Canvas do
69.   begin
70.     Brush.Color := AColor;
71.     Pen.Style := psClear;  // No border on Rectangle
72.     FillRect(Round(x * k), Round(y * k), Round(x * k) + Round(SizeFactor * k), Round(y * k) + Round(SizeFactor * k));
73.   end;
74. end;
75.  
76. procedure TForm1.DrawPattern(x, y, RecIndex: Integer; Seeds: array of TColor);
77. var
78.   i, j, NewX, NewY, NewSize: Integer;
79. begin
80.   for i := 0 to SizeFactor - 1 do  // Ensure loop range matches JS 'size'
81.     for j := 0 to SizeFactor - 1 do
82.     begin
83.       NewX := x + i * Round(Power(SizeFactor, RecIndex + 1));
84.       NewY := y + j * Round(Power(SizeFactor, RecIndex + 1));
85.  
86.       if RecIndex = 0 then
87.         DrawRect(NewX, NewY, Seeds[Pattern[i, j]])  // Correctly assign colors based on the pattern
88.       else
89.         DrawPattern(NewX, NewY, RecIndex - 1, Seeds[Pattern[i, j]]);  // Pass the correct color subset
90.     end;
91. end;
92.  
93.  
94. procedure TForm1.DrawCarpet;
95. var
96.   Seed, pi, pj, X, Y: Integer;
97.   Seeds: array of specialize TArray<TColor>;  // Array to hold shuffled color arrays for each seed
98.   ShuffledColors: specialize TArray<TColor>;  // Temporary array for shuffled colors
99.   patternSize: Integer;
100. begin
101.   patternSize := 6;  // Set the pattern size to match the number of colors
102.  
103.  
104.   SetLength(Seeds, patternSize);
105.  
106.   // Shuffle colors for each seed and store in the Seeds array
107.   for Seed := 0 to patternSize - 1 do
108.   begin
109.     ShuffledColors := ShuffleArray(Colors);
110.     Seeds[Seed] := ShuffledColors;  // Store shuffled colors for this seed
111.   end;
112.  
113.   with PaintBox1.Canvas do
114.   begin
115.     Brush.Color := clWhite;
116.     FillRect(PaintBox1.ClientRect);
117.   end;
118.  
119.   for Seed := 0 to patternSize - 1 do
120.   begin
121.     for pi := 0 to SizeFactor - 1 do
122.       for pj := 0 to SizeFactor - 1 do
123.       begin
124.         if Pattern[pi, pj] <> Seed then
125.           Continue;
126.  
127.         X := pi * SizeFactor * SizeFactor * SizeFactor;
128.         Y := pj * SizeFactor * SizeFactor * SizeFactor;
129.  
130.         // Pass the shuffled colors for the current seed
131.         DrawPattern(X, Y, 1, Seeds[Seed]);
132.       end;
133.   end;
134. end;
135.  
136. procedure TForm1.PaintBox1Paint(Sender: TObject);
137. begin
138.    DrawCarpet;
139. end;
140.  
141. procedure TForm1.FormCreate(Sender: TObject);
142. begin
143.   Randomize;
144.   Paintbox1.Width:= Round(Power(SizeFactor, RecCount + 1) * k);
145.   Paintbox1.Height:= Round(Power(SizeFactor, RecCount + 1) * k);
146.   DrawCarpet;
147. end;
148.  
149. procedure TForm1.btnRefreshClick(Sender: TObject);
150. begin
151.    DrawCarpet;
152. end;
153.  
154. end.

The second attached png shows the positional mapping of the squares with the same fill pattern.
As can be seen:

Going horizontally across the top row gives the same fill pattern order as going vertically down the first column.
                      Red, Pink, Blue, Pink, Red                                                    Red, Pink, Blue, Pink, Red 
     
Going horizontally across the middle row gives the same fill pattern order as going vertically down the middle column.
                      blue, Yellow, none, Yellow, blue                                            blue, Yellow, none, Yellow, blue

[majolika]

Carpet should not have black pixels. Something's going wrong.
If I were you I would try to rewrite this algorithm from scratch, step by step.
How to create a pattern (for simplicity assume that rectangle is just one pixel. ):

for PatternsCount to 0
     put the pixel at the relative coordinates you get from Pattern (for 5 it's 2,2, center);
     (for drawing you have to convert relative coordinates to real coordinates on canvas)

That's how you draw the rectangle.
Just repeat it and repeat it and your carpet will grow somehow like a fractal.

P.S.
Oh! You googled. That's cheating.

[Boleeman]

I zoomed in on the top row of squares in both versions and saw what you are talking about, but ...

fixing it "I am Stumped"



Actually as I was signing out I realized how the JavaScript was allocating the colours (as shown below in 2nd pmg)
Looks like the Lazarus version is not doing that color allocation of the rectangles  correctly!

That's it for today. Need a rest.

[majolika]

I hope you get an idea!

[majolika]

Look at the attachment.
It works on 0 and 1st levels of recursion but completely forget to remember and recall palettes generated on 2nd level of recursion.
Now you need a TList or something that could be a recursively nested dynamic array.
It will make procedure DrawCarpet more independent and formalized and you will have pissibility to draw a carpet of almost any sizes and patterns (uneven, of course).

[Boleeman]

Yes majolika, that's getting closer to the JavaScript version but in your version there are 25 different patterns.

How do we make only 6 patterns (0,1,2,3,4,5) with the positions like in:

    (0, 1, 2, 1, 0),
    (1, 3, 4, 3, 1),
    (2, 4, 5, 4, 2),
    (1, 3, 4, 3, 1),
    (0, 1, 2, 1, 0)

Thanks majolika for helping out.

[majolika]

Yes majolika, that's getting closer to the JavaScript version but in your version there are 25 different patterns.

It's because I leave some work for you to do.

Look, in case of 5x5 pattern we have 3 depths of recursion: the highest level — whole carpet, on 0 level — minimal pattern 5x5 "pixels" in the center.
DrawPattern procedure creates 6 palettes for every level of recursion depth but operates with only array of palettes.
You need something like dynamic array to save array of palettes on every level of recursion.
This will allow you to draw carpet with any other pattern sizes: 7x7, 9x9, 11x11...

How do we make only 6 patterns (0,1,2,3,4,5) with the positions like in:

Because we have 6 colors in this pattern. And we only need 6 palettes for 6 colors to make our carpet looks like the real carpet.
You can make another pattern with more or less colors but what you'll see is unpredictable.

[majolika]

And then you get DrawCarpet procedure to work you can easily convert you program to a tool for testing different carpets.
Just add on the left panel some sliders, color pickers etc...
For example like I did for testing some animations.

[Boleeman]

Created a 7x7 = 49 square carpet in JavaScript. Ran it OK in Firefox browser.

To generate a new carpet just click on the browser canvas.

JavaScript source is below.

Unfortunately the original saved png is 1.7Mb (original size 1223x1226 pixels), so it is too bit as an attachment.

Resized it and optimized to 140 kB to get a feel for what it looks like.

[majolika]

Created a 7x7 = 49 square carpet in JavaScript. Ran it OK in Firefox browser.

As I said it's because JS remembers all palettes on all levels of recursion in this line:

Code: Pascal  [Select][+][-]

1. const seeds = [...Array(patternSize).keys()].map(() => shuffleArray(colors));

I don't know how exactly it works but you should do the same in Lazarus version.
Don't worry about keys.map, just find a way to do the same job not the same expression.
Look once more:

seeds = [ ...Array ( patternSize ) .keys() ] .map( () => shuffleArray(colors) )

() => shuffleArray(colors) // colors shaffled and the new array of colors (that I call "palette") goes to map as a parameter
.map( () ) // map simply puts this new array of colors in the array seeds = [ ...Array ( patternSize ) .keys() ] every time when new palette's drawing starts

P.S.
Any time you try to recreate a program written in one language with another language don't try to copy it word by word. It's nonsense.
Because even if things seems  the same they can work in different ways.

[Boleeman]

I went back to a version that I had experimented with and changed

        X := pi * SizeFactor * SizeFactor * SizeFactor;
        Y := pj * SizeFactor * SizeFactor * SizeFactor;

to

        X := pi * SizeFactor * SizeFactor;
        Y := pj * SizeFactor * SizeFactor;

and that scaled level 1 OK.

I created 2 dynamic arrays which are:

  Seeds: array of specialize TArray<TColor>;  // Array to hold shuffled color arrays for each seed
  ShuffledColors: specialize TArray<TColor>;  // Temporary array for shuffled colors

but level 2 carpet is not five times as big ?

Was trying to compare your version to see how got it to the next level size.

With JavaScript Map, it remembers the order of the colors in the array.

Also used this with your version to make the carpet 7x7 = 49 squares

  pxsz: integer = 3; // size of carpet's "pixel"
  ptrnsz: Integer = 7; // size of carpet
  UsedColorOrders: array of TColorArray;
  Ptrn: TPatternArray = (
  (0, 1, 2, 3, 2, 1, 0),
  (1, 3, 4, 5, 4, 3, 1),
  (2, 4, 5, 6, 5, 4, 2),
  (3, 5, 6, 7, 6, 5, 3),
  (2, 4, 5, 6, 5, 4, 2),
  (1, 3, 4, 5, 4, 3, 1),
  (0, 1, 2, 3, 2, 1, 0)
  );
  Clrs: TColorArray = (clBlue, clSkyBlue, clCream, clYellow, clRed, clMaroon, $CDEDA3, $2778D2);
  Clrs2: TColorArray = ($C53F29, $DCB44B, $8A281E, $719AB7, $EDEDD3, $5778A2, $CDEDA3, $2778D2);   


Not sure why you said: TList needed, or something that could be a recursively nested dynamic array  as Seeds is a dynamic array created here:  SetLength(seeds, Length(plttpatt));   ?