Random Carpet Designs: Worked it out another way. lazarus / 39-Graphics ---------------------------------------------------------------------- Boleeman · 2025-02-10 04:14 Worked it Out Another way. Yay. See last reply for download. ---------------------------------------------------------------------- majolika · 2025-02-10 08:34 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 · 2025-02-10 09:15 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 · 2025-02-10 09:35 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; 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 · 2025-02-10 10:28 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i  unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  Math; type  { TForm1 }  TForm1 = class(TForm)    btnRefresh: TButton;    PaintBox1: TPaintBox;    Panel1: TPanel;    procedure btnRefreshClick(Sender: TObject);    procedure FormCreate(Sender: TObject);    procedure PaintBox1Paint(Sender: TObject);  private    procedure DrawCarpet;    procedure DrawPattern(x, y, RecIndex: Integer; Seeds: array of TColor);    procedure DrawRect(x, y: Integer; AColor: TColor);    function ShuffleArray(Colors: array of TColor): specialize TArray;  end; var  Form1: TForm1;  //Colors: array[0..5] of TColor = (clBlue, clSkyBlue, clCream, clOlive, clRed, clMaroon);  Colors: array[0..5] of TColor = (clBlue, clSkyBlue, clCream, clOlive, clRed, clMaroon);  Pattern: array[0..4, 0..4] of Integer = (    (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)  );  SizeFactor: Integer = 5;  RecCount: Integer = 5;  k: Double = 0.6; implementation {$R *.lfm} { Shuffle an array to randomize colors }function TForm1.ShuffleArray(Colors: array of TColor): specialize TArray;var  i, j: Integer;  Temp: TColor;begin  SetLength(Result, Length(Colors));  for i := 0 to High(Colors) do    Result[i] := Colors[i];   // Fisher-Yates shuffle  for i := High(Result) downto 1 do  begin    j := Random(i + 1);    Temp := Result[i];    Result[i] := Result[j];    Result[j] := Temp;  end;end; procedure TForm1.DrawRect(x, y: Integer; AColor: TColor);begin  with PaintBox1.Canvas do  begin    Brush.Color := AColor;    Pen.Style := psClear;  // No border on Rectangle    FillRect(Round(x * k), Round(y * k), Round(x * k) + Round(SizeFactor * k), Round(y * k) + Round(SizeFactor * k));  end;end; procedure TForm1.DrawPattern(x, y, RecIndex: Integer; Seeds: array of TColor);var  i, j, NewX, NewY, NewSize: Integer;begin  for i := 0 to SizeFactor - 1 do  // Ensure loop range matches JS 'size'    for j := 0 to SizeFactor - 1 do    begin      NewX := x + i * Round(Power(SizeFactor, RecIndex + 1));      NewY := y + j * Round(Power(SizeFactor, RecIndex + 1));       if RecIndex = 0 then      DrawRect(NewX, NewY, Seeds[Pattern[i, j]])  // Correctly assign colors based on the pattern      else        DrawPattern(NewX, NewY, RecIndex - 1, Seeds[Pattern[i, j]]);  // Pass the correct color subset    end;end;  procedure TForm1.DrawCarpet;var  Seed, pi, pj, X, Y: Integer;  Seeds: array of specialize TArray;  // Array to hold shuffled color arrays for each seed  ShuffledColors: specialize TArray;  // Temporary array for shuffled colors  patternSize: Integer;begin  patternSize := 6;  // Set the pattern size to match the number of colors    SetLength(Seeds, patternSize);   // Shuffle colors for each seed and store in the Seeds array  for Seed := 0 to patternSize - 1 do  begin    ShuffledColors := ShuffleArray(Colors);  Seeds[Seed] := ShuffledColors;  // Store shuffled colors for this seed  end;   with PaintBox1.Canvas do  begin    Brush.Color := clWhite;    FillRect(PaintBox1.ClientRect);  end;   for Seed := 0 to patternSize - 1 do  begin    for pi := 0 to SizeFactor - 1 do      for pj := 0 to SizeFactor - 1 do      begin        if Pattern[pi, pj] <> Seed then          Continue;         X := pi * SizeFactor * SizeFactor * SizeFactor;        Y := pj * SizeFactor * SizeFactor * SizeFactor;         // Pass the shuffled colors for the current seed        DrawPattern(X, Y, 1, Seeds[Seed]);      end;  end;end; procedure TForm1.PaintBox1Paint(Sender: TObject);begin   DrawCarpet;end; procedure TForm1.FormCreate(Sender: TObject);begin  Randomize;  Paintbox1.Width:= Round(Power(SizeFactor, RecCount + 1) * k);  Paintbox1.Height:= Round(Power(SizeFactor, RecCount + 1) * k);  DrawCarpet;end; procedure TForm1.btnRefreshClick(Sender: TObject);begin   DrawCarpet;end; 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 · 2025-02-10 11:50 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 · 2025-02-10 12:10 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 · 2025-02-10 12:18 I hope you get an idea! ---------------------------------------------------------------------- majolika · 2025-02-11 17:01 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 · 2025-02-12 13:21 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 · 2025-02-12 14:47 Quote from: Boleeman on February 12, 2025, 02:21:29 pmYes 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... Quote from: Boleeman on February 12, 2025, 02:21:29 pmHow 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 · 2025-02-12 15:03 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 · 2025-02-14 07:39 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 · 2025-02-14 08:11 Quote from: Boleeman on February 14, 2025, 08:39:34 amCreated 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i 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 · 2025-02-14 10:12 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;  // Array to hold shuffled color arrays for each seed   ShuffledColors: specialize TArray;  // 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));   ? ---------------------------------------------------------------------- majolika · 2025-02-14 12:57 Quote from: Boleeman on February 14, 2025, 11:12:34 amthe order of the colors I call this "palette". I create the palettes with this cycle     for n := High(plttpatt) downto 0 do begin and use it with this cycle     for c := High(plttpatt) downto 0 do begin The order is the same. Quote from: Boleeman on February 14, 2025, 11:12:34 amNot 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));   ? Array Seeds saves the paletttes for this particular level of recursion. On the 0 level of recursion we use given palette (in other words, the given order of colors placed on the given pattern) to draw colors. On the higher levels of recursion we use given palette to draw previously saved palettes. For the 5x5 carpet it means that on the 1st level Seeds remembers the palettes for every 1/25 part of carpet but completely forget it when it's back on the 2nd level. Look: drawCarpet(5x5):    drawPalette, 2nd level — the whole carpet       create 6 seeds and save it in Seeds       drawPalette. 1st level — 1/25 part of carpet          create 6 seeds and save it in Seeds          drawPalette, 0 level — draw "pixels" aka rectangles       back to the 1st level and draw next palette from Seeds    back to the 2nd level and — boom! — we create new 6 seeds and save it in Seeds Of course you can use array of Seeds but this will works only for 2 levels of recursion depth. What if you'll need to go deeper? P.S. But maybe I'm wrong... Try to use array of Seeds. ---------------------------------------------------------------------- majolika · 2025-02-14 14:30 By the way, did you mention the const in JS source? I don't know JS but I suppose it prevents seeds of rewriting when procedure dives up on the higher level of recursion. That's why my version creates carpet with 25 different — let's call it "blocks" — of carpet. ---------------------------------------------------------------------- Boleeman · 2025-02-14 23:58 Decided to simplify things with just a 9 block carpet pattern. The pattern looks more like a table clothe pattern, as it only has 3 colors. Made a JavaScript version and it works well and saves to very small size, as it has only 3 colors and few pixel positions. I then tried a Lazarus version, but still no pattern conforming to the pattern map array at level 2. ---------------------------------------------------------------------- majolika · 2025-02-15 06:07 Quote from: Boleeman on February 15, 2025, 12:58:41 amI then tried a Lazarus version, but still no pattern conforming to the pattern map array at level 2. I suppose you get it wrong. Level 3 will be a carpet of 25 blocks of carpets (if we talk about 5x5 pattern). ---------------------------------------------------------------------- Boleeman · 2025-02-15 07:54 majolika, I ended up making a 3x3 version to try to further simplify the coding. Sort of got it working (conforming to the pattern map array) for the simplified 3x3 = 9 Blocks version, but I have extra colors. Comparing it to the JavaScript version output, the overall patterns look quite different. What is happening is when I use Round (and also with Trunc) in:         X := x0patt + pi * Round(Power(SizeFactor, seRecLevel.Value + 1 ));         Y := y0patt + pj * Round(Power(SizeFactor, seRecLevel.Value + 1 )); and in       NewX := x + i * Round(Power(SizeFactor, RecIndex ));       NewY := y + j * Round(Power(SizeFactor, RecIndex )); It seems to be interfering with DrawPattern(NewX, NewY, RecIndex - 1, Seeds[Pattern[i, j]]);   and adding extra colors. I have Indigo, clRed, clYellow in Colors: array[0..2] of TColor = (TColor($82004B), clRed, clYellow); but there are extra colors appearing on the TPaintbox canvas. ---------------------------------------------------------------------- Boleeman · 2025-07-26 15:11 Finally worked out another way of correctly getting the carpet pattern. Enjoy. Also been working on a higher resolution Carpet. Sample below. ---------------------------------------------------------------------- majolika · 2025-07-26 15:28 Great!