home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / FONTS / ZIPFILES / JEMTEX2.ZIP / JIS2MF.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-04-14  |  32.5 KB  |  940 lines
  1. {$A-,B-,D-,E-,F-,I+,L-,N-,O-,R-,S-,V-}
  2. {Compile with Turbo-Pascal 5.0}
  3. Program JIS2MF(Input,Output);
  4. {
  5.   This program generates METAFONT code from a Bitmaps file JIS24
  6.  
  7.   Author: Francois Jalbert
  8.               '
  9.   Date: November 1990
  10.  
  11.   Version: 1.0
  12.  
  13.   Date: April 1991
  14.  
  15.   Version: 2.00
  16.  
  17.   Modifications: - Added four kanjis.
  18.                  - Fixed incorrect VGA resolution.
  19.                  - Command line parameter now supported.
  20.                  - Added automatic mode.
  21.                  - Added batch mode.
  22.                  - Updated and improved run-time messages.
  23.                  - Long triangles added by Mr. Masatoshi Watanabe. Fantastic!
  24.                  - Fixed and proportional parameters added.
  25.                  - Standard and dictionary parameters added.
  26.                  - JIS24 now accessed through low-level I/O channel for speed.
  27.  
  28.   Error Levels: 0 - Normal termination.
  29.                 1 - Error.
  30.                 2 - All fonts generated (batch).
  31. }
  32. Const
  33.   {Number of Bitmaps in JIS24}
  34.   BitmapMax=7806;
  35.   {Size of each square Bitmap}
  36.   SizeMax=24;
  37.   SizeMax1=25;
  38.   {DOS Record Size}
  39.   RecSize=72; {SizeMax*SizeMax/8}
  40.   {Parameter flag}
  41.   Flag1='/'; {DOS style}
  42.   Flag2='-'; {UNIX style}
  43.   {Parameter keywords}
  44.   FixedX1:String[10]='FIXEDWIDTH';
  45.   FixedX2:String[6]='FIXEDX';
  46.   FixedX3:String[19]='NOPROPORTIONALWIDTH';
  47.   FixedX4:String[15]='NOPROPORTIONALX';
  48.   NoFixedX1:String[12]='NOFIXEDWIDTH';
  49.   NoFixedX2:String[8]='NOFIXEDX';
  50.   NoFixedX3:String[17]='PROPORTIONALWIDTH';
  51.   NoFixedX4:String[13]='PROPORTIONALX';
  52.   FixedY1:String[11]='FIXEDHEIGHT';
  53.   FixedY2:String[6]='FIXEDY';
  54.   FixedY3:String[20]='NOPROPORTIONALHEIGHT';
  55.   FixedY4:String[15]='NOPROPORTIONALY';
  56.   NoFixedY1:String[13]='NOFIXEDHEIGHT';
  57.   NoFixedY2:String[8]='NOFIXEDY';
  58.   NoFixedY3:String[18]='PROPORTIONALHEIGHT';
  59.   NoFixedY4:String[13]='PROPORTIONALY';
  60.   Standard1:String[8]='STANDARD';
  61.   NoStandard1:String[10]='DICTIONARY';
  62.   Batch1:String[5]='BATCH';
  63.  
  64. Type
  65.   InFileType=File; {Low-level I/O channel}
  66.   OutFileType=Text;
  67.   BitmapRange=1..BitmapMax;
  68.   Bitmap0Range=0..BitmapMax;
  69.   SizeRange=1..SizeMax;
  70.   Size0Range=0..SizeMax1;
  71.   {Buffer for the Bitmap Data}
  72.   ColumnType=Record Data1,Data2,Data3:Byte End;
  73.   BufferType=Array [SizeRange] Of ColumnType;
  74.   {The Bitmap array is defined larger to simplify the forthcoming code}
  75.   BitmapType=Array [Size0Range,Size0Range] Of Boolean;
  76.   BitmapsType=Record
  77.                 Bitmap:BitmapType;
  78.                 XMin,XMax,YMin,YMax:Size0Range
  79.               End;
  80.   {Run time parameters}
  81.   RunTimeType=Record
  82.                 FileName:String;
  83.                 {Batch mode}
  84.                 Batch:Boolean;
  85.                 {Automatic mode for JemTeX fonts only}
  86.                 Automatic:Boolean;
  87.                 {Fixed or proportional fonts}
  88.                 FixedX,FixedY:Boolean;
  89.                 {Standard or dictionary fonts}
  90.                 Standard:Boolean
  91.               End;
  92.  
  93. Var
  94.   {JIS24 and METAFONT file names}
  95.   InFile:InFileType;
  96.   OutFile:OutFileType;
  97.   {Current METAFONT character number}
  98.   Number:Integer;
  99.   {Run time parameters}
  100.   RunTime:RunTimeType;
  101.  
  102. {-------------------------------- GetParameters ------------------------------}
  103.  
  104. Procedure SimpleQuery(Title,ChoiceA,ChoiceB:String; Var Answer:Boolean);
  105. Var
  106.   JChar:Char;
  107.   Valid:Boolean;
  108. Begin
  109. Repeat
  110.   Valid:=True;
  111.   Writeln(Title+':');
  112.   Writeln('   a)  '+ChoiceA);
  113.   Writeln('   b)  '+ChoiceB);
  114.   Write('Your choice? ');
  115.   Readln(JChar);
  116.   JChar:=UpCase(JChar);
  117.   If JChar='A' Then Answer:=True
  118.   Else
  119.     If JChar='B' Then Answer:=False
  120.     Else
  121.       Begin Valid:=False; Write(Chr(7)) End
  122. Until Valid;
  123. Writeln
  124. End;
  125.  
  126. Procedure GetMode(Var RunTime:RunTimeType);
  127. {Determines if the desired font is a JemTeX font}
  128. Begin
  129. With RunTime Do
  130.   Begin
  131.   Automatic:=False;
  132.   If UpCase(FileName[1])='K' Then
  133.   If UpCase(FileName[2])='A' Then
  134.   If UpCase(FileName[3])='N' Then
  135.   If UpCase(FileName[4])='J' Then
  136.   If UpCase(FileName[5])='I' Then
  137.   If ('A'<=UpCase(FileName[6])) And (UpCase(FileName[6])<='H') Then
  138.   If ('A'<=UpCase(FileName[7])) And (UpCase(FileName[7])<='H') Then
  139.   If Length(FileName)=7 Then
  140.   If UpCase(FileName[6])<='G' Then Automatic:=True
  141.   Else
  142.   If UpCase(FileName[7])<='E' Then Automatic:=True
  143.   End
  144. End;
  145.  
  146. Procedure EchoParameters(Var RunTime:RunTimeType);
  147. {Echoes the current parameters}
  148. Begin
  149. With RunTime Do
  150.   Begin
  151.   Write('Font='+FileName);
  152.   If FixedX Then Write('  Fixed Width')
  153.   Else Write('  Prop. Width');
  154.   If FixedY Then Write('  Fixed Height')
  155.   Else Write('  Prop. Height');
  156.   If Standard Then Write('  Standard')
  157.   Else Write('  Dictionary');
  158.   If Automatic Then Write('  Automatic')
  159.   Else Write('  Manual');
  160.   If Batch Then Write('  Batch');
  161.   Writeln('.')
  162.   End
  163. End;
  164.  
  165. Procedure Manual(Var RunTime:RunTimeType);
  166. {Get parameters from user}
  167. Begin
  168. With RunTime Do
  169.   Begin
  170.   Write('METAFONT file name? ');
  171.   Readln(FileName);
  172.   Writeln;
  173.   SimpleQuery('Fixed or proportional font width','Fixed','Proportional',FixedX);
  174.   SimpleQuery('Fixed or proportional font height','Fixed','Proportional',FixedY);
  175.   SimpleQuery('Standard or dictionary font','Standard','Dictionary',Standard);
  176.   {Batch mode intrinsically isn't manual}
  177.   Batch:=False
  178.   End
  179. End;
  180.  
  181. Procedure FindBefore(Var FileName:String);
  182. {No check for before kanjiaa}
  183. Begin
  184. If FileName[7]='a' Then
  185.   Begin
  186.   FileName[7]:='h';
  187.   FileName[6]:=Pred(FileName[6])
  188.   End
  189. Else
  190.   FileName[7]:=Pred(FileName[7])
  191. End;
  192.  
  193. Procedure FindAfter(Var FileName:String);
  194. {No check for above kanjihe}
  195. Begin
  196. If FileName[7]='h' Then
  197.   Begin
  198.   FileName[7]:='a';
  199.   FileName[6]:=Succ(FileName[6])
  200.   End
  201. Else
  202.   FileName[7]:=Succ(FileName[7])
  203. End;
  204.  
  205. Procedure ScanMF(Var FileName:String);
  206. {Scans backwards for the last JemTeX font generated}
  207. {Looks first for a .TFM and then for an .MF}
  208. {If no more fonts to generate, stops with error level 2}
  209. Var 
  210.   TestFile:Text;
  211.   Found:Boolean;
  212. Begin
  213. FileName:='kanjihf';
  214. Repeat
  215.   FindBefore(FileName);
  216.   Assign(TestFile,FileName+'.tfm');
  217.   {$I-}Reset(TestFile);{$I+}
  218.   {IOResult must be immediately used once only}
  219.   Found:=(IOResult=0);
  220.   If Not Found Then 
  221.     Begin
  222.     Assign(TestFile,FileName+'.mf');
  223.     {$I-}Reset(TestFile);{$I+}
  224.     {IOResult must be immediately used once only}
  225.     Found:=(IOResult=0)
  226.     End;
  227. Until Found Or (FileName='kanjiaa');
  228. If Found Then
  229.   Begin
  230.   Close(TestFile);
  231.   If FileName='kanjihe' Then
  232.     Begin
  233.     Writeln(Chr(7)+'All JemTeX fonts generated!');
  234.     Halt(2)
  235.     End
  236.   Else FindAfter(FileName)
  237.   End
  238. End;
  239.  
  240. Procedure Automate(Var RunTime:RunTimeType);
  241. {Get parameters from command line}
  242. {Finds the next font to be generated if in batch mode}
  243. Var
  244.   ParamIndex,Index:Integer;
  245.   Param:String;
  246. Begin
  247. With RunTime Do
  248.   Begin
  249.   {Defaults}
  250.   FileName:='kanjiaa';
  251.   FixedX:=False;
  252.   FixedY:=False;
  253.   Standard:=True;
  254.   Batch:=False;
  255.   {Scan command line parameters}
  256.   For ParamIndex:=1 To ParamCount Do
  257.     Begin
  258.     Param:=ParamStr(ParamIndex);
  259.     If (Param[1]=Flag1) Or (Param[1]=Flag2) Then
  260.       {Not a font name}
  261.       Begin
  262.       {Delete 1 char at the 1st position}
  263.       Delete(Param,1,1);
  264.       {Convert to upper case}
  265.       For Index:=1 To Length(Param) Do 
  266.         Param[Index]:=UpCase(Param[Index]);
  267.       {Scan known keywords}
  268.       If (Param=FixedX1) Or (Param=FixedX2) Or (Param=FixedX3) Or 
  269.          (Param=FixedX4) Then FixedX:=True
  270.       Else
  271.       If (Param=NoFixedX1) Or (Param=NoFixedX2) Or (Param=NoFixedX3) Or 
  272.          (Param=NoFixedX4) Then FixedX:=False
  273.       Else
  274.       If (Param=FixedY1) Or (Param=FixedY2) Or (Param=FixedY3) Or 
  275.          (Param=FixedY4) Then FixedY:=True
  276.       Else
  277.       If (Param=NoFixedY1) Or (Param=NoFixedY2) Or (Param=NoFixedY3) Or 
  278.          (Param=NoFixedY4) Then FixedY:=False
  279.       Else
  280.       If Param=Standard1 Then Standard:=True
  281.       Else
  282.       If Param=NoStandard1 Then Standard:=False
  283.       Else
  284.       If Param=Batch1 Then Batch:=True
  285.       Else
  286.         {Unknown keyword}
  287.         Begin
  288.         Writeln(Chr(7)+'Invalid command line parameter: '+Param+'...');
  289.         Halt(1)
  290.         End
  291.       End
  292.     Else
  293.       {Must be a font name}
  294.       FileName:=Param
  295.     End;
  296.   If Batch Then ScanMF(FileName)
  297.   End
  298. End;
  299.  
  300. Procedure GetParameters(Var RunTime:RunTimeType);
  301. {Get parameters from user or command line}
  302. Begin
  303. If ParamCount=0 Then Manual(RunTime)
  304. Else Automate(RunTime);
  305. GetMode(RunTime);
  306. EchoParameters(RunTime);
  307. Writeln
  308. End;
  309.  
  310. {----------------------------------- Output ----------------------------------}
  311.  
  312. Procedure BeginOut(Var OutFile:OutFileType; Var RunTime:RunTimeType);
  313. {Writes initial METAFONT header}
  314. {Co-author is Mr. Masatoshi Watanabe}
  315. Begin
  316. Writeln(OutFile,'%JIS2MF Version 2.00 of 14 April 1991.');
  317. Writeln(OutFile);
  318. Writeln(OutFile,'% Font='+RunTime.FileName);
  319. If RunTime.FixedX Then Writeln(OutFile,'% Fixed Width')
  320. Else Writeln(OutFile,'% Proportional Width');
  321. If RunTime.FixedY Then Writeln(OutFile,'% Fixed Height')
  322. Else Writeln(OutFile,'% Proportional Height');
  323. If RunTime.Standard Then Writeln(OutFile,'% Standard Positioning')
  324. Else Writeln(OutFile,'% Dictionary Positioning');
  325. Writeln(OutFile);
  326. Writeln(OutFile,'tracingstats:=1;');
  327. Writeln(OutFile,'screen_cols:=640; %VGA');
  328. Writeln(OutFile,'screen_rows:=480; %VGA');
  329. Writeln(OutFile,'font_size 10pt#;');
  330. If RunTime.Standard Then
  331.   Begin
  332.   Writeln(OutFile,'u#:=12.7/36pt#;');
  333.   Writeln(OutFile,'body_height#:=23.25u#;');
  334.   Writeln(OutFile,'desc_depth#:=4.75u#;')
  335.   End
  336. Else
  337.   Begin
  338.   Writeln(OutFile,'u#:=13/36pt#;');
  339.   Writeln(OutFile,'body_height#:=21u#;');
  340.   Writeln(OutFile,'desc_depth#:=7u#;')
  341.   End;
  342. Writeln(OutFile);
  343. Writeln(OutFile,'letter_fit#:=0pt#;');
  344. Writeln(OutFile,'asc_height#:=0pt#;');
  345. Writeln(OutFile,'cap_height#:=0pt#;');
  346. Writeln(OutFile,'fig_height#:=0pt#;');
  347. Writeln(OutFile,'x_height#:=0pt#;');
  348. Writeln(OutFile,'math_axis#:=0pt#;');
  349. Writeln(OutFile,'bar_height#:=0pt#;');
  350. Writeln(OutFile,'comma_depth#:=0pt#;');
  351. Writeln(OutFile,'crisp#:=0pt#;');
  352. Writeln(OutFile,'tiny#:=0pt#;');
  353. Writeln(OutFile,'fine#:=0pt#;');
  354. Writeln(OutFile,'thin_join#:=0pt#;');
  355. Writeln(OutFile,'hair#:=1pt#;');
  356. Writeln(OutFile,'stem#:=1pt#;');
  357. Writeln(OutFile,'curve#:=1pt#;');
  358. Writeln(OutFile,'flare#:=1pt#;');
  359. Writeln(OutFile,'dot_size#:=0pt#;');
  360. Writeln(OutFile,'cap_hair#:=1pt#;');
  361. Writeln(OutFile,'cap_stem#:=1pt#;');
  362. Writeln(OutFile,'cap_curve#:=1pt#;');
  363. Writeln(OutFile,'rule_thickness#:=0pt#;');
  364. Writeln(OutFile,'vair#:=0pt#;');
  365. Writeln(OutFile,'notch_cut#:=0pt#;');
  366. Writeln(OutFile,'bar#:=1pt#;');
  367. Writeln(OutFile,'slab#:=1pt#;');
  368. Writeln(OutFile,'cap_bar#:=1pt#;');
  369. Writeln(OutFile,'cap_band#:=1pt#;');
  370. Writeln(OutFile,'cap_notch_cut#:=0pt#;');
  371. Writeln(OutFile,'serif_drop#:=0pt#;');
  372. Writeln(OutFile,'stem_corr#:=0pt#;');
  373. Writeln(OutFile,'vair_corr#:=0pt#;');
  374. Writeln(OutFile,'o#:=0pt#;');
  375. Writeln(OutFile,'apex_o#:=0pt#;');
  376. Writeln(OutFile,'hefty:=true;');
  377. Writeln(OutFile,'serifs:=true;');
  378. Writeln(OutFile,'monospace:=false;');
  379. Writeln(OutFile,'math_fitting:=false;');
  380. Writeln(OutFile);
  381. Writeln(OutFile,'mode_setup;');
  382. Writeln(OutFile,'font_setup;');
  383. Writeln(OutFile);
  384. Writeln(OutFile,'pair z;');
  385. Writeln(OutFile);
  386. Writeln(OutFile,'def s(expr col,row)= %square');
  387. Writeln(OutFile,' z:=((col*u),(row*u));');
  388. Writeln(OutFile,' fill unitsquare scaled u shifted z;');
  389. Writeln(OutFile,'enddef;');
  390. Writeln(OutFile,'def sul(expr col,row)= %upper left square');
  391. Writeln(OutFile,' z:=((col*u),(row*u)+.5u);');
  392. Writeln(OutFile,' fill unitsquare scaled .5u shifted z;');
  393. Writeln(OutFile,'enddef;');
  394. Writeln(OutFile,'def sur(expr col,row)= %upper right square');
  395. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
  396. Writeln(OutFile,' fill unitsquare scaled .5u shifted z;');
  397. Writeln(OutFile,'enddef;');
  398. Writeln(OutFile,'def sbr(expr col,row)= %bottom right square');
  399. Writeln(OutFile,' z:=((col*u)+.5u,(row*u));');
  400. Writeln(OutFile,' fill unitsquare scaled .5u shifted z;');
  401. Writeln(OutFile,'enddef;');
  402. Writeln(OutFile,'def sbl(expr col,row)= %bottom left square');
  403. Writeln(OutFile,' z:=((col*u),(row*u));');
  404. Writeln(OutFile,' fill unitsquare scaled .5u shifted z;');
  405. Writeln(OutFile,'enddef;');
  406. Writeln(OutFile);
  407. Writeln(OutFile,'def c(expr col,row)= %circle');
  408. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
  409. Writeln(OutFile,' fill fullcircle scaled u shifted z;');
  410. Writeln(OutFile,'enddef;');
  411. Writeln(OutFile,'def cul(expr col,row)= %upper left circle');
  412. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
  413. Writeln(OutFile,' fill z--quartercircle rotated 90 scaled u shifted z--cycle;');
  414. Writeln(OutFile,'enddef;');
  415. Writeln(OutFile,'def cur(expr col,row)= %upper right circle');
  416. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
  417. Writeln(OutFile,' fill z--quartercircle scaled u shifted z--cycle;');
  418. Writeln(OutFile,'enddef;');
  419. Writeln(OutFile,'def cbr(expr col,row)= %bottom right circle');
  420. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
  421. Writeln(OutFile,' fill z--quartercircle rotated 270 scaled u shifted z--cycle;');
  422. Writeln(OutFile,'enddef;');
  423. Writeln(OutFile,'def cbl(expr col,row)= %bottom left circle');
  424. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
  425. Writeln(OutFile,' fill z--quartercircle rotated 180 scaled u shifted z--cycle;');
  426. Writeln(OutFile,'enddef;');
  427. Writeln(OutFile);
  428. Writeln(OutFile,'def tul(expr col,row)= %upper left triangle');
  429. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
  430. Writeln(OutFile,' fill z--z+(0,.5u)--z-(.5u,0)--cycle;');
  431. Writeln(OutFile,'enddef;');
  432. Writeln(OutFile,'def tur(expr col,row)= %upper right triangle');
  433. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
  434. Writeln(OutFile,' fill z--z+(0,.5u)--z+(.5u,0)--cycle;');
  435. Writeln(OutFile,'enddef;');
  436. Writeln(OutFile,'def tbr(expr col,row)= %bottom right triangle');
  437. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
  438. Writeln(OutFile,' fill z--z-(0,.5u)--z+(.5u,0)--cycle;');
  439. Writeln(OutFile,'enddef;');
  440. Writeln(OutFile,'def tbl(expr col,row)= %bottom left triangle');
  441. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+.5u);');
  442. Writeln(OutFile,' fill z--z-(0,.5u)--z-(.5u,0)--cycle;');
  443. Writeln(OutFile,'enddef;');
  444. Writeln(OutFile);
  445. Writeln(OutFile,'def rul(expr col,row)= %upper left reverse triangle');
  446. Writeln(OutFile,' z:=((col*u),(row*u)+u);');
  447. Writeln(OutFile,' fill z--z-(0,.5u)--z+(.5u,0)--cycle;');
  448. Writeln(OutFile,'enddef;');
  449. Writeln(OutFile,'def rur(expr col,row)= %upper right reverse triangle');
  450. Writeln(OutFile,' z:=((col*u)+u,(row*u)+u);');
  451. Writeln(OutFile,' fill z--z-(0,.5u)--z-(.5u,0)--cycle;');
  452. Writeln(OutFile,'enddef;');
  453. Writeln(OutFile,'def rbr(expr col,row)= %bottom right reverse triangle');
  454. Writeln(OutFile,' z:=((col*u)+u,(row*u));');
  455. Writeln(OutFile,' fill z--z+(0,.5u)--z-(.5u,0)--cycle;');
  456. Writeln(OutFile,'enddef;');
  457. Writeln(OutFile,'def rbl(expr col,row)= %bottom left reverse triangle');
  458. Writeln(OutFile,' z:=((col*u),(row*u));');
  459. Writeln(OutFile,' fill z--z+(0,.5u)--z+(.5u,0)--cycle;');
  460. Writeln(OutFile,'enddef;');
  461. Writeln(OutFile);
  462. Writeln(OutFile,'def tuul(expr col,row)= %upper left long triangle');
  463. Writeln(OutFile,' z:=((col*u)+u,(row*u)+.5u);');
  464. Writeln(OutFile,' fill z--z+(0,.5u)--z-(u,0)--cycle;');
  465. Writeln(OutFile,'enddef;');
  466. Writeln(OutFile,'def tull(expr col,row)= %upper left long triangle');
  467. Writeln(OutFile,' z:=((col*u)+.5u,(row*u));');
  468. Writeln(OutFile,' fill z--z+(0,u)--z-(.5u,0)--cycle;');
  469. Writeln(OutFile,'enddef;');
  470. Writeln(OutFile,'def tuur(expr col,row)= %upper right long triangle');
  471. Writeln(OutFile,' z:=((col*u),(row*u)+.5u);');
  472. Writeln(OutFile,' fill z--z+(0,.5u)--z+(u,0)--cycle;');
  473. Writeln(OutFile,'enddef;');
  474. Writeln(OutFile,'def turr(expr col,row)= %upper right long triangle');
  475. Writeln(OutFile,' z:=((col*u)+.5u,(row*u));');
  476. Writeln(OutFile,' fill z--z+(0,u)--z+(.5u,0)--cycle;');
  477. Writeln(OutFile,'enddef;');
  478. Writeln(OutFile,'def tbbr(expr col,row)= %bottom right long triangle');
  479. Writeln(OutFile,' z:=((col*u),(row*u)+.5u);');
  480. Writeln(OutFile,' fill z--z-(0,.5u)--z+(u,0)--cycle;');
  481. Writeln(OutFile,'enddef;');
  482. Writeln(OutFile,'def tbrr(expr col,row)= %bottom right long triangle');
  483. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+u);');
  484. Writeln(OutFile,' fill z--z-(0,u)--z+(.5u,0)--cycle;');
  485. Writeln(OutFile,'enddef;');
  486. Writeln(OutFile,'def tbbl(expr col,row)= %bottom left long triangle');
  487. Writeln(OutFile,' z:=((col*u)+u,(row*u)+.5u);');
  488. Writeln(OutFile,' fill z--z-(0,.5u)--z-(u,0)--cycle;');
  489. Writeln(OutFile,'enddef;');
  490. Writeln(OutFile,'def tbll(expr col,row)= %bottom left long triangle');
  491. Writeln(OutFile,' z:=((col*u)+.5u,(row*u)+u);');
  492. Writeln(OutFile,' fill z--z-(0,u)--z-(.5u,0)--cycle;');
  493. Writeln(OutFile,'enddef;');
  494. Writeln(OutFile);
  495. Writeln(OutFile,'def ruul(expr col,row)= %upper left reverse long triangle');
  496. Writeln(OutFile,' z:=((col*u),(row*u)+u);');
  497. Writeln(OutFile,' fill z--z-(0,u)--z+(.5u,0)--cycle;');
  498. Writeln(OutFile,'enddef;');
  499. Writeln(OutFile,'def rull(expr col,row)= %upper left reverse long triangle');
  500. Writeln(OutFile,' z:=((col*u),(row*u)+u);');
  501. Writeln(OutFile,' fill z--z-(0,.5u)--z+(u,0)--cycle;');
  502. Writeln(OutFile,'enddef;');
  503. Writeln(OutFile,'def ruur(expr col,row)= %upper right reverse long triangle');
  504. Writeln(OutFile,' z:=((col*u)+u,(row*u)+u);');
  505. Writeln(OutFile,' fill z--z-(0,u)--z-(.5u,0)--cycle;');
  506. Writeln(OutFile,'enddef;');
  507. Writeln(OutFile,'def rurr(expr col,row)= %upper right reverse long triangle');
  508. Writeln(OutFile,' z:=((col*u)+u,(row*u)+u);');
  509. Writeln(OutFile,' fill z--z-(0,.5u)--z-(u,0)--cycle;');
  510. Writeln(OutFile,'enddef;');
  511. Writeln(OutFile,'def rbbr(expr col,row)= %bottom right reverse long triangle');
  512. Writeln(OutFile,' z:=((col*u)+u,(row*u));');
  513. Writeln(OutFile,' fill z--z+(0,u)--z-(.5u,0)--cycle;');
  514. Writeln(OutFile,'enddef;');
  515. Writeln(OutFile,'def rbrr(expr col,row)= %bottom right reverse long triangle');
  516. Writeln(OutFile,' z:=((col*u)+u,(row*u));');
  517. Writeln(OutFile,' fill z--z+(0,.5u)--z-(u,0)--cycle;');
  518. Writeln(OutFile,'enddef;');
  519. Writeln(OutFile,'def rbbl(expr col,row)= %bottom left reverse long triangle');
  520. Writeln(OutFile,' z:=((col*u),(row*u));');
  521. Writeln(OutFile,' fill z--z+(0,u)--z+(.5u,0)--cycle;');
  522. Writeln(OutFile,'enddef;');
  523. Writeln(OutFile,'def rbll(expr col,row)= %bottom left reverse long triangle');
  524. Writeln(OutFile,' z:=((col*u),(row*u));');
  525. Writeln(OutFile,' fill z--z+(0,.5u)--z+(u,0)--cycle;');
  526. Writeln(OutFile,'enddef;');
  527. Writeln(OutFile)
  528. End;
  529.  
  530. Procedure ActiveBitmap(Var OutFile:OutFileType; Var Bitmap:BitmapType; 
  531.                        X,Y:SizeRange; XX:Integer; YY:Real);
  532. {Writes METAFONT code for an active cell}
  533. {Co-author is Mr. Masatoshi Watanabe}
  534. Var
  535.   SquareUR,SquareUL,SquareBR,SquareBL:Boolean;
  536.   CircleUR,CircleUL,CircleBR,CircleBL:Boolean;
  537.   LTryUUR,LTryURR,LTryUUL,LTryULL:Boolean;
  538.   LTryBBR,LTryBRR,LTryBBL,LTryBLL:Boolean;
  539. Begin
  540. SquareUL:=(Bitmap[X-1,Y] Or Bitmap[X-1,Y+1] Or Bitmap[X,Y+1]);
  541. SquareUR:=(Bitmap[X+1,Y] Or Bitmap[X+1,Y+1] Or Bitmap[X,Y+1]);
  542. SquareBL:=(Bitmap[X-1,Y] Or Bitmap[X-1,Y-1] Or Bitmap[X,Y-1]);
  543. SquareBR:=(Bitmap[X+1,Y] Or Bitmap[X+1,Y-1] Or Bitmap[X,Y-1]);
  544. CircleUL:=(Not Bitmap[X-1,Y-1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y+1] And
  545.            Not Bitmap[X,Y+1] And Not Bitmap[X+1,Y+1]);
  546. CircleUR:=(Not Bitmap[X+1,Y-1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y+1] And
  547.            Not Bitmap[X,Y+1] And Not Bitmap[X-1,Y+1]);
  548. CircleBL:=(Not Bitmap[X-1,Y+1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y-1] And
  549.            Not Bitmap[X,Y-1] And Not Bitmap[X+1,Y-1]);
  550. CircleBR:=(Not Bitmap[X+1,Y+1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y-1] And
  551.            Not Bitmap[X,Y-1] And Not Bitmap[X-1,Y-1]);
  552. LTryUUL:=(Bitmap[X-1,Y-1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y+1] And
  553.           Not Bitmap[X,Y+1] And Not Bitmap[X+1,Y+1] And Bitmap[X+1,Y]);
  554. LTryUUR:=(Bitmap[X+1,Y-1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y+1] And
  555.           Not Bitmap[X,Y+1] And Not Bitmap[X-1,Y+1] And Bitmap[X-1,Y]);
  556. LTryBBL:=(Bitmap[X-1,Y+1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y-1] And
  557.           Not Bitmap[X,Y-1] And Not Bitmap[X+1,Y-1] And Bitmap[X+1,Y]);
  558. LTryBBR:=(Bitmap[X+1,Y+1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y-1] And
  559.           Not Bitmap[X,Y-1] And Not Bitmap[X-1,Y-1] And Bitmap[X-1,Y]);
  560. LTryULL:=(Not Bitmap[X-1,Y-1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y+1] And
  561.           Not Bitmap[X,Y+1] And Bitmap[X+1,Y+1] And Bitmap[X,Y-1]);
  562. LTryURR:=(Not Bitmap[X+1,Y-1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y+1] And
  563.           Not Bitmap[X,Y+1] And Bitmap[X-1,Y+1] And Bitmap[X,Y-1]);
  564. LTryBLL:=(Not Bitmap[X-1,Y+1] And Not Bitmap[X-1,Y] And Not Bitmap[X-1,Y-1] And
  565.           Not Bitmap[X,Y-1] And Bitmap[X+1,Y-1] And Bitmap[X,Y+1]);
  566. LTryBRR:=(Not Bitmap[X+1,Y+1] And Not Bitmap[X+1,Y] And Not Bitmap[X+1,Y-1] And
  567.           Not Bitmap[X,Y-1] And Bitmap[X-1,Y-1] And Bitmap[X,Y+1]);
  568. If LTryUUL Then Write(OutFile,'tuul(',XX,',',YY:4:2,');');
  569. If LTryULL Then Write(OutFile,'tull(',XX,',',YY:4:2,');');
  570. If LTryUUR Then Write(OutFile,'tuur(',XX,',',YY:4:2,');');
  571. If LTryURR Then Write(OutFile,'turr(',XX,',',YY:4:2,');');
  572. If LTryBBL Then Write(OutFile,'tbbl(',XX,',',YY:4:2,');');
  573. If LTryBLL Then Write(OutFile,'tbll(',XX,',',YY:4:2,');');
  574. If LTryBBR Then Write(OutFile,'tbbr(',XX,',',YY:4:2,');');
  575. If LTryBRR Then Write(OutFile,'tbrr(',XX,',',YY:4:2,');');
  576. If SquareUL And SquareUR And SquareBL And SquareBR Then
  577.   Write(OutFile,'s(',XX,',',YY:4:2,');')
  578. Else
  579.   If CircleUL And CircleUR And CircleBL And CircleBR Then
  580.     Write(OutFile,'c(',XX,',',YY:4:2,');')
  581.   Else
  582.     Begin
  583.     If Not LTryUUL And Not LTryULL And Not LTryUUR And Not LTryBLL Then
  584.       If SquareUL Then Write(OutFile,'sul(',XX,',',YY:4:2,');')
  585.       Else
  586.         If CircleUL Then Write(OutFile,'cul(',XX,',',YY:4:2,');')
  587.         Else Write(OutFile,'tul(',XX,',',YY:4:2,');');
  588.     If Not LTryUUL And Not LTryURR And Not LTryUUR And Not LTryBRR Then
  589.       If SquareUR Then Write(OutFile,'sur(',XX,',',YY:4:2,');')
  590.       Else
  591.         If CircleUR Then Write(OutFile,'cur(',XX,',',YY:4:2,');')
  592.         Else Write(OutFile,'tur(',XX,',',YY:4:2,');');
  593.     If Not LTryBBL And Not LTryULL And Not LTryBBR And Not LTryBLL Then
  594.       If SquareBL Then Write(OutFile,'sbl(',XX,',',YY:4:2,');')
  595.       Else
  596.         If CircleBL Then Write(OutFile,'cbl(',XX,',',YY:4:2,');')
  597.         Else Write(OutFile,'tbl(',XX,',',YY:4:2,');');
  598.     If Not LTryBBL And Not LTryURR And Not LTryBBR And Not LTryBRR Then
  599.       If SquareBR Then Write(OutFile,'sbr(',XX,',',YY:4:2,');')
  600.       Else
  601.         If CircleBR Then Write(OutFile,'cbr(',XX,',',YY:4:2,');')
  602.         Else Write(OutFile,'tbr(',XX,',',YY:4:2,');')
  603.     End
  604. End;
  605.  
  606. Procedure InactiveBitmap(Var OutFile:OutFileType; Var Bitmap:BitmapType;
  607.                          X,Y:SizeRange; XX:Integer; YY:Real; Var Active:Boolean);
  608. {Writes METAFONT code for an inactive cell}
  609. {Co-author is Mr. Masatoshi Watanabe}
  610. Begin
  611. If Bitmap[X-1,Y] And Bitmap[X,Y+1] Then
  612.   If Bitmap[X-1,Y-1] And Not Bitmap[X+1,Y+1] Then
  613.     Begin Active:=True; Write(OutFile,'ruul(',XX,',',YY:4:2,');') End
  614.   Else
  615.     If Bitmap[X+1,Y+1] And Not Bitmap[X-1,Y-1] Then
  616.       Begin Active:=True; Write(OutFile,'rull(',XX,',',YY:4:2,');') End
  617.     Else
  618.       Begin Active:=True; Write(OutFile,'rul(',XX,',',YY:4:2,');') End;
  619. If Bitmap[X+1,Y] And Bitmap[X,Y+1] Then
  620.   If Bitmap[X+1,Y-1] And Not Bitmap[X-1,Y+1] Then
  621.     Begin Active:=True; Write(OutFile,'ruur(',XX,',',YY:4:2,');') End
  622.   Else
  623.     If Bitmap[X-1,Y+1] And Not Bitmap[X+1,Y-1] Then
  624.       Begin Active:=True; Write(OutFile,'rurr(',XX,',',YY:4:2,');') End
  625.     Else
  626.       Begin Active:=True; Write(OutFile,'rur(',XX,',',YY:4:2,');') End;
  627. If Bitmap[X-1,Y] And Bitmap[X,Y-1] Then
  628.   If Bitmap[X-1,Y+1] And Not Bitmap[X+1,Y-1] Then
  629.     Begin Active:=True; Write(OutFile,'rbbl(',XX,',',YY:4:2,');') End
  630.   Else
  631.     If Bitmap[X+1,Y-1] And Not Bitmap[X-1,Y+1] Then
  632.       Begin Active:=True; Write(OutFile,'rbll(',XX,',',YY:4:2,');') End
  633.     Else
  634.       Begin Active:=True; Write(OutFile,'rbl(',XX,',',YY:4:2,');') End;
  635. If Bitmap[X+1,Y] And Bitmap[X,Y-1] Then
  636.   If Bitmap[X+1,Y+1] And Not Bitmap[X-1,Y-1] Then
  637.     Begin Active:=True; Write(OutFile,'rbbr(',XX,',',YY:4:2,');') End
  638.   Else
  639.     If Bitmap[X-1,Y-1] And Not Bitmap[X+1,Y+1] Then
  640.       Begin Active:=True; Write(OutFile,'rbrr(',XX,',',YY:4:2,');') End
  641.     Else
  642.       Begin Active:=True; Write(OutFile,'rbr(',XX,',',YY:4:2,');') End
  643. End;
  644.  
  645. Procedure MiddleOut(Var OutFile:OutFileType; Var Bitmaps:BitmapsType; 
  646.                     Number:Integer; Standard:Boolean);
  647. {Writes METAFONT code for a given Bitmap}
  648. Var 
  649.   X,Y:SizeRange;
  650.   Active:Boolean;
  651. Begin
  652. With Bitmaps Do
  653.   Begin
  654.   Write(OutFile,'beginchar(',Number,',',XMax-XMin+1,'u#,');
  655.   If Standard Then
  656.     Begin
  657.     If YMax>0.75 Then Write(OutFile,(YMax-0.75):4:2,'u#,')
  658.     Else Write(OutFile,'0,');
  659.     If 5.75>YMin Then Writeln(OutFile,(5.75-YMin):4:2,'u#);')
  660.     Else Writeln(OutFile,'0);')
  661.     End
  662.   Else
  663.     Begin
  664.     If YMax>3 Then Write(OutFile,YMax-3,'u#,')
  665.     Else Write(OutFile,'0,');
  666.     If 8>YMin Then Writeln(OutFile,8-YMin,'u#);')
  667.     Else Writeln(OutFile,'0);')
  668.     End;
  669.   Writeln(OutFile,'normal_adjust_fit(2u#,2u#);');
  670.   For X:=XMin To XMax Do
  671.     For Y:=1 To SizeMax Do
  672.       Begin
  673.       Active:=Bitmap[X,Y];
  674.       If Active Then
  675.         {Current pixel is on}
  676.         If Standard Then ActiveBitmap(OutFile,Bitmap,X,Y,X-XMin,Y-3.75)
  677.         Else ActiveBitmap(OutFile,Bitmap,X,Y,X-XMin,Y-6)
  678.       Else
  679.         {Current pixel is off}
  680.         If Standard Then InactiveBitmap(OutFile,Bitmap,X,Y,X-XMin,Y-3.75,Active)
  681.         Else InactiveBitmap(OutFile,Bitmap,X,Y,X-XMin,Y-6,Active);
  682.       {Avoid METAFONT buffer overflow}
  683.       If Active Then Writeln(OutFile)
  684.       End;
  685.   Writeln(OutFile,'endchar;');
  686.   Writeln(OutFile)
  687.   End
  688. End; 
  689.  
  690. Procedure EndOut(Var OutFile:OutFileType; Var RunTime:RunTimeType);
  691. {Writes final METAFONT header}
  692. Begin
  693. Writeln(OutFile,'font_identifier "'+RunTime.FileName+'";');
  694. If RunTime.Standard Then 
  695.   Writeln(OutFile,'font_coding_scheme "JemTeX Standard";')
  696. Else Writeln(OutFile,'font_coding_scheme "JemTeX Dictionary";');
  697. Writeln(OutFile,'font_slant slant;');
  698. Writeln(OutFile,'font_normal_space 8u#;');
  699. Writeln(OutFile,'font_normal_stretch 4u#;');
  700. Writeln(OutFile,'font_normal_shrink 3u#;');
  701. Writeln(OutFile,'font_x_height 24u#; %ex');
  702. Writeln(OutFile,'font_quad 24u#; %em');
  703. Writeln(OutFile,'font_extra_space 0u#;');
  704. Writeln(OutFile);
  705. {Must end with CR/LF because of a bug(?) in emTeX METAFONT}
  706. Writeln(OutFile,'bye')
  707. End;
  708.  
  709. {---------------------------------- Generate ---------------------------------}
  710.  
  711. Procedure FindWantedBitmap(Automatic:Boolean; Var First:Boolean;
  712.                            Var WantedBitmap:Bitmap0Range; Var Number:Integer);
  713. {Finds the number of the next desired Bitmap either automatically or manually}
  714. {The characters 0 and 1 in the first font kanjiaa are both set to Bitmap 1}
  715. Var Valid:Boolean;
  716. Begin
  717. If Automatic Then
  718.   {Find automatically}
  719.   If First Then
  720.     {Early in font kanjiaa}
  721.     If WantedBitmap=-1 Then WantedBitmap:=1
  722.     Else
  723.       Begin
  724.       WantedBitmap:=1;
  725.       First:=False
  726.       End
  727.   Else
  728.     If (Number=128) Or (WantedBitmap=BitmapMax) Then WantedBitmap:=0
  729.     Else WantedBitmap:=WantedBitmap+1
  730. Else
  731.   {Find manually}
  732.   Repeat
  733.     Write('Bitmap number? ');
  734.     Readln(WantedBitmap);
  735.     Writeln;
  736.     Valid:=( (0<=WantedBitmap) And (WantedBitmap<=BitmapMax) );
  737.     If Not Valid Then Writeln(Chr(7)+'Bitmap ',WantedBitmap,' out of range...')
  738.   Until Valid;
  739. Writeln('Bitmap number ',WantedBitmap,'.')
  740. End;
  741.  
  742. Procedure ScanBitmap(Var InFile:InFileType; Var Bitmap:BitmapType;
  743.                      Var Empty:Boolean);
  744. {Reads the Bitmap in a logical grid}
  745. {(0,0) is the lower left corner of the Bitmap}
  746. Label 1;
  747. Var
  748.   Y:SizeRange;
  749.   Buffer:BufferType;
  750. Begin
  751. {Read the Bitmap}
  752. BlockRead(InFile,Buffer,1);
  753. {Find if the Bitmap is empty}
  754. Empty:=True;
  755. For Y:=1 To SizeMax Do
  756.   With Buffer[Y] Do
  757.     If (Data1<>$00) Or (Data2<>$00) Or (Data3<>$00) Then
  758.       Begin
  759.       Empty:=False;
  760.       Goto 1
  761.       End;
  762. {Update logical grid}
  763. 1:If Not Empty Then
  764.   For Y:=1 To SizeMax Do 
  765.     With Buffer[SizeMax1-Y] Do
  766.       Begin
  767.       Bitmap[ 1,Y]:=((Data1 And $80)<>0);
  768.       Bitmap[ 2,Y]:=((Data1 And $40)<>0);
  769.       Bitmap[ 3,Y]:=((Data1 And $20)<>0);
  770.       Bitmap[ 4,Y]:=((Data1 And $10)<>0);
  771.       Bitmap[ 5,Y]:=((Data1 And $08)<>0);
  772.       Bitmap[ 6,Y]:=((Data1 And $04)<>0);
  773.       Bitmap[ 7,Y]:=((Data1 And $02)<>0);
  774.       Bitmap[ 8,Y]:=((Data1 And $01)<>0);
  775.       Bitmap[ 9,Y]:=((Data2 And $80)<>0);
  776.       Bitmap[10,Y]:=((Data2 And $40)<>0);
  777.       Bitmap[11,Y]:=((Data2 And $20)<>0);
  778.       Bitmap[12,Y]:=((Data2 And $10)<>0);
  779.       Bitmap[13,Y]:=((Data2 And $08)<>0);
  780.       Bitmap[14,Y]:=((Data2 And $04)<>0);
  781.       Bitmap[15,Y]:=((Data2 And $02)<>0);
  782.       Bitmap[16,Y]:=((Data2 And $01)<>0);
  783.       Bitmap[17,Y]:=((Data3 And $80)<>0);
  784.       Bitmap[18,Y]:=((Data3 And $40)<>0);
  785.       Bitmap[19,Y]:=((Data3 And $20)<>0);
  786.       Bitmap[20,Y]:=((Data3 And $10)<>0);
  787.       Bitmap[21,Y]:=((Data3 And $08)<>0);
  788.       Bitmap[22,Y]:=((Data3 And $04)<>0);
  789.       Bitmap[23,Y]:=((Data3 And $02)<>0);
  790.       Bitmap[24,Y]:=((Data3 And $01)<>0)
  791.       End
  792. End;
  793.  
  794. Procedure ScanSides(Var Bitmaps:BitmapsType; FixedX,FixedY:Boolean);
  795. {Determines the minimal size of the Bitmap for proportional spacing}
  796. Var X,Y:SizeRange;
  797. Begin
  798. With Bitmaps Do
  799.   Begin
  800.   If FixedX Then
  801.     Begin 
  802.     XMin:=1; 
  803.     XMax:=SizeMax 
  804.     End
  805.   Else
  806.     Begin
  807.     XMin:=SizeMax1;
  808.     For X:=SizeMax DownTo 1 Do 
  809.       For Y:=1 To SizeMax Do 
  810.         If Bitmap[X,Y] Then XMin:=X;
  811.     XMax:=0;
  812.     For X:=1 To SizeMax Do 
  813.       For Y:=1 To SizeMax Do 
  814.         If Bitmap[X,Y] Then XMax:=X
  815.     End;
  816.   If FixedY Then
  817.     Begin 
  818.     YMin:=1; 
  819.     YMax:=SizeMax 
  820.     End
  821.   Else
  822.     Begin
  823.     YMin:=SizeMax1;
  824.     For Y:=SizeMax DownTo 1 Do
  825.       For X:=1 To SizeMax Do
  826.         If Bitmap[X,Y] Then YMin:=Y;
  827.     YMax:=0;
  828.     For Y:=1 To SizeMax Do
  829.       For X:=1 To SizeMax Do
  830.         If Bitmap[X,Y] Then YMax:=Y
  831.     End
  832.   End
  833. End;
  834.  
  835. Procedure Generate(Var InFile:InFileType; Var OutFile:OutFileType;
  836.                    Var Number:Integer; Var RunTime:RunTimeType);
  837. {Generates the METAFONT code for the selected font}
  838. Var
  839.   {Bitmap pointers}
  840.   CurrentBitmap,WantedBitmap:Bitmap0Range;
  841.   {Current Bitmap}
  842.   Bitmaps:BitmapsType;
  843.   X,Y:Size0Range;
  844.   {Indicates early in font kanjiaa}
  845.   First:Boolean;
  846.   {Indicates current Bitmap is empty}
  847.   Empty:Boolean;
  848. Begin
  849. {Clear the area outside the Bitmap once and for all}
  850. With Bitmaps Do
  851.   Begin
  852.   For X:=0 To SizeMax1 Do 
  853.     Begin Bitmap[X,0]:=False; Bitmap[X,SizeMax1]:=False End;
  854.   For Y:=1 To SizeMax Do 
  855.     Begin Bitmap[0,Y]:=False; Bitmap[SizeMax1,Y]:=False End
  856.   End;
  857. {Number of the Bitmap ready to be read}
  858. CurrentBitmap:=1;
  859. {First METAFONT character number}
  860. Number:=0;
  861. {First Bitmap wanted}
  862. If RunTime.Automatic Then
  863.   Begin
  864.   WantedBitmap:=1024 * ( Ord(UpCase(RunTime.FileName[6]))-Ord('A') ) +
  865.                 128 * ( Ord(UpCase(RunTime.FileName[7]))-Ord('A') ) - 1;
  866.   First:=(WantedBitmap=-1)
  867.   End;
  868. Repeat
  869.   FindWantedBitmap(RunTime.Automatic,First,WantedBitmap,Number);
  870.   If WantedBitmap<>0 Then
  871.     Begin
  872.     {Position pointer}
  873.     If WantedBitmap<>CurrentBitmap Then 
  874.       Begin
  875.       Seek(InFile,WantedBitmap-1);
  876.       CurrentBitmap:=WantedBitmap
  877.       End;
  878.     Write('Reading Bitmap');
  879.     ScanBitmap(InFile,Bitmaps.Bitmap,Empty);
  880.     CurrentBitmap:=CurrentBitmap+1;
  881.     Writeln('.');
  882.     {Process Bitmap}
  883.     If Empty Then Writeln('Bitmap is empty, no METAFONT code ',Number,'.')
  884.     Else
  885.       Begin
  886.       Write('Writing METAFONT code ',Number);
  887.       ScanSides(Bitmaps,RunTime.FixedX,RunTime.FixedY);
  888.       MiddleOut(OutFile,Bitmaps,Number,RunTime.Standard);
  889.       Writeln('.')
  890.       End;
  891.     Writeln;
  892.     {Ready to generate next METAFONT character}
  893.     Number:=Number+1
  894.     End;
  895. Until WantedBitmap=0
  896. End;
  897.  
  898. {------------------------------------ Main -----------------------------------}
  899.  
  900. Begin
  901. Writeln;
  902. Writeln('Bitmaps to METAFONT Conversion Program.');   {To make Borland happy}
  903. Writeln('Version 2.00 Copyright F. Jalbert 1991.');
  904. Writeln;
  905.  
  906. Write('Opening Bitmap file JIS24');
  907. Assign(InFile,'JIS24');
  908. Reset(InFile,RecSize);
  909. Writeln('.');
  910. Writeln;
  911.  
  912. GetParameters(RunTime);
  913. Write('Creating METAFONT file '+RunTime.FileName+'.mf');
  914. Assign(OutFile,RunTime.FileName+'.mf');
  915. Rewrite(OutFile);
  916. Writeln('.');
  917. Writeln;
  918.  
  919. Write('Writing initial METAFONT header');
  920. BeginOut(OutFile,RunTime);
  921. Writeln('.');
  922. Writeln;
  923. Generate(InFile,OutFile,Number,RunTime);
  924. Writeln;
  925.  
  926. Write('Writing final METAFONT header');
  927. EndOut(OutFile,RunTime);
  928. Writeln('.');
  929. Write('Closing METAFONT file '+RunTime.FileName+'.mf');
  930. Close(OutFile);
  931. Writeln('.');
  932. Write('Closing Bitmap file JIS24');
  933. Close(InFile);
  934. Writeln('.');
  935. Writeln;
  936.  
  937. Writeln('METAFONT code for ',Number,' Bitmap(s) generated.');
  938. Writeln
  939. End.
  940.