gtext.inc 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820
  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 OutTextXY(x,y : smallint;const TextString : string);
  305. type
  306. Tpoint = record
  307. X,Y: smallint;
  308. end;
  309. var
  310. i,j,k,c : longint;
  311. xpos,ypos : longint;
  312. counter : longint;
  313. FontBitmap : TBitmapChar;
  314. cnt1,cnt2 : smallint;
  315. cnt3,cnt4 : smallint;
  316. charsize : word;
  317. WriteMode : word;
  318. curX2, curY2, xpos2, ypos2, x2, y2: graph_float;
  319. oldvalues : linesettingstype;
  320. chr : char;
  321. begin
  322. { save current write mode }
  323. WriteMode := CurrentWriteMode;
  324. CurrentWriteMode := NormalPut;
  325. GetTextPosition(xpos,ypos,textstring);
  326. X:=X-XPos; Y:=Y+YPos;
  327. XPos:=X; YPos:=Y;
  328. CharSize := CurrentTextInfo.Charsize;
  329. if Currenttextinfo.font=DefaultFont then
  330. begin
  331. c:=length(textstring);
  332. { We must a length strength which is ZERO based }
  333. { if c is a byte and length is zero, this is }
  334. { dangerous, fixed }
  335. Dec(c);
  336. if CurrentTextInfo.direction=HorizDir then
  337. { Horizontal direction }
  338. begin
  339. for i:=0 to c do
  340. begin
  341. chr := TextString[i+1];
  342. xpos:=x+(i shl 3)*Charsize;
  343. { we copy the character bitmap before accessing it }
  344. { this improves speed on non optimizing compilers }
  345. { since it is one less address calculation. }
  346. Fontbitmap:=TBitmapChar(DefaultFontData[chr]);
  347. { no scaling }
  348. if CharSize = 1 then
  349. Begin
  350. for j:=0 to 7 do
  351. for k:=0 to 7 do
  352. if Fontbitmap[j,k] <> 0 then PutPixel(xpos+k,j+y,CurrentColor);
  353. end
  354. else
  355. { perform scaling of bitmap font }
  356. Begin
  357. j:=0;
  358. cnt3:=0;
  359. while j <= 7 do
  360. begin
  361. { X-axis scaling }
  362. for cnt4 := 0 to charsize-1 do
  363. begin
  364. k:=0;
  365. cnt2 := 0;
  366. while k <= 7 do
  367. begin
  368. for cnt1 := 0 to charsize-1 do
  369. begin
  370. If FontBitmap[j,k] <> 0 then
  371. PutPixel(xpos+cnt1+cnt2,y+cnt3+cnt4,CurrentColor);
  372. end;
  373. Inc(k);
  374. Inc(cnt2,charsize);
  375. end;
  376. end;
  377. Inc(j);
  378. Inc(cnt3,charsize);
  379. end;
  380. end;
  381. end;
  382. end
  383. else
  384. { Vertical direction }
  385. begin
  386. for i:=0 to c do
  387. begin
  388. chr := TextString[i+1];
  389. Fontbitmap:=TBitmapChar(DefaultFontData[chr]);
  390. ypos := y-(i shl 3)*CharSize;
  391. { no scaling }
  392. if CharSize = 1 then
  393. Begin
  394. for j:=0 to 7 do
  395. for k:=0 to 7 do
  396. if Fontbitmap[j,k] <> 0 then PutPixel(xpos+j,ypos-k,
  397. CurrentColor);
  398. end
  399. else
  400. { perform scaling of bitmap font }
  401. Begin
  402. j:=0;
  403. cnt3:=0;
  404. while j<=7 do
  405. begin
  406. { X-axis scaling }
  407. for cnt4 := 0 to charsize-1 do
  408. begin
  409. k:=0;
  410. cnt2 := 0;
  411. while k<=7 do
  412. begin
  413. for cnt1 := 0 to charsize-1 do
  414. begin
  415. If FontBitmap[j,k] <> 0 then
  416. PutPixel(xpos+cnt3-cnt4,ypos+cnt1-cnt2,
  417. CurrentColor);
  418. end;
  419. Inc(k);
  420. Inc(cnt2,charsize);
  421. end;
  422. end;
  423. Inc(j);
  424. Inc(cnt3,charsize);
  425. end;
  426. end;
  427. end;
  428. end;
  429. end else
  430. { This is a stroked font which is already loaded into memory }
  431. begin
  432. getlinesettings(oldvalues);
  433. { reset line style to defaults }
  434. setlinestyle(solidln,oldvalues.pattern,normwidth);
  435. if Currenttextinfo.direction=vertdir then
  436. xpos:=xpos + Textheight(textstring);
  437. CurX2:=xpos; xpos2 := curX2; x2 := xpos2;
  438. CurY2:=ypos; ypos2 := curY2; y2 := ypos2;
  439. { x:=xpos; y:=ypos;}
  440. for i:=1 to length(textstring) do
  441. begin
  442. c:=byte(textstring[i]);
  443. { Stroke_Count[c] := }
  444. unpack( fonts[CurrentTextInfo.font].instr,
  445. fonts[CurrentTextInfo.font].Offsets[c], Strokes );
  446. counter:=0;
  447. while true do
  448. begin
  449. if CurrentTextInfo.direction=VertDir then
  450. begin
  451. xpos2:=x2-(Strokes[counter].Y*CurrentYRatio);
  452. ypos2:=y2-(Strokes[counter].X*CurrentXRatio);
  453. end
  454. else
  455. begin
  456. xpos2:=x2+(Strokes[counter].X*CurrentXRatio) ;
  457. ypos2:=y2-(Strokes[counter].Y*CurrentYRatio) ;
  458. end;
  459. case opcodes(Strokes[counter].opcode) of
  460. _END_OF_CHAR: break;
  461. _DO_SCAN: begin
  462. { Currently unsupported };
  463. end;
  464. _MOVE : Begin
  465. CurX2 := XPos2;
  466. CurY2 := YPos2;
  467. end;
  468. _DRAW: Begin
  469. Line(trunc(CurX2),trunc(CurY2),trunc(xpos2),trunc(ypos2));
  470. CurX2:=xpos2;
  471. CurY2:=ypos2;
  472. end;
  473. else
  474. Begin
  475. end;
  476. end;
  477. Inc(counter);
  478. end; { end while }
  479. if Currenttextinfo.direction=VertDir then
  480. y2:=y2-(byte(fonts[CurrenttextInfo.font].widths[c])*CurrentXRatio)
  481. else
  482. x2:=x2+(byte(fonts[Currenttextinfo.font].widths[c])*CurrentXRatio);
  483. end;
  484. setlinestyle( oldvalues.linestyle, oldvalues.pattern, oldvalues.thickness);
  485. end;
  486. { restore write mode }
  487. CurrentWriteMode := WriteMode;
  488. end;
  489. procedure OutText(const TextString : string);
  490. var x,y:smallint;
  491. begin
  492. { Save CP }
  493. x:=CurrentX;
  494. y:=CurrentY;
  495. OutTextXY(CurrentX,CurrentY,TextString);
  496. { If the direction is Horizontal and the justification left }
  497. { then and only then do we update the CP }
  498. if (Currenttextinfo.direction=HorizDir) and
  499. (Currenttextinfo.horiz=LeftText) then
  500. inc(x,textwidth(TextString));
  501. { Update the CP }
  502. CurrentX := X;
  503. CurrentY := Y;
  504. end;
  505. procedure SetTextJustify(horiz,vert : word);
  506. begin
  507. if (horiz<0) or (horiz>2) or
  508. (vert<0) or (vert>2) then
  509. begin
  510. _graphresult:=grError;
  511. exit;
  512. end;
  513. Currenttextinfo.horiz:=horiz;
  514. Currenttextinfo.vert:=vert;
  515. end;
  516. procedure SetTextStyle(font,direction : word;charsize : word);
  517. var
  518. f : file;
  519. Prefix: array[0..Prefix_Size-1] of char; {* File Prefix Holder *}
  520. Length, Current: longint;
  521. FontData: Pchar;
  522. hp : pchar;
  523. i : longint;
  524. begin
  525. if font>installedfonts then
  526. begin
  527. _graphresult:=grInvalidFontNum;
  528. exit;
  529. end;
  530. Currenttextinfo.font:=font;
  531. if (direction<>HorizDir) and (direction<>VertDir) then
  532. direction:=HorizDir;
  533. Currenttextinfo.direction:=direction;
  534. { According to the Turbo Pascal programmer's reference }
  535. { maximum charsize for bitmapped font is 10 }
  536. if (CurrentTextInfo.Font = DefaultFont) and (Charsize > 10) then
  537. Currenttextinfo.charsize:=10
  538. else if charsize<1 then
  539. Currenttextinfo.charsize:=1
  540. else
  541. Currenttextinfo.charsize:=charsize;
  542. { This is only valid for stroked fonts }
  543. {$ifdef logging}
  544. LogLn('(org_to_cap - org_to_dec): ' + strf(
  545. fonts[Currenttextinfo.font].header.org_to_cap-
  546. fonts[Currenttextinfo.font].header.org_to_dec));
  547. {$endif logging}
  548. if (charsize <> usercharsize) then
  549. Case CharSize of
  550. 1: Begin
  551. CurrentXRatio := 0.55;
  552. CurrentYRatio := 0.55;
  553. End;
  554. 2: Begin
  555. CurrentXRatio := 0.65;
  556. CurrentYRatio := 0.65;
  557. End;
  558. 3: Begin
  559. CurrentXRatio := 0.75;
  560. CurrentYRatio := 0.75;
  561. End;
  562. 4: Begin
  563. CurrentXRatio := 1.0;
  564. CurrentYRatio := 1.0;
  565. End;
  566. 5: Begin
  567. CurrentXRatio := 1.3;
  568. CurrentYRatio := 1.3;
  569. End;
  570. 6: Begin
  571. CurrentXRatio := 1.65;
  572. CurrentYRatio := 1.65
  573. End;
  574. 7: Begin
  575. CurrentXRatio := 2.0;
  576. CurrentYRatio := 2.0;
  577. End;
  578. 8: Begin
  579. CurrentXRatio := 2.5;
  580. CurrentYRatio := 2.5;
  581. End;
  582. 9: Begin
  583. CurrentXRatio := 3.0;
  584. CurrentYRatio := 3.0;
  585. End;
  586. 10: Begin
  587. CurrentXRatio := 4.0;
  588. CurrentYRatio := 4.0;
  589. End
  590. End;
  591. { if this is a stroked font then load it if not already loaded }
  592. { into memory... }
  593. if (font>DefaultFont) and not assigned(fonts[font].instr) then
  594. begin
  595. assign(f,bgipath+fonts[font].name+'.CHR');
  596. {$i-}
  597. reset(f,1);
  598. {$i+}
  599. if ioresult<>0 then
  600. begin
  601. _graphresult:=grFontNotFound;
  602. Currenttextinfo.font:=DefaultFont;
  603. exit;
  604. end;
  605. {* Read in the file prefix *}
  606. BlockRead(F, Prefix, Prefix_Size);
  607. hp:=Prefix;
  608. i:=0;
  609. while (hp[i] <> chr($1a)) do Inc(i);
  610. move(hp[i+1],fonts[font].PHeader,sizeof(TFHeader));
  611. (* Read in the Header file *)
  612. BlockRead(F,fonts[font].Header,Sizeof(THeader));
  613. BlockRead(F,Fonts[font].Offsets[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(smallint));
  614. {* Load the character width table into memory. *}
  615. BlockRead(F,Fonts[font].Widths[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(byte));
  616. {* Determine the length of the stroke database. *}
  617. current := FilePos( f ); {* Current file location *}
  618. Seek( f, FileSize(F)); {* Go to the end of the file *}
  619. length := FilePos( f ); {* Get the file length *}
  620. Seek( f, current); {* Restore old file location *}
  621. {* Load the stroke database. *}
  622. { also allocate space for Null character }
  623. Getmem(FontData, Length+1); {* Create space for font data *}
  624. BlockRead(F, FontData^, length-current); {* Load the stroke data *}
  625. FontData[length-current+1] := #0;
  626. if fonts[font].header.Signature<> SIGNATURE then
  627. begin
  628. _graphResult:=grInvalidFont;
  629. Currenttextinfo.font:=DefaultFont;
  630. Freemem(FontData, Length+1);
  631. exit;
  632. end;
  633. fonts[font].instr:=FontData;
  634. fonts[font].instrLength:=Length+1;
  635. if not testfont(Prefix) then
  636. begin
  637. _graphresult:=grInvalidFont;
  638. Currenttextinfo.font:=DefaultFont;
  639. Freemem(FontData, Length+1);
  640. end;
  641. close(f);
  642. end;
  643. end;
  644. procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
  645. begin
  646. CurrentXRatio := MultX / DivX;
  647. CurrentYRatio := MultY / DivY;
  648. end;
  649. {
  650. $Log$
  651. Revision 1.15 2000-02-27 14:41:25 peter
  652. * removed warnings/notes
  653. Revision 1.14 2000/01/07 16:41:38 daniel
  654. * copyright 2000
  655. Revision 1.13 2000/01/07 16:32:26 daniel
  656. * copyright 2000 added
  657. Revision 1.12 2000/01/06 16:17:56 jonas
  658. * fixed bug in outTextXY for vertical text
  659. Revision 1.11 2000/01/02 19:02:39 jonas
  660. * removed/commented out (inited but) unused vars and unused types
  661. Revision 1.10 1999/12/23 16:48:13 jonas
  662. * turn off IO checking when attempting to open a font file (to avoid RTE)
  663. Revision 1.9 1999/12/20 11:22:36 peter
  664. * integer -> smallint to overcome -S2 switch needed for ggi version
  665. Revision 1.8 1999/11/11 22:29:21 florian
  666. * the writing of the default font was wrong when doing scaling:
  667. the last colunm/row wasn't drawn
  668. Revision 1.7 1999/09/28 15:07:47 jonas
  669. * fix for disposing font data because it can contain #0 chars
  670. Revision 1.6 1999/09/28 13:56:29 jonas
  671. * reordered some local variables (first 4 byte vars, then 2 byte vars
  672. etc)
  673. * font data is now disposed in exitproc, exitproc is now called
  674. GraphExitProc (was CleanModes) and resides in graph.pp instead of in
  675. modes.inc
  676. Revision 1.5 1999/09/27 23:34:42 peter
  677. * new graph unit is default for go32v2
  678. * removed warnings/notes
  679. Revision 1.4 1999/09/26 13:31:07 jonas
  680. * changed name of modeinfo variable to vesamodeinfo and fixed
  681. associated errors (fillchar(modeinfo,sizeof(tmodeinfo),#0) instead
  682. of sizeof(TVesamodeinfo) etc)
  683. * changed several sizeof(type) to sizeof(varname) to avoid similar
  684. errors in the future
  685. Revision 1.3 1999/09/22 14:54:11 jonas
  686. * changed ratios so font sizes on screen are the same as with TP
  687. * SetUserCharSize must also use / instead of DIV
  688. Revision 1.2 1999/09/22 13:30:52 jonas
  689. * changed org_to_cap, org_to_dec and org_to_base to shortint (from
  690. Michael Knapp's gxtext unit, part of the GraphiX package)
  691. * in settextstyle, the calculation of the ratios must be done
  692. with /, not DIV!!
  693. Revision 1.1 1999/09/22 13:13:36 jonas
  694. * renamed text.inc -> gtext.inc to avoid conflict with system unit
  695. * fixed textwidth
  696. * isgraphmode now gets properly updated, so mode restoring works
  697. again
  698. Revision 1.7 1999/09/12 17:29:00 jonas
  699. * several changes to internalellipse to make it faster
  700. and to make sure it updates the ArcCall correctly
  701. (not yet done for width = 3)
  702. * Arc mostly works now, only sometimes an endless loop, don't know
  703. why
  704. Revision 1.6 1999/09/12 08:02:22 florian
  705. * fixed outtext(''), c was a byte, this leads to an underflow and
  706. garbage was written
  707. Revision 1.5 1999/07/26 09:38:43 florian
  708. * bar: y2 can be less y1, fixed
  709. * settextstyle: charsize can be 0, must be changed into 1
  710. Revision 1.4 1999/07/12 13:27:16 jonas
  711. + added Log and Id tags
  712. * added first FPC support, only VGA works to some extend for now
  713. * use -dasmgraph to use assembler routines, otherwise Pascal
  714. equivalents are used
  715. * use -dsupportVESA to support VESA (crashes under FPC for now)
  716. * only dispose vesainfo at closegrph if a vesa card was detected
  717. * changed int32 to longint (int32 is not declared under FPC)
  718. * changed the declaration of almost every procedure in graph.inc to
  719. "far;" becquse otherwise you can't assign them to procvars under TP
  720. real mode (but unexplainable "data segnment too large" errors prevent
  721. it from working under real mode anyway)
  722. }