Forum > Graphics
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, Math, Generics.Collections; 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 DrawRect(x, y: Integer; AColor: TColor); procedure DrawPattern(x, y, RecIndex: Integer; Seeds: array of TColor); function ShuffleArray(const Colors: array of TColor): specialize TArray<TColor>; public end; var Form1: TForm1; Size, RecCount: Integer; K: Double; 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) ); Colors: array[0..5] of TColor = (clBlue, clSkyBlue, clCream, clYellow, clRed, clMaroon); implementation {$R *.lfm} { TForm1 } function TForm1.ShuffleArray(const Colors: array of TColor): specialize TArray<TColor>;var i, j: Integer; Temp: TColor; ResultArray: specialize TArray<TColor>;begin SetLength(ResultArray, Length(Colors)); for i := 0 to High(Colors) do ResultArray[i] := Colors[i]; for i := High(ResultArray) downto 1 do begin j := Random(i + 1); Temp := ResultArray[i]; ResultArray[i] := ResultArray[j]; ResultArray[j] := Temp; end; Result := ResultArray;end; procedure TForm1.FormCreate(Sender: TObject);begin Size := 5; RecCount := 5; K := 0.6; Randomize; PaintBox1.Width := Round(Power(Size, RecCount + 1) * K); PaintBox1.Height := Round(Power(Size, RecCount + 1) * K);end; procedure TForm1.PaintBox1Paint(Sender: TObject);begin btnRefreshClick(Sender);end; procedure TForm1.DrawPattern(x, y, RecIndex: Integer; Seeds: array of TColor);var i, j, NewX, NewY: Integer;begin for i := 0 to Size - 1 do for j := 0 to Size - 1 do begin NewX := x + i * Round(Power(Size, RecIndex + 1)); NewY := y + j * Round(Power(Size, RecIndex + 1)); if RecIndex = 0 then DrawRect(NewX, NewY, Seeds[Pattern[i, j]]) else DrawPattern(NewX, NewY, RecIndex - 1, Seeds[Pattern[i, j]]); end;end; procedure TForm1.btnRefreshClick(Sender: TObject);var i, j, Seed: Integer; Seeds: array of TColor;begin with PaintBox1.Canvas do begin Brush.Color := clWhite; FillRect(PaintBox1.ClientRect); end; SetLength(Seeds, 6); for Seed := 0 to High(Seeds) do Seeds[Seed] := Colors[Seed]; Seeds := ShuffleArray(Seeds); for i := 0 to Size - 1 do for j := 0 to Size - 1 do if Pattern[i, j] <> -1 then DrawPattern(i * Size * Size * Size, j * Size * Size * Size, 1, Seeds);end; procedure TForm1.DrawRect(x, y: Integer; AColor: TColor);begin with PaintBox1.Canvas do begin Brush.Color := AColor; FillRect(Rect(Round(x * K), Round(y * K), Round((x + Size) * K), Round((y + Size) * K))); end;end; end.
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} --- 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<TColor>; 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<TColor>;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<TColor>; // Array to hold shuffled color arrays for each seed ShuffledColors: specialize TArray<TColor>; // 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
Navigation
[0] Message Index
[#] Next page