summaryrefslogtreecommitdiff
path: root/systems/msdos/jemtex2/jis2mf.pas
diff options
context:
space:
mode:
Diffstat (limited to 'systems/msdos/jemtex2/jis2mf.pas')
-rw-r--r--systems/msdos/jemtex2/jis2mf.pas939
1 files changed, 939 insertions, 0 deletions
diff --git a/systems/msdos/jemtex2/jis2mf.pas b/systems/msdos/jemtex2/jis2mf.pas
new file mode 100644
index 0000000000..ee944f7913
--- /dev/null
+++ b/systems/msdos/jemtex2/jis2mf.pas
@@ -0,0 +1,939 @@
+{$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;
+
+{-------------------------------- GetParameters ------------------------------}
+
+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;
+
+{----------------------------------- Output ----------------------------------}
+
+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;
+
+{---------------------------------- Generate ---------------------------------}
+
+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;
+
+Write('Opening Bitmap file JIS24');
+Assign(InFile,'JIS24');
+Reset(InFile,RecSize);
+Writeln('.');
+Writeln;
+
+GetParameters(RunTime);
+Write('Creating METAFONT file '+RunTime.FileName+'.mf');
+Assign(OutFile,RunTime.FileName+'.mf');
+Rewrite(OutFile);
+Writeln('.');
+Writeln;
+
+Write('Writing initial METAFONT header');
+BeginOut(OutFile,RunTime);
+Writeln('.');
+Writeln;
+Generate(InFile,OutFile,Number,RunTime);
+Writeln;
+
+Write('Writing final METAFONT header');
+EndOut(OutFile,RunTime);
+Writeln('.');
+Write('Closing METAFONT file '+RunTime.FileName+'.mf');
+Close(OutFile);
+Writeln('.');
+Write('Closing Bitmap file JIS24');
+Close(InFile);
+Writeln('.');
+Writeln;
+
+Writeln('METAFONT code for ',Number,' Bitmap(s) generated.');
+Writeln
+End.