(* SHOWFONT.PAS -- show 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 ShowFont;

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

CONST
 NameColor = LightGray;
 BoxColor  = Red;
 CharColor = White;

VAR
 wait_key: BOOLEAN;
 x0, y0: INTEGER;
 height: BYTE;

PROCEDURE usage;
BEGIN
 WriteLn('SHOWFONT  Version 0.3',country,'  Show GEOS fonts');
 WriteLn('Copyright (c) 1995,1996 Jochen Metzinger ');
 WriteLn;
 WriteLn(short_usage);
 WriteLn;
 WriteLn('  filename    GEOS font file');
 WriteLn('    /N          don''t wait for key');
 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: STRING;
BEGIN
 short_usage := 'SHOWFONT [/?] filename [options]';
 in_name := ''; wait_key := TRUE;
 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;
      'N':  wait_key := FALSE;
      '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
   FATAL('too many arguments');
 END; (* for *)
 IF in_name = '' THEN usage;
 cvt_open(in_name);
 short_usage := '';
 IF NOT is_font THEN FATAL('not a font');
 open_fonts;
 OpenGraphic(EGAcp);
END; (* init *)

PROCEDURE OutChar(ch: CHAR);
 VAR width, underline: WORD;
  x, y: INTEGER;
BEGIN
 IF select_char(ch, width, underline) THEN
  BEGIN
   IF x0+width > VGA_MAXX THEN BEGIN
    Inc(y0, height + 4);
    x0 := 0;
   END; (* if *)
   Rectangle(x0, y0, x0+width-1, y0+height-1);
   Line(x0, y0+underline, x0+width-1, y0+underline);
   FOR y := 0 TO height-1 DO
    FOR x := 0 TO width-1 DO
     IF get_dot(x, y) THEN
      PutPixel(x0+x, y0+y, CharColor);
   Inc(x0, width+2);
  END
 ELSE
  G_err_stop;
END; (* OutChar *)

PROCEDURE OutputFont;
 VAR ch: CHAR;
BEGIN
 SetColor(NameColor);
 OutTextXY(0,y0+8,font_id+' '+long2str(height,0));
 Inc(y0, 12);
 SetColor(BoxColor);
 x0 := 0;
 FOR ch := #32 TO #126 DO OutChar(ch);
 x0 := 0;
 Inc(y0, height + 10);
END; (* OutputFont *)

BEGIN
 Init;
 y0 := 0;
 height := 0;
 WHILE open_font(height) DO BEGIN
  OutputFont;
  close_font;
  Inc(height);
 END; (* while *)
 G_err_stop;
 CloseGraphic(wait_key);
 close_fonts;
 cvt_close;
END. (* ShowFont *)