/packages/ptc/examples/flower.pp
https://github.com/slibre/freepascal · Puppet · 222 lines · 187 code · 35 blank · 0 comment · 13 complexity · bdc95d0a85b1aa3bd00a3238f483ba84 MD5 · raw file
- {
- Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net)
- }
- {
- Flower demo for OpenPTC 1.0 C++ API
- Copyright (c) Scott Buchanan (aka Goblin)
- This source code is licensed under the GNU GPL
- }
- program Flower;
- {$MODE objfpc}
- uses
- ptc, Math;
- function pack(r, g, b: Uint32): Uint32;
- begin
- { pack color integer }
- pack := (r shl 16) or (g shl 8) or b;
- end;
- procedure generate_flower(flower: IPTCSurface);
- var
- data: PUint8;
- x, y, fx, fy, fx2, fy2: Integer;
- TWO_PI: Single;
- begin
- { lock surface }
- data := flower.lock;
- try
- { surface width and height constants for cleaner code }
- fx := flower.width;
- fy := flower.height;
- fx2 := fx div 2;
- fy2 := fy div 2;
- { useful 2*pi constant }
- TWO_PI := 2 * PI;
- { generate flower image }
- for y := 0 to fy - 1 do
- for x := 0 to fx - 1 do
- data[x + y * fx] := Trunc(1.0 * Cos(18*ArcTan2((y - fy2),(x - fx2))) * 255 / TWO_PI +
- 0.3 * Sin(15*ArcTan2((y - fy2),(x - fx2))) * 255 / TWO_PI +
- Sqrt((y - fy2) * (y - fy2) + (x - fx2) * (x - fx2))) and $FF;
- { You might want to move the 1.0 and 0.3 and the 18 and the 15
- to parameters passed to the generate function...
- the 1.0 and the 0.3 define the 'height' of the flower, while the
- 18 and 15 control the number of 'petals' }
- finally
- flower.unlock;
- end;
- end;
- procedure generate(palette: IPTCPalette);
- var
- data: PUint32;
- i, c: Integer;
- begin
- { lock palette data }
- data := palette.Lock;
- try
- { black to yellow }
- i := 0;
- c := 0;
- while i < 64 do
- begin
- data[i] := pack(c, c, 0);
- Inc(c, 4);
- Inc(i);
- end;
- { yellow to red }
- c := 0;
- while i < 128 do
- begin
- data[i] := pack(255, 255 - c, 0);
- Inc(c, 4);
- Inc(i);
- end;
- { red to white }
- c := 0;
- while i < 192 do
- begin
- data[i] := pack(255, c, c);
- Inc(c, 4);
- Inc(i);
- end;
- { white to black }
- c := 0;
- while i < 256 do
- begin
- data[i] := pack(255 - c, 255 - c, 255 - c);
- Inc(c, 4);
- Inc(i);
- end;
- finally
- { unlock palette }
- palette.Unlock;
- end;
- end;
- var
- console: IPTCConsole;
- format: IPTCFormat;
- flower_surface: IPTCSurface;
- surface: IPTCSurface;
- palette: IPTCPalette;
- area: IPTCArea;
- time, delta: Single;
- scr, map: PUint8;
- width, height, mapWidth: Integer;
- xo, yo, xo2, yo2, xo3, yo3: Single;
- offset1, offset2, offset3: Integer;
- x, y: Integer;
- begin
- try
- try
- { create format }
- format := TPTCFormatFactory.CreateNew(8);
- { create console }
- console := TPTCConsoleFactory.CreateNew;
- { create flower surface }
- flower_surface := TPTCSurfaceFactory.CreateNew(640, 400, format);
- { generate flower }
- generate_flower(flower_surface);
- { open console }
- console.open('Flower demo', 320, 200, format);
- { create surface }
- surface := TPTCSurfaceFactory.CreateNew(320, 200, format);
- { create palette }
- palette := TPTCPaletteFactory.CreateNew;
- { generate palette }
- generate(palette);
- { set console palette }
- console.palette(palette);
- { set surface palette }
- surface.palette(palette);
- { setup copy area }
- area := TPTCAreaFactory.CreateNew(0, 0, 320, 200);
- { time data }
- time := 0;
- delta := 0.04;
- { main loop }
- while not console.KeyPressed do
- begin
- { lock surface pixels }
- scr := surface.lock;
- try
- map := flower_surface.lock;
- try
- { get surface dimensions }
- width := surface.width;
- height := surface.height;
- mapWidth := flower_surface.width;
- xo := (width / 2) + 120 * sin(time * 1.1 + 1.5);
- yo := (height / 2) + 90 * cos(time * 0.8 + 1.1);
- offset1 := Trunc(xo) + Trunc(yo) * mapWidth;
- xo2 := (width / 2) + 120 * sin(time * 0.9 + 4.2);
- yo2 := (height / 2) + 90 * cos(time * 0.7 + 6.9);
- offset2 := Trunc(xo2) + Trunc(yo2) * mapWidth;
- xo3 := (width / 2) + 120 * sin(time * 0.9 + 3.1);
- yo3 := (height / 2) + 90 * cos(time * 1.1 + 1.2);
- offset3 := Trunc(xo3) + Trunc(yo3) * mapWidth;
- { vertical loop }
- for y := 0 to height - 1 do
- { horizontal loop }
- for x := 0 to width - 1 do
- scr[x + y * width] := (map[x + y * mapWidth + offset1] +
- map[x + y * mapWidth + offset2] +
- map[x + y * mapWidth + offset3]) and $FF;
- finally
- { unlock surface }
- flower_surface.unlock;
- end;
- finally
- { unlock surface }
- surface.unlock;
- end;
- { copy surface to console }
- surface.copy(console, area, area);
- { update console }
- console.update;
- { update time }
- time := time + delta;
- end;
- finally
- if Assigned(console) then
- console.close;
- end;
- except
- on error: TPTCError do
- { report error }
- error.report;
- end;
- end.