gtext.inc 31 KB

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