home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / programs / list / msigns12.ark / GMAKEFNT.SRC < prev    next >
Text File  |  1986-12-24  |  4KB  |  116 lines
  1. PROGRAM GMakeFnt;
  2.  
  3. {******************************************************************************
  4. **
  5. **  Author: Robert W. Bloom
  6. **
  7. **  Function:  This program reads input from the file 'CHARS.ASC' and creates
  8. **             a file 'CHARS.DAT.'  CHARS.DAT is used by the program 'SIGNS'
  9. **             to create signs or banners.  See Signs.DOC for more info.
  10. **             This is a generic Pascal version for Pascal MT+.
  11. **
  12. *****************************************************************************}
  13.  
  14. CONST
  15.           Date = '30 Apr 86';      {date of last revision of this prog}
  16.      Input_DFN = 'Chars.ASC';      {default input file}
  17.     Output_DFN = 'GChars.DAT';      {default output file}
  18.      Max_Width = 10;               {these must be no greater then input file}
  19.     Max_Height = 12;               {and match CONSTs in signs.pas!}
  20.  
  21. TYPE
  22.     CHAR_RECORD = RECORD           {record type used for random access}
  23.         character : CHAR;
  24.             width : INTEGER;
  25.            height : INTEGER;
  26.               pic : ARRAY[1..Max_Height,1..Max_Width] OF CHAR
  27.     END; {record}
  28.     IN_FILE_TYPE = TEXT;
  29.     OUT_FILE_TYPE = FILE OF CHAR_RECORD;
  30.  
  31. LABEL   1;                            {for error recovery}
  32.  
  33. VAR           c : CHAR;
  34.     ans,ifn,ofn : STRING[14];
  35.        input_fn : IN_FILE_TYPE;
  36.       output_fn : OUT_FILE_TYPE;
  37.       trans_chr : CHAR_RECORD;
  38.      i,j,result : INTEGER;
  39. BEGIN
  40.     WRITELN('<<< program -- MakeFont, ',Date,' -- started >>>');
  41.     WRITELN;
  42.  
  43. 1:  WRITE('Enter filename of input file, <cr> for the default ''Chars.ASC'' -->');
  44.     READLN(ans);
  45.     IF ans = '' THEN
  46.        ifn := Input_DFN
  47.     ELSE
  48.        ifn := ans;
  49.  
  50.     WRITE('Enter filename of output file, <cr> for the default ''GChars.DAT'' -->');
  51.     READLN(ans);
  52.     IF ans = '' THEN
  53.        ofn := Output_DFN
  54.     ELSE
  55.        ofn := ans;
  56.  
  57.     ASSIGN(input_fn,ifn);
  58.     RESET(input_fn);
  59.     IF IORESULT = 255 THEN BEGIN
  60.         WRITELN('No input file found!');
  61.         GOTO 1
  62.     END;
  63.  
  64.     ASSIGN(output_fn,ofn);
  65.     REWRITE(output_fn);
  66.     IF IORESULT = 255 THEN BEGIN
  67.         WRITELN('failed trying to open output file - enter a different name!');
  68.         GOTO 1
  69.     END;
  70.  
  71.     WRITELN;
  72.     WRITE('Date of font file --> ');
  73.     FOR i := 1 TO 10 DO BEGIN
  74.         READ(input_fn,c);
  75.         WRITE(c);
  76.     END; {output date of file}
  77.     READLN(input_fn);  {skip rest of line}
  78.     WRITELN;
  79.  
  80.     WRITE('defining characters --> ');
  81.     WHILE NOT EOF(input_fn) DO
  82.         WITH trans_chr DO BEGIN
  83.  
  84.             FOR i := 1 TO Max_Height DO
  85.                 FOR j := 1 TO Max_Width DO
  86.                     pic[i,j] := ' ';              {fill with all spaces}
  87.             READLN(input_fn,character,width,height);
  88.  
  89.             FOR i := 1 TO height DO BEGIN
  90.                 FOR j := 1 TO width DO
  91.                     READ(input_fn,pic[i,j]);
  92.                 READLN(input_fn)
  93.             END;
  94.  
  95.             WRITE(output_fn,trans_chr);         {write out record to file}
  96.             WRITE(character);                   {echo char just processed}
  97.  
  98. (*          WRITELN;                            {echo of char picture}
  99.             FOR i := 1 TO Max_Height DO BEGIN   {commented out for less 'noise'}
  100.                 FOR j := 1 TO Max_Width DO      {during processing}
  101.                     WRITE(pic[i,j]);
  102.                 WRITELN
  103.             END;                                 *)
  104.  
  105.         END; {with trans_chr}
  106.     {END while}
  107.     WRITELN;
  108.  
  109.     CLOSE(input_fn,result);
  110.     CLOSE(output_fn,result);
  111.     WRITELN;
  112.     WRITELN('<<< program -- MakeFont -- completed >>>')
  113. END.
  114. (input_fn,result);
  115.     CLOSE(output_fn,result);
  116.     WRI