(* CVT2FNT.PAS -- dump GEOS fonts
** Copyright (c) 1995,1996 Jochen Metzinger
**
** This program is free software; you can redistribute it and/or modify
** it under the terms of the GNU General Public License as published by
** the Free Software Foundation; either version 2, or (at your option)
** any later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software
** Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

PROGRAM cvt2fnt;

USES global, errors, geos, coding, fonts, cvt;

CONST
 MAX_LINE = 80;

VAR
 out_file: TEXT;
 height: BYTE;
 x0: WORD;
 lines: ARRAY [0..125] OF STRING;

PROCEDURE usage;
BEGIN
 WriteLn('CVT2FNT  Version 0.3',country,'  Convert GEOS font files');
 WriteLn('Copyright (c) 1995,1996 Jochen Metzinger ');
 WriteLn;
 WriteLn(short_usage);
 WriteLn;
 WriteLn('  filename  GEOS file');
 WriteLn('  output    output file');
 WriteLn('    /F        create output file');
 Write('    /G        german');
 IF default_code = ge_coding THEN Write(' [default]');
 WriteLn;
 Write('    /E        english');
 IF default_code = uk_coding THEN Write(' [default]');
 WriteLn;
 HALT(1);
END; (* usage *)

PROCEDURE Init;
 VAR i, j: WORD; par: STRING;
  in_name, out_name: STRING;
  force_file: BOOLEAN;
BEGIN
 short_usage := 'CVT2FNT [/?] filename [output] [options]';
 in_name := ''; out_name := '';
 force_file := FALSE;
 IF ParamCount = 0 THEN
  usage;
 FOR i := 1 TO ParamCount DO BEGIN
  par := ParamStr(i);
  IF (par[1] = '/') OR (par[1] = '-') THEN
   BEGIN
    IF Length(par) = 1 THEN
     FATAL('unknown option '+par);
    FOR j := 2 TO Length(par) DO
     CASE UpCase(par[j]) OF
      '?', 'H': usage;
      'F': force_file := TRUE;
      'G': SetCoding(ge_coding);
      'E': SetCoding(uk_coding);
      ELSE FATAL('unknown option '+par);
     END; (* case *)
   END
  ELSE IF in_name = '' THEN
   in_name := AddExt(par, CVT_EXT)
  ELSE IF out_name = '' THEN
   out_name := AddExt(par, '.FNT')
  ELSE
   FATAL('too many arguments');
 END; (* for *)
 IF in_name = '' THEN usage;
 IF force_file THEN BEGIN
  IF out_name <> '' THEN FATAL('too many arguments');
  out_name := GetFileName(in_name) + '.FNT';
 END; (* if *)
 cvt_open(in_name);
 IF NOT is_font THEN FATAL('not a font');
 open_fonts;
 FOR i := 0 TO 125 DO lines[i] := '';
 x0 := 0;
 (*$I-*)
 Assign(out_file, out_name);
 ReWrite(out_file);
 IF IOResult <> 0 THEN
  FATAL('unable to open output');
 (*$I+*)
 short_usage := '';
END; (* init *)

PROCEDURE PrintLines;
 VAR i: INTEGER;
BEGIN
 FOR i := 0 TO height-1 DO BEGIN
  WriteLn(out_file, lines[i]);
  lines[i] := '';
 END; (* for *)
 WriteLn(out_file);
 x0 := 0;
END; (* PrintLines *)

CONST
 background: ARRAY [0..3] OF CHAR = ('ù', '-', '|', '+');

PROCEDURE OutChar(ch: CHAR);
 VAR wd, underline, x, y: WORD; i0, i: BYTE;
BEGIN
 IF NOT select_char(ch, wd, underline) THEN
  EXIT;
 IF x0 + wd + 1 >= MAX_LINE THEN
  PrintLines;
 FOR y := 0 TO height-1 DO BEGIN
  i0 := ORD((y = 0) OR (y = underline) OR (y = height-1));
  FOR x := 0 TO wd-1 DO
   IF get_dot(x,y) THEN
    lines[y] := lines[y] + '²'
   ELSE BEGIN
    i := i0 OR ORD((x = 0) OR (x = wd-1)) SHL 1;
    lines[y] := lines[y] + background[i];
   END; (* else *)
  lines[y] := lines[y] + ' ';
 END; (* for *)
 Inc(x0, wd+1);
END; (* OutChar *)

PROCEDURE OutputFont;
 VAR ch: CHAR;
BEGIN
 WriteLn(out_file, '#');
 WriteLn(out_file, '# ', font_id, '  ', height, ':', get_underline);
 WriteLn(out_file, '#');
 WriteLn(out_file);
 FOR ch := #32 TO #126 DO OutChar(ch);
 PrintLines;
 WriteLn(out_file);
END; (* OutputFont *)

BEGIN
 Init;
 height := 0;
 WHILE open_font(height) DO BEGIN
  OutputFont;
  close_font;
  Inc(height);
 END; (* while *)
 err_stop;
 close_fonts;
 cvt_close;
 Close(out_file);
END. (* cvt2fnt *)