gtext.inc 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888
  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.1 2000-07-13 06:30:52 michael
  700. + Initial import
  701. Revision 1.19 2000/06/16 17:06:08 sg
  702. * The text functions can now convert the character sets of the given
  703. strings. By default, for GO32V2 there is no conversion, and for all
  704. other platforms the strings are converted from ANSI to DOS-ASCII.
  705. Revision 1.18 2000/04/16 08:45:48 jonas
  706. * fixed registerbgifont (webbug 847)
  707. Revision 1.17 2000/04/02 12:13:36 florian
  708. * some more procedures can be now hooked by the OS specific implementation
  709. Revision 1.16 2000/03/24 18:16:33 florian
  710. * introduce a DrawBitmapCharHoriz procedure variable to accelerate output on
  711. win32
  712. Revision 1.15 2000/02/27 14:41:25 peter
  713. * removed warnings/notes
  714. Revision 1.14 2000/01/07 16:41:38 daniel
  715. * copyright 2000
  716. Revision 1.13 2000/01/07 16:32:26 daniel
  717. * copyright 2000 added
  718. Revision 1.12 2000/01/06 16:17:56 jonas
  719. * fixed bug in outTextXY for vertical text
  720. Revision 1.11 2000/01/02 19:02:39 jonas
  721. * removed/commented out (inited but) unused vars and unused types
  722. Revision 1.10 1999/12/23 16:48:13 jonas
  723. * turn off IO checking when attempting to open a font file (to avoid RTE)
  724. Revision 1.9 1999/12/20 11:22:36 peter
  725. * integer -> smallint to overcome -S2 switch needed for ggi version
  726. Revision 1.8 1999/11/11 22:29:21 florian
  727. * the writing of the default font was wrong when doing scaling:
  728. the last colunm/row wasn't drawn
  729. Revision 1.7 1999/09/28 15:07:47 jonas
  730. * fix for disposing font data because it can contain #0 chars
  731. Revision 1.6 1999/09/28 13:56:29 jonas
  732. * reordered some local variables (first 4 byte vars, then 2 byte vars
  733. etc)
  734. * font data is now disposed in exitproc, exitproc is now called
  735. GraphExitProc (was CleanModes) and resides in graph.pp instead of in
  736. modes.inc
  737. Revision 1.5 1999/09/27 23:34:42 peter
  738. * new graph unit is default for go32v2
  739. * removed warnings/notes
  740. Revision 1.4 1999/09/26 13:31:07 jonas
  741. * changed name of modeinfo variable to vesamodeinfo and fixed
  742. associated errors (fillchar(modeinfo,sizeof(tmodeinfo),#0) instead
  743. of sizeof(TVesamodeinfo) etc)
  744. * changed several sizeof(type) to sizeof(varname) to avoid similar
  745. errors in the future
  746. Revision 1.3 1999/09/22 14:54:11 jonas
  747. * changed ratios so font sizes on screen are the same as with TP
  748. * SetUserCharSize must also use / instead of DIV
  749. Revision 1.2 1999/09/22 13:30:52 jonas
  750. * changed org_to_cap, org_to_dec and org_to_base to shortint (from
  751. Michael Knapp's gxtext unit, part of the GraphiX package)
  752. * in settextstyle, the calculation of the ratios must be done
  753. with /, not DIV!!
  754. Revision 1.1 1999/09/22 13:13:36 jonas
  755. * renamed text.inc -> gtext.inc to avoid conflict with system unit
  756. * fixed textwidth
  757. * isgraphmode now gets properly updated, so mode restoring works
  758. again
  759. Revision 1.7 1999/09/12 17:29:00 jonas
  760. * several changes to internalellipse to make it faster
  761. and to make sure it updates the ArcCall correctly
  762. (not yet done for width = 3)
  763. * Arc mostly works now, only sometimes an endless loop, don't know
  764. why
  765. Revision 1.6 1999/09/12 08:02:22 florian
  766. * fixed outtext(''), c was a byte, this leads to an underflow and
  767. garbage was written
  768. Revision 1.5 1999/07/26 09:38:43 florian
  769. * bar: y2 can be less y1, fixed
  770. * settextstyle: charsize can be 0, must be changed into 1
  771. Revision 1.4 1999/07/12 13:27:16 jonas
  772. + added Log and Id tags
  773. * added first FPC support, only VGA works to some extend for now
  774. * use -dasmgraph to use assembler routines, otherwise Pascal
  775. equivalents are used
  776. * use -dsupportVESA to support VESA (crashes under FPC for now)
  777. * only dispose vesainfo at closegrph if a vesa card was detected
  778. * changed int32 to longint (int32 is not declared under FPC)
  779. * changed the declaration of almost every procedure in graph.inc to
  780. "far;" becquse otherwise you can't assign them to procvars under TP
  781. real mode (but unexplainable "data segnment too large" errors prevent
  782. it from working under real mode anyway)
  783. }