gtext.inc 32 KB

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