gtext.inc 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by the Free Pascal development team
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {***************************************************************************}
  12. { Text output routines }
  13. {***************************************************************************}
  14. const
  15. maxfonts = 16; { maximum possible fonts }
  16. MaxChars = 255; { Maximum nr. of characters in a file }
  17. Prefix_Size = $80; { prefix size to skip }
  18. SIGNATURE = '+'; { Signature of CHR file }
  19. type
  20. (* pbyte = ^byte;
  21. pword = ^word;
  22. *)
  23. { Prefix header of Font file }
  24. { PFHeader = ^TFHeader;}
  25. TFHeader = packed record
  26. header_size: word; {* Version 2.0 Header Format *}
  27. font_name: array[1..4] of char;
  28. font_size: word; {* Size in byte of file *}
  29. font_major: byte; {* Driver Version Information *}
  30. font_minor: byte;
  31. min_major: byte; {* BGI Revision Information *}
  32. min_minor: byte;
  33. end;
  34. { Font record information }
  35. { PHeader = ^THeader;}
  36. THeader = packed record
  37. Signature: char; { signature byte }
  38. Nr_chars: smallint; { number of characters in file }
  39. Reserved: byte;
  40. First_char: byte; { first character in file }
  41. cdefs : smallint; { offset to character definitions }
  42. scan_flag: byte; { TRUE if char is scanable }
  43. org_to_cap: shortint; { Height from origin to top of capitol }
  44. org_to_base:shortint; { Height from origin to baseline }
  45. org_to_dec: shortint; { Height from origin to bot of decender }
  46. _reserved: array[1..4] of char;
  47. Unused: byte;
  48. end;
  49. TOffsetTable =array[0..MaxChars] of smallint;
  50. TWidthTable =array[0..MaxChars] of byte;
  51. tfontrec = packed record
  52. name : string[8];
  53. header : THeader; { font header }
  54. pheader : TFHeader; { prefix header }
  55. offsets : TOffsetTable;
  56. widths : TWidthTable;
  57. instrlength: longint; { length of instr, because instr can }
  58. instr : pchar; { contain null characters }
  59. end;
  60. { pStroke = ^TStroke;}
  61. TStroke = packed record
  62. opcode: byte;
  63. x: smallint; { relative x offset character }
  64. y: smallint; { relative y offset character }
  65. end;
  66. TStrokes = Array[0..1000] of TStroke;
  67. opcodes = (_END_OF_CHAR, _DO_SCAN, _MOVE, _DRAW);
  68. var
  69. fonts : array[1..maxfonts] of tfontrec;
  70. Strokes: TStrokes; {* Stroke Data Base *}
  71. { Stroke_count: Array[0..MaxChars] of smallint;} {* Stroke Count Table *}
  72. {***************************************************************************}
  73. { Internal support routines }
  74. {***************************************************************************}
  75. function testfont(p : pchar) : boolean;
  76. begin
  77. testfont:=(p[0]='P') and
  78. (p[1]='K') and
  79. (p[2]=#8) and
  80. (p[3]=#8);
  81. end;
  82. function InstallUserFont(const FontFileName : string) : smallint;
  83. begin
  84. _graphresult:=grOk;
  85. { first check if we do not allocate too many fonts! }
  86. if installedfonts=maxfonts then
  87. begin
  88. _graphresult:=grError;
  89. InstallUserFont := DefaultFont;
  90. exit;
  91. end;
  92. inc(installedfonts);
  93. fonts[installedfonts].name:=FontFileName;
  94. fonts[installedfonts].instr := nil;
  95. fonts[installedfonts].instrlength := 0;
  96. InstallUserFont:=installedfonts;
  97. end;
  98. function Decode(byte1,byte2: char; var x,y: smallint): smallint;
  99. { This routines decoes a signle word in a font opcode section }
  100. { to a stroke record. }
  101. var
  102. b1,b2: shortint;
  103. Begin
  104. b1:=shortint(byte1);
  105. b2:=shortint(byte2);
  106. { Decode the CHR OPCODE }
  107. Decode:=smallint(((b1 and $80) shr 6)+((b2 and $80) shr 7));
  108. { Now get the X,Y coordinates }
  109. { bit 0..7 only which are considered }
  110. { signed values. }
  111. {$R-}
  112. b1:=b1 and $7f;
  113. b2:=b2 and $7f;
  114. { Now if the MSB of these values are set }
  115. { then the value is signed, therefore we }
  116. { sign extend it... }
  117. if (b1 and $40)<>0 then b1:=b1 or $80;
  118. if (b2 and $40)<>0 then b2:=b2 or $80;
  119. x:=smallint(b1);
  120. y:=smallint(b2);
  121. {$ifdef debug}
  122. {$R+}
  123. {$endif debug}
  124. end;
  125. function unpack(buf: pchar; index: smallint; var Stroke: TStrokes): smallint;
  126. var
  127. po: TStrokes;
  128. num_ops: smallint;
  129. opcode, i, opc: word;
  130. counter: smallint;
  131. lindex: smallint;
  132. jx, jy: smallint;
  133. begin
  134. num_ops := 0;
  135. counter := index;
  136. lindex :=0;
  137. while TRUE do {* For each byte in buffer *}
  138. Begin
  139. Inc(num_ops); {* Count the operation *}
  140. opcode := decode( buf[counter], buf[counter+1] ,jx, jy );
  141. Inc(counter,2);
  142. if( opcode = ord(_END_OF_CHAR) ) then break; {* Exit loop at end of char *}
  143. end;
  144. counter:=index;
  145. for i:=0 to num_ops-1 do { /* For each opcode in buffer */ }
  146. Begin
  147. opc := decode(buf[counter], buf[counter+1], po[lindex].x, po[lindex].y); {* Decode the data field *}
  148. inc(counter,2);
  149. po[lindex].opcode := opc; {* Save the opcode *}
  150. Inc(lindex);
  151. end;
  152. Stroke:=po;
  153. unpack := num_ops; {* return OPS count *}
  154. end;
  155. procedure GetTextPosition(var xpos,ypos: longint; const TextString: string);
  156. begin
  157. if CurrentTextInfo.Font = DefaultFont then
  158. begin
  159. if Currenttextinfo.direction=horizdir then
  160. begin
  161. case Currenttextinfo.horiz of
  162. centertext : XPos:=(textwidth(textstring) shr 1);
  163. lefttext : XPos:=0;
  164. righttext : XPos:=textwidth(textstring);
  165. end;
  166. case Currenttextinfo.vert of
  167. centertext : YPos:=-(textheight(textstring) shr 1);
  168. bottomtext : YPos:=-textheight(textstring);
  169. toptext : YPos:=0;
  170. end;
  171. end else
  172. begin
  173. case Currenttextinfo.horiz of
  174. centertext : XPos:=(textheight(textstring) shr 1);
  175. lefttext : XPos:=textheight(textstring);
  176. righttext : XPos:=textheight(textstring);
  177. end;
  178. case Currenttextinfo.vert of
  179. centertext : YPos:=(textwidth(textstring) shr 1);
  180. bottomtext : YPos:=0;
  181. toptext : YPos:=textwidth(textstring);
  182. end;
  183. end;
  184. end
  185. else
  186. begin
  187. if Currenttextinfo.direction=horizdir then
  188. begin
  189. case CurrentTextInfo.horiz of
  190. centertext : XPos:=(textwidth(textstring) shr 1);
  191. lefttext : XPos:=0;
  192. righttext : XPos:=textwidth(textstring);
  193. end;
  194. case CurrentTextInfo.vert of
  195. centertext : YPos:=(textheight(textstring) shr 1);
  196. bottomtext : YPos:=0;
  197. toptext : YPos:=textheight(textstring);
  198. end;
  199. end else
  200. begin
  201. case CurrentTextInfo.horiz of
  202. centertext : XPos:=(textheight(textstring) shr 1);
  203. lefttext : XPos:=0;
  204. righttext : XPos:=textheight(textstring);
  205. end;
  206. case CurrentTextInfo.vert of
  207. centertext : YPos:=(textwidth(textstring) shr 1);
  208. bottomtext : YPos:=0;
  209. toptext : YPos:=textwidth(textstring);
  210. end;
  211. end;
  212. end;
  213. end;
  214. {***************************************************************************}
  215. { Exported routines }
  216. {***************************************************************************}
  217. function RegisterBGIfont(font : pointer) : smallint;
  218. var
  219. hp : pchar;
  220. b : word;
  221. i: longint;
  222. Header: THeader;
  223. counter: longint;
  224. FontData: pchar;
  225. FHeader: TFHeader;
  226. begin
  227. RegisterBGIfont:=grInvalidFontNum;
  228. i:=0;
  229. { Check if the font header is valid first of all }
  230. if testfont(font) then
  231. begin
  232. hp:=pchar(font);
  233. { Move to EOF in prefix header }
  234. while (hp[i] <> chr($1a)) do Inc(i);
  235. move(hp[i+1],FHeader,sizeof(FHeader));
  236. move(hp[Prefix_Size],header,sizeof(Header));
  237. { check if the font name is already allocated? }
  238. i:=Prefix_Size+sizeof(Header)+1;
  239. for b:=1 to installedfonts do
  240. begin
  241. if fonts[b].name=FHeader.Font_name then
  242. begin
  243. move(FHeader,fonts[b].PHeader,sizeof(FHeader));
  244. move(Header,fonts[b].Header,sizeof(Header));
  245. move(hp[i],Fonts[b].Offsets[Fonts[b].Header.First_Char],Fonts[b].Header.Nr_chars*sizeof(smallint));
  246. Inc(i,Fonts[b].Header.Nr_chars*sizeof(smallint));
  247. move(hp[i],Fonts[b].Widths[Fonts[b].Header.First_Char],Fonts[b].Header.Nr_chars*sizeof(byte));
  248. Inc(i,Fonts[b].Header.Nr_chars*sizeof(byte));
  249. counter:=Fonts[b].PHeader.font_size+PREFIX_SIZE-i;
  250. { allocate also space for null }
  251. GetMem(FontData,Counter+1);
  252. move(hp[i],FontData^,Counter);
  253. { Null terminate the string }
  254. FontData[counter+1] := #0;
  255. if fonts[b].header.Signature<> SIGNATURE then
  256. begin
  257. _graphResult:=grInvalidFont;
  258. Freemem(FontData, Counter+1);
  259. exit;
  260. end;
  261. fonts[b].instr:=FontData;
  262. fonts[b].instrlength:=Counter+1;
  263. RegisterBGIfont:=b;
  264. end;
  265. end;
  266. end
  267. else
  268. RegisterBGIFont:=grInvalidFont;
  269. end;
  270. procedure GetTextSettings(var TextInfo : TextSettingsType);
  271. begin
  272. textinfo:=currenttextinfo;
  273. end;
  274. function TextHeight(const TextString : string) : word;
  275. begin
  276. if Currenttextinfo.font=DefaultFont
  277. then TextHeight:=8*CurrentTextInfo.CharSize
  278. else
  279. TextHeight:=Trunc((fonts[Currenttextinfo.font].header.org_to_cap-
  280. fonts[Currenttextinfo.font].header.org_to_dec) * CurrentYRatio);
  281. end;
  282. function TextWidth(const TextString : string) : word;
  283. var i,x : smallint;
  284. c : byte;
  285. begin
  286. x := 0;
  287. { if this is the default font ... }
  288. if Currenttextinfo.font = Defaultfont then
  289. TextWidth:=length(TextString)*8*CurrentTextInfo.CharSize
  290. { This is a stroked font ... }
  291. else begin
  292. for i:=1 to length(TextString) do
  293. begin
  294. c:=byte(textstring[i]);
  295. { dec(c,fonts[Currenttextinfo.font].header.first_char);}
  296. if (c-fonts[Currenttextinfo.font].header.first_char>=
  297. fonts[Currenttextinfo.font].header.nr_chars) then
  298. continue;
  299. x:=x+byte(fonts[Currenttextinfo.font].widths[c]);
  300. end;
  301. TextWidth:=round(x * CurrentXRatio) ;
  302. end;
  303. end;
  304. procedure DrawBitmapCharHorizDefault(x,y : longint;charsize : word;const s : string);
  305. var
  306. cnt1,cnt2,cnt3,cnt4,j,k,i,xpos,c : longint;
  307. fontbitmap : TBitmapChar;
  308. begin
  309. c:=length(s);
  310. for i:=0 to c-1 do
  311. begin
  312. xpos:=x+(i*8)*Charsize;
  313. { we copy the character bitmap before accessing it }
  314. { this improves speed on non optimizing compilers }
  315. { since it is one less address calculation. }
  316. Fontbitmap:=TBitmapChar(DefaultFontData[s[i+1]]);
  317. { no scaling }
  318. if CharSize = 1 then
  319. Begin
  320. for j:=0 to 7 do
  321. for k:=0 to 7 do
  322. if Fontbitmap[j,k]<>0 then
  323. PutPixel(xpos+k,j+y,CurrentColor);
  324. end
  325. else
  326. { perform scaling of bitmap font }
  327. Begin
  328. j:=0;
  329. cnt3:=0;
  330. while j <= 7 do
  331. begin
  332. { X-axis scaling }
  333. for cnt4 := 0 to charsize-1 do
  334. begin
  335. k:=0;
  336. cnt2 := 0;
  337. while k <= 7 do
  338. begin
  339. for cnt1 := 0 to charsize-1 do
  340. begin
  341. If FontBitmap[j,k] <> 0 then
  342. PutPixel(xpos+cnt1+cnt2,y+cnt3+cnt4,CurrentColor);
  343. end;
  344. Inc(k);
  345. Inc(cnt2,charsize);
  346. end;
  347. end;
  348. Inc(j);
  349. Inc(cnt3,charsize);
  350. end;
  351. end;
  352. end;
  353. end;
  354. procedure OutTextXY(x,y : smallint;const TextString : string);
  355. type
  356. Tpoint = record
  357. X,Y: smallint;
  358. end;
  359. var
  360. i,j,k,c : longint;
  361. xpos,ypos : longint;
  362. counter : longint;
  363. cnt1,cnt2 : smallint;
  364. cnt3,cnt4 : smallint;
  365. charsize : word;
  366. WriteMode : word;
  367. curX2, curY2, xpos2, ypos2, x2, y2: graph_float;
  368. oldvalues : linesettingstype;
  369. fontbitmap : TBitmapChar;
  370. chr : char;
  371. begin
  372. { save current write mode }
  373. WriteMode := CurrentWriteMode;
  374. CurrentWriteMode := NormalPut;
  375. GetTextPosition(xpos,ypos,textstring);
  376. X:=X-XPos; Y:=Y+YPos;
  377. XPos:=X; YPos:=Y;
  378. CharSize := CurrentTextInfo.Charsize;
  379. if Currenttextinfo.font=DefaultFont then
  380. begin
  381. c:=length(textstring);
  382. { We must a length strength which is ZERO based }
  383. { if c is a byte and length is zero, this is }
  384. { dangerous, fixed }
  385. Dec(c);
  386. if CurrentTextInfo.direction=HorizDir then
  387. { Horizontal direction }
  388. DrawBitmapCharHoriz(x,y,charsize,TextString)
  389. else
  390. { Vertical direction }
  391. begin
  392. for i:=0 to c do
  393. begin
  394. chr := TextString[i+1];
  395. Fontbitmap:=TBitmapChar(DefaultFontData[chr]);
  396. ypos := y-(i shl 3)*CharSize;
  397. { no scaling }
  398. if CharSize = 1 then
  399. Begin
  400. for j:=0 to 7 do
  401. for k:=0 to 7 do
  402. if Fontbitmap[j,k] <> 0 then PutPixel(xpos+j,ypos-k,
  403. CurrentColor);
  404. end
  405. else
  406. { perform scaling of bitmap font }
  407. Begin
  408. j:=0;
  409. cnt3:=0;
  410. while j<=7 do
  411. begin
  412. { X-axis scaling }
  413. for cnt4 := 0 to charsize-1 do
  414. begin
  415. k:=0;
  416. cnt2 := 0;
  417. while k<=7 do
  418. begin
  419. for cnt1 := 0 to charsize-1 do
  420. begin
  421. If FontBitmap[j,k] <> 0 then
  422. PutPixel(xpos+cnt3-cnt4,ypos+cnt1-cnt2,
  423. CurrentColor);
  424. end;
  425. Inc(k);
  426. Inc(cnt2,charsize);
  427. end;
  428. end;
  429. Inc(j);
  430. Inc(cnt3,charsize);
  431. end;
  432. end;
  433. end;
  434. end;
  435. end else
  436. { This is a stroked font which is already loaded into memory }
  437. begin
  438. getlinesettings(oldvalues);
  439. { reset line style to defaults }
  440. setlinestyle(solidln,oldvalues.pattern,normwidth);
  441. if Currenttextinfo.direction=vertdir then
  442. xpos:=xpos + Textheight(textstring);
  443. CurX2:=xpos; xpos2 := curX2; x2 := xpos2;
  444. CurY2:=ypos; ypos2 := curY2; y2 := ypos2;
  445. { x:=xpos; y:=ypos;}
  446. for i:=1 to length(textstring) do
  447. begin
  448. c:=byte(textstring[i]);
  449. { Stroke_Count[c] := }
  450. unpack( fonts[CurrentTextInfo.font].instr,
  451. fonts[CurrentTextInfo.font].Offsets[c], Strokes );
  452. counter:=0;
  453. while true do
  454. begin
  455. if CurrentTextInfo.direction=VertDir then
  456. begin
  457. xpos2:=x2-(Strokes[counter].Y*CurrentYRatio);
  458. ypos2:=y2-(Strokes[counter].X*CurrentXRatio);
  459. end
  460. else
  461. begin
  462. xpos2:=x2+(Strokes[counter].X*CurrentXRatio) ;
  463. ypos2:=y2-(Strokes[counter].Y*CurrentYRatio) ;
  464. end;
  465. case opcodes(Strokes[counter].opcode) of
  466. _END_OF_CHAR: break;
  467. _DO_SCAN: begin
  468. { Currently unsupported };
  469. end;
  470. _MOVE : Begin
  471. CurX2 := XPos2;
  472. CurY2 := YPos2;
  473. end;
  474. _DRAW: Begin
  475. Line(trunc(CurX2),trunc(CurY2),trunc(xpos2),trunc(ypos2));
  476. CurX2:=xpos2;
  477. CurY2:=ypos2;
  478. end;
  479. else
  480. Begin
  481. end;
  482. end;
  483. Inc(counter);
  484. end; { end while }
  485. if Currenttextinfo.direction=VertDir then
  486. y2:=y2-(byte(fonts[CurrenttextInfo.font].widths[c])*CurrentXRatio)
  487. else
  488. x2:=x2+(byte(fonts[Currenttextinfo.font].widths[c])*CurrentXRatio);
  489. end;
  490. setlinestyle( oldvalues.linestyle, oldvalues.pattern, oldvalues.thickness);
  491. end;
  492. { restore write mode }
  493. CurrentWriteMode := WriteMode;
  494. end;
  495. procedure OutText(const TextString : string);
  496. var x,y:smallint;
  497. begin
  498. { Save CP }
  499. x:=CurrentX;
  500. y:=CurrentY;
  501. OutTextXY(CurrentX,CurrentY,TextString);
  502. { If the direction is Horizontal and the justification left }
  503. { then and only then do we update the CP }
  504. if (Currenttextinfo.direction=HorizDir) and
  505. (Currenttextinfo.horiz=LeftText) then
  506. inc(x,textwidth(TextString));
  507. { Update the CP }
  508. CurrentX := X;
  509. CurrentY := Y;
  510. end;
  511. procedure SetTextJustify(horiz,vert : word);
  512. begin
  513. if (horiz<0) or (horiz>2) or
  514. (vert<0) or (vert>2) then
  515. begin
  516. _graphresult:=grError;
  517. exit;
  518. end;
  519. Currenttextinfo.horiz:=horiz;
  520. Currenttextinfo.vert:=vert;
  521. end;
  522. procedure SetTextStyle(font,direction : word;charsize : word);
  523. var
  524. f : file;
  525. Prefix: array[0..Prefix_Size-1] of char; {* File Prefix Holder *}
  526. Length, Current: longint;
  527. FontData: Pchar;
  528. hp : pchar;
  529. i : longint;
  530. begin
  531. if font>installedfonts then
  532. begin
  533. _graphresult:=grInvalidFontNum;
  534. exit;
  535. end;
  536. Currenttextinfo.font:=font;
  537. if (direction<>HorizDir) and (direction<>VertDir) then
  538. direction:=HorizDir;
  539. Currenttextinfo.direction:=direction;
  540. { According to the Turbo Pascal programmer's reference }
  541. { maximum charsize for bitmapped font is 10 }
  542. if (CurrentTextInfo.Font = DefaultFont) and (Charsize > 10) then
  543. Currenttextinfo.charsize:=10
  544. else if charsize<1 then
  545. Currenttextinfo.charsize:=1
  546. else
  547. Currenttextinfo.charsize:=charsize;
  548. { This is only valid for stroked fonts }
  549. {$ifdef logging}
  550. LogLn('(org_to_cap - org_to_dec): ' + strf(
  551. fonts[Currenttextinfo.font].header.org_to_cap-
  552. fonts[Currenttextinfo.font].header.org_to_dec));
  553. {$endif logging}
  554. if (charsize <> usercharsize) then
  555. Case CharSize of
  556. 1: Begin
  557. CurrentXRatio := 0.55;
  558. CurrentYRatio := 0.55;
  559. End;
  560. 2: Begin
  561. CurrentXRatio := 0.65;
  562. CurrentYRatio := 0.65;
  563. End;
  564. 3: Begin
  565. CurrentXRatio := 0.75;
  566. CurrentYRatio := 0.75;
  567. End;
  568. 4: Begin
  569. CurrentXRatio := 1.0;
  570. CurrentYRatio := 1.0;
  571. End;
  572. 5: Begin
  573. CurrentXRatio := 1.3;
  574. CurrentYRatio := 1.3;
  575. End;
  576. 6: Begin
  577. CurrentXRatio := 1.65;
  578. CurrentYRatio := 1.65
  579. End;
  580. 7: Begin
  581. CurrentXRatio := 2.0;
  582. CurrentYRatio := 2.0;
  583. End;
  584. 8: Begin
  585. CurrentXRatio := 2.5;
  586. CurrentYRatio := 2.5;
  587. End;
  588. 9: Begin
  589. CurrentXRatio := 3.0;
  590. CurrentYRatio := 3.0;
  591. End;
  592. 10: Begin
  593. CurrentXRatio := 4.0;
  594. CurrentYRatio := 4.0;
  595. End
  596. End;
  597. { if this is a stroked font then load it if not already loaded }
  598. { into memory... }
  599. if (font>DefaultFont) and not assigned(fonts[font].instr) then
  600. begin
  601. assign(f,bgipath+fonts[font].name+'.CHR');
  602. {$i-}
  603. reset(f,1);
  604. {$i+}
  605. if ioresult<>0 then
  606. begin
  607. _graphresult:=grFontNotFound;
  608. Currenttextinfo.font:=DefaultFont;
  609. exit;
  610. end;
  611. {* Read in the file prefix *}
  612. BlockRead(F, Prefix, Prefix_Size);
  613. hp:=Prefix;
  614. i:=0;
  615. while (hp[i] <> chr($1a)) do Inc(i);
  616. move(hp[i+1],fonts[font].PHeader,sizeof(TFHeader));
  617. (* Read in the Header file *)
  618. BlockRead(F,fonts[font].Header,Sizeof(THeader));
  619. BlockRead(F,Fonts[font].Offsets[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(smallint));
  620. {* Load the character width table into memory. *}
  621. BlockRead(F,Fonts[font].Widths[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(byte));
  622. {* Determine the length of the stroke database. *}
  623. current := FilePos( f ); {* Current file location *}
  624. Seek( f, FileSize(F)); {* Go to the end of the file *}
  625. length := FilePos( f ); {* Get the file length *}
  626. Seek( f, current); {* Restore old file location *}
  627. {* Load the stroke database. *}
  628. { also allocate space for Null character }
  629. Getmem(FontData, Length+1); {* Create space for font data *}
  630. BlockRead(F, FontData^, length-current); {* Load the stroke data *}
  631. FontData[length-current+1] := #0;
  632. if fonts[font].header.Signature<> SIGNATURE then
  633. begin
  634. _graphResult:=grInvalidFont;
  635. Currenttextinfo.font:=DefaultFont;
  636. Freemem(FontData, Length+1);
  637. exit;
  638. end;
  639. fonts[font].instr:=FontData;
  640. fonts[font].instrLength:=Length+1;
  641. if not testfont(Prefix) then
  642. begin
  643. _graphresult:=grInvalidFont;
  644. Currenttextinfo.font:=DefaultFont;
  645. Freemem(FontData, Length+1);
  646. end;
  647. close(f);
  648. end;
  649. end;
  650. procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
  651. begin
  652. CurrentXRatio := MultX / DivX;
  653. CurrentYRatio := MultY / DivY;
  654. end;
  655. {
  656. $Log$
  657. Revision 1.16 2000-03-24 18:16:33 florian
  658. * introduce a DrawBitmapCharHoriz procedure variable to accelerate output on
  659. win32
  660. Revision 1.15 2000/02/27 14:41:25 peter
  661. * removed warnings/notes
  662. Revision 1.14 2000/01/07 16:41:38 daniel
  663. * copyright 2000
  664. Revision 1.13 2000/01/07 16:32:26 daniel
  665. * copyright 2000 added
  666. Revision 1.12 2000/01/06 16:17:56 jonas
  667. * fixed bug in outTextXY for vertical text
  668. Revision 1.11 2000/01/02 19:02:39 jonas
  669. * removed/commented out (inited but) unused vars and unused types
  670. Revision 1.10 1999/12/23 16:48:13 jonas
  671. * turn off IO checking when attempting to open a font file (to avoid RTE)
  672. Revision 1.9 1999/12/20 11:22:36 peter
  673. * integer -> smallint to overcome -S2 switch needed for ggi version
  674. Revision 1.8 1999/11/11 22:29:21 florian
  675. * the writing of the default font was wrong when doing scaling:
  676. the last colunm/row wasn't drawn
  677. Revision 1.7 1999/09/28 15:07:47 jonas
  678. * fix for disposing font data because it can contain #0 chars
  679. Revision 1.6 1999/09/28 13:56:29 jonas
  680. * reordered some local variables (first 4 byte vars, then 2 byte vars
  681. etc)
  682. * font data is now disposed in exitproc, exitproc is now called
  683. GraphExitProc (was CleanModes) and resides in graph.pp instead of in
  684. modes.inc
  685. Revision 1.5 1999/09/27 23:34:42 peter
  686. * new graph unit is default for go32v2
  687. * removed warnings/notes
  688. Revision 1.4 1999/09/26 13:31:07 jonas
  689. * changed name of modeinfo variable to vesamodeinfo and fixed
  690. associated errors (fillchar(modeinfo,sizeof(tmodeinfo),#0) instead
  691. of sizeof(TVesamodeinfo) etc)
  692. * changed several sizeof(type) to sizeof(varname) to avoid similar
  693. errors in the future
  694. Revision 1.3 1999/09/22 14:54:11 jonas
  695. * changed ratios so font sizes on screen are the same as with TP
  696. * SetUserCharSize must also use / instead of DIV
  697. Revision 1.2 1999/09/22 13:30:52 jonas
  698. * changed org_to_cap, org_to_dec and org_to_base to shortint (from
  699. Michael Knapp's gxtext unit, part of the GraphiX package)
  700. * in settextstyle, the calculation of the ratios must be done
  701. with /, not DIV!!
  702. Revision 1.1 1999/09/22 13:13:36 jonas
  703. * renamed text.inc -> gtext.inc to avoid conflict with system unit
  704. * fixed textwidth
  705. * isgraphmode now gets properly updated, so mode restoring works
  706. again
  707. Revision 1.7 1999/09/12 17:29:00 jonas
  708. * several changes to internalellipse to make it faster
  709. and to make sure it updates the ArcCall correctly
  710. (not yet done for width = 3)
  711. * Arc mostly works now, only sometimes an endless loop, don't know
  712. why
  713. Revision 1.6 1999/09/12 08:02:22 florian
  714. * fixed outtext(''), c was a byte, this leads to an underflow and
  715. garbage was written
  716. Revision 1.5 1999/07/26 09:38:43 florian
  717. * bar: y2 can be less y1, fixed
  718. * settextstyle: charsize can be 0, must be changed into 1
  719. Revision 1.4 1999/07/12 13:27:16 jonas
  720. + added Log and Id tags
  721. * added first FPC support, only VGA works to some extend for now
  722. * use -dasmgraph to use assembler routines, otherwise Pascal
  723. equivalents are used
  724. * use -dsupportVESA to support VESA (crashes under FPC for now)
  725. * only dispose vesainfo at closegrph if a vesa card was detected
  726. * changed int32 to longint (int32 is not declared under FPC)
  727. * changed the declaration of almost every procedure in graph.inc to
  728. "far;" becquse otherwise you can't assign them to procvars under TP
  729. real mode (but unexplainable "data segnment too large" errors prevent
  730. it from working under real mode anyway)
  731. }