fork download
copy 
  1. {$mode objfpc} {$longstrings+} {$modeswitch duplicatelocals}
  2. uses
  3. 	SysUtils, Math, StrUtils;
  4.  
  5. type
  6. 	float = single;
  7.  
  8. 	// для полуавтоматического подсчёта ссылок: сразу после создания объекта его
  9. 	// нужно присвоить какой-нибудь Reference, и пока объект нужен,
  10. 	// он должен быть присвоен хотя бы одной Reference.
  11. 	// Таким образом, сильная ссылка на объект T хранится как v: T + life: Reference.
  12. 	Reference = IInterface;
  13.  
  14. 	Vec3 = object
  15. 		x, y, z: float;
  16. 		class function Make(const x, y, z: float): Vec3; static;
  17. 		procedure &Set(const x, y, z: float);
  18. 		class function Zero: Vec3; static;
  19. 		function Length: float;
  20. 		function Normalized: Vec3;
  21. 		function ToString: string;
  22. 	end;
  23.  
  24. 	operator +(const a, b: Vec3): Vec3; begin result.&Set(a.x + b.x, a.y + b.y, a.z + b.z); end;
  25. 	operator -(const a, b: Vec3): Vec3;begin result.&Set(a.x - b.x, a.y - b.y, a.z - b.z); end;
  26. 	operator *(const a: Vec3; const b: float): Vec3; begin result.&Set(a.x * b, a.y * b, a.z * b); end;
  27.  
  28. 	class function Vec3.Make(const x, y, z: float): Vec3; begin result.&Set(x, y, z); end;
  29. 	procedure Vec3.&Set(const x, y, z: float); begin self.x := x; self.y := y; self.z := z; end;
  30. 	class function Vec3.Zero: Vec3; const ZeroVec3: Vec3 = (x: 0; y: 0; z: 0); begin result := ZeroVec3; end;
  31. 	function Vec3.Length: float; begin result := sqrt(sqr(x) + sqr(y) + sqr(z)); end;
  32. 	function Vec3.Normalized: Vec3; begin result := self * (1 / Length); end;
  33. 	function Vec3.ToString: string; begin result := FloatToStr(x) + ', ' + FloatToStr(y) + ', ' + FloatToStr(z); end;
  34.  
  35. 	// Для динамического роста массивов:
  36. 	// if count > length(storage) then SetLength(storage, ArrayGrowStgy(count, length(storage)));
  37. 	function ArrayGrowStgy(desired, physical: SizeInt): SizeInt;
  38. 	var
  39. 		delta: SizeInt;
  40. 	begin
  41. 		Assert(desired > physical);
  42. 		if physical <= 8 then delta := 4
  43. 		else if physical <= 64 then delta := 16
  44. 		else delta := physical div 4;
  45. 		result := max(desired, physical + delta);
  46. 	end;
  47.  
  48. type
  49. 	// Менеджер текущих и новых значений.
  50. 	// BindVec3 создаёт новый вектор и возвращает Vec3Binding с автоподсчётом в life.
  51. 	// Vec3Binding.value предоставляет доступ к этому вектору, при этом
  52. 	// запись откладывается до CommitFrame, или, другими словами,
  53. 	// чтение возвращает значение с последнего CommitFrame.
  54. 	CurNewManager = class(TInterfacedObject)
  55. 	type
  56. 		Vec3Binding = class(TInterfacedObject)
  57. 			destructor Destroy; override;
  58. 		private
  59. 			mgr: CurNewManager;
  60. 			mgrLife: Reference;
  61. 			id: SizeInt;
  62. 			curValue, newValue: Vec3;
  63. 		public
  64. 			property value: Vec3 read curValue write newValue;
  65. 		end;
  66.  
  67. 		function BindVec3(var life: Reference): Vec3Binding;
  68. 		procedure CommitFrame;
  69.  
  70. 	private
  71. 		nVec3s: SizeInt;
  72. 		vec3s: array of Vec3Binding;
  73. 	end;
  74.  
  75. 	destructor CurNewManager.Vec3Binding.Destroy;
  76. 	begin
  77. 		// Удалить вектор из менеджера.
  78. 		if Assigned(mgr) then
  79. 		begin
  80. 			mgr.vec3s[id] := mgr.vec3s[mgr.nVec3s - 1];
  81. 			mgr.vec3s[id].id := id;
  82. 			dec(mgr.nVec3s);
  83. 			mgr := nil;
  84. 		end;
  85. 	end;
  86.  
  87. 	function CurNewManager.BindVec3(var life: Reference): Vec3Binding;
  88. 	begin
  89. 		if nVec3s + 1 > length(vec3s) then
  90. 			SetLength(vec3s, ArrayGrowStgy(nVec3s + 1, length(vec3s)));
  91. 		result := Vec3Binding.Create; life := result;
  92. 		nVec3s += 1;
  93. 		vec3s[nVec3s - 1] := result;
  94. 		result.mgr := self; result.mgrLife := self;
  95. 		result.id := nVec3s - 1;
  96. 	end;
  97.  
  98. 	procedure CurNewManager.CommitFrame;
  99. 	var
  100. 		i: SizeInt;
  101. 	begin
  102. 		for i := 0 to nVec3s - 1 do
  103. 			vec3s[i].curValue := vec3s[i].newValue;
  104. 	end;
  105.  
  106. type
  107. 	Thing = class(TInterfacedObject)
  108. 		name: string;
  109. 		posBind: CurNewManager.Vec3Binding;
  110. 		posBindLife: Reference;
  111.  
  112. 		constructor Create(const name: string; mgr: CurNewManager);
  113. 		function ToString: string; override;
  114. 		function GetPos: Vec3;
  115. 		procedure SetPos(const value: Vec3);
  116. 		property pos: Vec3 read GetPos write SetPos;
  117. 	end;
  118.  
  119. 	constructor Thing.Create(const name: string; mgr: CurNewManager);
  120. 	begin
  121. 		inherited Create;
  122. 		self.name := name;
  123. 		posBind := mgr.BindVec3(posBindLife);
  124. 	end;
  125.  
  126. 	function Thing.ToString: string;
  127. 	begin
  128. 		result := name + ' (' + pos.ToString + ')';
  129. 	end;
  130.  
  131. 	function Thing.GetPos: Vec3;
  132. 	begin
  133. 		result := posBind.value;
  134. 	end;
  135.  
  136. 	procedure Thing.SetPos(const value: Vec3);
  137. 	begin
  138. 		posBind.value := value;
  139. 	end;
  140.  
  141. var
  142. 	mgr: CurNewManager;
  143. 	mgrLife: Reference;
  144. 	things: array of record
  145. 		t: Thing;
  146. 		tLife: Reference;
  147. 	end;
  148.  
  149. 	procedure CohereThingToCenter(t: Thing; const d: float);
  150. 	var
  151. 		i: SizeInt;
  152. 		center: Vec3;
  153. 	begin
  154. 		center := Vec3.Zero;
  155. 		for i := 0 to High(things) do
  156. 			center += things[i].t.pos;
  157. 		center *= 1 / length(things);
  158. 		writeln('Обновление ' + t.name + ': центр = ' + center.ToString);
  159. 		t.pos := t.pos + (center - t.pos).Normalized * d;
  160. 	end;
  161.  
  162. 	function DescribeThings: string;
  163. 	var
  164. 		i: SizeInt;
  165. 	begin
  166. 		result := '';
  167. 		for i := 0 to High(things) do
  168. 			result += IfThen(i > 0, ', ') + things[i].t.ToString;
  169. 	end;
  170.  
  171. var
  172. 	i: SizeInt;
  173.  
  174. begin
  175. 	mgr := CurNewManager.Create; mgrLife := mgr;
  176.  
  177. 	SetLength(things, 3);
  178. 	for i := 0 to High(things) do
  179. 	begin
  180. 		things[i].t := Thing.Create(chr(ord('A') + i mod (ord('Z') - ord('A') + 1)), mgr);
  181. 		things[i].tLife := things[i].t;
  182. 	end;
  183.  
  184. 	things[0].t.pos := Vec3.Make(10, 0, 0);
  185. 	things[1].t.pos := Vec3.Make(18, 0, 0);
  186. 	things[2].t.pos := Vec3.Make(20, 0, 0);
  187. 	mgr.CommitFrame;
  188. 	writeln('Начальные позиции: ' + DescribeThings);
  189.  
  190. 	for i := 0 to High(things) do CohereThingToCenter(things[i].t, 0.5);
  191. 	writeln('Позиции перед коммитом: ' + DescribeThings);
  192. 	mgr.CommitFrame;
  193. 	writeln('Позиции после коммита, придвинутые к центру на 0.5:' + LineEnding + DescribeThings);
  194. end.
Success #stdin #stdout 0s 4424KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Начальные позиции: A (10, 0, 0), B (18, 0, 0), C (20, 0, 0)
Обновление A: центр = 16, 0, 0
Обновление B: центр = 16, 0, 0
Обновление C: центр = 16, 0, 0
Позиции перед коммитом: A (10, 0, 0), B (18, 0, 0), C (20, 0, 0)
Позиции после коммита, придвинутые к центру на 0.5:
A (10.5, 0, 0), B (17.5, 0, 0), C (19.5, 0, 0)
https://ideone.com/5p1fGk
language:
Pascal (fpc 3.0.4)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!