gtext.inc 28 KB

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