(* FONTNAME.PAS -- 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.
*)

UNIT fontname;

INTERFACE

USES global, coding;

PROCEDURE SetFontCoding(id: WORD);
(* set font ID coding *)

FUNCTION font_name: STRING;
(* return current font name *)

IMPLEMENTATION

CONST
 NR_FONTS = 35;
 default_font: ARRAY [CODE_TYPE] OF INTEGER = (1, NR_FONTS);

TYPE
 FontInfo = RECORD id: WORD; code: CODE_TYPE; name: STRING[16]; END;

CONST
 font: ARRAY [1..NR_FONTS] OF FontInfo =
  ((id: $000; code: uk_coding; name: 'BSW'),
   (id: $001; code: uk_coding; name: 'University'),
   (id: $002; code: uk_coding; name: 'California'),
   (id: $003; code: uk_coding; name: 'Roma'),
   (id: $004; code: uk_coding; name: 'Dwinelle'),
   (id: $005; code: uk_coding; name: 'Cory'),
   (id: $006; code: uk_coding; name: 'Tolman'),
   (id: $007; code: uk_coding; name: 'Bubble'),
   (id: $008; code: uk_coding; name: 'Fontknox'),
   (id: $009; code: uk_coding; name: 'Harmon'),
   (id: $00A; code: uk_coding; name: 'Mykonos'),
   (id: $00B; code: uk_coding; name: 'Boalt'),
   (id: $00C; code: uk_coding; name: 'Stadium'),
   (id: $00D; code: uk_coding; name: 'Tilden'),
   (id: $00E; code: uk_coding; name: 'Evans'),
   (id: $00F; code: uk_coding; name: 'Durant'),
   (id: $010; code: uk_coding; name: 'Telegraph'),
   (id: $011; code: uk_coding; name: 'Superb'),
   (id: $012; code: uk_coding; name: 'Bowditch'),
   (id: $013; code: uk_coding; name: 'Ormond'),
   (id: $014; code: uk_coding; name: 'Elmwood'),
   (id: $015; code: uk_coding; name: 'Hearst'),
   (id: $016; code: uk_coding; name: 'Brennens'),
   (id: $017; code: uk_coding; name: 'Channing'),
   (id: $018; code: uk_coding; name: 'Putnam'),
   (id: $019; code: uk_coding; name: 'LeConte'),
   (id: $038; code: ge_coding; name: 'University_GE'),
   (id: $039; code: ge_coding; name: 'California_GE'),
   (id: $040; code: ge_coding; name: 'Roma_GE'),
   (id: $041; code: ge_coding; name: 'Dwinelle_GE'),
   (id: $042; code: ge_coding; name: 'Cory_GE'),
   (id: $058; code: ge_coding; name: 'LW_Roma_GE'),
   (id: $059; code: ge_coding; name: 'LW_Cal_GE'),
   (id: $05B; code: ge_coding; name: 'LW_Barrows_GE'),
   (id: $080; code: ge_coding; name: 'BSW_GE'));

VAR
 index: INTEGER;

PROCEDURE SetFontCoding(id: WORD);
 VAR i: INTEGER;
BEGIN
 FOR i := 1 TO NR_FONTS DO
  IF font[i].id = id THEN BEGIN
   index := i;
   SetCoding(font[i].code);
   EXIT;
  END; (* if *)
 index := -id;
 SetCoding(default_code);
END; (* SetFontCoding *)

FUNCTION font_name: STRING;
BEGIN
 IF (0 < index) AND (index <= NR_FONTS) THEN
   font_name := font[index].name
 ELSE
   font_name := '#'+long2str(-index,0)+'#';
END; (* font_name *)

BEGIN
 index := default_font[default_code];
END. (* fontname *)