Programmer 7500/MAX_PROGRAMMERS.iso/PROGRAMS/UTILS/LASER/FONTLD.ZIP/WT2SPL.PAS

Pascal/Delphi Source File | 1990-06-29 | 11.7 KB | 327 lines

program wt2spl; { FontLoader Width Table to Sprint programing language. }

type
    font_descriptor = record
         orientation  : byte;
         symbol_set   : word;
         spacing      : boolean;
         pitch,
         height       : word;
         style        : byte;
         weight       : shortint;
         typeface,
         font_type    : byte;
         baseline,
         cell_width,
         cell_height,
         xheight      : word;
         font_name    : array [0..15] of char;
         end;

    char_descriptor = record
         defined      : boolean;
         deltax       : integer;
         char_width,
         char_height  : word;
         left_offset,
         top_offset   : integer;
         end;
{
  Pitch, height, xheight, and deltax are all in quarter dots.  Divide by
  four to obtain the value in dots.
}

var font_des      : font_descriptor;
    chars         : array [0..255] of char_descriptor;
    font_name,
    esc_code,
    esc_code_cond,
    in_line,
    out_line,
    tmp_line      : string;
    tmp_str0,
    tmp_str1,
    tmp_str2,
    tmp_str3,
    tmp_str4,
    tmp_str5      : string[10];


    in_file       : text;
    out_file      : text;
    in_file_name,
    out_file_name : string;

    error,
    val_err,
    i, j, k,
    in_line_no,
    out_line_no   : word;

    comma         : char;

const
    in_io_error   =  4;
    out_io_error  =  8;
    ch_start_no   = 19;

procedure Display_Title;
    begin
    writeln;
    writeln('Width Table to Sprint SPL.');
    writeln;
    end;
procedure Display_End(var s, s1 : string);
    begin
    writeln(s, ' successfully translated to: ',s1);
    end;
procedure Display_Help;
    begin
    writeln('Format:  WT2SPL.EXE  InFile.WID  [OutFile]');
    writeln;
    writeln('Where File.WID is a width file created by FontLoader.');
    writeln('If OutFile is not specified,  ".SPL" is appended to InFile.');
    writeln;
    end;

procedure Handle_Error(error : word; str : string);
    begin
    case error of
         1 : begin
             display_help;
             writeln('ERROR=>  Need a file name to process!');
             halt(error);
             end;
         2 : begin
             Display_Help;
             writeln('ERROR=>  Unable to open file:  ',str);
             halt(error);
             end;
         4 : writeln('ERROR=>  Error reading input file:  ',str);
         8 : writeln('ERROR=>  Error writing output file:  ',str);
         end;
     end;

procedure Trim_Ext(var s : string); { Trims the extension off a file name. }
    var i, j : word;
    begin
    i := 0; { Get last '.' }
    for j := 1 to length(s) do
        begin
        if s[j] = '.' then i := j
        else if s[j] = '\' then i := 0;
        end;
    if i <> 0 then delete(s,i,4);
    end;

function Typeface(typeface_num : byte) : string;
    begin
    case typeface_num of
         0 : typeface := 'LinePtr';
         1 : typeface := 'Pica';
         2 : typeface := 'Elite';
         3 : typeface := 'Courier';
         4 : typeface := 'Helv';
         5 : typeface := 'TmsRmn';
         6 : typeface := 'LtrGothic';
         7 : typeface := 'Script';
         8 : typeface := 'Prestige';
         9 : typeface := 'Caslon';
        10 : typeface := 'Orator';
        11 : typeface := 'Presentation';
        12 : typeface := 'HelvCond';
        14 : typeface := 'Futura';
        15 : typeface := 'Palatino';
        16 : typeface := 'Souvenir';
        17 : typeface := 'Optima';
        18 : typeface := 'Garamond';
        19 : typeface := 'CooperBlk';
        20 : typeface := 'CoronetBld';
        21 : typeface := 'Broadway';
        22 : typeface := 'Bauer';
        23 : typeface := 'Century';
        24 : typeface := 'UnivRoman';
        25 : typeface := 'AvantGarde';
        27 : typeface := 'Korinna';
        28 : typeface := 'BitCharter';
        29 : typeface := 'CloisterBlk';
        30 : typeface := 'Galliard';
        else typeface := 'Unknown';
        end;
    end;

Begin
    Display_Title;
    if ParamCount > 0 then in_file_name  := ParamStr(1)
    else Handle_Error(1,'');
    if ParamCount > 1 then out_file_name := ParamStr(2)
    else
        begin
        out_file_name := in_file_name;
        Trim_Ext(out_file_name);
        if length(out_file_name) < 252 then
           out_file_name := out_file_name + '.SPL';
        end;

    assign(in_file, in_file_name);
    {$I-}reset(in_file);{$I+}
    if IOResult <> 0 then Handle_Error(2, in_file_name)
    else
        begin
        assign(out_file, out_file_name);
        {$I-}rewrite(out_file);{$I+}
        if IOResult <> 0 then Handle_Error(2, out_file_name)
        else
            begin
            error := 0;
            in_line_no  := 1;
            out_line_no := 1;
            While (not(EOF(in_file))) and (error = 0)
                  and (in_line_no < ch_start_no) do
                begin
                {$I-}Readln(in_file, in_line);{$I+}
                val_err := 0;
                if IOResult <> 0 then error := in_io_error
                else case in_line_no of
                    1 :  font_name := in_line;
                    2 :  Val(in_line,font_des.orientation,val_err);
                    3 :  Val(in_line,font_des.symbol_set,val_err);
                    4 :  if in_line = '0' then font_des.spacing := false
                         else if in_line = '1' then font_des.spacing := true
                         else error := in_io_error;
                    5 :  Val(in_line,font_des.pitch,val_err);
                    6 :  Val(in_line,font_des.height,val_err);
                    7 :  Val(in_line,font_des.style,val_err);
                    8 :  Val(in_line,font_des.weight,val_err);
                    9 :  Val(in_line,font_des.typeface,val_err);
                    10 : Val(in_line,font_des.font_type,val_err);
                    11 : Val(in_line,font_des.baseline,val_err);
                    12 : Val(in_line,font_des.cell_width,val_err);
                    13 : Val(in_line,font_des.cell_height,val_err);
                    14 : Val(in_line,font_des.xheight,val_err);
                    15 : if length(in_line) < 17 then font_name := in_line
                         else error := in_io_error;
                    16 : esc_code := in_line;
                    17 : esc_code_cond := in_line;
                    end;
                if val_err <> 0 then error := in_io_error;
                inc(in_line_no);
                end; { while not eof }
            { Initialize chars array. }
            for i := 0 to 255 do chars[i].defined := false;
            { Read characters that are defined into the array. }
            While (not(EOF(in_file))) and (error = 0) do
                begin
                {$I-}Readln(in_file, tmp_str0,
                     tmp_str1, tmp_str2, tmp_str3, tmp_str4, tmp_str5);{$I+}
                Val(tmp_str0, j, i); { j is the character number. }
                if i <> 0 then error := in_io_error
                else
                with chars[j] do
                    begin
                    defined := true;
                    Val(tmp_str1, deltax, i);
                    if i <> 0 then error := in_io_error;
                    Val(tmp_str2, char_width,  i);
                    if i <> 0 then error := in_io_error;
                    Val(tmp_str3, char_height, i);
                    if i <> 0 then error := in_io_error;
                    Val(tmp_str4, left_offset, i);
                    if i <> 0 then error := in_io_error;
                    Val(tmp_str5, top_offset,  i);
                    if i <> 0 then error := in_io_error;
                    end;
                end;

{
  To create width tables for other programs,  I recommend modifying the
  following section.
}

            if error = 0 then  { Write Sprint SPL file. }
               begin
               {$I-}
               writeln(out_file,';; This file is to be inserted into HP.SPL.');
               writeln(out_file);
               { Write font definition with escape code. }
               Str(((72 / 300) * (font_des.height / 4)):1:0, tmp_str0);
               tmp_line := typeface(font_des.typeface) + tmp_str0;
               write(out_file, 'font ',tmp_line, ',');
               if font_des.spacing  then
                   write(out_file, 'size ',font_des.cell_height)
               else
                   write(out_file, 'width ', (font_des.pitch div 4));
               write(out_file, ',on');
               delete(esc_code_cond,1,5); { Remove orientation esc code. }
               for i := 1 to length(esc_code_cond) do { Write esc code. }
                   begin
                   if esc_code_cond[i] = #27 then
                        write(out_file, '^[')
                   else write(out_file, esc_code_cond[i]);
                   end;
               writeln(out_file, ',pst ',tmp_line);

               { Write the Sprint width table.                      }
               { Sprint's uses two tables in a multi-column format. }
               { I suggest making an example to look at by running  }
               { WT2SPL.EXE.                                        }
               writeln(out_file, 'pst ', tmp_line, ',');
               comma := ',';
               for i := 32 to 47 do
                   begin
                   for j := 0 to 5 do
                       begin
                       k := i + (j * 16); { k is character number. }
                       if k = ord(' ') then
                          write(out_file, 'SP ')
                       else if k in
                           [ord('\'),ord('^'),ord('~')] then
                          write(out_file, '\', char(k), ' ')
                       else if k <> 127 then
                       write(out_file, char(k), ' ');
                       if k <> 127 then
                         begin
                         if chars[k].defined then
                              write(out_file, (chars[k].deltax div 4), ',',#9)
                         else write(out_file, (font_des.pitch  div 4), ',',#9);
                         end;
                       end;
                   writeln(out_file);
                   end;
               writeln(out_file);
               for i := (32 + 128) to (47 + 128) do
                   begin
                   for j := 0 to 5 do
                       begin
                       k := i + (j * 16); { k is character number. }
                       if k = (ord(' ') + 128) then
                          write(out_file, '~SP ')
                       else if (k - 128) in
                           [ord('\'),ord('^')] then
                          write(out_file, '~\', char(k - 128), ' ')
                       else if k <> 255 then
                         write(out_file, '~', char(k - 128), ' ');
                       if k = (ord('o') + 128) then
                           comma := ' ' else comma := ',';
                       if k <> 255 then
                         begin
                         if chars[k].defined then
                            write(out_file, (chars[k].deltax div 4), comma,#9)
                         else
                            write(out_file, (font_des.pitch  div 4), comma,#9);
                         end;
                       end;
                   writeln(out_file);
                   end;
               {$I+}
               end;
{
  End of section to modify.
}

            if error = 0 then Display_End(in_file_name, out_file_name);
            {$I-}close(out_file);{$I+}
            end; { open out_file }
        {$I-}close(in_file);{$I+}
        end; {open in_file }
End.