home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / text / jemtex-2.00.lha / JemTeX / sources / jis2mf.pas < prev   
Pascal/Delphi Source File  |  1993-12-21  |  33KB  |  940 lines
  1. {$A-,B-,D-,E-,F-,I+,L-,N-,O-,R-,S-,V-}
  2. {Compile with Turbo-Pascal 5.0}
  3. Program JIS2MF(Input,Output);
  4. {
  5.   This program generates METAFONT code from a Bitmaps file JIS24
  6.  
  7.   Author: Francois Jalbert
  8.               '
  9.   Date: November 1990
  10.  
  11.   Version: 1.0
  12.  
  13.   Date: April 1991
  14.  
  15.   Version: 2.00
  16.  
  17.   Modifications: - Added four kanjis.
  18.                  - Fixed incorrect VGA resolution.
  19.                  - Command line parameter now supported.
  20.                  - Added automatic mode.
  21.                  - Added batch mode.
  22.                  - Updated and improved run-time messages.
  23.                  - Long triangles added by Mr. Masatoshi Watanabe. Fantastic!
  24.                  - Fixed and proportional parameters added.
  25.                  - Standard and dictionary parameters added.
  26.                  - JIS24 now accessed through low-level I/O channel for speed.
  27.  
  28.   Error Levels: 0 - Normal termination.
  29.                 1 - Error.
  30.                 2 - All fonts generated (batch).
  31. }
  32. Const
  33.   {Number of Bitmaps in JIS24}
  34.   BitmapMax=7806;
  35.   {Size of each square Bitmap}
  36.   SizeMax=24;
  37.   SizeMax1=25;
  38.   {DOS Record Size}
  39.   RecSize=72; {SizeMax*SizeMax/8}
  40.   {Parameter flag}
  41.   Flag1='/'; {DOS style}
  42.   Flag2='-'; {UNIX style}
  43.   {Parameter keywords}
  44.   FixedX1:String[10]='FIXEDWIDTH';
  45.   FixedX2:String[6]='FIXEDX';
  46.   FixedX3:String[19]='NOPROPORTIONALWIDTH';
  47.   FixedX4:String[15]='NOPROPORTIONALX';
  48.   NoFixedX1:String[12]='NOFIXEDWIDTH';
  49.   NoFixedX2:String[8]='NOFIXEDX';
  50.   NoFixedX3:String[17]='PROPORTIONALWIDTH';
  51.   NoFixedX4:String[13]='PROPORTIONALX';
  52.   FixedY1:String[11]='FIXEDHEIGHT';
  53.   FixedY2:String[6]='FIXEDY';
  54.   FixedY3:String[20]='NOPROPORTIONALHEIGHT';
  55.   FixedY4:String[15]='NOPROPORTIONALY';
  56.   NoFixedY1:String[13]='NOFIXEDHEIGHT';
  57.   NoFixedY2:String[8]='NOFIXEDY';
  58.   NoFixedY3:String[18]='PROPORTIONALHEIGHT';
  59.   NoFixedY4:String[13]='PROPORTIONALY';
  60.   Standard1:String[8]='STANDARD';
  61.   NoStandard1:String[10]='DICTIONARY';
  62.   Batch1:String[5]='BATCH';
  63.  
  64. Type
  65.   InFileType=File; {Low-level I/O channel}
  66.   OutFileType=Text;
  67.   BitmapRange=1..BitmapMax;
  68.   Bitmap0Range=0..BitmapMax;
  69.   SizeRange=1..SizeMax;
  70.   Size0Range=0..SizeMax1;
  71.   {Buffer for the Bitmap Data}
  72.   ColumnType=Record Data1,Data2,Data3:Byte End;
  73.   BufferType=Array [SizeRange] Of ColumnType;
  74.   {The Bitmap array is defined larger to simplify the forthcoming code}
  75.   BitmapType=Array [Size0Range,Size0Range] Of Boolean;
  76.   BitmapsType=Record
  77.                 Bitmap:BitmapType;
  78.                 XMin,XMax,YMin,YMax:Size0Range
  79.               End;
  80.   {Run time parameters}
  81.   RunTimeType=Record
  82.                 FileName:String;
  83.                 {Batch mode}
  84.                 Batch:Boolean;
  85.                 {Automatic mode for JemTeX fonts only}
  86.                 Automatic:Boolean;
  87.                 {Fixed or proportional fonts}
  88.                 FixedX,FixedY:Boolean;
  89.                 {Standard or dictionary fonts}
  90.                 Standard:Boolean
  91.               End;
  92.  
  93. Var
  94.   {JIS24 and METAFONT file names}
  95.   InFile:InFileType;
  96.   OutFile:OutFileType;
  97.   {Current METAFONT character number}
  98.   Number:Integer;
  99.   {Run time parameters}
  100.   RunTime:RunTimeType;
  101.  
  102. {-------------------------------- GetParameters ------------------------------}
  103.  
  104. Procedure SimpleQuery(Title,ChoiceA,ChoiceB:String; Var Answer:Boolean);
  105. Var
  106.   JChar:Char;
  107.   Valid:Boolean;
  108. Begin
  109. Repeat
  110.   Valid:=True;
  111.   Writeln(Title+':');
  112.   Writeln('   a)  '+ChoiceA);
  113.   Writeln('   b)  '+ChoiceB);
  114.   Write('Your choice? ');
  115.   Readln(JChar);
  116.   JChar:=UpCase(JChar);
  117.   If JChar='A' Then Answer:=True
  118.   Else
  119.     If JChar='B' Then Answer:=False
  120.     Else
  121.       Begin Valid:=False; Write(Chr(7)) End
  122. Until Valid;
  123. Writeln
  124. End;
  125.  
  126. Procedure GetMode(Var RunTime:RunTimeType);
  127. {Determines if the desired font is a JemTeX font}
  128. Begin
  129. With RunTime Do
  130.   Begin
  131.   Automatic:=False;
  132.   If UpCase(FileName[1])='K' Then
  133.   If UpCase(FileName[2])='A' Then
  134.   If UpCase(FileName[3])='N' Then
  135.   If UpCase(FileName[4])='J' Then
  136.   If UpCase(FileName[5])='I' Then
  137.   If ('A'<=UpCase(FileName[6])) And (UpCase(FileName[6])<='H') Then
  138.   If ('A'<=UpCase(FileName[7])) And (UpCase(FileName[7])<='H') Then
  139.   If Length(FileName)=7 Then
  140.   If UpCase(FileName[6])<='G' Then Automatic:=True
  141.   Else
  142.   If UpCase(FileName[7])<='E' Then Automatic:=True
  143.   End
  144. End;
  145.  
  146. Procedure EchoParameters(Var RunTime:RunTimeType);
  147. {Echoes the current parameters}
  148. Begin
  149. With RunTime Do
  150.   Begin
  151.   Write('Font='+FileName);
  152.   If FixedX Then Write('  Fixed Width')
  153.   Else Write('  Prop. Width');
  154.   If FixedY Then Write('  Fixed Height')
  155.   Else Write('  Prop. Height');
  156.   If Standard Then Write('  Standard')
  157.   Else Write('  Dictionary');
  158.   If Automatic Then Write('  Automatic')
  159.   Else Write('  Manual');
  160.   If Batch Then Write('  Batch');
  161.   Writeln('.')
  162.   End
  163. End;
  164.  
  165. Procedure Manual(Var RunTime:RunTimeType);
  166. {Get parameters from user}
  167. Begin
  168. With RunTime Do
  169.   Begin
  170.   Write('METAFONT file name? ');
  171.   Readln(FileName);
  172.   Writeln;
  173.   SimpleQuery('Fixed or proportional font width','Fixed','Proportional',FixedX);
  174.   SimpleQuery('Fixed or proportional font height','Fixed','Proportional',FixedY);
  175.   SimpleQuery('Standard or dictionary font','Standard','Dictionary',Standard);
  176.   {Batch mode intrinsically isn't manual}
  177.   Batch:=False
  178.   End
  179. End;
  180.  
  181. Procedure FindBefore(Var FileName:String);
  182. {No check for before kanjiaa}
  183. Begin
  184. If FileName[7]='a' Then
  185.   Begin
  186.   FileName[7]:='h';
  187.   FileName[6]:=Pred(FileName[6])
  188.   End
  189. Else
  190.   FileName[7]:=Pred(FileName[7])
  191. End;
  192.  
  193. Procedure FindAfter(Var FileName:String);
  194. {No check for above kanjihe}
  195. Begin
  196. If FileName[7]='h' Then
  197.   Begin
  198.   FileName[7]:='a';
  199.   FileName[6]:=Succ(FileName[6])
  200.   End
  201. Else
  202.   FileName[7]:=Succ(FileName[7])
  203. End;
  204.  
  205. Procedure ScanMF(Var FileName:String);
  206. {Scans backwards for the last JemTeX font generated}
  207. {Looks first for a .TFM and then for an .MF}
  208. {If no more fonts to generate, stops with error level 2}
  209. Var 
  210.   TestFile:Text;
  211.   Found:Boolean;
  212. Begin
  213. FileName:='kanjihf';
  214. Repeat
  215.   FindBefore(FileName);
  216.   Assign(TestFile,FileName+'.tfm');
  217.   {$I-}Reset(TestFile);{$I+}
  218.   {IOResult must be immediately used once only}
  219.   Found:=(IOResult=0);
  220.   If Not Found Then 
  221.     Begin
  222.     Assign(TestFile,FileName+'.mf');
  223.     {$I-}Reset(TestFile);{$I+}
  224.     {IOResult must be immediately used once only}
  225.     Found:=(IOResult=0)
  226.     End;
  227. Until Found Or (FileName='kanjiaa');
  228. If Found Then
  229.   Begin
  230.   Close(TestFile);
  231.   If FileName='kanjihe' Then
  232.     Begin
  233.     Writeln(Chr(7)+'All JemTeX fonts generated!');
  234.     Halt(2)
  235.     End
  236.   Else FindAfter(FileName)
  237.   End
  238. End;
  239.  
  240. Procedure Automate(Var RunTime:RunTimeType);
  241. {Get parameters from command line}
  242. {Finds the next font to be generated if in batch mode}
  243. Var
  244.   ParamIndex,Index:Integer;
  245.   Param:String;
  246. Begin
  247. With RunTime Do
  248.   Begin
  249.   {Defaults}
  250.   FileName:='kanjiaa';
  251.   FixedX:=False;
  252.   FixedY:=False;
  253.   Standard:=True;
  254.   Batch:=False;
  255.   {Scan command line parameters}
  256.   For ParamIndex:=1 To ParamCount Do
  257.     Begin
  258.     Param:=ParamStr(ParamIndex);
  259.     If (Param[1]=Flag1) Or (Param[1]=Flag2) Then
  260.       {Not a font name}
  261.       Begin
  262.       {Delete 1 char at the 1st position}
  263.       Delete(Param,1,1);
  264.       {Convert to upper case}
  265.       For Index:=1 To Length(Param) Do 
  266.         Param[Index]:=UpCase(Param[Index]);
  267.       {Scan known keywords}
  268.       If (Param=FixedX1) Or (Param=FixedX2) Or (Param=FixedX3) Or 
  269.          (Param=FixedX4) Then FixedX:=True
  270.       Else
  271.       If (Param=NoFixedX1) Or (Param=NoFixedX2) Or (Param=NoFixedX3) Or 
  272.          (Param=NoFixedX4) Then FixedX:=False
  273.       Else
  274.       If (Param=FixedY1) Or (Param=FixedY2) Or (Param=FixedY3) Or 
  275.          (Param=FixedY4) Then FixedY:=True
  276.       Else
  277.       If (Param=NoFixedY1) Or (Param=NoFixedY2) Or (Param=NoFixedY3) Or 
  278.          (Param=NoFixedY4) Then FixedY:=False
  279.       Else
  280.       If Param=Standard1 Then Standard:=True
  281.       Else
  282.       If Param=NoStandard1 Then Standard:=False
  283.       Else
  284.       If Param=Batch1 Then Batch:=True
  285.       Else
  286.         {Unknown keyword}
  287.         Begin
  288.         Writeln(Chr(7)+'Invalid comman