/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

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