Kind of confusing code (at least shown like this), functions returning functions. What's the origin of the snippets?This will require some digging on the source.
Kind of confusing code (at least shown like this), functions returning functions. What's the origin of the snippets?This will require some digging on the source.
From brazil (:
Pascal pownz!
Here's some code which uses virtual functions (as JSoftware) suggested. Most of the code should compile (I didn't test it). Let me know if you need more detailed explanation.
Code:/* def linear_gradient(start_value, stop_value, start_offset=0.0, stop_offset=1.0): return lambda offset: (start_value + ((offset - start_offset) / (stop_offset - start_offset) * (stop_value - start_value))) / 255.0 */ type Tabstract_linear_gradient_function = class function execute(offset: Single): Single; virtual; abstract; end; Tlinear_gradient_function = class(Tabstract_linear_gradient_function) start_value: Single; stop_value: Single; start_offset: Single; stop_offset: Single; constructor Create(start_v, stop_v, start_o, stop_o: Single); override; function execute(offset: Single): Single; override; end; constructor Tlinear_gradient_function.Create(start_v, stop_v, start_o, stop_o: Single); begin start_value := start_v; stop_value := stop_v; start_offset := start_o; stop_offset := stop_o; end; funciton Tlinear_gradient_function.execute(offset: Single): Single; begin Result := (start_value + ((offset - start_offset) / (stop_offset - start_offset) * (stop_value - start_value))) / 255.0; end; /* def RADIAL(center_x, center_y): return lambda x, y: (x - center_x) ** 2 + (y - center_y) ** 2 */ type Tvalue_func = class function execute(x, y: Single): Single; virtual; abstract; end; type TRADIAL_value_func = class(Tvalue_func) center_x: Single; center_y: Single; constructor Create(cx, cy: Single); override; function execute(x, y: Single): Single; override; end; constructor TRADIAL_value_func.Create(cx, cy: Single); begin center_x := cx; center_y := cy; end; function TRADIAL_value_func.execute(x, y: Single): Single; begin Result := Sqr(x - center_x) + Sqr(y - center_y); end; /* def GAUSSIAN(sigma): def add_noise(r, g, b): d = random.gauss(0, sigma) return r + d, g + d, b + d return add_noise */ type TRGB = record r, g, b: Single; end; Tnoise_func = class function execute(const rgb: TRGB): TRGB; virtual; abstract; end; TGAUSSIAN_noise_func = class(Tnoise_func) sigma: Single; constructor Create; function execute(const rgb: TRGB): TRGB; override; end; constructor TGAUSSIAN_noise_func.Create; begin end; function TGAUSSIAN_noise_func.execute(const rgb: TRGB): TRGB; var d: Single; begin d := RandomGauss(0, sigma); Result.r := rgb.r + d; Result.g := rgb.g + d; Result.b := rgb.b + d; end; /* def gradient(value_func, noise_func, DATA): def gradient_function(x, y): initial_offset = 0.0 v = value_func(x, y) for offset, start, end in DATA: if v < offset: r = linear_gradient(start[0], end[0], initial_offset, offset)(v) g = linear_gradient(start[1], end[1], initial_offset, offset)(v) b = linear_gradient(start[2], end[2], initial_offset, offset)(v) return noise_func(r, g, b) initial_offset = offset return noise_func(end[0] / 255.0, end[1] / 255.0, end[2] / 255.0) return gradient_function */ type TData = record _offset: Single; _start: array [0..2] of Single; _end: array [0..2] of Single; end; Tgradient_function = class value_func: Tvalue_func; noise_func: Tnoise_func;  ATA: array of TData; constructor Create(const vf: Tvalue_func; const nf: Tnoise_function; const d: array of TData); function execute(x, y: Single): TRGB; end; constructor Create(const vf: Tvalue_func; const nf: Tnoise_function; const d: array of TData); begin value_func := vf; noise_func := nf; 0  ATA := d; end; function Tgradient_function.execute(x, y: Single): TRGB; var initial_offset: Single; v: Single; i: Integer; rgb: TRGB; lg: Tabstract_linear_gradient_function; begin initial_offset := 0.0; v := value_func.execute(x, y); for i := 0 to Length(DATA) - 1 do begin if v < DATA[i]._offset then begin lg := Tlinear_gradient_function.Create(DATA[i]._start[0], DATA[i]._end[0], initial_offset, DATA[i]._offset); rgb.r := lg.execute(v); lg.Free; lg := Tlinear_gradient_function.Create(DATA[i]._start[1], DATA[i]._end[1], initial_offset, DATA[i]._offset); rgb.g := lg.execute(v); lg.Free; lg := Tlinear_gradient_function.Create(DATA[i]._start[2], DATA[i]._end[2], initial_offset, DATA[i]._offset); rgb.b := lg.execute(v); lg.Free; Result := noise_func.execute(rgb); Exit; end; initial_offset:= DATA[i]._offset; end; rgb.r := DATA[Length(DATA) - 1]._end[0] / 255.0; rgb.g := DATA[Length(DATA) - 1]._end[1] / 255.0; rgb.b := DATA[Length(DATA) - 1]._end[2] / 255.0; Result := noise_func(rgb); end; /* write_png("example11.png", 480, 100, gradient(RADIAL(0.5, 0.0), GAUSSIAN(0.01), [(0.8, (0x22, 0x22, 0x22), (0x00, 0x00, 0x00))] )) */ procedure main; const d: TData = (_offset: 0.8; _start: ($22, $22, $22); _end: ($00, $00, $00)); var vf: Tvalue_func; nf: Tnoise_func; gf: Tgradient_function; begin vf := TRADIAL_value_func.Create(0.5, 0.0); nf := TGAUSSIAN_noise_func(0.01); gf := Tgradient_function(vf, nf, d); write_png('example11.png', 480, 100, gf); gf.Free; vf.Free; nf.Free; end;
blog: http://alexionne.blogspot.com/
eek! Please use code blocks. Especially for big monsters like that. I made the fix for you though, have a look at it with the edit button, you'll see that the cdoe blocks are the same as before with the bbPHP and SMF BBCode.
On a more on-topic note, Python is a strange language. I wanted to take it up to do some programming on an old Roomba I have, but doesn't work. I imagine if you understood it well, you could translate it to Object Pascal. Are there any websites dedicated to programming in Python out there?
Games:
Seafox
Pages:
Syntax Error Software
itch.io page
Online Chess
http://gameknot.com/#paul_nicholls
My bad - will be more careful next time.
Personally, I like Python, and I use it alot to script something here-and-there. As of Python to Object Pascal conversion, it is possible (in the end, we are still in Turing-complete lands), but if your Python code (like the on above) uses features like lambda expressions, multiple result values, iterators, closures... you'll have really hard time converting it to Object Pascal code.Originally Posted by WILL
You're welcome! :-)
blog: http://alexionne.blogspot.com/
Hi alexione and all
After some fiddling around with the code supplied by alexione, I finally got it compiling, and then completely working...yay!
I have cleaned up the code and made it much easier to generate gradient images now LOL
The output is very slightly different at times, but is very subtle (possibly due to the HSV routine converting differently to the Python one, and the gaussian random function used I guess).
The code below is how I use the routines now (using examples from here [http://eldarion.com/blog/2009/08/18/...d-textures/]):
I have to post the actual unit code in the next post as it pushes this post over 10000 characters!Code:function CreateGradient(const aIndex: Integer): TImageBuffer; begin if aIndex = 0 then begin // Here is the famous blue gradient used by default in Pinax Result := CreateGradientImage(50,80,LINEAR_Y,NO_NOISE,[ NewData(1.00,RGB($00, $11, $33),RGB($00, $55, $77)) ]); end else if aIndex = 1 then begin // Here is a glassy button background and the code used to create it. // Notice the use of an HSV colour space to keep // consistent hue and saturation and only vary the value. Result := CreateGradientImage(200, 40,LINEAR_Y,NO_NOISE,[ NewData(0.5,HSV(0.55, 0.2, 0.40),HSV(0.55, 0.2, 0.54)), NewData(1.0,HSV(0.55, 0.2, 0.47),HSV(0.55, 0.2, 0.61)) ]); end else if aIndex = 2 then begin // This is an example of a subtle radial gradient combined with a Gaussian noise texture Result := CreateGradientImage(480, 100,RADIAL(0.5, 0.0),GAUSSIAN(0.01),[ NewData(0.8,RGB($22, $22, $22),RGB($00, $00, $00)) ]); end else if aIndex = 3 then begin // And finally here is a textured linear gradient inspired by Ryan Berg's // on http://djangofriendly.com/. Result := CreateGradientImage(200, 350, LINEAR_Y, GAUSSIAN(0.01),[ NewData(0.5,RGB($01, $10, $09),RGB($09, $2D, $1F)) ]); end; end; procedure TForm1.Button_CreateGradientClick(Sender: TObject); var x,y: Integer; ImageBuffer: TImageBuffer; Colour: TRGB; begin ImageBuffer := CreateGradient(RadioGroup_Gadients.ItemIndex); Image_Gradient.Width := ImageBuffer.Width; Image_Gradient.Height := ImageBuffer.Height; Image_Gradient.Picture.Bitmap.Width := ImageBuffer.Width; Image_Gradient.Picture.Bitmap.Height := ImageBuffer.Height; for y := 0 to ImageBuffer.Height - 1 do for x := 0 to ImageBuffer.Width - 1 do begin Colour := ImageBuffer.Pixels[y,x]; Image_Gradient.Picture.Bitmap.Canvas.Pixels[x,y] := Windows.RGB(Colour.r,Colour.g,Colour.b); end; Image_Gradient.Invalidate; Image_Gradient.Picture.SaveToFile('Gradient'+IntToStr(RadioGroup_Gadients.ItemIndex)+'.bmp'); end;
Thanks all, I hope someone else finds this useful
cheers,
Paul
Games:
Seafox
Pages:
Syntax Error Software
itch.io page
Online Chess
http://gameknot.com/#paul_nicholls
The attached code is the actual gradients unit (407 lines) unit_Gradients.txt
It was still too large, hence the attachment
I have also cleaned up the interface section and moved what wasn't needed into the implementation section...
cheers,
Paul
Last edited by paul_nicholls; 28-09-2010 at 05:47 AM. Reason: I changed the attached file a bit
Games:
Seafox
Pages:
Syntax Error Software
itch.io page
Online Chess
http://gameknot.com/#paul_nicholls
Bump!
cheers,
Paul
Games:
Seafox
Pages:
Syntax Error Software
itch.io page
Online Chess
http://gameknot.com/#paul_nicholls
Bookmarks