home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB40.ZIP / FONTEDIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-05-20  |  33.5 KB  |  834 lines
  1. Program FontEdit;
  2. {  This program helps create font characters for the Epson and compatible  }
  3. {  printers.  The font codes are stored in a file and can be loaded into   }
  4. {  the printer RAM with the program EpsonLdr.                              }
  5. {                                                                          }
  6. {       Version 1.0                               Copyright (c) 1986       }
  7. {                   Writen by:    Claire A. Rinehart                       }
  8. {                                18 C University Houses                    }
  9. {                                   Madison, WI  53705                     }
  10. {                                                                          }
  11.  
  12. CONST
  13.   MinChar       =  0;        {lowest character number in font}
  14.   MaxChar       =  255;      {maximum number of characters in font}
  15.   MaxCol        =  11;       {maximum column number for sfont}
  16.   EliteOn       =  #27'M';        {                              }
  17.   EliteOff      =  #27'P';        {                              }
  18.   CompressOn    =  #15;           {                              }
  19.   CompressOff   =  #18;           {                              }
  20.   EmphOn        =  #27'E';        {                              }
  21.   EmphOff       =  #27'F';        {                              }
  22.   DoubleOn      =  #27'G';        {         Epson printer codes  }
  23.   DoubleOff     =  #27'H';        {                              }
  24.   UnderOn       =  #27'-1';       {                              }
  25.   UnderOff      =  #27'-0';       {                              }
  26.   RAMon         =  #27'%'#01#00;  {                              }
  27.   RAMoff        =  #27'%'#00#00;  {                              }
  28.   LoadRAM       =  #27'&'#00;     {                              }
  29.   Print128on    =  #27'6';        {                              }
  30.   Print128off   =  #27'7';        {                              }
  31.   Print0on      =  #27'I1';       {                              }
  32.   Print0off     =  #27'I0';       {                              }
  33.   Reset         =  #27'@';        {                              }
  34.  
  35.  
  36. TYPE
  37.   FonType = array[0..MaxCol] of integer;
  38.   ScreenType = array[0..MaxCol, 0..7] of integer;
  39.   FileType  = file of FonType;
  40.   Str4   =  Array[1..4] of char;
  41.  
  42. VAR
  43.   font     :  array[MinChar..MaxChar] of fontype;
  44.   sfont    :  screentype;
  45.   {  The variables sfont and font are used to display the font characters}
  46.   {  on the screen and store them in a disk file respectively.           }
  47.   {          BitPower                                                    }
  48.   {             7   * * * * * * * * * * *                                }
  49.   {             6   * * * * * * * * * * *           sfont is an array    }
  50.   {             5   * * * * * * * * * * *           of 0s and 1s.        }
  51.   {             4   * * * * * * * * * * *           A 1 will be displayed}
  52.   {             3   * * * * * * * * * * *           as a dot on the      }
  53.   {             2   * * * * * * * * * * *           screen and a 0 as a  }
  54.   {             1   * * * * * * * * * * *           blank.               }
  55.   {             0   * * * * * * * * * * *                                }
  56.   {               0 1 2 3 4 5 6 7 8 9 10 11  ColNum                      }
  57.   {                                                                      }
  58.   {               | | | | | | | | | | |  |                               }
  59.   {                                                 each font character  }
  60.   {               0 1 2 3 4 5 6 7 8 9 10 11         is an array of       }
  61.   {               |                                 integers that contain}
  62.   {   bit         7  1=top 8 pins;0= bottom 8 pins  the summation of the }
  63.   { pattern       6  \                              binary values found  }
  64.   {    of         5   > starting column for         in sfont.  Notice    }
  65.   { ColNum 0      4  /  proportional spacing        that ColNum 0 is not }
  66.   {               3  \                              displayed.  This is  }
  67.   {               2   \ ending column for           the attribute integer}
  68.   {               1   / proportional spacing        and is used as shown }
  69.   {               0  /                              in the figure.       }
  70.   FontFile :  Filetype;                     {file identification variable}
  71.   CopyFile :  Filetype;
  72.   CharNum  :  Integer;     {counter for selecting a character out of font}
  73.   Ans      :  integer;             {return variable for the Answer proc  }
  74.   ColNum,                          {defined above}
  75.   BitPower : integer;              {defined above}
  76.   Extension: Str4;         {file name extension characters defined as .FNT }
  77.  
  78. Type
  79.   Str255 =  String[255];    { \  Used by Answer.inc.  }
  80.   Str80  =  String[80];     { /                       }
  81. Var
  82.   Ch     :  char;                   {character returned by Mainmenu}
  83.  
  84. {$I Var.inc }
  85. {$I WindMngr.inc }
  86. {$I Beep.inc }
  87. {$I Answer.inc }
  88. {$I IXtoN.inc }
  89. {$I DirExt.inc }
  90. {$I Files.inc }
  91.  
  92. Procedure ShowDot;                          {prints a dot to the screen}
  93.   begin
  94.     if frac(ColNum / 2.0) > 0 then          {If an odd column then print}
  95.       begin                                 {a light blue dot           }
  96.         textcolor(LightBlue);
  97.         write(chr(4));
  98.       end
  99.     else
  100.       begin
  101.         textcolor(Blue);                    {If an even column then print}
  102.         write(chr(4));                      {a dark blue dot             }
  103.       end;
  104.   end;  {ShowDot}
  105.  
  106. Procedure ShowChar;                   {Use sfont array to create character}
  107.   begin
  108.     ClrScr;
  109.     for BitPower := 7 downto 0 do
  110.       begin
  111.         for ColNum := 1 to MaxCol do
  112.          begin
  113.            if sfont[ColNum, BitPower] = 1 then
  114.             begin                                {print a 1 in sfont as a dot}
  115.               gotoXY(ColNum, 8 - BitPower);
  116.               ShowDot;                     {Prints the appropriate colored dot}
  117.             end;
  118.          end;
  119.       end;
  120.   end; {ShowChar}
  121.  
  122. Procedure DisplayChar;
  123. Var
  124.   CharTitle : String[80];           {Title for window}
  125.   TempChar  : Fontype;              {Temporary work character}
  126. Begin
  127.   Add_Window(10,10,MaxCol+11,21,1,7,2);        {display character window}
  128.   TempChar := font[CharNum];
  129.   for ColNum := 0 to MaxCol do              {convert font to sfont bit array}
  130.     begin
  131.       for BitPower := 7 downto 0 do
  132.        begin
  133.          sfont[ColNum, BitPower] := Trunc(TempChar[ColNum]/IXtoN(2,BitPower));  {decode ColNum into a bit array}
  134.          if sfont[ColNum, BitPower] = 1 then                                    {if the bitpower is a 1 then }
  135.            TempChar[ColNum] := TempChar[ColNum] - IXtoN(2,BitPower);            {subtract that power from the total ColNum}
  136.        end;
  137.     end;
  138.   Str(CharNum:3,CharTitle);                    {\                    }
  139.   CharTitle := 'Char# ' + CharTitle;           { >set up window title}
  140.   Window_Title(CharTitle,(14 + (0 * 16)));     {/                    }
  141.   ShowChar;                                   {put character pattern on screen}
  142. End;  {DisplayChar}
  143.  
  144. Procedure CharEdit;
  145. Var
  146.   EditExit : boolean;        {used to determine if edit should be exited}
  147.   PrtChar  : boolean;        {used to determine if the character should be printed}
  148.   pin      : string[6];      {\                                    }
  149.   StartCol : Integer;        { > used to set up the attribute bit  }
  150.   EndCol   : Integer;        {/                                    }
  151.   Key      : Char;
  152.   CopyNum  : Integer;
  153.   tchar    : ScreenType;     {temporary array for shifting character}
  154.   CapLock  : Integer;        {used to read caplock key value}
  155.   IOErr    : Integer;
  156.   Error    : Str80;
  157.  
  158. { local procedures      }
  159.   procedure ShowPos;         {show the position of the cursor}
  160.   begin
  161.     gotoXY(1,9);
  162.     writeln('Row   : ',BitPower:1);
  163.     write('Column: ',ColNum:2);
  164.     gotoXY(ColNum, 8 - BitPower);
  165.   end;
  166.  
  167.   procedure PrintLine;     {prints a line of the character on the printer}
  168.   Var
  169.     I  :  integer;
  170.   begin
  171.     write(Lst,RAMon);       {select RAM for printing}
  172.     for I := 1 to 15 do write(Lst,chr(33));   {print single strike }
  173.     write(Lst,DoubleOn);                        {select double strike}
  174.     for I := 1 to 16 do write(Lst,chr(33));
  175.     write(Lst,DoubleOff,EmphOn);       {double off, emphasized on}
  176.     for I := 1 to 16 do write(Lst,chr(33));
  177.     write(Lst,DoubleOn);                  {double added to emphasized}
  178.     for I := 1 to 16 do write(Lst,chr(33));
  179.     write(Lst,DoubleOff,EmphOff,RAMoff);            {select ROM for printing and turn off double and emphasized modes}
  180.     writeln(Lst);
  181.   end;  {PrintLine}
  182. {  end local procedures  }
  183.  
  184. Begin   {Character edit procedure}
  185.   EditExit := false;
  186.   PrtChar := false;
  187.   ColNum := 1;
  188.   BitPower := 7;
  189.   gotoXY(ColNum,8 - BitPower);
  190.   ShowPos;
  191. {      **************  Edit Characters  *******************   }
  192.   repeat
  193.     read(Kbd,Key);
  194.     if KeyPressed then
  195.     begin
  196.       read(Kbd,Key);
  197.       case Key of
  198.       'H' :  begin                               {up arrow}
  199.                BitPower := BitPower + 1;
  200.                if BitPower > 7 then BitPower := 0;
  201.                ShowPos;       {subt bitpower from 8 to get}
  202.              end;                                {proper display line        }
  203.       'M' :  begin
  204.                ColNum := ColNum + 1;             {right arrow}
  205.                if ColNum > MaxCol then ColNum := 1;
  206.                ShowPos;
  207.              end;
  208.       'K' :  begin                               {left arrow}
  209.                ColNum := ColNum-1;
  210.                if ColNum < 1 then ColNum := MaxCol;
  211.                ShowPos;
  212.              end;
  213.       'P' :  begin                               {down arrow}
  214.                BitPower := BitPower - 1;
  215.                if BitPower < 0 then BitPower := 7;
  216.                ShowPos;
  217.              end;
  218.       'G' :  begin                              {home}
  219.                ColNum := 1;
  220.                BitPower := 7;
  221.                ShowPos;
  222.              end;
  223.       'O' :  begin                              {end}
  224.                ColNum := MaxCol;
  225.                BitPower := 0;
  226.                ShowPos;
  227.              end;
  228.       'I' :  begin                              {pg-up}
  229.                BitPower := 7;
  230.                ShowPos;
  231.              end;
  232.       'Q' :  begin                              {pg-down}
  233.                BitPower := 0;
  234.                ShowPos;
  235.              end;
  236.       'R' :  begin                              {insert}
  237.                      {check for adjacent dots}
  238.                if ((sfont[ColNum-1,BitPower]>0) AND (sfont[ColNum-1,BitPower] = 1)) OR (sfont[ColNum+1,BitPower] = 1) then
  239.                 beep(1)
  240.                else
  241.                 begin
  242.                  sfont[ColNum,BitPower] := 1;
  243.                  ShowDot;
  244.                 end;
  245.                CapLock := mem[0000:1047];  {test for caplock on/off}
  246.                if CapLock in [64, 96, 192, 224] then
  247.                  begin
  248.                    ColNum := ColNum + 2;
  249.                    if ColNum > MaxCol then
  250.                      begin
  251.                        ColNum := 1;
  252.                        BitPower := BitPower -1;
  253.                        if BitPower < 0 then BitPower := 7;
  254.                      end;
  255.                  end;
  256.                ShowPos;
  257.              end;
  258.       'S' :  begin                              {del}
  259.                sfont[ColNum,BitPower] := 0;
  260.                write(' ');
  261.                CapLock := mem[0000:1047];  {test for caplock on/off}
  262.                if CapLock in [64, 96, 192, 224] then
  263.                  begin
  264.                    ColNum := ColNum -2;
  265.                    if ColNum < 1 then
  266.                      begin
  267.                        ColNum := MaxCol;
  268.                        BitPower := BitPower + 1;
  269.                        if BitPower > 7 then BitPower := 0;
  270.                      end;
  271.                  end;
  272.                ShowPos;
  273.              end;
  274.       ';' :  begin                              {F1  = Shift left}
  275.                tchar := sfont;
  276.                FillChar(sfont, sizeof(sfont),0);
  277.                for ColNum := 2 to MaxCol do
  278.                  for BitPower := 7 downto 0 do
  279.                    sfont[ColNum - 1, BitPower] := tchar[ColNum, BitPower];
  280.                ShowChar;
  281.                ShowPos;
  282.              end;
  283.       '<' :  begin                              {F2  = Shift up}
  284.                tchar := sfont;
  285.                FillChar(sfont, sizeof(sfont),0);
  286.                for ColNum := 1 to MaxCol do
  287.                  for BitPower := 6 downto 0 do
  288.                    sfont[ColNum, BitPower + 1] := tchar[ColNum, BitPower];
  289.                ShowChar;
  290.                ShowPos;
  291.              end;
  292.       '=' :  begin                              {F3  = Shift down}
  293.                tchar := sfont;
  294.                FillChar(sfont, sizeof(sfont),0);
  295.                for ColNum := 1 to MaxCol do
  296.                  for BitPower := 7 downto 1 do
  297.                    sfont[ColNum, BitPower - 1] := tchar[ColNum, BitPower];
  298.                ShowChar;
  299.                ShowPos;
  300.              end;
  301.       '>' :  begin                              {F4  = Shift right}
  302.                tchar := sfont;
  303.                FillChar(sfont, sizeof(sfont),0);
  304.                for ColNum := 1 to 10 do
  305.                  for BitPower := 7 downto 0 do
  306.                    sfont[ColNum + 1, BitPower] := tchar[ColNum, BitPower];
  307.                ShowChar;
  308.                ShowPos;
  309.              end;
  310.       '?' :  begin                              {F5  = Fill even columns}
  311.                FillChar(sfont, sizeof(sfont),0);
  312.                ColNum := 0;
  313.                repeat
  314.                  for BitPower := 0 to 7 do sfont[ColNum, BitPower] := 1;
  315.                  ColNum := ColNum + 2;
  316.                until ColNum > MaxCol;
  317.                ShowChar;
  318.                ShowPos;
  319.              end;
  320.       '@' :  begin                              {F6  = Fill odd columns}
  321.                FillChar(sfont, sizeof(sfont),0);
  322.                ColNum := 1;
  323.                repeat
  324.                  for BitPower := 0 to 7 do sfont[ColNum, BitPower] := 1;
  325.                  ColNum := ColNum + 2;
  326.                until ColNum > MaxCol;
  327.                ShowChar;
  328.                ShowPos;
  329.              end;
  330.       'A' :  begin                             {F7 = Clear character}
  331.                FillChar(sfont, sizeof(sfont),0);
  332.                ShowChar;
  333.                ShowPos;
  334.              end;
  335.       'B' :  begin                             {F8 = Copy character from within current font}
  336.                Remove(1);
  337.                repeat
  338.                  Add_Window(38,10,80,14,14,2,1);
  339.                  write('Enter a character number. (',MinChar,'-',MaxChar,'):  ');
  340.                  read(CopyNum);
  341.                  Remove(1);
  342.                until CopyNum in [MinChar..MaxChar];
  343.                font[CharNum] := font[CopyNum];
  344.                DisplayChar;
  345.                ShowPos;
  346.              end;
  347.       'C' :  begin                              {F9 = print character}
  348.                EditExit := true;
  349.                PrtChar := true;
  350.              end;
  351.       'D' :  EditExit := true;                  {F10 = exit}
  352.       end; {Case of Key}
  353.     end;
  354.   until EditExit = true;
  355.   {       ********* Edit character attribute column *********                }
  356.   Add_Window(30,10,80,20,1,7,2);        {show character attribute window}
  357.   If sfont[0,7] = 1 then
  358.     pin := 'top'
  359.   else
  360.     pin := 'bottom';
  361.   StartCol := sfont[0,6]*4 + sfont[0,5]*2 + sfont[0,4];
  362.   EndCol := sfont[0,3]*8 + sfont[0,2]*4 + sfont[0,1]*2 + sfont[0,0];
  363.   if EndCol = 0 then
  364.     begin
  365.       EndCol := MaxCol;
  366.       pin := 'top';
  367.       sfont[0,7] := 1;
  368.       sfont[0,3] := 1;
  369.       sfont[0,2] := 0;
  370.       sfont[0,1] := 1;
  371.       sfont[0,0] := 1;
  372.     end;
  373.   writeln('The current pin setting is for the ',pin,' 8 pins.');
  374.   writeln('The current starting column is ',StartCol,'.');
  375.   writeln('The current ending column is ',EndCol,'.');
  376.   writeln;
  377.   write('Do you wish to change these values?  ');
  378.   answer('yes,no',ans,false);
  379.   writeln;
  380.   if ans = 1 then
  381.     begin
  382.       writeln('Enter choice (top/bottom) for the pin setting.');
  383.       answer('bottom, top',sfont[0,7],false);
  384.       sfont[0,7] := sfont[0,7] - 1;
  385.       writeln;
  386.       repeat
  387.        write('Enter the starting column number. (0-7)  ');
  388.        answer('1,2,3,4,5,6,7,0',StartCol,false);
  389.        if StartCol in [1, 3, 5, 7] then sfont[0,4] := 1 else sfont[0,4] := 0;
  390.        if StartCol in [2, 3, 6, 7] then sfont[0,5] := 1 else sfont[0,5] := 0;
  391.        if StartCol in [4, 5, 6, 7] then sfont[0,6] := 1 else sfont[0,6] := 0;
  392.        if StartCol = 8 then StartCol := 0;
  393.        writeln;
  394.        write('Enter the ending column number. (01,2,3..11)  ');
  395.        answer('01,2,3,4,5,6,7,8,9,10,11',EndCol,false);
  396.        if EndCol in [1,3,5,7,9,11] then sfont[0,0] := 1 else sfont[0,0] := 0;
  397.        if EndCol in [2,3,6,7,10,11] then sfont[0,1] := 1 else sfont[0,1] := 0;
  398.        if EndCol in [4,5,6,7] then sfont[0,2] := 1 else sfont[0,2] := 0;
  399.        if EndCol in [8,9,10,11] then sfont[0,3] := 1 else sfont[0,3] := 0;
  400.        writeln;
  401.       until StartCol < EndCol;
  402.   end;
  403.  
  404.   {         ************** Convert sfont back to Font **************         }
  405.   {  Convert edited sfont binary array back into the integer font array      }
  406.   for ColNum := 0 to MaxCol do
  407.     begin
  408.       font[CharNum, ColNum] := 0;
  409.       for BitPower := 0 to 7 do
  410.         font[CharNum, ColNum] := font[CharNum, ColNum] + sfont[ColNum,BitPower] * IXtoN(2,BitPower);
  411.     end;
  412.  
  413.   {         ************** Print character *************                      }
  414.   if PrtChar  then
  415.     begin
  416.       repeat
  417.         writeln(Lst,Reset);                              {reset printer}
  418.         IOCheck(IOErr,Error);
  419.         If Error <> '' then
  420.           begin
  421.             writeln(Error);
  422.             write('Try printer again? (Y/N)  ');
  423.             Answer('yes,no',Ans,false);
  424.             writeln;
  425.           end;
  426.       until (Ans = 2) or (Error = '');
  427.       if Error = '' then
  428.        begin
  429.         write(Lst,LoadRam,chr(33),chr(33));    {send character}
  430.         for ColNum := 0 to MaxCol do write(Lst,chr(font[CharNum,ColNum]));  {to printer RAM}
  431.         writeln(Lst, 'Character # ',CharNum);
  432.         write(Lst,UnderOn);                          {turn on underline}
  433.         writeln(Lst, '             Single         Double          Emphasized      Double-Emphasized');
  434.         write(Lst,UnderOff);                         {turn off underline}
  435.         write(Lst,   'Pica         ');
  436.         PrintLine;
  437.         write(Lst,   'Elite        ',EliteOn);            {turn on Elite}
  438.         PrintLine;
  439.         write(Lst,EliteOff,'Compressed   ',CompressOn); {Elite off, compressed on}
  440.         PrintLine;
  441.         writeln(Lst,Reset);
  442.        end;
  443.   end;
  444. End;  {CharEdit}
  445.  
  446. Procedure MainMenu;
  447. Var
  448.   Exit    : boolean;    {variable tested for MainMenu exit condition}
  449.   Error   : Str80;      {text description of error produced in I/O operations}
  450.   Ans     : integer;    {return variable for answer procedure}
  451.   IOErr   : integer;    {I/O error number}
  452.   CopyNum : integer;    {counter used for copying partial character files}
  453.   I,C1,C2 : integer;    {counter and range variables for copying partial character files}
  454. Begin
  455.   FillChar(font, sizeof(font),0);
  456.   Add_Window(30,1,80,18,5,1,2);
  457.   Window_Title('Epson-JX80 Font Editor      by C. A. Rinehart',(14+(0*16)));
  458.   TextColor(15);
  459.   write('Cursor keys ');
  460.   TextColor(7);
  461.   writeln(': Up, right = next character.');
  462.   writeln('              down,left = last character.');
  463.   writeln;
  464.   TextColor(15);
  465.   write('Fn1  ');
  466.   TextColor(7);
  467.   writeln(': Edit character.');
  468.   TextColor(15);
  469.   write('Fn2  ');
  470.   TextColor(7);
  471.   writeln(': Advance to next character.');
  472.   TextColor(15);
  473.   write('Fn3  ');
  474.   TextColor(7);
  475.   writeln(': Backup to previous character.');
  476.   TextColor(15);
  477.   write('Fn4  ');
  478.   TextColor(7);
  479.   writeln(': Select character number');
  480.   TextColor(15);
  481.   write('Fn5  ');
  482.   TextColor(7);
  483.   writeln(': Read font file.');
  484.   TextColor(15);
  485.   write('Fn6  ');
  486.   TextColor(7);
  487.   writeln(': Save font file.');
  488.   TextColor(15);
  489.   write('Fn7  ');
  490.   TextColor(7);
  491.   writeln(': Copy characters from another font.');
  492.   TextColor(15);
  493.   write('Fn8  ');
  494.   TextColor(7);
  495.   writeln(': Clear current font.');
  496.   TextColor(15);
  497.   write('Fn9  ');
  498.   TextColor(7);
  499.   writeln(': Print current font on printer.');
  500.   TextColor(15);
  501.   write('Fn10 ');
  502.   TextColor(7);
  503.   writeln(': Exit program.');
  504.   DisplayChar;
  505.   Exit := false;
  506.   repeat
  507.     read(kbd,Ch);
  508.     if KeyPressed then
  509.     begin
  510.       read(kbd,Ch);
  511.       case Ch of
  512.         ';'  :  begin                                {Fn1=edit character}
  513.                   Remove(1);
  514.                   Add_Window(30,2,80,22,5,1,2);
  515.                   Window_Title('Use these keys to edit character',(14+(0*16)));
  516.                   writeln;
  517.                   TextColor(15);
  518.                   write('Cursor keys ');
  519.                   TextColor(7);
  520.                   writeln(': Up, down, right, left, home, end,');
  521.                   writeln('              top & bottom.');
  522.                   TextColor(15);
  523.                   write('Ins  ');
  524.                   TextColor(7);
  525.                   writeln(': Place a dot on the screen.');
  526.                   TextColor(15);
  527.                   write('Del  ');
  528.                   TextColor(7);
  529.                   writeln(': Delete a dot on the screen.');
  530.                   TextColor(15);
  531.                   write('Caps Lock');
  532.                   TextColor(7);
  533.                   writeln(': Toggle for INS and DEL.  Moves cursor');
  534.                   writeln('            2 spaces after function.');
  535.                   TextColor(15);
  536.                   write('Fn1  ');
  537.                   TextColor(7);
  538.                   writeln(': Shift character left one column.');
  539.                   TextColor(15);
  540.                   write('Fn2  ');
  541.                   TextColor(7);
  542.                   writeln(': Shift character up one row.');
  543.                   TextColor(15);
  544.                   write('Fn3  ');
  545.                   TextColor(7);
  546.                   writeln(': Shift character down one row.');
  547.                   TextColor(15);
  548.                   write('Fn4  ');
  549.                   TextColor(7);
  550.                   writeln(': Shift character right one column.');
  551.                   TextColor(15);
  552.                   write('Fn5  ');
  553.                   TextColor(7);
  554.                   writeln(': Fill even columns with dots.');
  555.                   TextColor(15);
  556.                   write('Fn6  ');
  557.                   TextColor(7);
  558.                   writeln(': Fill odd columns with dots.');
  559.                   TextColor(15);
  560.                   write('Fn7  ');
  561.                   TextColor(7);
  562.                   writeln(': Clear character.');
  563.                   TextColor(15);
  564.                   write('Fn8  ');
  565.                   TextColor(7);
  566.                   writeln(': Copy a character from this font.');
  567.                   TextColor(15);
  568.                   write('Fn9  ');
  569.                   TextColor(7);
  570.                   writeln(': Print character on printer.');
  571.                   TextColor(15);
  572.                   write('Fn10 ');
  573.                   TextColor(7);
  574.                   writeln(': End edit.');
  575.                   DisplayChar;
  576.                   CharEdit;
  577.                   Remove(3);
  578.                   DisplayChar;
  579.                 end;
  580. '<','H','M'  :  begin                                {Fn2,up,right=Advance one character}
  581.                   Remove(1);
  582.                   CharNum := CharNum + 1;
  583.                   if CharNum > MaxChar then CharNum := MinChar;
  584.                  DisplayChar;
  585.                 end;
  586. '=','P','K'  :  begin                                {Fn3,down,left=Back-Up one character}
  587.                   Remove(1);
  588.                   CharNum := CharNum -1;
  589.                   if CharNum < MinChar then CharNum := MaxChar;
  590.                   DisplayChar;
  591.                 end;
  592.         '>'  :  begin                                {Fn4=Choose a character number}
  593.                   Remove(1);
  594.                   repeat
  595.                     Add_Window(35,10,80,14,14,1,1);
  596.                     write('Enter a character number. (',MinChar,' - ',MaxChar,'):  ');
  597.                     read(CharNum);
  598.                     Remove(1);
  599.                   until CharNum in [MinChar..MaxChar];
  600.                   DisplayChar;
  601.                 end;
  602.         '?'  :  begin                          {Fn5=Read font from file}
  603.                   Remove(1);
  604.                   Add_Window(1,15,80,23,14,1,3);
  605.                   writeln('Read font from disk file.');
  606.                   repeat
  607.                     writeln('The current font files are:');
  608.                     Listdirectory;
  609.                     writeln;
  610.                     Error := 'O';
  611.                     OpenFile(FontFile,Error,Extension);
  612.                     If Error <> '' then
  613.                      begin
  614.                        writeln(Error);
  615.                        write('Try another file? (Y/N)  ');
  616.                        Answer('yes,no',Ans,false);
  617.                        writeln;
  618.                      end;
  619.                   until (Ans = 2) or (Error = '');
  620.                   CharNum := MinChar;
  621.                   if Error = '' then
  622.                     while  NOT EOF(FontFile) do
  623.                       begin
  624.                         read(fontfile, font[CharNum]);
  625.                         CharNum := CharNum + 1;
  626.                       end
  627.                   else
  628.                     begin
  629.                       writeln;
  630.                       writeln('No characters read from file!');
  631.                       beep(1);
  632.                       delay(2000);
  633.                     end;
  634.                   CloseFile(FontFile, Error);
  635.                   if Error <> '' then
  636.                     begin
  637.                       writeln('Close file error:');
  638.                       writeln(Error);
  639.                       beep(1);
  640.                       delay(2000);
  641.                     end;
  642.                   Remove(1);
  643.                   CharNum := MinChar;
  644.                   DisplayChar;
  645.                 end;
  646.         '@'  :  begin                           {Fn6=Save font to file}
  647.                   Remove(1);
  648.                   Add_Window(1,15,80,23,14,1,3);
  649.                   writeln('Save font to disk file.');
  650.                   repeat
  651.                     writeln('The current font files are:');
  652.                     Listdirectory;
  653.                     writeln;
  654.                     Error := 'N';
  655.                     OpenFile(FontFile,Error,Extension);
  656.                     If Error <> '' then
  657.                      begin
  658.                        writeln(Error);
  659.                        write('Try another file? (Y/N)  ');
  660.                        Answer('yes,no',Ans,false);
  661.                        writeln;
  662.                      end;
  663.                   until (Ans = 2) or (Error = '');
  664.                   if Error = '' then
  665.                     for CharNum := MinChar to MaxChar do write(FontFile, font[CharNum])
  666.                   else
  667.                     begin
  668.                       writeln;
  669.                       writeln('No characters written to file!');
  670.                       beep(1);
  671.                       delay(2000);
  672.                     end;
  673.                   CloseFile(FontFile, Error);
  674.                   if Error <> '' then
  675.                     begin
  676.                       writeln('Close file error:');
  677.                       writeln(Error);
  678.                       beep(1);
  679.                       delay(2000);
  680.                     end;
  681.                   Remove(1);
  682.                   CharNum := MinChar;
  683.                   DisplayChar;
  684.                 end;
  685.         'A'  :  begin                          {Fn7=Copy font from another font file}
  686.                   Remove(1);
  687.                   Add_Window(1,15,80,23,14,1,3);
  688.                   writeln('Copy characters from disk font file into present font.');
  689.                   repeat
  690.                     writeln('The current font files are:');
  691.                     Listdirectory;
  692.                     writeln;
  693.                     Error := 'O';
  694.                     OpenFile(CopyFile,Error,Extension);
  695.                     If Error <> '' then
  696.                      begin
  697.                        writeln(Error);
  698.                        write('Try another file? (Y/N)  ');
  699.                        Answer('yes,no',Ans,false);
  700.                        writeln;
  701.                      end;
  702.                   until (Ans = 2) or (Error = '');
  703.                   CharNum := MinChar;
  704.                   if Error = '' then
  705.                    begin
  706.                     repeat
  707.                      write('Enter first character # to be copied.  ');
  708.                      readln(c1);
  709.                      write('Enter last character # to be copied.  ');
  710.                      readln(c2);
  711.                      write('Enter first character # to which the characters will be copied.  ');
  712.                      readln(CharNum);
  713.                     until (c2 >= c1) and (CharNum in [MinChar..MaxChar]) and (c2 in [MinChar..MaxChar]);
  714.                     seek(copyfile,c1);
  715.                     CopyNum := c2-c1;
  716.                     while  (NOT EOF(CopyFile)) and (CharNum <= MaxChar) and (CopyNum >= 0) do
  717.                       begin
  718.                        read(copyfile, font[CharNum]);
  719.                        CharNum := CharNum + 1;
  720.                        CopyNum := CopyNum - 1;
  721.                       end;
  722.                    end
  723.                   else
  724.                     begin
  725.                       writeln;
  726.                       writeln('No characters read from file!');
  727.                       beep(1);
  728.                       delay(2000);
  729.                     end;
  730.                   CloseFile(CopyFile, Error);
  731.                   if Error <> '' then
  732.                     begin
  733.                       writeln('Close file error:');
  734.                       writeln(Error);
  735.                       beep(1);
  736.                       delay(2000);
  737.                     end;
  738.                   Remove(1);
  739.                   CharNum := c1;
  740.                   DisplayChar;
  741.                 end;
  742.         'B'  :  begin               {F8 =  Clear current font}
  743.                   Remove(1);
  744.                   Add_Window(20,5,60,10,14,6,1);
  745.                   writeln('         CLEAR Current Font');
  746.                   write('Are you sure?  ');
  747.                   Answer('yes,no',Ans,false);
  748.                   if ans = 1 then
  749.                     FillChar(font,sizeof(font),0);
  750.                   Remove(1);
  751.                   DisplayChar;
  752.                 end;
  753.         'C'  :  begin                               {Fn9 = Print Font}
  754.                   Add_Window(20,20,78,24,19,1,2);
  755.                   {$I-}
  756.                   repeat
  757.                     writeln(Lst,Reset);                              {reset printer}
  758.                     IOCheck(IOErr,Error);
  759.                     If Error <> '' then
  760.                      begin
  761.                        writeln(Error);
  762.                        write('Try printer again? (Y/N)  ');
  763.                        Answer('yes,no',Ans,false);
  764.                        writeln;
  765.                      end;
  766.                   until (Ans = 2) or (Error = '');
  767.                   if Error = '' then
  768.                    begin
  769.                     writeln('       Sending font to printer,');
  770.                     writeln('          Please stand by  . . .');
  771.                     write(Lst,LoadRam,chr(MinChar),chr(MaxChar));    {send character}
  772.                     for CharNum := MinChar to MaxChar do
  773.                       for ColNum := 0 to MaxCol do write(Lst,chr(font[CharNum,ColNum]));  {to printer RAM}
  774.                     write(Lst,Print0on,Print128on); {Enable printing of 0-31 and 128-159}
  775.                     write(Lst,RAMon);  {selects RAM as source of character set}
  776.                     for CharNum := MinChar to MaxChar do
  777.                       begin
  778.                         if frac(CharNum/16) = 0 then writeln(Lst,RAMoff,'  ',CharNum-1,RAMon); {print 16 char / line}
  779.                         if CharNum in [7..15, 17..20, 24, 27, 127, 137, 255] then
  780.                           write(Lst,RAMoff,' ',RAMon)  {print space instead of control code}
  781.                         else
  782.                           write(Lst, chr(CharNum));    {print character from RAM}
  783.                       end;
  784.                     writeln(Lst,Reset);  {Reset printer codes}
  785.                    end;
  786.                   Remove(1);
  787.                 end;
  788.         'D'  :  begin                               {Fn10=Quit program}
  789.                   Remove(1);
  790.                   Add_Window(20,5,60,10,14,1,4);
  791.                   writeln('              EXIT');
  792.                   writeln('Are you sure? ');
  793.                   write('Have you saved your Font? (Y/N)  ');
  794.                   Answer('yes,no',Ans,false);
  795.                   writeln;
  796.                   if ans = 1 then
  797.                    Exit := true;
  798.                   Remove(1);
  799.                   DisplayChar;
  800.                 end;
  801.       end; {case}
  802.     end;
  803.   until Exit;
  804. End; {MainMenu}
  805.  
  806. BEGIN
  807.   ClrScr;
  808.   Initialize;
  809.   Extension[1] := '.';
  810.   Extension[2] := 'F';
  811.   Extension[3] := 'N';
  812.   Extension[4] := 'T';
  813.   INT24On;            { interupt 24 error checking on at beginning. }
  814.   CharNum := MinChar;
  815.   TextColor(lightred);
  816.   gotoxy(33,8);
  817.   write('F O N T E D I T');
  818.   TextColor(lightgreen);
  819.   gotoxy(12,15);
  820.   write('A font editor for EPSON JX, FX and compatible printers.');
  821.   Textcolor(lightblue);
  822.   gotoxy(30,22);
  823.   write('by Claire A. Rinehart');
  824.   Textcolor(cyan);
  825.   gotoxy(34,24);
  826.   write('Version 1.00');
  827.   delay(5000);
  828.   ClrScr;
  829.   MainMenu;
  830.   Remove(2);
  831.   INT24Off;      { interupt 24 error checking off before exiting. }
  832.   Clrscr;
  833. END.
  834.