You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

510 lines
15 KiB

  1. unit utsCharCache;
  2. {$IFDEF FPC}
  3. {$mode objfpc}{$H+}
  4. {$ENDIF}
  5. interface
  6. uses
  7. Classes, SysUtils,
  8. utsChar, utsFont, utsUtils, utsContext, utsTypes, utsImage;
  9. type
  10. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  11. TtsCharArray = packed record
  12. Chars: array [Byte] of TtsChar;
  13. Count: Byte;
  14. end;
  15. PtsCharArray = ^TtsCharArray;
  16. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  17. TtsRenderRefGenerator = class(TtsRefManager)
  18. private
  19. fContext: TtsContext;
  20. fFormat: TtsFormat;
  21. public
  22. property Context: TtsContext read fContext;
  23. property Format: TtsFormat read fFormat;
  24. function CreateRenderRef(const aChar: TtsChar; const aImage: TtsImage): TtsRenderRef; virtual; abstract;
  25. procedure FreeRenderRef(const aRenderRef: TtsRenderRef); virtual; abstract;
  26. constructor Create(const aContext: TtsContext; const aFormat: TtsFormat);
  27. end;
  28. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  29. TtsChars = class(TObject)
  30. private
  31. fRenderRefGenerator: TtsRenderRefGenerator;
  32. fFont: TtsFont;
  33. fCanCreate: Boolean;
  34. fChars: array[Byte] of PtsCharArray;
  35. function GenerateChar(const aCharCode: WideChar): TtsChar;
  36. public
  37. function GetChar(const aCharCode: WideChar): TtsChar;
  38. function AddChar(const aCharCode: WideChar): TtsChar;
  39. procedure DelChar(const aCharCode: WideChar);
  40. procedure AddCharRange(const aStart, aStop: WideChar);
  41. procedure DelCharRange(const aStart, aStop: WideChar);
  42. procedure Clear;
  43. public
  44. property CanCreate: Boolean read fCanCreate write fCanCreate;
  45. property Char[const aCharCode: WideChar]: TtsChar read GetChar;
  46. function GetTextWidthW(aText: PWideChar): Integer;
  47. function GetTextWidthA(aText: PAnsiChar): Integer;
  48. constructor Create(const aRenderRefGen: TtsRenderRefGenerator; const aFont: TtsFont);
  49. destructor Destroy; override;
  50. end;
  51. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  52. PtsCharCacheItem = ^TtsCharCacheItem;
  53. TtsCharCacheItem = packed record
  54. key: TtsFont;
  55. val: TtsChars;
  56. end;
  57. TtsCharCache = class(TtsRefManager)
  58. private
  59. fRenderRefGenerator: TtsRenderRefGenerator;
  60. fItems: TList;
  61. function GetChars(const aKey: TtsFont): TtsChars;
  62. function Find(const aMin, aMax: Integer; const aKey: TtsFont; out aIndex: Integer): Integer;
  63. protected
  64. function DelSlave(const aSlave: TtsRefManager): Boolean; override;
  65. public
  66. property Chars[const aKey: TtsFont]: TtsChars read GetChars;
  67. procedure Clear;
  68. constructor Create(const aRenderRefGen: TtsRenderRefGenerator);
  69. destructor Destroy; override;
  70. end;
  71. implementation
  72. uses
  73. Math,
  74. utsConstants;
  75. type
  76. TtsWritableChar = class(TtsChar)
  77. public
  78. property RenderRef: TtsRenderRef read fRenderRef write fRenderRef;
  79. end;
  80. {$IFNDEF fpc}
  81. {$IFDEF WIN64}
  82. PtrUInt = System.UInt64;
  83. {$ELSE}
  84. PtrUInt = Cardinal;
  85. {$ENDIF}
  86. {$ENDIF}
  87. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  88. //TtsChars//////////////////////////////////////////////////////////////////////////////////////////////////////////////
  89. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  90. function TtsChars.GenerateChar(const aCharCode: WideChar): TtsChar;
  91. var
  92. GlyphSize: TtsPosition;
  93. CharImage: TtsImage;
  94. m: TtsGlyphMetric;
  95. c: TtsWritableChar;
  96. procedure FillLine(aData: PByte);
  97. var
  98. w, i: Integer;
  99. c: TtsColor4f;
  100. tmp: PByte;
  101. begin
  102. w := CharImage.Width;
  103. while (w > 0) do begin
  104. tmp := aData;
  105. tsFormatUnmap(CharImage.Format, tmp, c);
  106. for i := 0 to 3 do
  107. c.arr[i] := 1.0;
  108. tsFormatMap(CharImage.Format, aData, c);
  109. dec(w);
  110. end;
  111. end;
  112. procedure DrawLine(aLinePosition, aLineSize: Integer);
  113. var
  114. ImgSize, ImgPos, Origin: TtsPosition;
  115. Rect: TtsRect;
  116. YOffset, y: Integer;
  117. begin
  118. if aLineSize <= 0 then
  119. exit;
  120. aLinePosition := aLinePosition - aLineSize;
  121. // calculate width and height
  122. ImgPos := tsPosition(0, 0);
  123. ImgSize := tsPosition(CharImage.Width, CharImage.Height);
  124. Origin := m.GlyphOrigin;
  125. Rect := m.GlyphRect;
  126. // expand left rect border to origin
  127. if (Origin.x > 0) then begin
  128. dec(Rect.Left, Origin.x);
  129. Origin.x := 0;
  130. end;
  131. // expand right rect border to advanced
  132. if (Rect.Right - Rect.Left < m.Advance) then begin
  133. Rect.Right := Rect.Left + m.Advance;
  134. end;
  135. // expand bottom rect border
  136. if (Origin.y - aLinePosition > Rect.Bottom) then begin
  137. Rect.Bottom := Origin.y - aLinePosition;
  138. end;
  139. // expand top rect border
  140. if (Origin.y - aLinePosition - aLineSize < Rect.Top) then begin
  141. Rect.Top := Origin.y - aLinePosition - aLineSize;
  142. Origin.y := aLinePosition + aLineSize;
  143. end;
  144. // update image size
  145. if (Rect.Right - Rect.Left > ImgSize.x) then begin
  146. ImgSize.x := Rect.Right - Rect.Left;
  147. ImgPos.x := Max(-Rect.Left, 0);
  148. inc(Rect.Left, ImgPos.x);
  149. inc(Rect.Right, ImgPos.x);
  150. end;
  151. if (Rect.Bottom - Rect.Top > ImgSize.y) then begin
  152. ImgSize.y := Rect.Bottom - Rect.Top;
  153. ImgPos.y := Max(-Rect.Top, 0);
  154. inc(Rect.Top, ImgPos.y);
  155. inc(Rect.Bottom, ImgPos.y);
  156. end;
  157. CharImage.Resize(ImgSize.x, ImgSize.y, ImgPos.x, ImgPos.y);
  158. // draw lines
  159. YOffset := Rect.Top + Origin.y - aLinePosition;
  160. for y := 1 to aLineSize do
  161. FillLine(CharImage.ScanLine[YOffset - y]);
  162. // move glyph rect
  163. m.GlyphOrigin := Origin;
  164. m.GlyphRect := Rect;
  165. end;
  166. begin
  167. result := nil;
  168. if (aCharCode <> #0) and
  169. (not fFont.GetGlyphMetrics(aCharCode, m.GlyphOrigin, GlyphSize, m.Advance) or
  170. not ((m.GlyphOrigin.x <> 0) or
  171. (m.GlyphOrigin.y <> 0) or
  172. (GlyphSize.x <> 0) or
  173. (GlyphSize.y <> 0) or
  174. (m.Advance <> 0))) then
  175. exit;
  176. CharImage := TtsImage.Create(nil);
  177. try
  178. if (aCharCode = #0) then begin
  179. CharImage.CreateEmpty(fRenderRefGenerator.Format, 3, 1);
  180. m.GlyphOrigin := tsPosition(0, 1);
  181. m.Advance := 1;
  182. end else if (GlyphSize.x > 0) and (GlyphSize.y > 0) then
  183. fFont.GetCharImage(aCharCode, CharImage, fRenderRefGenerator.Format);
  184. if CharImage.IsEmpty and ([tsStyleUnderline, tsStyleStrikeout] * fFont.Metric.Style <> []) then begin
  185. CharImage.CreateEmpty(fRenderRefGenerator.Format, max(m.Advance, 1), 1);
  186. m.GlyphOrigin.y := 1;
  187. end;
  188. c := TtsWritableChar.Create(aCharCode);
  189. try
  190. if (aCharCode = #0)
  191. then m.GlyphRect := tsRect(1, 0, 2, 1)
  192. else m.GlyphRect := tsRect(0, 0, CharImage.Width, CharImage.Height);
  193. try
  194. if (tsStyleUnderline in fFont.Metric.Style) then
  195. DrawLine(fFont.Metric.UnderlinePos, fFont.Metric.UnderlineSize);
  196. if (tsStyleStrikeout in fFont.Metric.Style) then
  197. DrawLine(fFont.Metric.StrikeoutPos, fFont.Metric.StrikeoutSize);
  198. except
  199. CharImage.FillColor(tsColor4f(1, 0, 0, 0), TS_COLOR_CHANNELS_RGB, TS_IMAGE_MODES_MODULATE_ALPHA);
  200. end;
  201. c.GlyphMetric := m;
  202. if Assigned(fFont.PostProcessor) then
  203. fFont.PostProcessor.Execute(c, CharImage);
  204. c.RenderRef := fRenderRefGenerator.CreateRenderRef(c, CharImage);
  205. result := c;
  206. except
  207. FreeAndNil(c);
  208. end;
  209. finally
  210. FreeAndNil(CharImage);
  211. end;
  212. end;
  213. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  214. function TtsChars.GetChar(const aCharCode: WideChar): TtsChar;
  215. var
  216. arr: PtsCharArray;
  217. begin
  218. arr := fChars[(Ord(aCharCode) shr 8) and $FF];
  219. if Assigned(arr) then
  220. result := arr^.Chars[Ord(aCharCode) and $FF]
  221. else
  222. result := nil;
  223. end;
  224. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  225. function TtsChars.AddChar(const aCharCode: WideChar): TtsChar;
  226. var
  227. h, l: Integer;
  228. arr: PtsCharArray;
  229. begin
  230. result := GetChar(aCharCode);
  231. if not Assigned(result) and fCanCreate then begin
  232. result := GenerateChar(aCharCode);
  233. if Assigned(result) then begin
  234. h := (Ord(aCharCode) shr 8) and $FF;
  235. arr := fChars[h];
  236. if not Assigned(arr) then begin
  237. New(arr);
  238. FillChar(arr^, SizeOf(arr^), 0);
  239. fChars[h] := arr;
  240. end;
  241. l := Ord(aCharCode) and $FF;
  242. arr^.Chars[l] := result;
  243. inc(arr^.Count);
  244. end;
  245. end;
  246. end;
  247. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  248. procedure TtsChars.DelChar(const aCharCode: WideChar);
  249. var
  250. h, l: Integer;
  251. c: TtsChar;
  252. arr: PtsCharArray;
  253. begin
  254. // find char array
  255. h := (Ord(aCharCode) shr 8) and $FF;
  256. arr := fChars[h];
  257. if not Assigned(arr) then
  258. exit;
  259. // find char
  260. l := Ord(aCharCode) and $FF;
  261. c := arr^.Chars[l];
  262. if not Assigned(c) then
  263. exit;
  264. // remove char
  265. arr^.Chars[l] := nil;
  266. dec(arr^.Count);
  267. if (arr^.Count <= 0) then begin
  268. fChars[h] := nil;
  269. Dispose(arr);
  270. end;
  271. if Assigned(c.RenderRef) then
  272. fRenderRefGenerator.FreeRenderRef(c.RenderRef);
  273. FreeAndNil(c);
  274. end;
  275. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  276. procedure TtsChars.AddCharRange(const aStart, aStop: WideChar);
  277. var
  278. c: WideChar;
  279. begin
  280. for c := aStart to aStop do
  281. AddChar(c);
  282. end;
  283. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  284. procedure TtsChars.DelCharRange(const aStart, aStop: WideChar);
  285. var
  286. c: WideChar;
  287. begin
  288. for c := aStart to aStop do
  289. DelChar(c);
  290. end;
  291. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  292. procedure TtsChars.Clear;
  293. var
  294. h, l: Integer;
  295. c: TtsChar;
  296. arr: PtsCharArray;
  297. begin
  298. for h := Low(fChars) to High(fChars) do begin
  299. arr := fChars[h];
  300. if Assigned(arr) then begin
  301. for l := Low(arr^.Chars) to High(arr^.Chars) do begin
  302. c := arr^.Chars[l];
  303. if Assigned(c) then begin
  304. if Assigned(c.RenderRef) then
  305. fRenderRefGenerator.FreeRenderRef(c.RenderRef);
  306. FreeAndNil(c);
  307. end;
  308. end;
  309. Dispose(arr);
  310. fChars[h] := nil;
  311. end;
  312. end;
  313. end;
  314. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  315. function TtsChars.GetTextWidthW(aText: PWideChar): Integer;
  316. var
  317. c: TtsChar;
  318. begin
  319. result := 0;
  320. if not Assigned(aText) then
  321. exit;
  322. while (aText^ <> #0) do begin
  323. c := AddChar(aText^);
  324. if not Assigned(c) then
  325. c := AddChar(fRenderRefGenerator.Context.DefaultChar);
  326. if Assigned(c) then begin
  327. if (result > 0) then
  328. result := result + fFont.CharSpacing;
  329. result := result + c.GlyphMetric.Advance;
  330. end;
  331. inc(aText);
  332. end;
  333. end;
  334. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  335. function TtsChars.GetTextWidthA(aText: PAnsiChar): Integer;
  336. var
  337. tmp: PWideChar;
  338. begin
  339. tmp := fRenderRefGenerator.Context.AnsiToWide(aText);
  340. try
  341. result := GetTextWidthW(tmp);
  342. finally
  343. tsStrDispose(tmp);
  344. end;
  345. end;
  346. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  347. constructor TtsChars.Create(const aRenderRefGen: TtsRenderRefGenerator; const aFont: TtsFont);
  348. begin
  349. inherited Create;
  350. fRenderRefGenerator := aRenderRefGen;
  351. fFont := aFont;
  352. fCanCreate := true;
  353. end;
  354. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  355. destructor TtsChars.Destroy;
  356. begin
  357. Clear;
  358. inherited Destroy;
  359. end;
  360. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  361. //TtsRenderRefGenerator/////////////////////////////////////////////////////////////////////////////////////////////////
  362. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  363. constructor TtsRenderRefGenerator.Create(const aContext: TtsContext; const aFormat: TtsFormat);
  364. begin
  365. inherited Create(aContext);
  366. fContext := aContext;
  367. fFormat := aFormat;
  368. end;
  369. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  370. //TtsCharCache//////////////////////////////////////////////////////////////////////////////////////////////////////////
  371. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  372. function TtsCharCache.GetChars(const aKey: TtsFont): TtsChars;
  373. var
  374. pos, index: Integer;
  375. p: PtsCharCacheItem;
  376. begin
  377. pos := Find(0, fItems.Count-1, aKey, index);
  378. if (pos < 0) then begin
  379. result := TtsChars.Create(fRenderRefGenerator, aKey);
  380. aKey.AddMaster(self);
  381. new(p);
  382. p^.key := aKey;
  383. p^.val := result;
  384. fItems.Insert(index, p);
  385. end else
  386. result := PtsCharCacheItem(fItems[pos])^.val;
  387. end;
  388. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  389. function TtsCharCache.Find(const aMin, aMax: Integer; const aKey: TtsFont; out aIndex: Integer): Integer;
  390. var
  391. i: Integer;
  392. begin
  393. if (aMin <= aMax) then begin
  394. i := aMin + Trunc((aMax - aMin) / 2);
  395. if (aKey = PtsCharCacheItem(fItems[i])^.key) then
  396. result := i
  397. else if (PtrUInt(aKey) < PtrUInt(PtsCharCacheItem(fItems[i])^.key)) then
  398. result := Find(aMin, i-1, aKey, aIndex)
  399. else
  400. result := Find(i+1, aMax, aKey, aIndex);
  401. end else begin
  402. result := -1;
  403. aIndex := aMin;
  404. end;
  405. end;
  406. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  407. function TtsCharCache.DelSlave(const aSlave: TtsRefManager): Boolean;
  408. var
  409. f: TtsFont;
  410. pos, index: Integer;
  411. p: PtsCharCacheItem;
  412. begin
  413. f := (aSlave as TtsFont);
  414. f.DelMaster(self);
  415. pos := Find(0, fItems.Count-1, f, index);
  416. if (pos >= 0) then begin
  417. p := PtsCharCacheItem(fItems[pos]);
  418. fItems.Delete(pos);
  419. FreeAndNil(p^.val);
  420. Dispose(p);
  421. end;
  422. result := inherited DelSlave(aSlave);
  423. end;
  424. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  425. procedure TtsCharCache.Clear;
  426. var
  427. p: PtsCharCacheItem;
  428. i: Integer;
  429. begin
  430. for i := 0 to fItems.Count-1 do begin
  431. p := PtsCharCacheItem(fItems[i]);
  432. p^.key.DelMaster(self);
  433. end;
  434. end;
  435. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  436. constructor TtsCharCache.Create(const aRenderRefGen: TtsRenderRefGenerator);
  437. begin
  438. inherited Create(aRenderRefGen);
  439. fRenderRefGenerator := aRenderRefGen;
  440. fItems := TList.Create;
  441. end;
  442. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  443. destructor TtsCharCache.Destroy;
  444. begin
  445. Clear;
  446. FreeAndNil(fItems);
  447. inherited Destroy;
  448. end;
  449. end.