{$A-,B-,D-,E-,F-,I+,L-,N-,O-,R-,S-,V-}
{Compile with Turbo-Pascal 5.0}
Program JIS2MF(Input,Output);
{
This program generates METAFONT code from a Bitmaps file JIS24
Author: Francois Jalbert
'
Date: November 1990
Version: 1.0
Date: April 1991
Version: 2.00
Modifications: - Added four kanjis.
- Fixed incorrect VGA resolution.
- Command line parameter now supported.
- Added automatic mode.
- Added batch mode.
- Updated and improved run-time messages.
- Long triangles added by Mr. Masatoshi Watanabe. Fantastic!
- Fixed and proportional parameters added.
- Standard and dictionary parameters added.
- JIS24 now accessed through low-level I/O channel for speed.
Error Levels: 0 - Normal termination.
1 - Error.
2 - All fonts generated (batch).
}
Const
{Number of Bitmaps in JIS24}
BitmapMax=7806;
{Size of each square Bitmap}
SizeMax=24;
SizeMax1=25;
{DOS Record Size}
RecSize=72; {SizeMax*SizeMax/8}
{Parameter flag}
Flag1='/'; {DOS style}
Flag2='-'; {UNIX style}
{Parameter keywords}
FixedX1:String[10]='FIXEDWIDTH';
FixedX2:String[6]='FIXEDX';
FixedX3:String[19]='NOPROPORTIONALWIDTH';
FixedX4:String[15]='NOPROPORTIONALX';
NoFixedX1:String[12]='NOFIXEDWIDTH';
NoFixedX2:String[8]='NOFIXEDX';
NoFixedX3:String[17]='PROPORTIONALWIDTH';
NoFixedX4:String[13]='PROPORTIONALX';
FixedY1:String[11]='FIXEDHEIGHT';
FixedY2:String[6]='FIXEDY';
FixedY3:String[20]='NOPROPORTIONALHEIGHT';
FixedY4:String[15]='NOPROPORTIONALY';
NoFixedY1:String[13]='NOFIXEDHEIGHT';
NoFixedY2:String[8]='NOFIXEDY';
NoFixedY3:String[18]='PROPORTIONALHEIGHT';
NoFixedY4:String[13]='PROPORTIONALY';
Standard1:String[8]='STANDARD';
NoStandard1:String[10]='DICTIONARY';
Batch1:String[5]='BATCH';
Type
InFileType=File; {Low-level I/O channel}
OutFileType=Text;
BitmapRange=1..BitmapMax;
Bitmap0Range=0..BitmapMax;
SizeRange=1..SizeMax;
Size0Range=0..SizeMax1;
{Buffer for the Bitmap Data}
ColumnType=Record Data1,Data2,Data3:Byte End;
BufferType=Array [SizeRange] Of ColumnType;
{The Bitmap array is defined larger to simplify the forthcoming code}
BitmapType=Array [Size0Range,Size0Range] Of Boolean;
BitmapsType=Record
Bitmap:BitmapType;
XMin,XMax,YMin,YMax:Size0Range
End;
{Run time parameters}
RunTimeType=Record
FileName:String;
{Batch mode}
Batch:Boolean;
{Automatic mode for JemTeX fonts only}
Automatic:Boolean;
{Fixed or proportional fonts}
FixedX,FixedY:Boolean;
{Standard or dictionary fonts}
Standard:Boolean
End;
Var
{JIS24 and METAFONT file names}
InFile:InFileType;
OutFile:OutFileType;
{Current METAFONT character number}
Number:Integer;
{Run time parameters}
RunTime:RunTimeType;
Procedure SimpleQuery(Title,ChoiceA,ChoiceB:String; Var Answer:Boolean);
Var
JChar:Char;
Valid:Boolean;
Begin
Repeat
Valid:=True;
Writeln(Title+':');
Writeln(' a) '+ChoiceA);
Writeln(' b) '+ChoiceB);
Write('Your choice? ');
Readln(JChar);
JChar:=UpCase(JChar);
If JChar='A' Then Answer:=True
Else
If JChar='B' Then Answer:=False
Else
Begin Valid:=False; Write(Chr(7)) End
Until Valid;
Writeln
End;
Procedure GetMode(Var RunTime:RunTimeType);
{Determines if the desired font is a JemTeX font}
Begin
With RunTime Do
Begin
Automatic:=False;
If UpCase(FileName[1])='K' Then
If UpCase(FileName[2])='A' Then
If UpCase(FileName[3])='N' Then
If UpCase(FileName[4])='J' Then
If UpCase(FileName[5])='I' Then
If ('A'<=UpCase(FileName[6])) And (UpCase(FileName[6])<='H') Then
If ('A'<=UpCase(FileName[7])) And (UpCase(FileName[7])<='H') Then
If Length(FileName)=7 Then
If UpCase(FileName[6])<='G' Then Automatic:=True
Else
If UpCase(FileName[7])<='E' Then Automatic:=True
End
End;
Procedure EchoParameters(Var RunTime:RunTimeType);
{Echoes the current parameters}
Begin
With RunTime Do
Begin
Write('Font='+FileName);
If FixedX Then Write(' Fixed Width')
Else Write(' Prop. Width');
If FixedY Then Write(' Fixed Height')
Else Write(' Prop. Height');
If Standard Then Write(' Standard')
Else Write(' Dictionary');
If Automatic Then Write(' Automatic')
Else Write(' Manual');
If Batch Then Write(' Batch');
Writeln('.')
End
End;
Procedure Manual(Var RunTime:RunTimeType);
{Get parameters from user}
Begin
With RunTime Do
Begin
Write('METAFONT file name? ');
Readln(FileName);
Writeln;
SimpleQuery('Fixed or proportional font width','Fixed','Proportional',FixedX);
SimpleQuery('Fixed or proportional font height','Fixed','Proportional',FixedY);
SimpleQuery('Standard or dictionary font','Standard','Dictionary',Standard);
{Batch mode intrinsically isn't manual}
Batch:=False
End
End;
Procedure FindBefore(Var FileName:String);
{No check for before kanjiaa}
Begin
If FileName[7]='a' Then
Begin
FileName[7]:='h';
FileName[6]:=Pred(FileName[6])
End
Else
FileName[7]:=Pred(FileName[7])
End;
Procedure FindAfter(Var FileName:String);
{No check for above kanjihe}
Begin
If FileName[7]='h' Then
Begin
FileName[7]:='a';
FileName[6]:=Succ(FileName[6])
End
Else
FileName[7]:=Succ(FileName[7])
End;
Procedure ScanMF(Var FileName:String);
{Scans backwards for the last JemTeX font generated}
{Looks first for a .TFM and then for an .MF}
{If no more fonts to generate, stops with error level 2}
Var
TestFile:Text;
Found:Boolean;
Begin
FileName:='kanjihf';
Repeat
FindBefore(FileName);
Assign(TestFile,FileName+'.tfm');
{$I-}Reset(TestFile);{$I+}
{IOResult must be immediately used once only}
Found:=(IOResult=0);
If Not Found Then
Begin
Assign(TestFile,FileName+'.mf');
{$I-}Reset(TestFile);{$I+}
{IOResult must be immediately used once only}
Found:=(IOResult=0)
End;
Until Found Or (FileName='kanjiaa');
If Found Then
Begin
Close(TestFile);
If FileName='kanjihe' Then
Begin
Writeln(Chr(7)+'All JemTeX fonts generated!');
Halt(2)
End
Else FindAfter(FileName)
End
End;
Procedure Automate(Var RunTime:RunTimeType);
{Get parameters from command line}
{Finds the next font to be generated if in batch mode}
Var
ParamIndex,Index:Integer;
Param:String;
Begin
With RunTime Do
Begin
{Defaults}
FileName:='kanjiaa';
FixedX:=False;
FixedY:=False;
Standard:=True;
Batch:=False;
{Scan command line parameters}
For ParamIndex:=1 To ParamCount Do
Begin
Param:=ParamStr(ParamIndex);
If (Param[1]=Flag1) Or (Param[1]=Flag2) Then
{Not a font name}
Begin
{Delete 1 char at the 1st position}
Delete(Param,1,1);
{Convert to upper case}
For Index:=1 To Length(Param) Do
Param[Index]:=UpCase(Param[Index]);
{Scan known keywords}
If (Param=FixedX1) Or (Param=FixedX2) Or (Param=FixedX3) Or
(Param=FixedX4) Then FixedX:=True
Else
If (Param=NoFixedX1) Or (Param=NoFixedX2) Or (Param=NoFixedX3) Or
(Param=NoFixedX4) Then FixedX:=False
Else
If (Param=FixedY1) Or (Param=FixedY2) Or (Param=FixedY3) Or
(Param=FixedY4) Then FixedY:=True
Else
If (Param=NoFixedY1) Or (Param=NoFixedY2) Or (Param=NoFixedY3) Or
(Param=NoFixedY4) Then FixedY:=False
Else
If Param=Standard1 Then Standard:=True
Else
If Param=NoStandard1 Then Standard:=False
Else
If Param=Batch1 Then Batch:=True
Else
{Unknown keyword}
Begin
Writeln(Chr(7)+'Invalid command line parameter: '+Param+'...');
Halt(1)
End
End
Else
{Must be a font name}
FileName:=Param
End;
If Batch Then ScanMF(FileName)
End
End;
Procedure GetParameters(Var RunTime:RunTimeType);
{Get parameters from user or command line}
Begin
If ParamCount=0 Then Manual(RunTime)
Else Automate(RunTime);
GetMode(RunTime);
EchoParameters(RunTime);
Writeln
End;
Procedure BeginOut(Var OutFile:OutFileType; Var RunTime:RunTimeType);
{Writes initial METAFONT header}
{Co-author is Mr. Masatoshi Watanabe}
Begin
Writeln(OutFile,'%JIS2MF Version 2.00 of 14 April 1991.');
Writeln(OutFile);
Writeln(OutFile,'% Font='+RunTime.FileName);
If RunTime.FixedX Then Writeln(OutFile,'% Fixed Width')
Else Writeln(OutFile,'% Proportional Width');
If RunTime.FixedY Then Writeln(OutFile,'% Fixed Height')
Else Writeln(OutFile,'% Proportional Height');
If RunTime.Standard Then Writeln(OutFile,'% Standard Positioning')
Else Writeln(OutFile,'% Dictionary Positioning');
Writeln(OutFile);
Writeln(OutFile,'tracingstats:=1;');
Writeln(OutFile,'screen_cols:=640; %VGA');
Writeln(OutFile,'screen_rows:=480; %VGA');
Writeln(OutFile,'font_size 10pt#;');
If RunTime.Standard Then
Begin
Writeln(OutFile,'u#:=12.7/36pt#;');
Writeln(OutFile,'body_height#:=23.25u#;');
Writeln(OutFile,'desc_depth#:=4.75u#;')
End
Else
Begin
Writeln(OutFile,'u#:=13/36pt#;');
Writeln(OutFile,'body_height#:=21u#;');
Writeln(OutFile,'desc_depth#:=7u#;')
End;
Writeln(OutFile);
Writeln(OutFile,'letter_fit#:=0pt#;');
Writeln(OutFile,'asc_height#:=0pt#;');
Writeln(OutFile,'cap_height#:=0pt#;');
Writeln(OutFile,'fig_height#:=0pt#;');
Writeln(OutFile,'x_height#:=0pt#;');
Writeln(OutFile,'math_axis#:=0pt#;');
Writeln(OutFile,'bar_height#:=0pt#;');
Writeln(OutFile,'comma_depth#:=0pt#;');
Writeln(OutFile,'crisp#:=0pt#;');
Writeln(OutFile,'tiny#:=0pt#;');
Writeln(OutFile,'fine#:=0pt#;');
Writeln(OutFile,'thin_join#:=0pt#;');
Writeln(OutFile,'hair#:=1pt#;');
Writeln(OutFile,'stem#:=1pt#;');
Writeln(OutFile,'curve#:=1pt#;');
Writeln(OutFile,'flare#:=1pt#;');
Writeln(OutFile,'dot_size#:=0pt#;');
Writeln(OutFile,'cap_hair#:=1pt#;');
Writeln(OutFile,'cap_stem#:=1pt#;');
Writeln(OutFile,'cap_curve#:=1pt#;');
Writeln(OutFile,'rule_thickness#:=0pt#;');
Writeln(OutFile,'vair#:=0pt#;');
Writeln(OutFile,'notch_cut#:=0pt#;');
Writeln(OutFile,'bar#:=1pt#;');
Writeln(OutFile,'slab#:=1pt#;');
Writeln(OutFile,'cap_bar#:=1pt#;');
Writeln(OutFile,'cap_band#:=1pt#;');
Writeln(OutFile,'cap_notch_cut#:=0pt#;');
Writeln(OutFile,'serif_drop#:=0pt#;');
Writeln(OutFile,'stem_corr#:=0pt#;');
Writeln(OutFile,'vair_corr#:=0pt#;');
Writeln(OutFile,'o#:=0pt#;');
Writeln(OutFile,'apex_o#:=0pt#;');
Writeln(OutFile,'hefty:=true;');
Writeln(OutFile,'serifs:=true;');
Writeln(OutFile,'monospace:=false;');
Writeln(OutFile,'math_fitting:=false;');
Writeln(OutFile);
Writeln(OutFile,'mode_setup;');
Writeln(OutFile,'font_setup;');
Writeln(OutFile);
Writeln(OutFile,'pair z;');
Writeln(OutFile);
Writeln(OutFile,'def s(expr col,row)= %square');
Writeln(OutFile,' z:=((col*u),(row*u));');
Writeln(OutFile,' fill unitsquare scaled u shifted z;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def sul(expr col,row)= %upper left square');
Writeln(OutFile,' z:=((col*u),(row*u)+.5u);');
Writeln(OutFile,' fill unitsquare scaled .5u shifted z;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def sur(expr col,row)= %upper right square');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
Writeln(OutFile,' fill unitsquare scaled .5u shifted z;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def sbr(expr col,row)= %bottom right square');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u));');
Writeln(OutFile,' fill unitsquare scaled .5u shifted z;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def sbl(expr col,row)= %bottom left square');
Writeln(OutFile,' z:=((col*u),(row*u));');
Writeln(OutFile,' fill unitsquare scaled .5u shifted z;');
Writeln(OutFile,'enddef;');
Writeln(OutFile);
Writeln(OutFile,'def c(expr col,row)= %circle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
Writeln(OutFile,' fill fullcircle scaled u shifted z;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def cul(expr col,row)= %upper left circle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
Writeln(OutFile,' fill z--quartercircle rotated 90 scaled u shifted z--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def cur(expr col,row)= %upper right circle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
Writeln(OutFile,' fill z--quartercircle scaled u shifted z--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def cbr(expr col,row)= %bottom right circle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
Writeln(OutFile,' fill z--quartercircle rotated 270 scaled u shifted z--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def cbl(expr col,row)= %bottom left circle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
Writeln(OutFile,' fill z--quartercircle rotated 180 scaled u shifted z--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile);
Writeln(OutFile,'def tul(expr col,row)= %upper left triangle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
Writeln(OutFile,' fill z--z+(0,.5u)--z-(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def tur(expr col,row)= %upper right triangle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
Writeln(OutFile,' fill z--z+(0,.5u)--z+(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def tbr(expr col,row)= %bottom right triangle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
Writeln(OutFile,' fill z--z-(0,.5u)--z+(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def tbl(expr col,row)= %bottom left triangle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
Writeln(OutFile,' fill z--z-(0,.5u)--z-(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile);
Writeln(OutFile,'def rul(expr col,row)= %upper left reverse triangle');
Writeln(OutFile,' z:=((col*u),(row*u)+u);');
Writeln(OutFile,' fill z--z-(0,.5u)--z+(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def rur(expr col,row)= %upper right reverse triangle');
Writeln(OutFile,' z:=((col*u)+u,(row*u)+u);');
Writeln(OutFile,' fill z--z-(0,.5u)--z-(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def rbr(expr col,row)= %bottom right reverse triangle');
Writeln(OutFile,' z:=((col*u)+u,(row*u));');
Writeln(OutFile,' fill z--z+(0,.5u)--z-(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def rbl(expr col,row)= %bottom left reverse triangle');
Writeln(OutFile,' z:=((col*u),(row*u));');
Writeln(OutFile,' fill z--z+(0,.5u)--z+(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile);
Writeln(OutFile,'def tuul(expr col,row)= %upper left long triangle');
Writeln(OutFile,' z:=((col*u)+u,(row*u)+.5u);');
Writeln(OutFile,' fill z--z+(0,.5u)--z-(u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def tull(expr col,row)= %upper left long triangle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u));');
Writeln(OutFile,' fill z--z+(0,u)--z-(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def tuur(expr col,row)= %upper right long triangle');
Writeln(OutFile,' z:=((col*u),(row*u)+.5u);');
Writeln(OutFile,' fill z--z+(0,.5u)--z+(u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def turr(expr col,row)= %upper right long triangle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u));');
Writeln(OutFile,' fill z--z+(0,u)--z+(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def tbbr(expr col,row)= %bottom right long triangle');
Writeln(OutFile,' z:=((col*u),(row*u)+.5u);');
Writeln(OutFile,' fill z--z-(0,.5u)--z+(u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def tbrr(expr col,row)= %bottom right long triangle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+u);');
Writeln(OutFile,' fill z--z-(0,u)--z+(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def tbbl(expr col,row)= %bottom left long triangle');
Writeln(OutFile,' z:=((col*u)+u,(row*u)+.5u);');
Writeln(OutFile,' fill z--z-(0,.5u)--z-(u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def tbll(expr col,row)= %bottom left long triangle');
Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+u);');
Writeln(OutFile,' fill z--z-(0,u)--z-(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile);
Writeln(OutFile,'def ruul(expr col,row)= %upper left reverse long triangle');
Writeln(OutFile,' z:=((col*u),(row*u)+u);');
Writeln(OutFile,' fill z--z-(0,u)--z+(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def rull(expr col,row)= %upper left reverse long triangle');
Writeln(OutFile,' z:=((col*u),(row*u)+u);');
Writeln(OutFile,' fill z--z-(0,.5u)--z+(u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def ruur(expr col,row)= %upper right reverse long triangle');
Writeln(OutFile,' z:=((col*u)+u,(row*u)+u);');
Writeln(OutFile,' fill z--z-(0,u)--z-(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def rurr(expr col,row)= %upper right reverse long triangle');
Writeln(OutFile,' z:=((col*u)+u,(row*u)+u);');
Writeln(OutFile,' fill z--z-(0,.5u)--z-(u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def rbbr(expr col,row)= %bottom right reverse long triangle');
Writeln(OutFile,' z:=((col*u)+u,(row*u));');
Writeln(OutFile,' fill z--z+(0,u)--z-(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def rbrr(expr col,row)= %bottom right reverse long triangle');
Writeln(OutFile,' z:=((col*u)+u,(row*u));');
Writeln(OutFile,' fill z--z+(0,.5u)--z-(u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def rbbl(expr col,row)= %bottom left reverse long triangle');
Writeln(OutFile,' z:=((col*u),(row*u));');
Writeln(OutFile,' fill z--z+(0,u)--z+(.5u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile,'def rbll(expr col,row)= %bottom left reverse long triangle');
Writeln(OutFile,' z:=((col*u),(row*u));');
Writeln(OutFile,' fill z--z+(0,.5u)--z+(u,0)--cycle;');
Writeln(OutFile,'enddef;');
Writeln(OutFile)
End;
Procedure ActiveBitmap(Var OutFile:OutFileType; Var Bitmap:BitmapType;
X,Y:SizeRange; XX:Integer; YY:Real);
{Writes METAFONT code for an active cell}
{Co-author is Mr. Masatoshi Watanabe}
Var
SquareUR,SquareUL,SquareBR,SquareBL:Boolean;
CircleUR,CircleUL,CircleBR,CircleBL:Boolean;
LTryUUR,LTryURR,LTryUUL,LTryULL:Boolean;
LTryBBR,LTryBRR,LTryBBL,LTryBLL:Boolean;
Begin
SquareUL:=(Bitmap[X-1,Y] Or Bitmap[X-1,Y+1] Or Bitmap[X,Y+1]);
SquareUR:=(Bitmap[X+1,Y] Or Bitmap[X+1,Y+1] Or Bitmap[X,Y+1]);
SquareBL:=(Bitmap[X-1,Y] Or Bitmap[X-1,Y-1] Or Bitmap[X,Y-1]);
SquareBR:=(Bitmap[X+1,Y] Or Bitmap[X+1,Y-1] Or Bitmap[X,Y-1]);
CircleUL:=(Not Bitmap[X-1,Y-1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y+1] And
Not Bitmap[X,Y+1] And Not Bitmap[X+1,Y+1]);
CircleUR:=(Not Bitmap[X+1,Y-1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y+1] And
Not Bitmap[X,Y+1] And Not Bitmap[X-1,Y+1]);
CircleBL:=(Not Bitmap[X-1,Y+1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y-1] And
Not Bitmap[X,Y-1] And Not Bitmap[X+1,Y-1]);
CircleBR:=(Not Bitmap[X+1,Y+1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y-1] And
Not Bitmap[X,Y-1] And Not Bitmap[X-1,Y-1]);
LTryUUL:=(Bitmap[X-1,Y-1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y+1] And
Not Bitmap[X,Y+1] And Not Bitmap[X+1,Y+1] And Bitmap[X+1,Y]);
LTryUUR:=(Bitmap[X+1,Y-1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y+1] And
Not Bitmap[X,Y+1] And Not Bitmap[X-1,Y+1] And Bitmap[X-1,Y]);
LTryBBL:=(Bitmap[X-1,Y+1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y-1] And
Not Bitmap[X,Y-1] And Not Bitmap[X+1,Y-1] And Bitmap[X+1,Y]);
LTryBBR:=(Bitmap[X+1,Y+1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y-1] And
Not Bitmap[X,Y-1] And Not Bitmap[X-1,Y-1] And Bitmap[X-1,Y]);
LTryULL:=(Not Bitmap[X-1,Y-1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y+1] And
Not Bitmap[X,Y+1] And Bitmap[X+1,Y+1] And Bitmap[X,Y-1]);
LTryURR:=(Not Bitmap[X+1,Y-1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y+1] And
Not Bitmap[X,Y+1] And Bitmap[X-1,Y+1] And Bitmap[X,Y-1]);
LTryBLL:=(Not Bitmap[X-1,Y+1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y-1] And
Not Bitmap[X,Y-1] And Bitmap[X+1,Y-1] And Bitmap[X,Y+1]);
LTryBRR:=(Not Bitmap[X+1,Y+1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y-1] And
Not Bitmap[X,Y-1] And Bitmap[X-1,Y-1] And Bitmap[X,Y+1]);
If LTryUUL Then Write(OutFile,'tuul(',XX,',',YY:4:2,');');
If LTryULL Then Write(OutFile,'tull(',XX,',',YY:4:2,');');
If LTryUUR Then Write(OutFile,'tuur(',XX,',',YY:4:2,');');
If LTryURR Then Write(OutFile,'turr(',XX,',',YY:4:2,');');
If LTryBBL Then Write(OutFile,'tbbl(',XX,',',YY:4:2,');');
If LTryBLL Then Write(OutFile,'tbll(',XX,',',YY:4:2,');');
If LTryBBR Then Write(OutFile,'tbbr(',XX,',',YY:4:2,');');
If LTryBRR Then Write(OutFile,'tbrr(',XX,',',YY:4:2,');');
If SquareUL And SquareUR And SquareBL And SquareBR Then
Write(OutFile,'s(',XX,',',YY:4:2,');')
Else
If CircleUL And CircleUR And CircleBL And CircleBR Then
Write(OutFile,'c(',XX,',',YY:4:2,');')
Else
Begin
If Not LTryUUL And Not LTryULL And Not LTryUUR And Not LTryBLL Then
If SquareUL Then Write(OutFile,'sul(',XX,',',YY:4:2,');')
Else
If CircleUL Then Write(OutFile,'cul(',XX,',',YY:4:2,');')
Else Write(OutFile,'tul(',XX,',',YY:4:2,');');
If Not LTryUUL And Not LTryURR And Not LTryUUR And Not LTryBRR Then
If SquareUR Then Write(OutFile,'sur(',XX,',',YY:4:2,');')
Else
If CircleUR Then Write(OutFile,'cur(',XX,',',YY:4:2,');')
Else Write(OutFile,'tur(',XX,',',YY:4:2,');');
If Not LTryBBL And Not LTryULL And Not LTryBBR And Not LTryBLL Then
If SquareBL Then Write(OutFile,'sbl(',XX,',',YY:4:2,');')
Else
If CircleBL Then Write(OutFile,'cbl(',XX,',',YY:4:2,');')
Else Write(OutFile,'tbl(',XX,',',YY:4:2,');');
If Not LTryBBL And Not LTryURR And Not LTryBBR And Not LTryBRR Then
If SquareBR Then Write(OutFile,'sbr(',XX,',',YY:4:2,');')
Else
If CircleBR Then Write(OutFile,'cbr(',XX,',',YY:4:2,');')
Else Write(OutFile,'tbr(',XX,',',YY:4:2,');')
End
End;
Procedure InactiveBitmap(Var OutFile:OutFileType; Var Bitmap:BitmapType;
X,Y:SizeRange; XX:Integer; YY:Real; Var Active:Boolean);
{Writes METAFONT code for an inactive cell}
{Co-author is Mr. Masatoshi Watanabe}
Begin
If Bitmap[X-1,Y] And Bitmap[X,Y+1] Then
If Bitmap[X-1,Y-1] And Not Bitmap[X+1,Y+1] Then
Begin Active:=True; Write(OutFile,'ruul(',XX,',',YY:4:2,');') End
Else
If Bitmap[X+1,Y+1] And Not Bitmap[X-1,Y-1] Then
Begin Active:=True; Write(OutFile,'rull(',XX,',',YY:4:2,');') End
Else
Begin Active:=True; Write(OutFile,'rul(',XX,',',YY:4:2,');') End;
If Bitmap[X+1,Y] And Bitmap[X,Y+1] Then
If Bitmap[X+1,Y-1] And Not Bitmap[X-1,Y+1] Then
Begin Active:=True; Write(OutFile,'ruur(',XX,',',YY:4:2,');') End
Else
If Bitmap[X-1,Y+1] And Not Bitmap[X+1,Y-1] Then
Begin Active:=True; Write(OutFile,'rurr(',XX,',',YY:4:2,');') End
Else
Begin Active:=True; Write(OutFile,'rur(',XX,',',YY:4:2,');') End;
If Bitmap[X-1,Y] And Bitmap[X,Y-1] Then
If Bitmap[X-1,Y+1] And Not Bitmap[X+1,Y-1] Then
Begin Active:=True; Write(OutFile,'rbbl(',XX,',',YY:4:2,');') End
Else
If Bitmap[X+1,Y-1] And Not Bitmap[X-1,Y+1] Then
Begin Active:=True; Write(OutFile,'rbll(',XX,',',YY:4:2,');') End
Else
Begin Active:=True; Write(OutFile,'rbl(',XX,',',YY:4:2,');') End;
If Bitmap[X+1,Y] And Bitmap[X,Y-1] Then
If Bitmap[X+1,Y+1] And Not Bitmap[X-1,Y-1] Then
Begin Active:=True; Write(OutFile,'rbbr(',XX,',',YY:4:2,');') End
Else
If Bitmap[X-1,Y-1] And Not Bitmap[X+1,Y+1] Then
Begin Active:=True; Write(OutFile,'rbrr(',XX,',',YY:4:2,');') End
Else
Begin Active:=True; Write(OutFile,'rbr(',XX,',',YY:4:2,');') End
End;
Procedure MiddleOut(Var OutFile:OutFileType; Var Bitmaps:BitmapsType;
Number:Integer; Standard:Boolean);
{Writes METAFONT code for a given Bitmap}
Var
X,Y:SizeRange;
Active:Boolean;
Begin
With Bitmaps Do
Begin
Write(OutFile,'beginchar(',Number,',',XMax-XMin+1,'u#,');
If Standard Then
Begin
If YMax>0.75 Then Write(OutFile,(YMax-0.75):4:2,'u#,')
Else Write(OutFile,'0,');
If 5.75>YMin Then Writeln(OutFile,(5.75-YMin):4:2,'u#);')
Else Writeln(OutFile,'0);')
End
Else
Begin
If YMax>3 Then Write(OutFile,YMax-3,'u#,')
Else Write(OutFile,'0,');
If 8>YMin Then Writeln(OutFile,8-YMin,'u#);')
Else Writeln(OutFile,'0);')
End;
Writeln(OutFile,'normal_adjust_fit(2u#,2u#);');
For X:=XMin To XMax Do
For Y:=1 To SizeMax Do
Begin
Active:=Bitmap[X,Y];
If Active Then
{Current pixel is on}
If Standard Then ActiveBitmap(OutFile,Bitmap,X,Y,X-XMin,Y-3.75)
Else ActiveBitmap(OutFile,Bitmap,X,Y,X-XMin,Y-6)
Else
{Current pixel is off}
If Standard Then InactiveBitmap(OutFile,Bitmap,X,Y,X-XMin,Y-3.75,Active)
Else InactiveBitmap(OutFile,Bitmap,X,Y,X-XMin,Y-6,Active);
{Avoid METAFONT buffer overflow}
If Active Then Writeln(OutFile)
End;
Writeln(OutFile,'endchar;');
Writeln(OutFile)
End
End;
Procedure EndOut(Var OutFile:OutFileType; Var RunTime:RunTimeType);
{Writes final METAFONT header}
Begin
Writeln(OutFile,'font_identifier "'+RunTime.FileName+'";');
If RunTime.Standard Then
Writeln(OutFile,'font_coding_scheme "JemTeX Standard";')
Else Writeln(OutFile,'font_coding_scheme "JemTeX Dictionary";');
Writeln(OutFile,'font_slant slant;');
Writeln(OutFile,'font_normal_space 8u#;');
Writeln(OutFile,'font_normal_stretch 4u#;');
Writeln(OutFile,'font_normal_shrink 3u#;');
Writeln(OutFile,'font_x_height 24u#; %ex');
Writeln(OutFile,'font_quad 24u#; %em');
Writeln(OutFile,'font_extra_space 0u#;');
Writeln(OutFile);
{Must end with CR/LF because of a bug(?) in emTeX METAFONT}
Writeln(OutFile,'bye')
End;
Procedure FindWantedBitmap(Automatic:Boolean; Var First:Boolean;
Var WantedBitmap:Bitmap0Range; Var Number:Integer);
{Finds the number of the next desired Bitmap either automatically or manually}
{The characters 0 and 1 in the first font kanjiaa are both set to Bitmap 1}
Var Valid:Boolean;
Begin
If Automatic Then
{Find automatically}
If First Then
{Early in font kanjiaa}
If WantedBitmap=-1 Then WantedBitmap:=1
Else
Begin
WantedBitmap:=1;
First:=False
End
Else
If (Number=128) Or (WantedBitmap=BitmapMax) Then WantedBitmap:=0
Else WantedBitmap:=WantedBitmap+1
Else
{Find manually}
Repeat
Write('Bitmap number? ');
Readln(WantedBitmap);
Writeln;
Valid:=( (0<=WantedBitmap) And (WantedBitmap<=BitmapMax) );
If Not Valid Then Writeln(Chr(7)+'Bitmap ',WantedBitmap,' out of range...')
Until Valid;
Writeln('Bitmap number ',WantedBitmap,'.')
End;
Procedure ScanBitmap(Var InFile:InFileType; Var Bitmap:BitmapType;
Var Empty:Boolean);
{Reads the Bitmap in a logical grid}
{(0,0) is the lower left corner of the Bitmap}
Label 1;
Var
Y:SizeRange;
Buffer:BufferType;
Begin
{Read the Bitmap}
BlockRead(InFile,Buffer,1);
{Find if the Bitmap is empty}
Empty:=True;
For Y:=1 To SizeMax Do
With Buffer[Y] Do
If (Data1<>$00) Or (Data2<>$00) Or (Data3<>$00) Then
Begin
Empty:=False;
Goto 1
End;
{Update logical grid}
1:If Not Empty Then
For Y:=1 To SizeMax Do
With Buffer[SizeMax1-Y] Do
Begin
Bitmap[ 1,Y]:=((Data1 And $80)<>0);
Bitmap[ 2,Y]:=((Data1 And $40)<>0);
Bitmap[ 3,Y]:=((Data1 And $20)<>0);
Bitmap[ 4,Y]:=((Data1 And $10)<>0);
Bitmap[ 5,Y]:=((Data1 And $08)<>0);
Bitmap[ 6,Y]:=((Data1 And $04)<>0);
Bitmap[ 7,Y]:=((Data1 And $02)<>0);
Bitmap[ 8,Y]:=((Data1 And $01)<>0);
Bitmap[ 9,Y]:=((Data2 And $80)<>0);
Bitmap[10,Y]:=((Data2 And $40)<>0);
Bitmap[11,Y]:=((Data2 And $20)<>0);
Bitmap[12,Y]:=((Data2 And $10)<>0);
Bitmap[13,Y]:=((Data2 And $08)<>0);
Bitmap[14,Y]:=((Data2 And $04)<>0);
Bitmap[15,Y]:=((Data2 And $02)<>0);
Bitmap[16,Y]:=((Data2 And $01)<>0);
Bitmap[17,Y]:=((Data3 And $80)<>0);
Bitmap[18,Y]:=((Data3 And $40)<>0);
Bitmap[19,Y]:=((Data3 And $20)<>0);
Bitmap[20,Y]:=((Data3 And $10)<>0);
Bitmap[21,Y]:=((Data3 And $08)<>0);
Bitmap[22,Y]:=((Data3 And $04)<>0);
Bitmap[23,Y]:=((Data3 And $02)<>0);
Bitmap[24,Y]:=((Data3 And $01)<>0)
End
End;
Procedure ScanSides(Var Bitmaps:BitmapsType; FixedX,FixedY:Boolean);
{Determines the minimal size of the Bitmap for proportional spacing}
Var X,Y:SizeRange;
Begin
With Bitmaps Do
Begin
If FixedX Then
Begin
XMin:=1;
XMax:=SizeMax
End
Else
Begin
XMin:=SizeMax1;
For X:=SizeMax DownTo 1 Do
For Y:=1 To SizeMax Do
If Bitmap[X,Y] Then XMin:=X;
XMax:=0;
For X:=1 To SizeMax Do
For Y:=1 To SizeMax Do
If Bitmap[X,Y] Then XMax:=X
End;
If FixedY Then
Begin
YMin:=1;
YMax:=SizeMax
End
Else
Begin
YMin:=SizeMax1;
For Y:=SizeMax DownTo 1 Do
For X:=1 To SizeMax Do
If Bitmap[X,Y] Then YMin:=Y;
YMax:=0;
For Y:=1 To SizeMax Do
For X:=1 To SizeMax Do
If Bitmap[X,Y] Then YMax:=Y
End
End
End;
Procedure Generate(Var InFile:InFileType; Var OutFile:OutFileType;
Var Number:Integer; Var RunTime:RunTimeType);
{Generates the METAFONT code for the selected font}
Var
{Bitmap pointers}
CurrentBitmap,WantedBitmap:Bitmap0Range;
{Current Bitmap}
Bitmaps:BitmapsType;
X,Y:Size0Range;
{Indicates early in font kanjiaa}
First:Boolean;
{Indicates current Bitmap is empty}
Empty:Boolean;
Begin
{Clear the area outside the Bitmap once and for all}
With Bitmaps Do
Begin
For X:=0 To SizeMax1 Do
Begin Bitmap[X,0]:=False; Bitmap[X,SizeMax1]:=False End;
For Y:=1 To SizeMax Do
Begin Bitmap[0,Y]:=False; Bitmap[SizeMax1,Y]:=False End
End;
{Number of the Bitmap ready to be read}
CurrentBitmap:=1;
{First METAFONT character number}
Number:=0;
{First Bitmap wanted}
If RunTime.Automatic Then
Begin
WantedBitmap:=1024 * ( Ord(UpCase(RunTime.FileName[6]))-Ord('A') ) +
128 * ( Ord(UpCase(RunTime.FileName[7]))-Ord('A') ) - 1;
First:=(WantedBitmap=-1)
End;
Repeat
FindWantedBitmap(RunTime.Automatic,First,WantedBitmap,Number);
If WantedBitmap<>0 Then
Begin
{Position pointer}
If WantedBitmap<>CurrentBitmap Then
Begin
Seek(InFile,WantedBitmap-1);
CurrentBitmap:=WantedBitmap
End;
Write('Reading Bitmap');
ScanBitmap(InFile,Bitmaps.Bitmap,Empty);
CurrentBitmap:=CurrentBitmap+1;
Writeln('.');
{Process Bitmap}
If Empty Then Writeln('Bitmap is empty, no METAFONT code ',Number,'.')
Else
Begin
Write('Writing METAFONT code ',Number);
ScanSides(Bitmaps,RunTime.FixedX,RunTime.FixedY);
MiddleOut(OutFile,Bitmaps,Number,RunTime.Standard);
Writeln('.')
End;
Writeln;
{Ready to generate next METAFONT character}
Number:=Number+1
End;
Until WantedBitmap=0
End;
{------------------------------------ Main -----------------------------------}
Begin
Writeln;
Writeln('Bitmaps to METAFONT Conversion Program.'); {To make Borland happy}
Writeln('Version 2.00 Copyright F. Jalbert 1991.');
Writeln;
