home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / visionix / test / tfonted.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-29  |  6.4 KB  |  326 lines
  1. uses vcrtu, vtypesu, vfontu, vgenu, vstringu, dos, vdoshu;
  2.  
  3. Var
  4.  
  5.   fs16 : tfontset;
  6.   fs8  : tfontset;
  7.  
  8.   l    : byte;
  9.   ch   : char;
  10.  
  11. {────────────────────────────────────────────────────────────────────────────}
  12.  
  13. Procedure LoadSet( S : STRING; ScanLines : BYTE );
  14.  
  15. Var
  16.  
  17.   fs : TFontSet;
  18.  
  19. BEGIN
  20.  
  21.   If NOT FileExist(S) Then
  22.   BEGIN
  23.  
  24.     WriteLn(S, ' not found.');
  25.     Halt(2);
  26.  
  27.   END;
  28.  
  29.   VFontSetNew( fs, 8, ScanLines );
  30.   VFontGetText( S,
  31.                 0,
  32.                 255,
  33.                 '#',
  34.                 ' ',
  35.                 fs );
  36.   VFontSetPut( fs );
  37.   VFontSetDispose( fs );
  38.  
  39. END;
  40.  
  41. {────────────────────────────────────────────────────────────────────────────}
  42.  
  43. Procedure SaveSet( S : STRING; ScanLines : BYTE );
  44.  
  45. Var
  46.  
  47.   fs : TFontSet;
  48.  
  49. BEGIN
  50.  
  51.   Case ScanLines of
  52.  
  53.     16 : VFontSetGet( Font_VGA_8x16, fs );
  54.     8  : VFontSetGet( Font_VGA_8x8, fs );
  55.  
  56.   End;
  57.   VFontPutText( S,
  58.                 0,
  59.                 255,
  60.                 '#',
  61.                 ' ',
  62.                 fs );
  63.   VFontSetDispose( fs );
  64.  
  65. END;
  66.  
  67. {────────────────────────────────────────────────────────────────────────────}
  68.  
  69. Procedure LoadImage( S : STRING );
  70.  
  71. Var
  72.  
  73.   fs : TFontSet;
  74.  
  75. BEGIN
  76.  
  77.   If NOT FileExist(S) Then
  78.   BEGIN
  79.  
  80.     WriteLn(S, ' not found.');
  81.     Halt(2);
  82.  
  83.   END;
  84.  
  85.   VFontGetNewImage( S, fs );
  86.  
  87.   VFontSetPut( fs );
  88.  
  89.   VFontSetDispose( fs );
  90.  
  91. END;
  92.  
  93. {────────────────────────────────────────────────────────────────────────────}
  94.  
  95. Procedure SaveImage( S : STRING; ScanLines : BYTE );
  96.  
  97. Var
  98.  
  99.   fs : TFontSet;
  100.  
  101. BEGIN
  102.  
  103.   Case ScanLines of
  104.  
  105.     16 : VFontSetGet( Font_VGA_8x16, fs );
  106.     8  : VFontSetGet( Font_VGA_8x8, fs );
  107.  
  108.   End;
  109.  
  110.   VFontPutImage( S, fs );
  111.  
  112.   VFontSetDispose( fs );
  113.  
  114. END;
  115.  
  116. {────────────────────────────────────────────────────────────────────────────}
  117.  
  118. Procedure ScaleSet(     fn1    : STRING;
  119.                         SL2str : STRING;
  120.                         fn2    : STRING    );
  121. Var
  122.  
  123.   SL2 : BYTE;
  124.   fs1 : TFontSet;
  125.   fs2 : TFontSet;
  126.  
  127. BEGIN
  128.  
  129.   SL2 := StrToInt(SL2str);
  130.  
  131.   fs1.Table := NIL;
  132.   fs2.Table := NIL;
  133.  
  134.   VFontGetText( fn1, 0, 255, '#', ' ', fs1 );
  135.  
  136.   VFontSetNew( fs2, 8, SL2 );
  137.   VFontSetScale( fs1, 0, 255, fs2 );
  138.  
  139.   VFontPutText( fn2, 0, 255, '#', ' ', fs2 );
  140.  
  141.   VFontSetDispose(fs1);
  142.   VFontSetDispose(fs2);
  143.  
  144. END;
  145.  
  146. {────────────────────────────────────────────────────────────────────────────}
  147.  
  148. Procedure LoadAltSet( S : STRING; ScanLines : BYTE );
  149.  
  150. Var
  151.  
  152.   fs : TFontSet;
  153.  
  154. BEGIN
  155.  
  156.   If NOT FileExist(S) Then
  157.   BEGIN
  158.  
  159.     WriteLn(S, ' not found.');
  160.     Halt(2);
  161.  
  162.   END;
  163.  
  164.   VFontSetNew( fs, 8, ScanLines );
  165.   VFontGetText( S,
  166.                 0,
  167.                 255,
  168.                 '#',
  169.                 ' ',
  170.                 fs );
  171.   VFontAltSetPut( fs );
  172.   VFontSetDispose( fs );
  173.  
  174. END;
  175.  
  176. {────────────────────────────────────────────────────────────────────────────}
  177.  
  178. Procedure LoadAltImage( S : STRING );
  179.  
  180. Var
  181.  
  182.   fs : TFontSet;
  183.  
  184. BEGIN
  185.  
  186.   If NOT FileExist(S) Then
  187.   BEGIN
  188.  
  189.     WriteLn(S, ' not found.');
  190.     Halt(2);
  191.  
  192.   END;
  193.  
  194.   VFontGetNewImage( S, fs );
  195.  
  196.   VFontAltSetPut( fs );
  197.  
  198.   VFontSetDispose( fs );
  199.  
  200. END;
  201.  
  202. {────────────────────────────────────────────────────────────────────────────}
  203.  
  204. Procedure TextToImage( Source : STRING; Target : STRING );
  205.  
  206. Var
  207.  
  208.   fs : TFontSet;
  209.  
  210. BEGIN
  211.  
  212.   fs.Table := NIL;
  213.  
  214.   VFontGetText( Source, 0, 255, '#', ' ', fs );
  215.   VFontPutImage( Target, fs );
  216.  
  217.   VFontSetDispose( fs );
  218.  
  219. END;
  220.  
  221. {────────────────────────────────────────────────────────────────────────────}
  222.  
  223. Procedure ImageToText( Source : STRING; Target : STRING );
  224.  
  225. Var
  226.  
  227.   fs : TFontSet;
  228.  
  229. BEGIN
  230.  
  231.   VFontGetNewImage( Source, fs );
  232.   VFontPutText( Target, 0, 255, '#', ' ', fs );
  233.  
  234.   VFontSetDispose( fs );
  235.  
  236. END;
  237. {────────────────────────────────────────────────────────────────────────────}
  238.  
  239. Procedure Help;
  240. BEGIN
  241.  
  242.   WriteLn('─══[ TFONTED 1.0 by Killamac ]══──────────────────────────────────────────');
  243.   WriteLn('Usage: TFONTED [filename] [option(s)]');
  244.   WriteLn('Where: [filename] is your source font file');
  245.   WriteLn('Options:');
  246.   WriteLn('  8x8 = Use 8x8 Font Set (default is 8x16)');
  247.   WriteLn('  LOADTEXT = Load textfile into VGA font set');
  248.   WriteLn('  SAVETEXT = Save current VGA font set in memory to textfile');
  249.   WriteLn('  LOADIMAGE = Load imagefile into VGA font set');
  250.   WriteLn('  SAVEIMAGE = Save imagefile from VGA font set');
  251.   WriteLn('  SCALE [SL] [OutFile] = Scales [filename] into a new scanline set');
  252.   WriteLn('    and saves to a target-file');
  253.   WriteLn('  LOADALTTEXT = Load textfile into VGA alternate font set');
  254.   WriteLn('  LOADALTIMAGE = Load imagefile into VGA alternate font set');
  255.   WriteLn('  TEXTTOIMAGE [OutFile]');
  256.   WriteLn('  IMAGETOTEXT [OutFile]');
  257.   WriteLn;
  258.   WriteLn('Examples:');
  259.   WriteLn('  TFONTED TE.FNT LOADSET (Loads TE.FNT 8x16 font textfile)');
  260.   WriteLn('  TFONTED A.FNT 8x8 SAVESET (Creates A.FNT 8x8 font textfile)');
  261.   WriteLn('  TFONTED A.FNT SCALE 16 B.FNT (Scales the last A.FNT 8x8 font');
  262.   WriteLn('    textfile into the 8x16 font textfile B.FNT)');
  263.   WriteLn('  TFONTED TE.FNT LOADALTSET (Loads TE.FNT into high-intensity foreground)');
  264.   Halt(1);
  265.  
  266. END;
  267.  
  268. {────────────────────────────────────────────────────────────────────────────}
  269. {────────────────────────────────────────────────────────────────────────────}
  270. {────────────────────────────────────────────────────────────────────────────}
  271.  
  272. Var
  273.  
  274.   fn    : PathStr;
  275.   Param : STRING;
  276.   SL    : BYTE;
  277.   L1    : BYTE;
  278.  
  279. BEGIN
  280.  
  281.   If ParamCount < 2 Then
  282.     Help;
  283.  
  284.   fn := ParamStr(1);
  285.  
  286.   SL := 16;
  287.  
  288.   For L1 := 2 to ParamCount Do
  289.   BEGIN
  290.  
  291.     Param := UpperString(ParamStr(L1));
  292.  
  293.     If Param = '8X8' Then
  294.       SL := 8
  295.     Else
  296.     If Param = 'SCALE' Then
  297.       ScaleSet( fn, ParamStr(L1+1), ParamStr(L1+2) )
  298.     Else
  299.     If Param = 'LOADTEXT' Then
  300.       LoadSet(fn, SL)
  301.     Else
  302.     If Param = 'SAVETEXT' Then
  303.       SaveSet(fn, SL)
  304.     Else
  305.     If Param = 'LOADIMAGE' Then
  306.       LoadImage(fn)
  307.     Else
  308.     If Param = 'SAVEIMAGE' Then
  309.       SaveImage(fn, SL)
  310.     Else
  311.     If Param = 'LOADALTTEXT' Then
  312.       LoadAltSet(fn, SL)
  313.     Else
  314.     If Param = 'LOADALTIMAGE' Then
  315.       LoadAltImage(fn)
  316.     Else
  317.     If Param = 'TEXTTOIMAGE' Then
  318.       TextToImage( fn, ParamStr(L1+1) )
  319.     Else
  320.     If Param = 'IMAGETOTEXT' Then
  321.       ImageToText( fn, ParamStr(L1+1) );
  322.  
  323.   END;
  324.  
  325. END.
  326.