/packages/ptc/examples/flower.pp

  1{
  2Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net)
  3}
  4
  5{
  6 Flower demo for OpenPTC 1.0 C++ API
  7 Copyright (c) Scott Buchanan (aka Goblin)
  8 This source code is licensed under the GNU GPL
  9}
 10
 11program Flower;
 12
 13{$MODE objfpc}
 14
 15uses
 16  ptc, Math;
 17
 18function pack(r, g, b: Uint32): Uint32;
 19begin
 20  { pack color integer }
 21  pack := (r shl 16) or (g shl 8) or b;
 22end;
 23
 24procedure generate_flower(flower: IPTCSurface);
 25var
 26  data: PUint8;
 27  x, y, fx, fy, fx2, fy2: Integer;
 28  TWO_PI: Single;
 29begin
 30  { lock surface }
 31  data := flower.lock;
 32
 33  try
 34    { surface width and height constants for cleaner code }
 35    fx := flower.width;
 36    fy := flower.height;
 37    fx2 := fx div 2;
 38    fy2 := fy div 2;
 39
 40    { useful 2*pi constant }
 41    TWO_PI := 2 * PI;
 42
 43    { generate flower image }
 44    for y := 0 to fy - 1 do
 45      for x := 0 to fx - 1 do
 46        data[x + y * fx] := Trunc(1.0 * Cos(18*ArcTan2((y - fy2),(x - fx2))) * 255 / TWO_PI +
 47                                  0.3 * Sin(15*ArcTan2((y - fy2),(x - fx2))) * 255 / TWO_PI +
 48                                  Sqrt((y - fy2) * (y - fy2) + (x - fx2) * (x - fx2))) and $FF;
 49
 50    { You might want to move the 1.0 and 0.3 and the 18 and the 15
 51      to parameters passed to the generate function...
 52      the 1.0 and the 0.3 define the 'height' of the flower, while the
 53      18 and 15 control the number of 'petals' }
 54  finally
 55    flower.unlock;
 56  end;
 57end;
 58
 59procedure generate(palette: IPTCPalette);
 60var
 61  data: PUint32;
 62  i, c: Integer;
 63begin
 64  { lock palette data }
 65  data := palette.Lock;
 66
 67  try
 68    { black to yellow }
 69    i := 0;
 70    c := 0;
 71    while i < 64 do
 72    begin
 73      data[i] := pack(c, c, 0);
 74      Inc(c, 4);
 75      Inc(i);
 76    end;
 77
 78    { yellow to red }
 79    c := 0;
 80    while i < 128 do
 81    begin
 82      data[i] := pack(255, 255 - c, 0);
 83      Inc(c, 4);
 84      Inc(i);
 85    end;
 86
 87    { red to white }
 88    c := 0;
 89    while i < 192 do
 90    begin
 91      data[i] := pack(255, c, c);
 92      Inc(c, 4);
 93      Inc(i);
 94    end;
 95
 96    { white to black }
 97    c := 0;
 98    while i < 256 do
 99    begin
100      data[i] := pack(255 - c, 255 - c, 255 - c);
101      Inc(c, 4);
102      Inc(i);
103    end;
104  finally
105    { unlock palette }
106    palette.Unlock;
107  end;
108end;
109
110var
111  console: IPTCConsole;
112  format: IPTCFormat;
113  flower_surface: IPTCSurface;
114  surface: IPTCSurface;
115  palette: IPTCPalette;
116  area: IPTCArea;
117  time, delta: Single;
118  scr, map: PUint8;
119  width, height, mapWidth: Integer;
120  xo, yo, xo2, yo2, xo3, yo3: Single;
121  offset1, offset2, offset3: Integer;
122  x, y: Integer;
123begin
124  try
125    try
126      { create format }
127      format := TPTCFormatFactory.CreateNew(8);
128
129      { create console }
130      console := TPTCConsoleFactory.CreateNew;
131
132      { create flower surface }
133      flower_surface := TPTCSurfaceFactory.CreateNew(640, 400, format);
134
135      { generate flower }
136      generate_flower(flower_surface);
137
138      { open console }
139      console.open('Flower demo', 320, 200, format);
140
141      { create surface }
142      surface := TPTCSurfaceFactory.CreateNew(320, 200, format);
143
144      { create palette }
145      palette := TPTCPaletteFactory.CreateNew;
146
147      { generate palette }
148      generate(palette);
149
150      { set console palette }
151      console.palette(palette);
152
153      { set surface palette }
154      surface.palette(palette);
155
156      { setup copy area }
157      area := TPTCAreaFactory.CreateNew(0, 0, 320, 200);
158
159      { time data }
160      time := 0;
161      delta := 0.04;
162
163      { main loop }
164      while not console.KeyPressed do
165      begin
166        { lock surface pixels }
167        scr := surface.lock;
168        try
169          map := flower_surface.lock;
170          try
171            { get surface dimensions }
172            width := surface.width;
173            height := surface.height;
174            mapWidth := flower_surface.width;
175
176            xo := (width / 2) + 120 * sin(time * 1.1 + 1.5);
177            yo := (height / 2) + 90 * cos(time * 0.8 + 1.1);
178            offset1 := Trunc(xo) + Trunc(yo) * mapWidth;
179
180            xo2 := (width / 2) + 120 * sin(time * 0.9 + 4.2);
181            yo2 := (height / 2) + 90 * cos(time * 0.7 + 6.9);
182            offset2 := Trunc(xo2) + Trunc(yo2) * mapWidth;
183
184            xo3 := (width / 2) + 120 * sin(time * 0.9 + 3.1);
185            yo3 := (height / 2) + 90 * cos(time * 1.1 + 1.2);
186            offset3 := Trunc(xo3) + Trunc(yo3) * mapWidth;
187
188            { vertical loop }
189            for y := 0 to height - 1 do
190              { horizontal loop }
191              for x := 0 to width - 1 do
192                scr[x + y * width] := (map[x + y * mapWidth + offset1] +
193                                       map[x + y * mapWidth + offset2] +
194                                       map[x + y * mapWidth + offset3]) and $FF;
195          finally
196            { unlock surface }
197            flower_surface.unlock;
198          end;
199        finally
200          { unlock surface }
201          surface.unlock;
202        end;
203
204        { copy surface to console }
205        surface.copy(console, area, area);
206
207        { update console }
208        console.update;
209
210        { update time }
211        time := time + delta;
212      end;
213    finally
214      if Assigned(console) then
215        console.close;
216    end;
217  except
218    on error: TPTCError do
219      { report error }
220      error.report;
221  end;
222end.