From e0c6872cf40896c7be36b11dcc744620f10adf1d Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 2 Sep 2019 13:46:59 +0900 Subject: Initial commit --- systems/msdos/jemtex2/jis2mf.pas | 939 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 939 insertions(+) create mode 100644 systems/msdos/jemtex2/jis2mf.pas (limited to 'systems/msdos/jemtex2/jis2mf.pas') 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. -- cgit v1.2.3