GBE.PlaneExtend.pas 7.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267
  1. unit GBE.PlaneExtend;
  2. (*
  3. Om:
  4. GBEPlaneExtend implements a rectangular mesh with oe source of sin wave
  5. Extended TWaveRec to calc amplitude and pitch
  6. Added excessive comments to help understanding Gregorys code
  7. *)
  8. interface
  9. uses
  10. System.SysUtils,
  11. System.Classes,
  12. System.Generics.Collections,
  13. System.Threading,
  14. System.Math.Vectors,
  15. System.RTLConsts,
  16. FMX.Types,
  17. FMX.Controls3D,
  18. FMX.Objects3D,
  19. FMX.Types3D,
  20. FMX.MaterialSources;
  21. type
  22. TWaveRec = record // calculates sin() wave amplitude at a given P (x,y)
  23. P, // wave origin
  24. D: TPoint3D;
  25. // wave params D = Point3D( MaxAmplitude, WaveLenght, WaveSpeed )
  26. function Wave(aSum, aX, aY, aT: single): single;
  27. function calcWaveAmplitudeAndPitch(aCap, aX, aY, aT: single;
  28. var aSumAmplitude, aSumDerivative: single): boolean;
  29. end;
  30. TGBEPlaneExtend = class(TPlane)
  31. private
  32. fAmplitude, fLongueur, fVitesse: single; // wave 1
  33. fOrigine: TPoint3D;
  34. procedure CalcWaves(D: TPoint3D); // D = Point3D(fAmplitude, fLongueur, fVitesse)
  35. protected
  36. fTime: single; // Om: movd stuff to protected
  37. fNbMesh: integer; // number of tiles in the mesh
  38. fActiveWaves, fShowlines, fUseTasks: boolean;
  39. fMaterialLignes: TColorMaterialSource;
  40. fCenter: TPoint3D;
  41. public
  42. constructor Create(AOwner: TComponent); override;
  43. destructor Destroy; override;
  44. procedure Render; override;
  45. // Property Data; //om: public
  46. function Altura(P: TPoint3D): single; // Om: calc wave amplitude on a point
  47. published
  48. property ActiveWaves: boolean read fActiveWaves write fActiveWaves;
  49. property Origine: TPoint3D read fOrigine write fOrigine;
  50. property Amplitude: single read fAmplitude write fAmplitude;
  51. property Longueur: single read fLongueur write fLongueur;
  52. property Vitesse: single read fVitesse write fVitesse;
  53. property ShowLines: boolean read fShowlines write fShowlines;
  54. property UseTasks: boolean read fUseTasks write fUseTasks;
  55. property MaterialLines: TColorMaterialSource read fMaterialLignes
  56. write fMaterialLignes;
  57. end;
  58. procedure Register;
  59. implementation //--------------------------------------------------------------
  60. // TWaveRec
  61. // wave world is x,y . z is the wave height ( amplitude )
  62. // /y
  63. // +---------/---------+
  64. // / ^ ^ / ^ ^ /
  65. // /---------+---------+----x
  66. // / ^ / ^ /
  67. // +---------/---------+
  68. //
  69. function TWaveRec.Wave(aSum, aX, aY, aT: single): single;
  70. // sums. Here aX,aY are in div units ( not m )
  71. var
  72. L, Ph: single;
  73. begin
  74. L := P.Distance(Point3d(aX, aY, 0)); // L= dist to sin wave origin
  75. Result := aSum;
  76. // start w/ previous sum, so we add wave amplitudes of different waves
  77. // D.x = MaxAmplitude in div ?
  78. // D.y = WaveLenght in div
  79. // D.z = WaveSpeed in div/s
  80. if (D.Y > 0) and (D.x > 0) then
  81. // ignore if wave length<=0 Om: ..or Amplitude=0 ( which produces no effect )
  82. begin
  83. Ph := L / D.Y - D.z * aT; // calc wave phase at the point
  84. Result := Result + D.x * sin(Ph) * 0.001;
  85. // sum sin() wave amplitude / 1000 ( result inside +- MaxAmplitude*0.001 )
  86. end;
  87. end;
  88. // here wave world is in x,y z is the wave height ( amplitude )
  89. function TWaveRec.calcWaveAmplitudeAndPitch(aCap, aX, aY, aT: single;
  90. var aSumAmplitude, aSumDerivative: single): boolean;
  91. var
  92. L, L0, L1, Ph, Ph0, Ph1, aAng, aAmp, aAmp0, aAmp1, aDeriv, DzaT: single;
  93. aP, P0, P1, DP: TPoint3D;
  94. begin
  95. Result := true; // always
  96. aP := Point3d(aX, aY, 0); // requested coordinate
  97. L := P.Distance(aP); // L= dist to sin wave origin P
  98. if (D.Y > 0) and (D.x > 0) then
  99. // ignore if wave length D.Y <= 0 or Amplitude D.x <=0
  100. begin
  101. Result := true;
  102. DzaT := D.z * aT; // memoise speed*DT (=wave displacement)
  103. Ph := L / D.Y - DzaT; // calc wave phase at the point P
  104. aAmp := D.x * sin(Ph) * 0.001;
  105. // add sin() wave amplitude / 1000 ( result inside +- MaxAmplitude*0.001 )
  106. // P.z := aAmp; //dont do that !
  107. // calc directional derivative
  108. aAng := -aCap * Pi / 180; // cap to radians
  109. DP := Point3d(sin(aAng), cos(aAng), 0) / 2;
  110. // semi displacement vector in boat direction dir
  111. // P0=pt 1/2 div before
  112. P0 := aP - DP; // move .5 unit in -cap direction
  113. L0 := P.Distance(P0); // calc amplitude for P0
  114. Ph0 := L0 / D.Y - DzaT;
  115. aAmp0 := D.x * sin(Ph0) * 0.001;
  116. // add sin() wave amplitude / 1000 ( result inside +- MaxAmplitude*0.001 )
  117. // P1=pt 1/2 div after
  118. P1 := aP + DP / 2; // move 0.5 unit in cap direction
  119. L1 := P.Distance(P1); // calc amplitude for P1
  120. Ph1 := L1 / D.Y - DzaT;
  121. aAmp1 := D.x * sin(Ph1) * 0.001;
  122. // derivative calculated from -0.5 to +0.5 div
  123. aDeriv := (aAmp1 - aAmp0); // directional derivative calculated in P0-P1
  124. // add amplitude to sum
  125. aSumAmplitude := aSumAmplitude + aAmp; // accumulate
  126. aSumDerivative := aSumDerivative + aDeriv;
  127. // derivative of sum = sum of derivatives
  128. end;
  129. end;
  130. // TGBEPlaneExtend
  131. procedure TGBEPlaneExtend.CalcWaves(D: TPoint3D);
  132. // D = Point3D(Amplitude, Longueur, Vitesse)
  133. var
  134. M: TMeshData;
  135. x, Y: integer;
  136. somme: single;
  137. front, back: PPoint3D;
  138. waveRec: TWaveRec;
  139. begin
  140. M := self.Data;
  141. // init waveRec
  142. waveRec.P := Point3d(SubdivisionsWidth, SubdivisionsHeight, 0) * 0.5 +
  143. fOrigine * fCenter;
  144. waveRec.D := D;
  145. for Y := 0 to SubdivisionsHeight do // 0..30 ( 30 divisions )
  146. for x := 0 to SubdivisionsWidth do
  147. begin
  148. front := M.VertexBuffer.VerticesPtr[x + (Y * (SubdivisionsWidth + 1))];
  149. back := M.VertexBuffer.VerticesPtr
  150. [fNbMesh + x + (Y * (SubdivisionsWidth + 1))];
  151. somme := 0;
  152. somme := waveRec.Wave(somme, x, Y, fTime);
  153. somme := somme * 100;
  154. front^.z := somme;
  155. back^.z := somme;
  156. end;
  157. M.CalcTangentBinormals;
  158. fTime := fTime + 0.01;
  159. // adv wave time by 0.01 seg. Should be 0.2s ? ( the animation speed )
  160. end;
  161. function TGBEPlaneExtend.Altura(P: TPoint3D): single; // Om:
  162. var
  163. M: TMeshData;
  164. x, Y: integer;
  165. front, back: PPoint3D;
  166. begin
  167. M := self.Data;
  168. x := Round(P.x);
  169. Y := Round(P.Y);
  170. if (x >= 0) and (x < SubdivisionsWidth) and (Y > 0) and
  171. (Y < SubdivisionsHeight) then
  172. begin
  173. front := M.VertexBuffer.VerticesPtr[x + (Y * (SubdivisionsWidth + 1))];
  174. back := M.VertexBuffer.VerticesPtr
  175. [fNbMesh + x + (Y * (SubdivisionsWidth + 1))];
  176. Result := (front^.z + back^.z) / 2; // ??
  177. end
  178. else
  179. Result := 0;
  180. end;
  181. constructor TGBEPlaneExtend.Create(AOwner: TComponent);
  182. begin
  183. inherited;
  184. fTime := 0; // wave time
  185. fAmplitude := 1; // wave params
  186. fLongueur := 1; // Om: only 1 ?
  187. fVitesse := 5; //
  188. self.SubdivisionsHeight := 30; // plane subdivisions
  189. self.SubdivisionsWidth := 30;
  190. fOrigine := Point3d(self.SubdivisionsWidth / self.Width,
  191. self.SubdivisionsHeight / self.Height, 2);
  192. fNbMesh := (SubdivisionsWidth + 1) * (SubdivisionsHeight + 1);
  193. // fCenter = SubD / width ( unit div/m )
  194. fCenter := Point3d(SubdivisionsWidth / self.Width,
  195. SubdivisionsHeight / self.Height, 0);
  196. fUseTasks := true; // default= using tasks
  197. end;
  198. destructor TGBEPlaneExtend.Destroy;
  199. begin
  200. inherited;
  201. end;
  202. procedure TGBEPlaneExtend.Render;
  203. var
  204. W1: TPoint3D;
  205. begin
  206. inherited;
  207. if fActiveWaves then
  208. begin
  209. W1 := Point3d(fAmplitude, fLongueur, fVitesse);
  210. if fUseTasks then
  211. begin
  212. TTask.Create(
  213. procedure
  214. begin
  215. CalcWaves(W1); // recalc mesh
  216. end).start;
  217. end
  218. else
  219. begin
  220. CalcWaves(W1);
  221. end;
  222. end;
  223. if ShowLines then
  224. Context.DrawLines(self.Data.VertexBuffer, self.Data.IndexBuffer,
  225. TMaterialSource.ValidMaterial(fMaterialLignes), 1);
  226. end;
  227. procedure Register;
  228. begin
  229. RegisterComponents('GXScene GBE', [TGBEPlaneExtend]);
  230. end;
  231. end.