home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / visionix / test / tfont.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-29  |  10.5 KB  |  543 lines
  1. uses vcrtu, vtypesu, vfontu, vgenu, vstringu;
  2.  
  3. Const
  4.  
  5.   FCCBR : Array[0..7] of BYTE =
  6.     ( $00, $00, $FC, $1C, $3C, $74, $E4, $E4 );
  7.  
  8. Var
  9.  
  10.   fs16 : tfontset;
  11.   fs8  : tfontset;
  12.  
  13.   l  : byte;
  14.   ch : char;
  15.  
  16.  
  17. {────────────────────────────────────────────────────────────────────────────}
  18.  
  19. Procedure DrawSet( FontSet : TFontSet;
  20.                    Index   : BYTE;
  21.                    Count   : WORD );
  22.  
  23. Var
  24.  
  25.   Z1,
  26.   Z2,
  27.   Z4  : INTEGER;
  28.   S   : STRING;
  29.  
  30. BEGIN
  31.  
  32.   Dec(Count);
  33.  
  34.   For Z1 := 0 to Count Do
  35.   BEGIN
  36.  
  37.     For Z2 := 1 to FontSet.ScanLines Do
  38.     BEGIN
  39.  
  40.       S[0] := #0;
  41.  
  42.       For Z4 := Pred(FontSet.Width) downto 0 Do
  43.       BEGIN
  44.  
  45.         If (TByteArray(FontSet.Table^)[((Index+Z1)*FontSet.ScanLines)+Z2] AND CBitMapW[Z4]) <> 0 Then
  46.           S := S + '█'
  47.         Else
  48.           S := S + '·';
  49.  
  50.       END;
  51.  
  52.       WriteLn(S);
  53.  
  54.     END;
  55.  
  56.     WriteLn;
  57.  
  58.   END;
  59.  
  60. END;
  61.  
  62. {────────────────────────────────────────────────────────────────────────────}
  63.  
  64. Procedure TestOne;
  65. BEGIN
  66.  
  67.   ClrScr;
  68.  
  69. {------------------------------------------}
  70.  
  71.   {--------------------}
  72.   { Make 8x16 font set }
  73.   {--------------------}
  74.  
  75.   TextMode(co80);
  76.   VFontROM8x16Load;
  77.   VFontSetGet( Font_VGA_8x16, fs16 );
  78.  
  79. {------------------------------------------}
  80.  
  81.   {-------------------}
  82.   { Make 8x8 font set }
  83.   {-------------------}
  84.  
  85.   TextMode(co80+font8x8);
  86.   VFontROM8x8Load;
  87.   VFontSetGet( Font_VGA_8x8, fs8 );
  88.  
  89. {------------------------------------------}
  90.  
  91.   {--------------------}
  92.   { Make 8x8 font file }
  93.   {--------------------}
  94.  
  95.   VFontPutText( 'FS8.FNT',
  96.                     0,
  97.                     255,
  98.                     '#',
  99.                     '.',
  100.                     fs8 );
  101.  
  102. {------------------------------------------}
  103.  
  104.   {-----------------------------}
  105.   { Scale 8x8 font file to 8x16 }
  106.   {-----------------------------}
  107.  
  108.   VFontGetText( 'FS8.FNT',
  109.                     0,
  110.                     255,
  111.                     '#',
  112.                     '.',
  113.                     fs8 );
  114.   VFontSetScale( fs8, 70, 80, fs16 );
  115.   VFontPutText( 'FS16.FNT',
  116.                     0,
  117.                     255,
  118.                     '#',
  119.                     '.',
  120.                     fs16 );
  121.  
  122. {------------------------------------------}
  123.  
  124.   {------------------------------------}
  125.   { Go 8x16 mode, then upload 8x16 set }
  126.   {------------------------------------}
  127.  
  128.   TextMode(co80);
  129.   VFontSetPut( fs16 );
  130.  
  131. (*
  132.  
  133. {------------------------------------------}
  134.  
  135.   {---------------------------}
  136.   { Scale ROM 8x16 downto 8x8 }
  137.   {---------------------------}
  138.  
  139.   VFontSetScale( fs16, 0, 255, fs8 );
  140.   VFontPutTextFile( 'FS1.FNT',
  141.                     0,
  142.                     255,
  143.                     '#',
  144.                     '.',
  145.                     fs8 );
  146.  
  147. {------------------------------------------}
  148.  
  149.   {-------------------------}
  150.   { Scale ROM 8x8 upto 8x16 }
  151.   {-------------------------}
  152.  
  153.   VFontSetScale( fs8, 0, 255, fs16 );
  154.   VFontPutTextFile( 'FS2.FNT',
  155.                     0,
  156.                     255,
  157.                     '#',
  158.                     '.',
  159.                     fs16 );
  160.  
  161. {------------------------------------------}
  162.  
  163. *)
  164.  
  165.   {-------------------}
  166.   { Dispose font sets }
  167.   {-------------------}
  168.  
  169.   VFontSetDispose( fs16 );
  170.   VFontSetDispose( fs8 );
  171.  
  172. {------------------------------------------}
  173.  
  174. END;
  175.  
  176. {────────────────────────────────────────────────────────────────────────────}
  177.  
  178. { Scales 8x16 downto 8x8 then same data back to 8x16 }
  179. { This shows loss of data by scale resolutions. }
  180.  
  181. Procedure TestTwo;
  182. BEGIN
  183.  
  184.   {--------------------}
  185.   { Make 8x16 font set }
  186.   {--------------------}
  187.  
  188.   TextMode(co80);
  189.   VFontROM8x16Load;
  190.   VFontSetGet( Font_VGA_8x16, fs16 );
  191.  
  192.   {-------------------}
  193.   { Make 8x8 font set }
  194.   {-------------------}
  195.  
  196.   TextMode(co80+font8x8);
  197.   VFontSetNew( fs8, 8, 8 );
  198.  
  199.   {-----------------------------------------}
  200.   { Scale 8x16 downto 8x8 then back to 8x16 }
  201.   {-----------------------------------------}
  202.  
  203.   VFontSetScale( fs16, 0, 255, fs8 );
  204.   VFontSetScale( fs8, 0, 255, fs16 );
  205.  
  206.   {---------------------------------}
  207.   { Save 8x16 font set to text file }
  208.   {---------------------------------}
  209.  
  210. (*
  211.   VFontPutTextFile( 'FS16.FNT',
  212.                     0,
  213.                     255,
  214.                     '#',
  215.                     '.',
  216.                     fs16 );
  217. *)
  218.  
  219.   {------------------------------------}
  220.   { Go 8x16 mode, then upload 8x16 set }
  221.   {------------------------------------}
  222.  
  223.   TextMode(co80);
  224.   VFontSetPut( fs16 );
  225.  
  226.   {-------------------}
  227.   { Dispose font sets }
  228.   {-------------------}
  229.  
  230.   VFontSetDispose( fs16 );
  231.   VFontSetDispose( fs8 );
  232.  
  233. END;
  234.  
  235. {────────────────────────────────────────────────────────────────────────────}
  236.  
  237. { Scales 8x8 up to 8x16 then same data back to 8x8 }
  238. { This shows NO loss of data by scale resolutions. }
  239.  
  240. Procedure TestThree;
  241. BEGIN
  242.  
  243.   {-------------------}
  244.   { Make 8x8 font set }
  245.   {-------------------}
  246.  
  247.   TextMode(co80+font8x8);
  248.   VFontROM8x8Load;
  249.   VFontPut( 65, 1, 8, @FCCBR );
  250.   VFontSetGet( Font_VGA_8x8, fs8 );
  251.  
  252.   {--------------------}
  253.   { Make 8x16 font set }
  254.   {--------------------}
  255.  
  256.   TextMode(co80);
  257.   VFontSetNew( fs16, 8, 16 );
  258.  
  259.   {--------------------------------------}
  260.   { Scale 8x8 upto 8x16 then back to 8x8 }
  261.   {--------------------------------------}
  262.  
  263.   VFontSetScale( fs8, 0, 255, fs16 );
  264.   VFontSetScale( fs16, 0, 255, fs8 );
  265.  
  266.   {--------------------------------}
  267.   { Save 8x8 font set to text file }
  268.   {--------------------------------}
  269.  
  270. (*
  271.   VFontPutTextFile( 'FS8.FNT',
  272.                     0,
  273.                     255,
  274.                     '#',
  275.                     '.',
  276.                     fs8 );
  277. *)
  278.  
  279.   {----------------------------------}
  280.   { Go 8x8 mode, then upload 8x8 set }
  281.   {----------------------------------}
  282.  
  283.   TextMode(co80+font8x8);
  284.   VFontSetPut( fs8 );
  285.  
  286.   {-------------------}
  287.   { Dispose font sets }
  288.   {-------------------}
  289.  
  290.   VFontSetDispose( fs16 );
  291.   VFontSetDispose( fs8 );
  292.  
  293. END;
  294.  
  295. {────────────────────────────────────────────────────────────────────────────}
  296.  
  297. {-------------------------------------}
  298. { Read a text file (8x16) into memory }
  299. {-------------------------------------}
  300.  
  301. Procedure TestFour;
  302.  
  303. BEGIN
  304.  
  305.   VFontSetNew( fs16, 8, 16 );
  306.   VFontGetText( 'FS16.FNT',
  307.                     0,
  308.                     255,
  309.                     '#',
  310.                     ' ',
  311.                     fs16 );
  312.   VFontSetPut( fs16 );
  313.   VFontSetDispose( fs16 );
  314.  
  315. END;
  316.  
  317. {────────────────────────────────────────────────────────────────────────────}
  318.  
  319. {---------------------------}
  320. { Make a ROM 8x16 Text File }
  321. {---------------------------}
  322.  
  323. Procedure TestFive;
  324.  
  325. BEGIN
  326.  
  327.   TextMode(co80);
  328.   VFontROM8x16Load;
  329.   VFontSetGet( Font_VGA_8x16, fs16 );
  330.   VFontSetPut( fs16 );
  331.   VFontPutText( 'FS16.FNT',
  332.                     0,
  333.                     255,
  334.                     '#',
  335.                     ' ',
  336.                     fs16 );
  337.   VFontSetPut( fs16 );
  338.   VFontSetDispose( fs16 );
  339.  
  340. END;
  341.  
  342. {────────────────────────────────────────────────────────────────────────────}
  343.  
  344. {----------------------------------------------}
  345. { Make a text file from default 8x16 font mode }
  346. {----------------------------------------------}
  347.  
  348. Procedure TestSix;
  349.  
  350. BEGIN
  351.  
  352.   TextMode(co80);
  353.   VFontSetGet( Font_VGA_8x16, fs16 );
  354.   VFontGetImage( '\BAT\BROADWAY.FNT', fs16 );
  355.   VFontPutText( 'FS16.FNT',
  356.                     0,
  357.                     255,
  358.                     '#',
  359.                     ' ',
  360.                     fs16 );
  361.   VFontSetDispose( fs16 );
  362.  
  363. END;
  364.  
  365. {────────────────────────────────────────────────────────────────────────────}
  366.  
  367. {
  368.  
  369.   Tests alternate map for 512 on screen fonts.  First table is using the
  370.   "fs16" var, and the second table is "fs8".  Then anytime you want to write
  371.   an "alternate" character to the screen, set the high intensity byte:
  372.  
  373.     TextAttr := TextAttr AND NOT 8;
  374.  
  375.   Then,
  376.  
  377.     TextAttr := TextAttr OR 8;
  378.  
  379.   will return to the original set.  NOTICE: YOU WILL NOT HAVE HIGH INTENSITY
  380.   CHARACTERS!  To reset to original 16 color mode, use the TextMode command.
  381. }
  382.  
  383. Procedure TestSeven;
  384.  
  385. Var
  386.  
  387.   L1 : LONGINT;
  388.  
  389. BEGIN
  390.  
  391.   TextMode(co80);
  392.  
  393.   {---}
  394.  
  395.   VFontROM8x16Load;
  396.   VFontSetGet( Font_VGA_8x16, fs16 );
  397.  
  398.   VFontSetGet( Font_VGA_8x16, fs8 );
  399.   VFontGetImage( '\BAT\BROADWAY.FNT', fs8 );
  400.  
  401.   {---}
  402.  
  403.   VFontAltSetPut( fs8 );
  404.  
  405.   {---}
  406.  
  407.   TextColor(White);
  408.   TextBackground(Black);
  409.  
  410.   TextAttr := TextAttr AND (NOT 8);
  411.  
  412.   For L1 := 0 to 255 Do
  413.     Write(Char(L1));
  414.  
  415.   WriteLn;
  416.  
  417.   TextAttr := TextAttr OR 8;
  418.  
  419.   For L1 := 0 to 255 Do
  420.     Write(Char(L1));
  421.  
  422.   WriteLn;
  423.  
  424.   {---}
  425.  
  426.   VFontSetDispose( fs16 );
  427.   VFontSetDispose( fs8 );
  428.  
  429. END;
  430.  
  431. {────────────────────────────────────────────────────────────────────────────}
  432.  
  433. {-----------------------------------------------}
  434. { Read a text file (8x16) into alternate memory }
  435. {-----------------------------------------------}
  436.  
  437. Procedure TestEight;
  438.  
  439. BEGIN
  440.  
  441.   VFontSetNew( fs16, 8, 16 );
  442.   VFontGetImage( '\BAT\BROADWAY.FNT', fs16 );
  443.   VFontAltSetPut( fs16 );
  444.   VFontSetDispose( fs16 );
  445.  
  446. END;
  447.  
  448. {────────────────────────────────────────────────────────────────────────────}
  449.  
  450. Procedure TestNine;
  451.  
  452. Var
  453.  
  454.   L1 : LONGINT;
  455.   Ch : CHAR;
  456.  
  457.   fs8b : TFontSet;
  458.  
  459. BEGIN
  460.  
  461.   TextMode(co80+font8x8);
  462.   VFontROM8x8Load;
  463.  
  464.   {---}
  465.  
  466.   VFontSetNew( fs16, 8, 16 );
  467.   VFontGetImage( '\BAT\COURIER.FNT', fs16 );
  468.  
  469.   VFontSetGet( Font_VGA_8x8, fs8 );
  470.  
  471.   VFontSetNew( fs8b, 8, 8 );
  472.   VFontSetScale( fs16, 0, 255, fs8b );
  473.  
  474.   {---}
  475.  
  476.   VFontSetPut( fs8 );
  477.   VFontAltSetPut( fs8b );
  478.  
  479.   {---}
  480.  
  481.   TextColor(White);
  482.   TextBackground(Black);
  483.  
  484.   TextAttr := TextAttr AND (NOT 8);
  485.  
  486.   For L1 := 0 to 255 Do
  487.     Write(Char(L1));
  488.  
  489.   WriteLn;
  490.  
  491.   TextAttr := TextAttr OR 8;
  492.  
  493.   For L1 := 0 to 255 Do
  494.     Write(Char(L1));
  495.  
  496.   WriteLn;
  497.   {---}
  498.  
  499.   VFontSetDispose( fs16 );
  500.   VFontSetDispose( fs8 );
  501.   VFontSetDispose( fs8b );
  502.  
  503. END;
  504.  
  505. {────────────────────────────────────────────────────────────────────────────}
  506.  
  507. Procedure TestTen;
  508.  
  509. BEGIN
  510.  
  511.   TextMode(co80);
  512.   VFontSetNew( fs16, 8, 16 );
  513.   VFontGetText( 'MAIN.FNT',
  514.                 0,
  515.                 255,
  516.                 '#',
  517.                 ' ',
  518.                 fs16 );
  519.   VFontSetPut( fs16 );
  520.  
  521. END;
  522.  
  523. {────────────────────────────────────────────────────────────────────────────}
  524. {────────────────────────────────────────────────────────────────────────────}
  525.  
  526. BEGIN
  527.  
  528.   TestOne;
  529.  
  530.   TestTwo;
  531.  
  532.   TestThree;
  533.  
  534.   TestFour;
  535.  
  536.   TestFive;
  537.  
  538.  
  539.   TestTen;
  540.  
  541. END.
  542.  
  543.